Slagalica

Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Conn        As New ADODB.Connection
Dim i           As Long
Dim slova(11)   As String
Dim rec         As String
Dim proteklo    As Long
Dim korisceno   As String
Dim lastLen     As Long
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 32 And Shift = 0 Then Call lblStartStop_Click
End Sub
Private Sub Form_Load()
    Conn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & "slagalica.mdb" & ";Persist Security Info=False")
    Randomize
    Me.Show
    DoEvents
    Call lblNova_Click
End Sub

Private Sub lblIzlaz_Click()
    Unload Me
End Sub
Private Sub lblNova_Click()
    Dim rs      As New ADODB.Recordset
    Dim n       As Long
    Dim duzina  As Long
    Dim tmp     As String
    Dim ascii   As Long

    lblStartStop.Caption = "Start": Timor.Enabled = False
    lblStartStop.Enabled = False

    txtInput.Text = "": txtNajduza.Text = ""
    txtInput.Enabled = False

    duzina = getRandom(8, 12) 'biramo duzinu "najduze" reci
    'UVEK, ali UVEK ovako otvarajte Recordset (poz za Shadowed-a ;P)
    Call rs.Open("SELECT DISTINCT Reci FROM " & CStr(duzina), Conn, adOpenKeyset)
    'naravno ako nameravate da koristite .RecordCount property
    rs.Move getRandom(0, rs.RecordCount - 1)
    rec = rs.Fields(0).Value 'ovo je nasa "najduza rec"
    tmp = UCase$(rec)

    Do While Not Len(tmp) = 12
        ascii = getRandom(65, 90)
        Do While Not (ascii <> Asc("W") And ascii <> Asc("X") And ascii <> Asc("Q"))
            ascii = getRandom(65, 90)
        Loop
        tmp = tmp & Chr$(ascii)
    Loop

    For n = 0 To 11
        lblSlovo(n).Caption = ""
        slova(n) = Mid$(tmp, n + 1, 1)
    Next

    shuffleArray slova 'mesamo array (vidi poslednju f-ju)
    picSlova.SetFocus 'uklanjamo fokus sa textbox-a

    picProgres.Width = 0
    proteklo = 0
    lblPoeni.Caption = "0"
    korisceno = ":"

    lblStartStop.Enabled = True

End Sub

Private Sub lblStartStop_Click()
    If Not lblStartStop.Enabled Then Exit Sub
    If lblStartStop.Caption = "Start" Then
        i = 0
        Timor.Enabled = True
        lblStartStop.Caption = "Stop"
        lblStartStop.Enabled = True
    Else
        lblSlovo(i).Caption = slova(i)
        i = i + 1
        If i = 12 Then
            txtInput.Enabled = True
            lblStartStop.Enabled = False
            lblStartStop.Caption = "Start"
            Timor.Enabled = False
            Vreme.Enabled = True
            txtInput.SetFocus
        End If
    End If
End Sub
Private Sub Timor_Timer()
    Dim ascii As Long

    ascii = getRandom(65, 90)
    Do While Not (ascii <> Asc("W") And ascii <> Asc("X") And ascii <> Asc("Q"))
        ascii = getRandom(65, 90)
    Loop

    lblSlovo(i).Caption = Chr$(ascii)
    DoEvents
End Sub
Private Sub Vreme_Timer()
    proteklo = proteklo + 1
    picProgres.Width = (proteklo / 60) * picVreme.ScaleWidth
    If proteklo = 60 Then 'vreme je isteklo
        'ovde bi trebalo da se uradi neka forma (kao InputBox) u koju
        'korisnik mora da upise rec (kao ono: "Vreme je isteklo, koja je vasa rec?"
        txtNajduza.Text = rec
        setInfo "Vreme je isteklo."
        proteklo = 0
        Vreme.Enabled = False
        txtInput.Enabled = False
    End If
    DoEvents
