Attribute VB_Name = "modAsocijacije"
'|============================================|
'|===[ modAsocijacije.bas ]                   |
'|============================================|
'|Source Type: Module                         |
'|Written by: The TV Slagalica Team           |
'|URL: http://www.elitesecurity.org/forum/21  |
'|============================================|
'|Last update: 31.01.2005. by krckoorascic    |
'|============================================|

Public konacno                  As String 'resenje cele asocijacije
Public grupe(1 To 4)            As String 'resenja svih grupa

Public polje(1 To 4, 1 To 4)    As String
'objasnjenje za ovu deklaraciju iznad:
'u 'polje' array-u se nalazi svih 16 polja.
'array-e sa vise od jedne fiksirane vrednosti (ovo 'x To y') najbolje je da
'posmatrate kao tabelu (bar ja tako radim). Evo kako bi ovo 'izgledalo':
'polje:
'       1       2       3       4       (1 To 4)
'   ________________________________
'   |___A1__|___A2__|___A3__|___A4__|   1(A)
'   |___B1__|___B2__|___B3__|___B4__|   2(B)
'   |___C1__|___C2__|___C3__|___C4__|   3(C)
'   |___D1__|___D2__|___D3__|___D4__|   4(D)
'
'dakle samo zamislite da su ovo prvo 'od 1 do 4' zapravo redovi neke tabele a
'drugo 'od 1 do 4' kolone te iste tabele (ili obrnuto)
'ovo sam pisao jer mozda nekim pocetnicima ovo nije jasno (meni je trebalo
'dosta da provalim sta su to array-i; i jos uvek ne umem da izgovorim tu rec) ;)

Private r                       As Long
Dim DBConn As New ADODB.Connection  'Konekcija sa bazom
Dim MyRecSet As New ADODB.Recordset 'Ovde ce biti smestani rezultati upita u bazu
Public Sub startujAsocijacije()
    On Error Resume Next 'za svaki slucaj
    
    'otvaramo konekciju ka bazi (baza mora da se nalazi u istom folderu sa exe-om)
    DBConn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\slagalica.mdb" & ";Persist Security Info=False")
    
    'Selektujemo sve reci bez ponavljanja
    Set MyRecSet = DBConn.Execute("SELECT DISTINCT Word FROM Associates")
    
End Sub
Public Sub GenerisiAsocijaciju()
    'On Error Resume Next 'nikad se ne zna! ;)
    
    Dim rec()       As String 'array u koji cemo da smestimo reci iz baze
    Dim ubaceno     As String 'ovde ce se cuvati ubacene reci (da se ne bi ponavljale)
    Dim tmp         As String 'za privremeno cuvanje reci
    Dim i           As Long 'za For...Next petlje
    Dim k           As Long
    
    
    Do Until MyRecSet.EOF
        On Error Resume Next 'ako je array prazan i mi ga prolsedimo Ubound
        'funkciji VB ce prijaviti error
        k = UBound(rec) + 1
        'uvecavamo array za 1 (ReDim). Preserve koristimo da ne bi obrisali reci
        'koje smo predhodno dodali. (kad bi napisali samo 'ReDim Rec(k)' onda bi
        'u arrayu (kad izadje iz ove petlje) bila samo poslednja procitana rec)
        ReDim Preserve rec(k) As String
        rec(k) = MyRecSet.Fields(0).Value 'snimamo rec u array
        MyRecSet.MoveNext 'pomeramo se na sledeci red
    Loop
    
'    For k = LBound(rec) To UBound(rec)
'        Debug.Print "rec(" & k & ") = " & rec(k)
'    Next
'    Exit Sub

    r = getRandom(LBound(rec), UBound(rec)) 'random biramo rec
    konacno = rec(r) 'dobili smo konacno resenje! 8o)

    Debug.Print "konacno: " & konacno

    ubaceno = ":"
    For i = 1 To 4
        tmp = uzmiRec(konacno) 'uzimamo rec koja asocira na konacno resenje

        Do While Not (InStr(1, ubaceno, ":" & tmp & ":") < 1) And (Len(tmp) > 0)
            'kroz ovu petlju cemo prolaziti sve dok ne pronadjemo rec koja
            'jos nije ubacena (koja se ne nalazi u 'ubaceno' stringu)
            tmp = uzmiRec(konacno)
            'sigurno se pitate zasto koristim ":"? uzmimo npr. da
            'string 'ubaceno' izgleda ovako:
            'ubaceno = ":macka:garfild:"
            'ako ne bi imali tacke [:] i uporedjujemo rec 'mac' sa stringom
            'ubaceno (da bi videli da li je 'mac' ubacen) InStr bi nam vratio
            'vrednost vecu od 0 jer je pronasao 'mac' u reci 'macka'! Ali kad
            'imamo dve tacke oko svake reci ovo ne moz' da se desi!
            DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
            Debug.Print "kolona: " & tmp
        Loop
        
        ubaceno = ubaceno & tmp & ":" 'pamtimo ovu rec

        grupe(i) = tmp 'pamtimo resenje ove grupe
        'grupe(1) - resenje kolone (grupe) A
        'grupe(2) - resenje kolone (grupe) B
        'grupe(3) - resenje kolone (grupe) C
        'grupe(4) - resenje kolone (grupe) D
    Next
    
    'sada popunjavamo svih 16 polja (zapravo popunjavamo array polje() a
    'polja (Label kontrole) ce biti popunjene kasnije
    
    For i = 1 To 4 'za sve 4 kolone
    
        ubaceno = ":" 'resetujemo nas string za pamcenje
        
        For k = 1 To 4 'za svako polje u i koloni
        
            tmp = uzmiRec(grupe(i)) 'resenje grupe
            
            Do While Not (InStr(1, ubaceno, ":" & tmp & ":") < 1) And (Len(tmp) > 0)
                'necemo duplikate!!!
                tmp = uzmiRec(grupe(i))
                DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
                Debug.Print "polje: " & tmp
            Loop
            
            ubaceno = ubaceno & tmp & ":" 'pamtimo ovu rec
            
            polje(i, k) = tmp 'pamtimo 'vrednost' ovog polja
            
        Next
        
    Next
    
    'sada imamo konacno resenje, resenja svih kolona i vrednosti svih polja!
    
    
    
End Sub
Function uzmiRec(glavnaRec As String) As String
    Dim rs  As New ADODB.Recordset 'Ovde ce biti smestani rezultati upita u bazu
    Dim a() As String 'array u kom cemo pamtiti reci
    
    'popunjavamo rs sa svim recima koje asociraju na 'glavnu' rec
    Set rs = DBConn.Execute("SELECT Associate FROM Associates WHERE Word = '" & glavnaRec & "'")

    Do Until rs.EOF
        On Error Resume Next 'zbog Ubound(a)
        r = UBound(a) + 1
        ReDim Preserve a(r) As String 'uvecavamo array
        a(r) = rs.Fields(0).Value
        rs.MoveNext 'sledeci zapis
    Loop
    
    uzmiRec = a(getRandom(LBound(a), UBound(a))) 'vracamo rec
    
    Erase a 'brisemo array
    rs.Close 'zatvaramo recordset
    Set rs = Nothing 'i brisemo ga
    
End Function
Public Function getRandom(min As Long, max As Long) As Long
    'ova funkcija sluzi za random (nasumicno) generisanje broja u
    'intervalu od min do max
    getRandom = CLng(Int((max - mix + 1) * Rnd + min))
End Function