Form
yang transaparan dengan background / gambar dibelakangnya terlihat
seperti gambar disamping ini, untuk membuat form transaparan dapat
dibuat dalam pemograman Visual Basic yang dapat menambah nilai art /
seni pada aplikasi yang telah dibuat.
Untuk pembuatannya membutuhkan sebuah
modul yang akan dipanggil / di execute pada form yang akan digunakan,
berikut langkah-langkahnya :
1. Siapkan modul dan isi dengan source code dibawah ini :
Option Explicit
Public Const LWA_COLORKEY = 1
Public Const LWA_ALPHA = 2
Public Const LWA_BOTH = 3
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = -20
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Sub SetTranslucent(ThehWnd As Long, color As Long, nTrans As Integer, flag As Byte)
On Error GoTo ErrorRtn
Dim attrib As Long
attrib = GetWindowLong(ThehWnd, GWL_EXSTYLE)
SetWindowLong ThehWnd, GWL_EXSTYLE, attrib Or WS_EX_LAYERED
SetLayeredWindowAttributes ThehWnd, color, nTrans, flag
Exit Sub
ErrorRtn:
MsgBox Err.Description & " Source : " & Err.Source
End Sub
2 Siapkan komponen yang akan digunakan pada form :
Nama Kontrol Properti Nilai
Form1 Caption Form Transparan
Name Form1
Image1 Picture Pilih Lokasi Gambar
NB: untuk penamaan atribut dapat diganti sesuai keinginan.
3. Masukan Source Code dibawah ini pada form yang telah dibuat :
Option Explicit
Dim MoveScreen As Boolean, color As Long, flag As Byte
Dim MousX, MousY, CurrX, CurrY As Integer
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Activate()
On Error GoTo ErrorRtn
color = RGB(0, 0, 255): flag = 0
flag = flag Or LWA_COLORKEY: Form1.Show
SetTranslucent Form1.hwnd, color, 0, flag
Exit Sub
ErrorRtn: MsgBox Err.Description & " Source : " & Err.Source
End Sub
Private Sub image1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
MoveScreen = True: MousX = x: MousY = Y
End Sub
Private Sub image1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If MoveScreen Then
CurrX = Me.Left - MousX + x: CurrY = Me.Top - MousY + Y
Me.Move CurrX, CurrY
End If
End Sub
Private Sub image1_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
MoveScreen = False
End Sub
4. Setelah itu coba Run, jika masih ada yang debug coba sesuaikan nama atribut yang ada pada form. Sekian, smoga bermanfaat...