|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Form Aspectro Diferente
|
 |
|
|
|
Postada em 13/3/2007 por Edinei
neisjb@hotmail.com
'Coloque o seguinte código no form:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 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 RGN_AND As Long = 1
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const HTCAPTION As Long = 2
Private Sub Form_Load()
Dim hRgn As Long
Me.Font.Name = "Wingdings"
Me.Font.Size = 200
hRgn = GetTextRgn()
SetWindowRgn hwnd, hRgn, 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, _
ByVal 0&
End Sub
Private Function GetTextRgn() As Long
Dim hRgn1 As Long, hRgn2 As Long
Dim rct As RECT
BeginPath hdc
TextOut hdc, 10, 10, Chr$(255), 1
EndPath hdc
hRgn1 = PathToRegion(hdc)
GetRgnBox hRgn1, rct
hRgn2 = CreateRectRgnIndirect(rct)
CombineRgn hRgn2, hRgn2, hRgn1, GN_AND
DeleteObject hRgn1
GetTextRgn = hRgn2
End Function
|
|
|
|
|
