Keskustelu: Koodit: VB6: Ittelles elämä

'tänks to ohjelmointiputkan väki josta nappasin pari sorsaa tähän.
'muutama kiva api joilla vähän kiusataan käyttäjää
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_BYCOMMAND = &H0&
Private Const SC_CLOSE = &HF060&
'ja sitten kursori formille -apua.
Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetCaretPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'globaalimuuttujat joiden pitää säilyä
Private tekstit(), teksti, mesta, abc, eks, yy

Private Sub Form_GotFocus()

   CreateCaret hwnd, 0, 1, 12 'caretti :D, eli vilkkuva kursori, formille
   ShowCaret hwnd             '...
   SetCaretPos eks, yy        '...

End Sub

Private Sub Form_Load()

    Randomize 'alustetaan mukasatunnaislukugeneraattori
    'aakkoset jotka tarvii skrollauksessa, tähän voi lisätä myös
    'muita merkkejä, ne skrollaa vasemmalta oikealle
    abc = "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö"
    ':D vaan 67 tekstiä. Voit vaihtaa tekstit ihan vapaasti... näissä kun ei
    'ole kovin paljon järkeä :P
    tekstit = Array("Elämä on laiffii.", _
    "No siis hei.", "Elämä on julmaa.", "Om mane anas hum.", "Mä olen ruma.", _
    "Sä olet ruma.", "Tää on hyvä ohjelma.", "Hanki elämä.", "Koodaa ittelles elämä.", _
    "Tilaa elämä loppuvuodeksi, itsellesi tai lahjaksi.", "Kipikapi kauppaan siitä ostamaan elämää!", _
    "Itselläni on kova meno päällä.", "Siis säälittävä jätkä", "Se hilluu täällä avaruudessa ikäänkuin Star Trek.", "Luvut on mun vihollisia!", _
    "Omena plus banaani on yhtä kuin hedelmäsalaatti.", "Tollasia muuten oli siellä ylen verkossa ihan sikana.", _
    "Ne lähti pois.", "Uuussh!", "Aaarg", "Nyt tähän tuli pimeänäkö!", "Se ei tiiä mikä on bändi kaks kuus", _
    "Nyt mä keksin hyvän idean", "Akne sano mulle että sä oot pessyt tukkas!", "Et kampaa tukkaas", "Se jää tälläseks", "Ei millään pahalla", "Onks tää se nettipeli hä?", "Meidän koulun atk-setä on kiva setä!", _
    "Vähä se oli hyvä ku se piirs sen tota äh.", "Mun kaks metrisii piuhoi varsinki jos on pimee ni sit ne kietoutuu tietsikan jalkojen väliin (LÄPS)! Pimeeks.", _
    "Netistä se oli niiii rasittavaa", "Toi oli siis niin läppä lause", "Tääl o tällasii neljäsluokkalaisten kansioita joitten taustakuva on sun kansiosta kopioitu!", _
    "Sun kansiosta kokoajan!", "Mä teen pelin", "Teet sä pelin?", "Mäki teen pelin", "Oota mäki teen pelin", "Pelaat sä antti mun peliä sit ku se on valmis?", _
    "Oota itseasias, venaa", "Kantsii sitten silleen...", "Noni!", "Haluuks joku tulla mukaan?", "Ei venaa antti sori antti venaa", _
    "Mitä helkkarii nää tekee mun kansiossa?", "Säälittävää", "Eiku en", "ÖÖÖR", "Tos on kaks asetusta suurin piirtein", "Aa joo nyt mäki tajusin", "Oot sä nyt ihan varma", _
    "Anna ny mä testaan viel", "Lähes valmis", "Ei mut toi on ei kyl se viel laihempi saa olla", "Öööööö", "Tää on ihan jumissa", "Duumia ei voi ohjata hiirellä", _
    "Mä voin tulla lyömää sua, käyks se?", "Koo yks koo kaks kookolme on kokonaislukuja", "Array(Paramarray ArgList() As Variant)", "Ei nyt lopetetaan oikeesti mä en tajuu", "Miksei tää hiiri toimi", _
    "Mä en oo laittanut tota hiirtä tohon", "Ei tätä voi pelaa kaksinpelinä", "No okei se on kyl ihan surkeeta näppäimistöllä", "Se on namitskuukkelilauta", "Mitäh onks tos kartta??")
    'irroitetaan X-nappi käyttäjän ärsyttämiseksi
    RemoveMenu GetSystemMenu(hwnd, False), SC_CLOSE, MF_BYCOMMAND
    'keskelle näyttöä
    Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2, 15 * 320, 15 * 240
    'ja ihan aina päällimmäiseksi
    SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
    'ja tekstinkirjoitustimeri päälle
    ajastin.Interval = 100

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    Cancel = -1 'ei varmana suleuduta!

End Sub

Private Sub Form_Unload(Cancel As Integer)

    Cancel = -1 'eikä siis ihan tosi suleuduta :D

End Sub

Private Sub ajastin_Timer() 'päätapahtumien säätäjä

    mesta = mesta + 1 'mesta kertoo missä kohtaa mennään nykyisessä
                      'hassutekstissä (tekstit() taulukko)
    If mesta > Len(tekstit(teksti)) Then 'jos hassutekstin lopussa, arvotaan uus
        mesta = 1 'alkuun
        teksti = Int(UBound(tekstit) * Rnd + 1) 'arvotaan se teksti
        s = Timer: Do: DoEvents: Loop Until s + 2 < Timer 'kivan näkönen näin
        eks = eks + 8 'missä kohtaa ollaan formilla menossa
        If eks > ScaleWidth - 18 Then eks = 0: yy = yy + 12 'jos mennään reunan yli
    End If

    merkki = Mid(tekstit(teksti), mesta, 1) 'en jaksa hokea kokoajan tota mid(...
    SetCaretPos eks + 8, yy 'kursori kohdalleen
    If InStr(abc, merkki) Then 'jos pitää skrollata merkki, skrollataan se
        'kohdasta 30 alkaa pienet kirjaimet, skrollataan sen kokoiset kirjaimet
        'mitä oikea merkkikin on. jos lisäät vaikka abc:hen erikoismerkkejä
        'ja haluat että erikoismerkkiin skrollataan vain erikoismerkit niin
        'tarkistat että jos merkki on erikois niin possi=se kohta mistä
        'erikoismerkit alkavat abc:ssä
        If merkki = UCase(merkki) Then possi = 1 Else possi = 30
        For i = possi To InStr(abc, merkki) 'skrollataa joka merkki ennen oikeaa merkkiä
            Char = Mid(abc, i, 1) 'merkki oikeasta kohdasta
            Line (eks, yy)-(eks + 12, yy + 12), BackColor, BF 'vanha pois
            CurrentX = eks 'siirretään kursori oikeaan kohtaan
            CurrentY = yy '...
            Print Mid(abc, i, 1) 'ja ulostetaan uus merkki
            'odotetaan jonkun aikaa että silmätkin ehtii mukaan
            s = Timer: Do: DoEvents: Loop Until s + 0.01 < Timer
        Next
    Else 'jos merkkiä ei ole skrollilistassa niin ei skrollata sitä
        CurrentX = eks 'siirretää kursori oikeaan kohtaan formilla
        CurrentY = yy '...
        Print merkki 'ulostetaa merkki
    End If
    eks = eks + 8  'siirretään printtikohtaa oikealle
    If eks > ScaleWidth - 18 Then eks = 0: yy = yy + 12 'reunan yli
    If yy >= ScaleHeight Then Cls: eks = 0: yy = 0 'jos formi on täynnä

End Sub