Tampilan Form Transparant Dengan Efect Warna Random



        1).  Pertama2  Buka VB 6.0 , Lalu create new form ->

kemudian tambahkan modul , dan di dalam code modul trsbt copy kan script di bwh ini.

 

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



          2).lalu close modul code

          3).tambahkan timer pada form dan intervalnya ubah menjadi "100"

          4).setelah timer tersedia , anda bisa Klick 2x pada area form

dan mencopykan script ini ke dalamnya.....

Dim i As Integer

Private Sub Form_Load()

Dim bool As Boolean
    i = 100
    GetWindowsVersion bool
    If Not bool Then
        MsgBox "Diperlukan Sistem Operasi Windows 2000 atau Lebih" & vbCrLf & "Program dibatalkan", , "Perhatian"
     
    End If
SetLayeredWindow Me.hWnd, True
    SetLayeredWindowAttributes Me.hWnd, 0, (255 * 100) / 100, LWA_ALPHA
    Form1.Caption = "Created By Ridhdevil"
Form1.WindowState = 2

End Sub

Private Sub Timer1_Timer()


Randomize
Form1.BackColor = RGB(Rnd * 300, Rnd * 300, Rnd * 300)
 i = i - 5
    SetLayeredWindow Me.hWnd, True
    SetLayeredWindowAttributes Me.hWnd, 0, (255 * i) / 100, LWA_ALPHA
    If i = 5 Then
        Unload Me
    End If
End Sub

Sudah selesai ... Silahkan Di Play / Jalankan ,,,atau Bisa Saja Langsung Di Jalankan,

Terimakasih Tas Pengunjungannya....... Matur Thank You.....

Created By: Ridhdevil@gmail.com      

care our unity