End Sub
Private Sub txtInput_KeyPress(KeyAscii As Integer)
    Dim n       As Long
    Dim ima     As Boolean
    Dim r       As String
    Dim rs      As New Recordset

    'pretvaramo mala slova u velika (samo uppercase dozovljeno)
    If KeyAscii > 96 And KeyAscii < 123 Then KeyAscii = KeyAscii - 32
    If KeyAscii < 65 Or KeyAscii > 90 Then 'nije slovo
        'ako je BackSpace ili Delete onda ne radimo nista (dopustamo ta dva key-a)
        If KeyAscii = vbKeyBack Or KeyAscii = vbKeyDelete Then Exit Sub
        If KeyAscii = vbKeyReturn Then 'korisnik je pritisnuo enter
            'zaustavljamo vreme i proveravamo unetu rec
            Vreme.Enabled = False
            r = txtInput.Text

            If Len(r) < 2 Then
                setInfo "Takva rec ne postoji."
                lblPoeni.Caption = "0"
                GoTo proc_exit 'zasto je GoTo "losa praksa"???
            End If

            Set rs = Conn.Execute("SELECT DISTINCT Reci FROM " & CStr(Len(r)))

            ima = False
            Do While Not rs.EOF
                If UCase$(rs.Fields(0).Value) = r Then
                    ima = True 'nasli smo rec
                    Exit Do
                End If
                rs.MoveNext
            Loop

            If ima Then
                'poeni: svako slovo nosi 10 poena - proteklo vreme (0-60)
                lblPoeni = 10 * Len(r) - Round(((picProgres.Width / picVreme.ScaleWidth) * 60))
                setInfo "Prihvatamo vasu rec."
            Else
                lblPoeni.Caption = "0"
                setInfo "Takva rec ne postoji."
            End If

            picProgres.Width = 0

proc_exit:
            txtNajduza.Text = UCase$(rec)
        End If
        KeyAscii = 0
    Else 'ne dozvoljavamo slova koja nisu ponudjena i koja su vec iskoriscena
        Dim k As Long
        k = 0
tryAgain:
        ima = False
        For n = k To 11
            If KeyAscii = Asc(slova(n)) Then
                ima = True 'ovo slovo je ponudjeno, sada da vidimo
                If InStr(1, korisceno, ":" & n & ":") > 0 Then 'da nije korisceno
                    k = n + 1
                    GoTo tryAgain
                Else
                   korisceno = korisceno & n & ":" 'pamtimo ovaj index
                End If
                Exit For
            End If
        Next
        If Not ima Then KeyAscii = 0 'ovo slovo nije ponudjeno il je vec korisceno
    End If
End Sub
Private Sub txtInput_Change()
'koristim Change event jer igrac moze i sa 'Cut' (iz menija) da promeni sadrzaj
'textbox-a, nemora da koristi backspace ili delete (mada ne znam ko ovo radi
'ali nikad nisi siguran - ima svakavih ljudi ;P)
    Dim n   As Long
    Dim k   As Long
    Dim l   As Long
    Dim tmp As String

    If Len(txtInput.Text) < lastLen Then 'ako je smanjena duzina
        korisceno = ":"
        For n = 1 To Len(txtInput.Text)
            tmp = Mid$(txtInput.Text, n, 1)
            l = 0
findNext:
            For k = l To 11
                If tmp = slova(k) Then
                    If InStr(1, korisceno, ":" & k & ":") > 0 Then
                        l = k + 1
                        GoTo findNext
                    Else
                        korisceno = korisceno & k & ":"
                        Exit For
                    End If
                End If
            Next
        Next
    Else
        lastLen = Len(txtInput.Text)
    End If

End Sub
Private Sub infoTimer_Timer()
    infoTimer.Enabled = False
    lblInfo.Caption = ""
End Sub
Sub setInfo(inf As String)
    lblInfo.Caption = inf
    infoTimer.Enabled = True
End Sub
Function getRandom(min As Long, max As Long) As Long
    getRandom = CLng(Int((max - min + 1) * Rnd + min))
End Function
Sub shuffleArray(inArray() As String)
'"mesanje" sadrzaja jednog array-a
'imam jedno pitanje: kako da deklarisem ulazni parametar (inArray) tako da je
'moguce koristiti ovu f-ju za bilo koji tip array-a? ako ga deklarisem:
'inArray() As Variant, onda i array koji hocu da izmesan mora biti Variant???
    Dim n       As Long
    Dim k       As Long
    Dim tmp     As Variant

    For n = LBound(inArray) To UBound(inArray)
        k = getRandom(LBound(inArray), UBound(inArray))
        tmp = inArray(n) 'prvo pamtimo n clan array-a
        inArray(n) = inArray(k) 'potom ga zamenjujemom sa k clanom array-a
        inArray(k) = tmp 'i zamenjujemo k clan sa n clanom (k se bira random)
    Next

End Sub