Cyberprotol Indonesia

Pusat informasi dunia cyber dan teknologi
Follow Me

Membuat form menjadi tembus pandang



By  Firman Arifin     4/30/2011 12:38:00 AM    Labels: 
Jika kalian ingin membuat form menjadi tembus pandang mungkin artikel berikut bisa sebagai referensi, dengan memanfaatkan fungsi API dari windows penulis akan mencoba membuat tampilan form menjadi terlihat transparan.
Berikut preview dari form yang sudah dijalankan

Nah ini untuk scriptnya codenya :
'script code untuk form-nya
Private Sub Form_Load()
Dim bool As Boolean
GetWindowsVersion 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

'script code untuk module-nya
Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Declare 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

Oke deeh silakan kalian mengembangkan tampilan form sesuai dengan ide kalian masing2, maaf kalo penulis terlalu simple memberikan contoh2 pembahasanya karena penulis juga masih amatiran...so kita sharing bareng disini...Oke? yang pasti tetap semangat!!!

About Firman Arifin

Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas euismod diam at commodo sagittis. Nam id molestie velit. Nunc id nisl tristique, dapibus tellus quis, dictum metus. Pellentesque id imperdiet est.

No comments:

Post a Comment

Silahkan masukkan komentar sobat, komentar sobat sangat berarti buat saya


Contact Form

Name

Email *

Message *

Labels

Translate