Bentuk form sesuai dengan gambar

Unknown | 08:31 | vb6
Bosan dengan tampilan form yang berbentuk persegi? Ingin mengubahnya dengan bentuk lain yang lebih dinamis? ikuti langkah-lagkah berikut !

Ubah BorderStyle form menjadi 0-None, tempatkan sebuah PictureBox, namai dengan “picMainSkin”. Tambahkan sebuah Module, ketik kode di bawah:

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetPixel Lib "gdi32" _
(ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long) As Long

Declare Function CreateRectRgn Lib "gdi32" _
(ByVal x1 As Long, _
ByVal y1 As Long, _
ByVal x2 As Long, _
ByVal y2 As Long) As Long

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 _
ReleaseCapture Lib "user32" () As Long

Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long

Declare Function CreateRoundRectRgn Lib "gdi32" _
(ByVal x1 As Long, _
ByVal y1 As Long, _
ByVal x2 As Long, _
ByVal y2 As Long, _
ByVal X3 As Long, _
ByVal Y3 As Long) As Long

Public StartX!
Public StartY!

Public Function BentukDaerah(picSkin As PictureBox) As Long
    Dim X As Long, Y As Long
    Dim AwalGaris As Long
    Dim DaerahPenuh As Long
    Dim GarisDaerah As Long
    Dim GarisDalam As Boolean
    Dim AwalDaerah As Boolean
    Dim hDC As Long
    Dim Lebar As Long
    Dim Tinggi As Long

    hDC = picSkin.hDC
    Lebar = picSkin.Width / Screen.TwipsPerPixelX
    Tinggi = picSkin.Height / Screen.TwipsPerPixelY

    AwalDaerah = True: GarisDalam = False

    X = AwalGaris = 0
    Y = 200

    For Y = 0 To Tinggi - 1
        For X = 0 To Lebar - 1
            If GetPixel(hDC, X, Y) = vbWhite Or X = Lebar Then
                If GarisDalam Then
                    GarisDalam = False
                    GarisDaerah = CreateRectRgn(AwalGaris, Y, X, Y + 1)
                    If AwalDaerah Then
                        DaerahPenuh = GarisDaerah
                        AwalDaerah = False
                    Else
                        CombineRgn DaerahPenuh, DaerahPenuh, GarisDaerah, 2
                        DeleteObject GarisDaerah
                    End If
                End If
            Else
                If Not GarisDalam Then
                    GarisDalam = True
                    AwalGaris = X
                End If
            End If
        Next
    Next

    BentukDaerah = DaerahPenuh
End Function

Public Sub PindahDonk(ctl As Object, Button As Integer, _
X As Single, Y As Single)
    If Button = 1 Then
        ctl.Left = IIf(X < StartX, ctl.Left - (StartX - X), _
        ctl.Left + (X - StartX))
        ctl.Top = IIf(Y < StartY, _
        ctl.Top - (StartY - Y), ctl.Top + (Y - StartY))
    End If
End Sub

Ketikkan source code di bawah ini pada form:

Option Explicit

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim WindowRegion As Long
    '
    With Me.picMainSkin
        .ScaleMode = 3

        .Move 0, 0
        .DrawWidth = 10

        .FillStyle = 0
        .FillColor = vbRed
        Me.picMainSkin.Circle (105, 105), 90, vbYellow

        .FillColor = vbBlue
        Me.picMainSkin.Circle (400, 105), 40, vbYellow

        .FillStyle = 1
        .ForeColor = vbYellow
        Me.picMainSkin.Line (105, 10)-(400, 60.5)
        Me.picMainSkin.Line (105, 200)-(400, 150)

        Width = .Width
        Height = .Height
    End With

    WindowRegion = BentukDaerah(Me.picMainSkin)
    SetWindowRgn Me.hwnd, WindowRegion, True

End Sub

Private Sub picMainSkin_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        StartX = X
        StartY = Y
    End If
End Sub

Private Sub picMainSkin_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
    PindahDonk Me, Button, X, Y
End Sub

jalankan program dan lihat hasilnya...
jangan lupa dikembangkan