Keskustelu: Koodit: VB6: Näytölle roskaa

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
'kun setataan pikseli, pitää tietää mihin se setataan
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'ikkunan x ja y koordien hakemiseen
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'set- ja getpixel käyttää DC:tä
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
'hiiren nappipainalluksen vakoiluun
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'hiiren kohdan vakoiluun
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

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

Private Teeks As Boolean 'sotataanko vai eikö sotata
Private xmax, ymax 'sotattavan neliön koko
Private x, y 'missä kohtaa ollaan menossa
Private starttix, starttiy 'tarkkuushommelia varten, tajuat kun selaat koodia
Private xstart, ystart 'x ja y coordit sotattavalle neliölle

Sub Duunaile() 'ite sottaussubi

    'kuka siellä
    hanska = WindowFromPoint(xstart + x, ystart + y)
    Dim rekti As RECT 'ikkunan x ja y:tä varten
    GetWindowRect hanska, rekti
    'lasketaan koordit mihin kohtaan _ikkunaa_ piirretään, x ja y ovat screenin koordit
    eks = xstart + x - rekti.Left
    yks = ystart + y - rekti.Top
    hoodeesee = GetWindowDC(hanska) 'get- ja setpixelille...
    If Miten(0) Then 'miten(0) on "käänteistä"
        v = vbWhite - GetPixel(hoodeesee, eks, yks)
    Else
        v = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
    End If
    SetPixel hoodeesee, eks, yks, v
    'siirretään x
    x = x + Tarkkuus
    If x > xmax Then 'jos mennään oikean reunan yli niin mennään vasempaan reunaan takasi ja siirretään y:tä
        x = starttix
        y = y + Tarkkuus
    End If
    If y > ymax Then
    'jos ollaan pohjassa niin mennään alkuun ja siirretään starttix:ää, aja ohjelma niin näet miten toimii jos et kelaa
        starttix = starttix + 1
        x = starttix
        y = starttiy
    End If
    If starttix = Tarkkuus Then 'lisää tarkkuus-pelleilyä
        starttix = 0
        starttiy = starttiy + 1
        x = 0
        y = starttiy
    End If
    If starttiy = Tarkkuus Then 'koko hoito piirretty?
        x = 0
        y = 0
        starttix = 0
        starttiy = 0
        If Toista = False Then 'jos ei toisteta niin ollaan lopussa
            Teeks = False
            Tee.Caption = "Aloita"
        End If
    End If

End Sub

Private Sub Form_Load()

    'defaulttiarvot
    Tarkkuus.Min = 1
    Tarkkuus.Max = 10
    Tarkkuus = 5
    TarkkuusInfo = "Tarkkuus: 5"
    xmax = 100
    ymax = 100
    Randomize 'randomsotkua varten
    Show 'esiin
    Do 'duunaile-systeemiä varten tarttee tällasen systeemin
        DoEvents
        If Teeks Then Duunaile
    Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)

    End 'do:sta pois

End Sub

Private Sub SäädäNe_Click()

    'säädetään startti- ja endiarvot
    MsgBox "Paina hiiren vasenta nappia sinne minne haluat startin.", vbInformation
    GetAsyncKeyState 1 'ettei ottaisi messaakiboxin painallusta
    Dim Possi As POINTAPI 'hiiren pos
    Do
        DoEvents
        GetCursorPos Possi
        If GetAsyncKeyState(1) And 1 Then Exit Do 'haetaan painallus
    Loop
    xstart = Possi.x
    ystart = Possi.y
    StarttiInfo = "StarttiPositio: (" & Possi.x & ", " & Possi.y & ")"
    MsgBox "Paina hiiren vasenta nappia sinne minne haluat endin.", vbInformation
    GetAsyncKeyState 1 'ettei ottaisi messaakiboxin painallusta
    Do
        DoEvents
        GetCursorPos Possi
        If GetAsyncKeyState(1) And 1 Then Exit Do 'haetaan painallus
    Loop
    'jos loppu on ennen alkua niin setataan ne oikein kun käyttäjä ei kerran osaa
    If Possi.x < xstart Then Swapi Possi.x, xstart
    If Possi.y < ystart Then Swapi Possi.y, ystart
    'lasketaan koko
    xmax = Possi.x - xstart
    ymax = Possi.y - ystart
    EndiInfo = "EndiPositio: (" & Possi.x & ", " & Possi.y & ")"
    MsgBox "Ookoo! Kiitti sikana!", vbInformation

End Sub

Sub Swapi(a, b) 'vaihtosysteemi

    a = a Xor b
    b = b Xor a
    a = a Xor b

End Sub

Private Sub Tarkkuus_Change()

    'kerrotaan mikä arvo on
    TarkkuusInfo = "Tarkkuus: " & Tarkkuus

End Sub

Private Sub Tarkkuus_Scroll()

    'kerrotaan mikä arvo on
    TarkkuusInfo = "Tarkkuus: " & Tarkkuus

End Sub

Private Sub Tee_Click()

    'vaihdetaan sotkustatea
    If Tee.Caption = "Aloita" Then
        Tee.Caption = "Lopeta"
        Teeks = True
    Else
        Tee.Caption = "Aloita"
        Teeks = False
    End If

End Sub

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
'kun setataan pikseli, pitää tietää mihin se setataan
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'ikkunan x ja y koordien hakemiseen
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'set- ja getpixel käyttää DC:tä
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public Sub Psettaa(x, y, v)

    'kuka siellä
    hanska = WindowFromPoint(xstart + x, ystart + y)
    Dim rekti As RECT 'ikkunan x ja y:tä varten
    GetWindowRect hanska, rekti
    'lasketaan koordit mihin kohtaan _ikkunaa_ piirretään, x ja y ovat screenin koordit
    hoodeesee = GetWindowDC(hanska)
    SetPixel hoodeesee, x - rekti.Left, y - rekti.Top, v

End Sub

Public Function Pgettaa(x, y)

    'kuka siellä
    hanska = WindowFromPoint(xstart + x, ystart + y)
    Dim rekti As RECT 'ikkunan x ja y:tä varten
    GetWindowRect hanska, rekti
    'lasketaan koordit mihin kohtaan _ikkunaa_ piirretään, x ja y ovat screenin koordit
    hoodeesee = GetWindowDC(hanska)
    Pgettaa = GetPixel(hoodeesee, x - rekti.Left, y - rekti.Top)

End Function