Those real cool looking GUI's

[Sophtware]

I make my programs with the normal rectangular GUI..but is there a way to change the forms shape from rectangular to say...round? or trapizoid...or hell hehe even pentagon.?

Any ideas? or is this only possible wit c++



Thanks

[oetje]

Read this article from John: http://www.vb-world.net/articles/shapedforms/

[hitcgar]

I've used these techniques a lot in VB etc.

It's actually very easy.

The URL mentioned in the previous post is a good place to start though.

Here's some old code that works very well:


'==============
' in module
'==============
Option Explicit

Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public 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 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

'This the Main Code to make an image-shaped Form
'It just scans the Image passed to it and then removes all lines that
'correspond to the transparent color, creating a new virtual image, but without a
'the passed trans color

Public Function GetBitmapRegion(pic As StdPicture, lngTrans As Long)
'Variable Declaration
Dim hRgn As Long, tRgn As Long
Dim X As Integer, Y As Integer, X0 As Integer
Dim hDC As Long, Bmp As BITMAP
'Create a new memory DC, where we will scan the picture
hDC = CreateCompatibleDC(0)
If hDC Then
' select the Picture
SelectObject hDC, pic
'Get the Picture dimensions and create a new rectangular region
GetObject pic, Len(Bmp), Bmp
hRgn = CreateRectRgn(0, 0, Bmp.bmWidth, Bmp.bmHeight)
'Start scanning the picture from top to bottom
For Y = 0 To Bmp.bmHeight
For X = 0 To Bmp.bmWidth
'Scan a line of non transparent pixels
While X <= Bmp.bmWidth And GetPixel(hDC, X, Y) <> lngTrans
X = X + 1
Wend
'Mark the start of a line of transparent pixels
X0 = X
'Scan a line of transparent pixels
While X <= Bmp.bmWidth And GetPixel(hDC, X, Y) = lngTrans
X = X + 1
Wend
'Create a new Region that corresponds
'to the row of Transparent pixels and then
'remove it from the main Region
If X0 < X Then
tRgn = CreateRectRgn(X0, Y, X, Y + 1)
CombineRgn hRgn, hRgn, tRgn, 4
'Free the memory
DeleteObject tRgn
End If
Next X
Next Y
'Return the memory address to the shaped region
GetBitmapRegion = hRgn
'Free memory by deleting the Picture
DeleteObject SelectObject(hDC, pic)
End If
'Free memory by deleting the created DC
DeleteDC hDC
End Function

'=================
' in Form
'=================
Private Sub Form_Load()
' transparent color = White ( RGB(255,255,255) )
' assumes you have designated a picture for the form
' you can of course use a picturebox on the form or from
'a resource or disk file
hRgn = GetBitmapRegion(Me.Picture, vbWhite)
'Set the Form's new Region
SetWindowRgn Me.hwnd, hRgn, True

End Sub

' to move the form on mousedown since there's no vivsible caption
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Free the used memory by the Region and unload the shaped Form
If hRgn Then DeleteObject hRgn
Unload Me
End Sub



Have fun ;)

See This tip (http://www.vb-world.net/articles/shapedforms/).

[V(ery) Basic]

Meg, that's the same link.





:rolleyes: Post Racer.





Tut tut tut :mad:

[hitcgar]

hmm...here's code that actually works right. :rolleyes: Sorry about the mistakes in my first post. I didn't have VB on that machine and couldn't test it 1st.

Use the same API declarations as before. Here's the module code:


Public Function MakeRgn(picSkin As PictureBox) As Long

Dim X As Long, Y As Long, startLineX As Long
Dim fullRgn As Long, lineRgn As Long
Dim transColor As Long
Dim inFirstRgn As Boolean
Dim inLine As Boolean ' Flags whether we are in a non-tranparent pixel sequence
Dim hDC As Long
Dim picWidth As Long
Dim picHeight As Long

hDC = picSkin.hDC
picWidth = picSkin.ScaleWidth
picHeight = picSkin.ScaleHeight

inFirstRgn = True
inLine = False
X = Y = startLineX = 0

transColor = vbBlack ' this is the color that will be removed

For Y = 0 To picHeight - 1
For X = 0 To picWidth - 1

If GetPixel(hDC, X, Y) = transColor Or X = picWidth Then
' We reached a transparent pixel
If inLine Then
inLine = False
lineRgn = CreateRectRgn(startLineX, Y, X, Y + 1)

If inFirstRgn Then
fullRgn = lineRgn
inFirstRgn = False
Else
CombineRgn fullRgn, fullRgn, lineRgn, RGN_OR
' Always clean up your mess
DeleteObject lineRgn
End If ' inFirstRgn
End If ' inline
Else
' We reached a non-transparent pixel
If Not inLine Then
inLine = True
startLineX = X
End If
End If ' GetPixel...
Next
Next

MakeRgn = fullRgn
End Function

Here's the form code:¸
Option Explicit

Dim hRgn As Long

'=================
' in Form
'=================
Private Sub Form_Load()
pic1.ScaleMode = vbPixels
pic1.AutoRedraw = True
pic1.AutoSize = True
hRgn = MakeRgn(pic1)
SetWindowRgn Me.hWnd, hRgn, True
End Sub

' to move the form on mousedown since there's no vivsible caption
Private Sub pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub


try it you'll like it.

[parksie]

Do a search on http://www.google.com for "Alex Vallat Shaped Form Creator" and there should be a link there.