Keskustelu: Koodit: VB6: Hiirirutto, näytön sotkeva pilaohjelma

'ohjelma piirtää pixeleitä siihen ikkunaan missä hiiri on
'T: Solof


Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Dim cursorpos As POINTAPI
Dim winpos As RECT
Dim RR, GG, BB, Runni As Integer

Private Sub Command2_Click()
    Runni = 0 'kiellä ohjelman toiminta
End Sub

Private Sub Form_Load()
    Command1.Caption = "käynnistä"
    Command2.Caption = "lopeta"

    'VÄRIT:
    BB = 0 'sininen 0-255
    RR = 250 'punanen 0-255
    GG = 0 'vihre' 0-255
End Sub

Private Sub Command1_Click()
    Runni = 1 'aseta ohjelma käyntiin
    Randomize
    Do While Runni = 1 'jos ohjelma on käynissä

        Call GetCursorPos(cursorpos) 'hiiren sijainti
        Whwnd = WindowFromPoint(cursorpos.x, cursorpos.y) 'ikkunan hwnd hiiren sijainnista
        Whdc = GetWindowDC(Whwnd) 'hdc hwnd:stä
        GetWindowRect Whwnd, winpos 'ikkunan sijoitus

        X1 = Int(Rnd * (winpos.Right - winpos.Left)) 'arvotaan jokin kohta ikkunana X akselissa
        Y1 = Int(Rnd * (winpos.Bottom - winpos.Top)) 'arvotaan jokin kohta ikkunana Y akselissa

        Call SetPixel(Whdc, X1, Y1, RGB(RR, BB, GG)) 'asetetaan pixeli kohtaan X1,Y1
        DoEvents 'muut toiminnot
    Loop
End Sub