Untuk mendesain sebuah program yang ada di VB biasanya kita menggunakan ukuran form standar dimana kita bisa meletakan control didalamnya.
Pada artikel kali ini saya membagikan trik bagaimana membuat sebuah form didalam form dengan menggunakan Ficture Box.Berikut adalah langkah-langkah pembuatannya:
1. Buka Form VB6 Anda dengan Standar EXE
2. Letakan didalam form 1 buah Picture Box, dengan Name "picMainSkin"
3. Tanamkan 1 buah CommandButton ditengah Picture Box
4. Atur Form1 dengan BordrStyle =0-None pada bagian Form Properties
5. Tambahkan 1 buah Module
6. Pada Module ketik kode dibawah ini :
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
7. Kembali ke Form Anda, kemudian doubel klok diarea form kosong, lalu ketik kode dibawah ini :
Option Explicit
Private Sub Command1_Click()
End
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
Else
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
No comments:
Post a Comment