Keskustelu: Koodit: VB6: Hiirirutto2 - Kuvarutto

'Hiirirutto2
'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 pixeli(500, 500) As Long
Dim leveys, pituus As Long


Private Sub Command1_Click()
    If Timer1.Enabled = False Then
        leveys = Picture1.Width - 5 'laitetaan muistiin kuvan leveys
        pituus = Picture1.Height - 5 'laitetaan muistiin kuvan korkeus
        For pit = 1 To pituus
            For lev = 1 To leveys
                pixeli(lev, pit) = GetPixel(Picture1.hdc, lev, pit)
                'Muodostetaan kuvasta eräänlainen tietokanta/taulukko
            Next
        Next
        Timer1.Enabled = True
        Command1.Caption = "LOPETA"
        Exit Sub
    End If
    If Timer1.Enabled = True Then
        Command1.Caption = "KÄYNNISTÄ"
        Timer1.Enabled = False
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 100 'Kuinka nopeasti kuvia tulee
    Form1.ScaleMode = 3
    Picture1.ScaleMode = 3

    Command1.Caption = "KÄYNNISTÄ"
    Picture1.AutoSize = True
    Picture1.BackColor = RGB(220, 10, 100) 'Asetetaan picture1:n taustaväri (liila), Jotta tunnistettaisiin läpinäkyvä alue
    Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
    Call GetCursorPos(cursorpos) 'otetaan kursorin paikka muistiin
    Whwnd = WindowFromPoint(cursorpos.x, cursorpos.y) 'haetaan ikkunan sijoitus hiiren kordinaateista
    whdc = GetWindowDC(Whwnd) 'otetaan hwnd:tä Hdc
    GetWindowRect Whwnd, winpos 'Haetaan ikkunan mitat
    ARTP whdc 'piirretään kuva
End Sub



Sub ARTP(winid) 'Lisätään Kuva Näytölle
    X1 = Int(Rnd * (winpos.Right - winpos.Left - pituus)) 'Arvotaan X -Akselista kohta valitun ikkunan sisällä
    Y1 = Int(Rnd * (winpos.Bottom - winpos.Top - leveys)) 'Arvotaan Y -Akselista kohta valitun ikkunan sisällä

    For pit = 1 To pituus
        For lev = 1 To leveys
            If pixeli(lev, pit) <> 6556380 Then 'Jos väri on muu kuin liila
                SetPixel winid, lev + X1, pit + Y1, pixeli(lev, pit)
                'Ladataan tieto taulukosta ja piirretään pixeli kerralla
            End If
        Next
    Next
End Sub