Fly the Flag

The clock applet that comes with Microsoft Plus! has an interesting feature: Its window is round instead of rectangular. Surprisingly, giving your form an odd shape is easy. Add this code to a new form to give your window the shape of the Microsoft Windows logo:

 Private Type RECT	Left As Long	Top As Long	Right As Long	Bottom As LongEnd TypePrivate Declare Function BeginPath Lib "gdi32" _	(ByVal hdc As Long) As LongPrivate 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 LongPrivate Declare Function EndPath Lib "gdi32" _	(ByVal hdc As Long) As LongPrivate Declare Function PathToRegion Lib "gdi32" _	(ByVal hdc As Long) As LongPrivate Declare Function GetRgnBox Lib "gdi32" _	(ByVal hRgn As Long, lpRect As RECT) As LongPrivate Declare Function CreateRectRgnIndirect Lib "gdi32" _	(lpRect As RECT) As LongPrivate Declare Function CombineRgn Lib "gdi32" _	(ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _	ByVal hSrcRgn2 As Long, _	ByVal nCombineMode As Long) As LongPrivate Const RGN_AND = 1Private Declare Function DeleteObject Lib "gdi32" _	(ByVal hObject As Long) As LongPrivate Declare Function SetWindowRgn Lib "user32" _	(ByVal hwnd As Long, ByVal hRgn As Long, _	ByVal bRedraw As Boolean) As LongPrivate Declare Function ReleaseCapture Lib "user32" _	() As LongPrivate Declare Function SendMessage Lib "user32" _	Alias "SendMessageA" (ByVal hwnd As Long, _	ByVal wMsg As Long, ByVal wParam As Long, _	lParam As Any) As LongPrivate Const WM_NCLBUTTONDOWN = &HA1Private Const HTCAPTION = 2Private Function GetTextRgn() As Long	Dim hRgn1 As Long, hRgn2 As Long	Dim rct As RECT	'Create a path for the window's shape	BeginPath hdc	TextOut hdc, 10, 10, Chr$(255), 1	EndPath hdc	'... Convert the path to a region...	hRgn1 = PathToRegion(hdc)	GetRgnBox hRgn1, rct	hRgn2 = CreateRectRgnIndirect(rct)	CombineRgn hRgn2, hRgn2, hRgn1, RGN_AND	'Return the region handle	DeleteObject hRgn1	GetTextRgn = hRgn2End FunctionPrivate Sub Form_DblClick()	'Need to be able to close the form	Unload MeEnd SubPrivate Sub Form_Load()	Dim hRgn As Long	Me.Font.Name = "Wingdings"	Me.Font.Size = 200	hRgn = GetTextRgn()	SetWindowRgn hwnd, hRgn, 1End SubPrivate Sub Form_MouseDown(Button As Integer, Shift _	As Integer, X As Single, Y As Single)	'Give us some way to move the form	ReleaseCapture	SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&End Sub

While this is a sort of novelty shape for a form, you can give a form any shape you want, provided you have a way to create the shape of the region. Look at the various region-related API calls to find methods of creating regions other than using font characters.

Share the Post:
Share on facebook
Share on twitter
Share on linkedin


Recent Articles: