|
|
Const RDW_INVALIDATE = &H1
Const BS_HATCHED = 2
Const HS_CROSS = 4
Private Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) 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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetRectEmpty Lib "user32" (lpRect As RECT) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Check if this window is a window
If IsWindow(Me.hwnd) = 0 Then
MsgBox "Hmm.. I hope you altered the code, or else your system is meeting with difficulties!", vbInformation
End If
'API uses pixels
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Redraw this window (invoke a Paint-event)
RedrawWindow Me.hwnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE
End Sub
Private Sub Form_Paint()
Dim LB As LOGBRUSH, R As RECT, Rgn As Long, RgnRect As RECT, hBrush As Long
'randomize
Randomize Timer
LB.lbColor = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
LB.lbStyle = BS_HATCHED
LB.lbHatch = HS_CROSS
'Create a new brush
hBrush = CreateBrushIndirect(LB)
'Set the rectangle's values
SetRect R, 0, 0, 200, 200
'Create a rectangle region
Rgn = CreateRectRgn(100, 50, 300, 10)
'Get the region box
GetRgnBox Rgn, RgnRect
'calculate the intersection of two rectangles
IntersectRect R, RgnRect, R
'Empty the rectangle
SetRectEmpty RgnRect
'Fill our rectangle
FillRect Me.hdc, R, hBrush
'delete our brush
DeleteObject hBrush
'Check if the rectangle is empty
If IsRectEmpty(RgnRect) <> 0 Then SetRectEmpty RgnRect
End Sub
|
|
