Membuat Tampilan Form Transparan di VB 6

Tidak ada komentar
Berikut ini adalah sedikit tutorial untuk mempercantik tampilan form vb 6, Membuat Tampilan Form Transparan di VB 6
langkahnya:
1. Siapkan Sebuah Modul, Ketik coding berikut:
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 Form yang akan di transparan dan sebuah gambar berekstensi .gif 
3. Kemudian Ketik koding berikut di form1 yang akan ditransparankan:

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. Silahkan Jalankan form1 tadi.

ok :) selamat mencoba dan sukses. terimakasih telah mengunjungi aprivb.blogspot.com

Tidak ada komentar :

Posting Komentar