Source Code Membuat Efek Tampilan Project Form Menjadi Transparan (VB)


Copikan Source Code berikut pada Project Form

 

Private Sub Form_Load()

Dim bool As BooleanGetWindowsVersion bool

If Not bool Then

MsgBox “Diperlukan Sistem Operasi Windows 2000 atau Lebih” & vbCrLf & “Program dibatalkan”, , “Perhatian”

End

End If

SetLayeredWindow Me.hWnd, True

SetLayeredWindowAttributes Me.hWnd, 0, (255 * 70) / 100, LWA_ALPHA

End Sub
 
 

Selanjutnya buatlah sebuah module dan copikan listing program berikut di dalamnya;

 

Fuction Module :

Declare Function GetVersionEx Lib “kernel32.dll” Alias “GetVersionExA” (lpVersionInformation As OSVERSIONINFO) As LongDeclare Function GetWindowLong Lib “user32.dll” Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib “user32.dll” Alias “SetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function SetLayeredWindowAttributes Lib “user32.dll” (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Declare Function UpdateLayeredWindow Lib “user32.dll” (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long

Public Type POINTAPI

x As Long

y As Long

End Type

Public Type SIZE

cx As Long

cy As Long

End Type

Public Type BLENDFUNCTION

BlendOp As Byte

BlendFlags As Byte

SourceConstantAlpha As Byte

AlphaFormat As Byte

End Type

Public Const GWL_STYLE = (-16)

Public Const GWL_EXSTYLE = (-20)

Public Const WS_EX_LAYERED = &H80000

Public Const ULW_COLORKEY = &H1

Public Const ULW_ALPHA = &H2

Public Const ULW_OPAQUE = &H4

Public Const AC_SRC_OVER = &H0

Public Const AC_SRC_ALPHA = &H1

Public Const AC_SRC_NO_PREMULT_ALPHA = &H1

Public Const AC_SRC_NO_ALPHA = &H2

Public Const AC_DST_NO_PREMULT_ALPHA = &H10

Public Const AC_DST_NO_ALPHA = &H20

Public Const LWA_COLORKEY = &H1

Public Const LWA_ALPHA = &H2

Public Type OSVERSIONINFO

dwOSVersionInfoSize As Long

dwMajorVersion As Long

dwMinorVersion As Long

dwBuildNumber As Long

dwPlatformId As Long

szCSDVersion As String * 128

End Type

Public Const VER_PLATFORM_WIN32_WINDOWS = 1

Public Const VER_PLATFORM_WIN32_NT = 2

Public Function IsLayeredWindow(ByVal hWnd As Long) As Boolean

Dim WinInfo As Long

WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)

If (WinInfo And WS_EX_LAYERED) = WS_EX_LAYERED Then

IsLayeredWindow = True

Else

IsLayeredWindow = False

End If

End Function

Public Sub SetLayeredWindow(ByVal hWnd As Long, _

ByVal bIsLayered As Boolean)

Dim WinInfo As Long

WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)

If bIsLayered = True Then

WinInfo = WinInfo Or WS_EX_LAYERED

Else

WinInfo = WinInfo And Not WS_EX_LAYERED

End If

SetWindowLong hWnd, GWL_EXSTYLE, WinInfo

End Sub

‘ ambil deskripsi sistem operasi

Public Function GetWindowsVersion(ByRef IsWin2000 As Boolean) As String

Dim TheOS As OSVERSIONINFO

Dim strCSDVersion As String

TheOS.dwOSVersionInfoSize = Len(TheOS)

GetVersionEx TheOS

Select Case TheOS.dwPlatformId

Case VER_PLATFORM_WIN32_WINDOWS

If TheOS.dwMinorVersion >= 10 Then

GetWindowsVersion = “Windows 98 version: ”

Else

GetWindowsVersion = “Windows 95 version: ”

End If

Case VER_PLATFORM_WIN32_NT

GetWindowsVersion = “Windows NT version: ”

End Select

‘ uraikan informasi tambahan dari string dengan null char

If InStr(TheOS.szCSDVersion, Chr(0)) <> 0 Then

strCSDVersion = “: ” & Left(TheOS.szCSDVersion, InStr(TheOS.szCSDVersion, Chr(0)) – 1)

Else

strCSDVersion = “”

End If

GetWindowsVersion = GetWindowsVersion & TheOS.dwMajorVersion & “.” & _

TheOS.dwMinorVersion & ” (Build ” & TheOS.dwBuildNumber & strCSDVersion & “)”

‘ set dalam mode parameter ByRef

If TheOS.dwMajorVersion = 5 Then

IsWin2000 = True

Else

IsWin2000 = False

End If

End Function

 

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s