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

sooda [26.06.2004 14:40:14]

Joko käänteisvärittää näytön osaa tai piirtää satunnaisväripixeleitä, hieanolla efektillä. Ei voi selittää, kokeile niin näet miten toimii. Filuja: http://sooda.dy.fi/foo/roska/ (havainnollistava kuva mukana)

Lisää formille labelit TarkkuusInfo, StarttiInfo ja EndiInfo, commandbuttonit Tee ja SäädäNe, HScrollBar Tarkkuus, kaksi optionbuttonia Miten (taulukkoon), sekä checkbox Toista.

Lisätty 27. 6. toi bonusjuttu jonka aioinkin eka tunkea vinkiksi mutta sitten se unohtui ja tein ton ekan :D

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

Bonusjuttu joka unohtui, settaa/gettaa _näytöltä_ mistä tahansa kohtaa pixelin:

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

BlueByte [27.06.2004 05:19:29]

Jännästi vie tehoja.

JoreSoft [27.06.2004 10:06:56]

Ohjelmasta puutui muuttuja määrittelyjä:

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

JoreSoft [27.06.2004 10:07:38]

Ohjelmasta puutui muuttuja määrittelyjä:

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

JoreSoft [27.06.2004 10:14:32]

En näköjään saanut edellistä muokattua...
Sain koneen jumiin tolla ohjelmalla, kun laitoin toisen ohjelman avoimeksi samaan aikaan.

water flea [27.06.2004 12:28:11]

Mitä järkee täs on?
Miksi tehdä noin ruma efekti noin vaikeasti?

sooda [27.06.2004 12:52:33]

Joresoft: siitä mitään puutu. Noi joita en ole määritellyt ei tartte määritellä :) ja tein aluksi ton näytöltämistätahansakohtaapixeli-jutun mutta innostuin sitte tekemään ton toisen jutun ja tärkein unohtui.

nomic [01.07.2004 09:33:35]

water flea, no kun kerran tiedät helpomman tavan ja selvästi tiedät myös mikä on hieno efekti ja mikä on ruma niin etköhän pistä meille esimerkkikoodia, ja jos se ei sisällä treijaamista sekä antialisingia niin täyttä p*skaa, minä pidän tästä koodista, viehän se tehoja juu mutta sain enemmän irti siitä että kuinka piirretään formin ulkopuolelle :) tähän voisin kokeilla yhdistää blittausta ja saadaan ukko randomina häiriköimään broidin konetta, vielä koko höskä startuppiin ;)
ei kyllä paras soodan esimerkki mutta omasta mielestäni paljon hyödyllisempi kuin moni muu täällä oleva pätkä :)

Latska [01.07.2004 23:23:22]

Tyylikäs efekti... Pitäsköhän minukin opetella jotain grafiikkajuttuja mieluummin, kuin säätää jotain sävelpeliä...

miiro [07.07.2004 15:18:00]

aika tyylikästä...jää vaan hirveet sotkut mutta keksin siihen näytönpuhdistimen: Väläys mustaa ruutua tjsp.

moptim [07.09.2006 19:33:19]

ton randomin vois tehä näin:

v = vbWhite * Rnd

EDIT: Latskalle suosittelen GRAFIIKKAA!!! Enkä mitään

KÄMÄSTÄ

sävelpeliä.

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu