Hiệu ứng khi Click vào Form homeXuất xứ : www.pscode.com Binh khí sử dụng : Không Đoạn mã : Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As
Trang 1Hiệu ứng khi Click vào Form home
Xuất xứ : www.pscode.com
Binh khí sử dụng : Không
Đoạn mã :
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long)
As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long)
As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1
As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Const NULL_BRUSH = 5
Private Selecting As Boolean
Private BorderDrawn As Boolean
Private Myhwnd As Long
Private Sub Command1_Click()
Draw
Trang 2Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If Selecting = False Then Exit Sub
Draw
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)
If Selecting = False Then Exit Sub
UnDraw
ReleaseCapture
Selecting = False
Myhwnd = 0
End Sub
Private Sub Draw()
Dim Cursor As POINTAPI
Dim RetVal As Long
Dim hdc As Long
Dim Pen As Long
Dim Brush As Long
Dim OldPen As Long
Dim OldBrush As Long
Dim OldROP As Long
Dim Region As Long
Dim OldRegion As Long
Dim FullWind As RECT
Dim Draw As RECT
GetCursorPos Cursor
RetVal = WindowFromPoint(Cursor.X, Cursor.Y)
If RetVal = Myhwnd Then Exit Sub
If BorderDrawn = True Then UnDraw
BorderDrawn = True
Myhwnd = RetVal
Me.Cls
Me.Print Hex(Myhwnd)
GetWindowRect Myhwnd, FullWind
Region = CreateRectRgn(0, 0, FullWind.Right - FullWind.Left,
FullWind.Bottom - FullWind.Top)
hdc = GetWindowDC(Myhwnd)
RetVal = GetClipRgn(hdc, OldRegion)
RetVal = SelectObject(hdc, Region)
Pen = CreatePen(DrawStyleConstants.vbSolid, 6, 0)
OldPen = SelectObject(hdc, Pen)
Brush = GetStockObject(NULL_BRUSH)
OldBrush = SelectObject(hdc, Brush)
OldROP = SetROP2(hdc, DrawModeConstants.vbInvert)
With Draw
.Left = 0
.Top = 0
.Bottom = FullWind.Bottom - FullWind.Top
.Right = FullWind.Right - FullWind.Left
Rectangle hdc, Left, Top, Right, Bottom
End With
Trang 3Private Sub UnDraw()
If BorderDrawn = False Then Exit Sub
BorderDrawn = False
If Myhwnd = 0 Then Exit Sub
Dim Cursor As POINTAPI
Dim RetVal As Long
Dim hdc As Long
Dim Pen As Long
Dim Brush As Long
Dim OldPen As Long
Dim OldBrush As Long
Dim OldROP As Long
Dim Region As Long
Dim OldRegion As Long
Dim FullWind As RECT
Dim Draw As RECT
GetWindowRect Myhwnd, FullWind
Region = CreateRectRgn(0, 0, FullWind.Right - FullWind.Left,
FullWind.Bottom - FullWind.Top)
hdc = GetWindowDC(Myhwnd)
RetVal = GetClipRgn(hdc, OldRegion)
RetVal = SelectObject(hdc, Region)
Pen = CreatePen(DrawStyleConstants.vbSolid, 6, 0) ' Draw Solid lines, width 6, and color black
OldPen = SelectObject(hdc, Pen)
Brush = GetStockObject(NULL_BRUSH)
OldBrush = SelectObject(hdc, Brush)
OldROP = SetROP2(hdc, DrawModeConstants.vbInvert) ' vbInvert means, whatever is draw,
With Draw
.Left = 0
.Top = 0
.Bottom = FullWind.Bottom - FullWind.Top
.Right = FullWind.Right - FullWind.Left
Rectangle hdc, Left, Top, Right, Bottom ' Really easy to understand - draw a rectangle, hDC, and coordinates
End With
SelectObject hdc, OldRegion
SetROP2 hdc, OldROP
SelectObject hdc, OldBrush
SelectObject hdc, OldPen
DeleteObject Brush
DeleteObject Pen
DeleteObject Region
ReleaseDC Myhwnd, hdc
End Sub