Efek Tetesan Hujan di Layar Monitor dengan VB
Halaman 1 dari 1
Efek Tetesan Hujan di Layar Monitor dengan VB
buat 1 form dan tambhkan timer
timer setting : enable dan interval 2
trus masukin coding nya
Code:
Selamat Mencoba
timer setting : enable dan interval 2
trus masukin coding nya
Code:
- Spoiler:
- Option Explicit
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Dim x As Integer, y As Integer
Dim Buffer As Long, hBitmap As Long, Desktop As Long, hScreen As Long, ScreenBuffer As Long
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
Unload Me
End If
End Sub
Private Sub Form_Load()
Desktop = GetWindowDC(GetDesktopWindow())
hBitmap = CreateCompatibleDC(Desktop)
hScreen = CreateCompatibleDC(Desktop)
Buffer = CreateCompatibleBitmap(Desktop, 32, 32)
ScreenBuffer = CreateCompatibleBitmap(Desktop, Screen.Width / 15, Screen.Height / 15)
SelectObject hBitmap, Buffer
SelectObject hScreen, ScreenBuffer
BitBlt hScreen, 0, 0, Screen.Width / 15, Screen.Height / 15, Desktop, 0, 0, SRCCOPY
End Sub
Private Sub Form_Unload(Cancel As Integer)
BitBlt Desktop, 0, 0, Screen.Width / 15, Screen.Height / 15, hScreen, 0, 0, SRCCOPY
End Sub
Private Sub timer1_Timer()
y = (Screen.Height / 15) * Rnd
x = (Screen.Width / 15) * Rnd
BitBlt hBitmap, 0, 0, 32, 32, Desktop, x, y, SRCCOPY
BitBlt Desktop, x + (3 - 6 * Rnd), y + (2 - 4 * Rnd), 32, 32, hBitmap, 0, 0, SRCCOPY
End Sub
Selamat Mencoba
Similar topics
» Buat Efek Suara Unik Dengan AV Voice Changer Diamond 6
» Menambah RAM dengan FlashDisk
» Membuat Media Player dengan Delphi
» Membuat Kalkulator dengan Visual Basic 6.0
» Mengamankan Akun Facebook Dengan Mengaktifkan HTTPS [HTTP + SSL/TLS + TCP] Topik sebelumnya
» Menambah RAM dengan FlashDisk
» Membuat Media Player dengan Delphi
» Membuat Kalkulator dengan Visual Basic 6.0
» Mengamankan Akun Facebook Dengan Mengaktifkan HTTPS [HTTP + SSL/TLS + TCP] Topik sebelumnya
Halaman 1 dari 1
Permissions in this forum:
Anda tidak dapat menjawab topik