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!!!
oiya yang mo download source code disini
Tidak ada komentar:
Posting Komentar