Rectangle Any Color

'Rectangle Any Color


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()

Me.Caption = "Click for Change Color"

'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