[Last Call] Learn how to a build a cloud-first strategyRegister Now


How To Create Custom Shaped Windows with VB6

Posted on 2006-03-31
Medium Priority
Last Modified: 2008-02-01
I've seen many desktop application that have these fancy interfaces with animations/interactions on them.
I'd like to know if I want to create a form with any kind of shape (according to an irregular background picture), how can it be done? I've seen API calls to create windows with simple shapes such as circles, but I can't understand how to create a form with irregular shapes.
Also, how can I create customized controls, like buttons have a roundish look with special effect when mouse over, and customized control box buttons (minimize, restore and close).
Thank you very much!
Question by:guest321
LVL 97

Expert Comment

by:Lee W, MVP
ID: 16344899
I have know knowledge with this, but I SUSPECT you would create a form that is transparent and put a picture on it.

Other than that "maybe how it's done" comment, I'm here to see how too.
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 16345049
LVL 15

Accepted Solution

JackOfPH earned 1000 total points
ID: 16348771
'Module Code
Option Explicit

Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) 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
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_OR = 2
Public Const HTCAPTION = 2

Public Function MakeRegion(picSkin As PictureBox) As Long
    ' Make a windows "region" based on a given picture box'
    ' picture. This done by passing on the picture line-
    ' by-line and for each sequence of non-transparent
    ' pixels a region is created that is added to the
    ' complete region. I tried to optimize it so it's
    ' fairly fast, but some more optimizations can
    ' always be done - mainly storing the transparency
    ' data in advance, since what takes the most time is
    ' the GetPixel calls, not Create/CombineRgn
    Dim X As Long, Y As Long, StartLineX As Long
    Dim FullRegion As Long, LineRegion As Long
    Dim TransparentColor As Long
    Dim InFirstRegion 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
    InFirstRegion = True: InLine = False
    X = Y = StartLineX = 0
    ' The transparent color is always the color of the
    ' top-left pixel in the picture. If you wish to
    ' bypass this constraint, you can set the tansparent
    ' color to be a fixed color (such as pink), or
    ' user-configurable
    TransparentColor = GetPixel(hDC, 0, 0)
    For Y = 0 To PicHeight - 1
        For X = 0 To PicWidth - 1
            If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then
                ' We reached a transparent pixel
                If InLine Then
                    InLine = False
                    LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
                    If InFirstRegion Then
                        FullRegion = LineRegion
                        InFirstRegion = False
                        CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
                        ' Always clean up your mess
                        DeleteObject LineRegion
                    End If
                End If
                ' We reached a non-transparent pixel
                If Not InLine Then
                    InLine = True
                    StartLineX = X
                End If
            End If
    MakeRegion = FullRegion
End Function


'Form1, Borderstyle = none
'Picturebox = picMainSkin
'CommandButton = Command1

Option Explicit

Private Sub Command1_Click()
    MsgBox "This is a real working form!"
End Sub

Private Sub Form_Load()
    Dim WindowRegion As Long
    ' I set all these settings here so you won't forget
    ' them and have a non-working demo... Set them in
    ' design time
    picMainSkin.ScaleMode = vbPixels
    picMainSkin.AutoRedraw = True
    picMainSkin.AutoSize = True
    picMainSkin.BorderStyle = vbBSNone
    Me.BorderStyle = vbBSNone
    Set picMainSkin.Picture = LoadPicture(App.Path & "\main.bmp")
    Me.Width = picMainSkin.Width
    Me.Height = picMainSkin.Height
    WindowRegion = MakeRegion(picMainSkin)
    SetWindowRgn Me.hWnd, WindowRegion, True
End Sub

Private Sub picMainSkin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      ' Pass the handling of the mouse down message to
      ' the (non-existing really) form caption, so that
      ' the form itself will be dragged when the picture is dragged.
      ' If you have Win 98, Make sure that the "Show window
      ' contents while dragging" display setting is on for nice results.
      SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

End Sub

Author Comment

ID: 16621820
I apologise for not getting back earlier.

JackOfPH your example works great!
Here I'd like to add 2 lines of code:
   picMainSkin.Left = 0
   picMainSkin.Top = 0
just after
  Me.Width = picMainSkin.Width
  Me.Height = picMainSkin.Height
to move the picturebox to the form's upper left corner for background image to display correctly in its position.

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month17 days, 16 hours left to enroll

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question