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.

[V(ery) Basic]

Meg, that's the same link.





Post Racer.





Tut tut tut

[hitcgar]

hmm...here's code that actually works right. 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.