2017-2-28
15:41

root
root

[程序代码]学习API制作不规则窗体二

Option Explicit
'‘类型声明
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'‘API声明
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long

Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Const RGN_AND = 1
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

'窗体代码
Private Sub Form_Load()
    Dim hRgn1, hRgn2 As Long
    Dim rct As RECT
    With Me
      .Font.Name = "宋体"
      .Font.Size = 200
      .FontTransparent = True
      .BackColor = vbRed
   ' ‘读者可设置为False观察其效果
    End With
   BeginPath hdc
'‘为窗体形状产生路径
    TextOut hdc, 10, 10, "J", 2
    EndPath hdc
   hRgn1 = PathToRegion(hdc)
'‘将指定路径转换为区域
   GetRgnBox hRgn1, rct
'‘获取完全包含指定区域的最小矩形
    hRgn2 = CreateRectRgnIndirect(rct)
  '‘创建rct确定的矩形区域
    CombineRgn hRgn2, hRgn2, hRgn1, RGN_AND
    DeleteObject hRgn1
   '‘删除GDI对象,释放占用的系统资源
    SetWindowRgn hwnd, hRgn2, 1
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift _
    As Integer, X As Single, Y As Single)
    '‘移动窗体
    ReleaseCapture
    SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Private Sub Form_DblClick()
   ' ‘卸载窗体
    Unload Me
End Sub

文章如需转载请注明:转载自: 紫灵幽梦
« 上一篇 下一篇 »

相关文章:

vb读取access并且显示  (2017-5-11 9:18:27)

VB 获取CPU温度示例  (2017-5-8 10:35:11)

VB程序逆向反汇编常见的函数   (2017-5-8 10:32:0)

VB内嵌汇编的模块示例  (2017-5-8 10:24:4)

内存数据的读写(PC)   (2017-3-1 17:51:40)

用VB制作外挂   (2017-3-1 16:16:53)

发表留言: