Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: Visual Basic
Expertise: Advanced
May 4, 1999

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 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 Const RGN_AND = 1
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 WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private 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 = hRgn2
End Function

Private Sub Form_DblClick()
	'Need to be able to close the form
	Unload Me
End Sub

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)
	'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.
Ben Baird
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date