VB6:Tutorial membuat skin dari gambar

Wah dah lama nie gak post tentang VB6 , gk kerasa udah Tahun baru
Happy new year 2013 all.

sekarang kita akan belajar cara membuat skin dari gambar.

OK langsung aja ya gk perlu basa-basi lagi

Bahan:
Visual Basic 6
Gambar yang akan di buat skin

Langkah-langkah nya :

1. Siap kan gambarnya
[-] contoh saya menggunakan gambar naruto

2. buka visual basic 6 nya

3. Pilih Standard EXE

4. Buat Form Baru

[-] Ubah BorderStyle = 0-none
[-] Ubah ShowInTaskbar = True
[-] Buat satu Command_button, ubah caption = Exit
[-] isi kan code berikut, dengan cara klik kanan pada form pilih view code

CODE:

'==================codenya====================
Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()

    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Picture1.Left = 0
    Me.Picture1.Top = 0
    SkinForm Me.Picture1
   
'my blog : kukar-xp.id-fb.com
'contact me : fuad.bhakti21@gmail.com
End Sub

Private Sub Picture1_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

'==================codenya====================

5. buat sebuah PictureBox

[-] Ubah BackColor = Putih (sesuai dengan Backgound gambar anda, misal nya biru ganti dengan warna biru juga)
[-] Ubah BorderStyle =  0-none
[-] Ubah AutoRedraw = True
[-] di Picture = masuk kan gambar anda
[-] Ubah ScaleMode = 3-Pixel

6. Buat 1 Module
[-] isi kan code berikut

CODE:

'===================codenya====================
'move form
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd 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 Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

Sub SkinForm(ByRef ppicSkin As PictureBox)
    Dim objTools    As SkinningTools
    Set objTools = New SkinningTools
    objTools.SkinForm ppicSkin
    Set objTools = Nothing
End Sub
'===================codenya====================

7. setelah itu buat  1 Class Module
[-] Ubah name = SkinningTools
[-] isi kan code berikut

CODE:

'===================codenya====================
Option Explicit

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const RGN_OR As Long = 2

Public Sub SkinForm(ByRef Skin As Object)
Dim lngRegion   As Long
    If TypeOf Skin Is PictureBox Then
        lngRegion = MakeRegion(Skin)
        SetRegion Skin.Parent.hwnd, lngRegion
    Else
        Err.Raise 13
    End If
End Sub

Private Function SetRegion(ByVal plnghWnd As Long, ByVal plngWindowRegion As Long)
    SetWindowRgn plnghWnd, plngWindowRegion, True
End Function

Private Function MakeRegion(ByRef ppicSkin As PictureBox) As Long
Dim lngX                As Long
Dim lngY                As Long
Dim lngStartLineX       As Long
Dim lngFullRegion       As Long
Dim lngLineRegion       As Long
Dim lngTransparentColor As Long
Dim blnInFirstRegion    As Boolean
Dim blnInLine           As Boolean
Dim lnghDC              As Long
Dim lngWidth            As Long
Dim lngHeight           As Long
    lnghDC = ppicSkin.hDC
    lngWidth = ppicSkin.ScaleWidth
    lngHeight = ppicSkin.ScaleHeight
    blnInFirstRegion = True
    blnInLine = False
    lngX = 0
    lngY = 0
    lngStartLineX = 0
    lngTransparentColor = GetPixel(lnghDC, 0, 0)
    For lngY = 0 To lngHeight - 1
        For lngX = 0 To lngWidth - 1
            If (GetPixel(lnghDC, lngX, lngY) = lngTransparentColor) Or (lngX = lngWidth) Then
                If blnInLine Then
                    blnInLine = False
                    lngLineRegion = CreateRectRgn(lngStartLineX, lngY, lngX, lngY + 1)
                    If blnInFirstRegion Then
                        lngFullRegion = lngLineRegion
                        blnInFirstRegion = False
                    Else
                        CombineRgn lngFullRegion, lngFullRegion, lngLineRegion, RGN_OR
                        DeleteObject lngLineRegion
                    End If
                End If
            Else
                If Not blnInLine Then
                    blnInLine = True
                    lngStartLineX = lngX
                End If
            End If
        Next lngX
    Next lngY
    MakeRegion = lngFullRegion
End Function
'===================codenya====================

Sekarang Tekan F5

SourceCode : File Size 183 kb
-=-=-=-=-=-=-=-=-=-=-=-=SEMOGA BERHASIL-=-=-=-=-=-=-=-=-=-=-=-=-