Option Explicit 'API声明 Private Declare Function CreateEllipticRgn Lib "gdi32" _ (ByVal x1 As Long, ByVal Y1 As Long, _ ByVal x2 As Long, ByVal Y2 As Long) 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 Declare Function SetWindowRgn Lib "user32" _ (ByVal hWnd As Long, ByVal hRgn As Long, _ ByVal bRedraw As Boolean) As Long '常数声明 Const RGN_XOR = 3
Private Sub Form_Load() Dim x1, x2 x1 = CreateEllipticRgn(100, 100, 400, 400) x2 = CreateEllipticRgn(200, 100, 500, 400) CombineRgn x1, x1, x2, RGN_XOR SetWindowRgn hWnd, x1, 1 End Sub
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
---- 参数说明如下:
---- hdc :设备场景的句柄 ;
---- x,y :绘图的起点,采用逻辑坐标 ;
---- lpString:欲绘制的字串 ;
---- nCount:字串中要绘制的字符数量,一个汉字的字符数量为2 。
---- 例程2生成一个宋体的“国”字形的窗体:
---- '例程2
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 '读者可设置为False观察其效果 End With BeginPath hdc '为窗体形状产生路径 TextOut hdc, 10, 10, "国", 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