xlPuzne   strona główna:
A po co ten Excel ;-)
 
    Całą ideę gry zaproponował Ja_Jakub na excelforum pytając o jeden z elementów. Gra polega na odpowiednim ustawieniu  
elementów planszy. Plansza to prostokąt/kwadrat składający się z określonej ilości (iW, iK) przycisków. Jeden przycisk nie ma opisu,  
opisem pozostałych jest losowo wybrana, unikalna, liczba całkowita z przedziału 1 do ((iK * iW) - 1). Należy ustawić elementy po  
ich opisach od 1 do x, po kolei. Żeby zmienić położenie przycisku/opisu należy wykorzystać przycisk bez opisu. Można zamieniać   Jdea gry
miejscami elementy: z opisem i bez opisu jeżeli są one sąsiadami w linii prostej (nie po przekątnej)  
    W pierwotnej wersji plansza zawsze składa się z 3x3 i każdy przycisk (element planszy) jest oprogramowany oddzielnie.  
 
Ja rozszerzyłem tę ideę o:   
 - planszę o dowolnej ilości elementów (min 3x3 - max 10x10),  
 - wspólną obsługę kliknięcia na element planszy,   
 - określenie sąsiadów klikniętego elementu,  
 - funkcję sortującą losowo zakres liczb od 1 do (ilość elementów - 1),  
 - zmiana BackColor elementu jeżeli znajduje się na odpowiedniej pozycji   
 
Część dot. określenia pozycji planszy (wyśrodkowana na formie) jest zapożyczona z xlSaper - pominę więc jej opis.    xlSaper
 
Utworzenie planszy  
 
ilość elementów, kształt planszy określimy poprzez dwa ScrolBar'y którym nadamy Min=3 i Max=10  
  Grę można
pobrać bezpośrenio z:
W kodzie UserForm'a  
 
Option Explicit   xlPuzle.zip
 
Private Sub ScrollBar1_Change()  
    Me.TextBox1 = Me.ScrollBar1  
End Sub  
 
Private Sub ScrollBar2_Change()  
    Me.TextBox2 = Me.ScrollBar2  
End Sub  
 
Private Sub UserForm_Initialize()  
    With Me  
        .TextBox1 = .ScrollBar1  
        .TextBox2 = .ScrollBar2  
        .ToggleButton1.Caption = "Start"  
    End With  
End Sub  
 
Private Sub ToggleButton1_Click()  
    Dim i As Integer, j As Integer  
    Dim objCB As MSForms.CommandButton  
    Dim pozXStart As Single, pozYStart As Single  
    Dim pozX As Single, pozY As Single  
      
    Dim objCtr As MSForms.Control, a As Integer  
    Dim objCButton As clsTBEvents  
      
    Dim tblLos As Variant, iL As Integer  
      
    Const sCtrH As Single = 30  
    Const sCtrW As Single = 30  
      
    Const sinTop As Single = 5  
    Const sinHeight As Single = 310  
    Const sinLeft As Single = 5  
    Const sinWidth As Single = 310  
      
    If Me.ToggleButton1 Then  
      
        With Me  
            iW = CInt(.TextBox1)  
            iK = CInt(.TextBox2)  
        End With  
          
        tblLos = SortujLosowo(1, iW * iK - 1)  
 
        pozXStart = (sinHeight - sinTop) / 2 - (iW * sCtrH) / 2  
        pozYStart = (sinWidth - sinLeft) / 2 - (iK * sCtrW) / 2  
        pozX = pozXStart: pozY = pozYStart  
          
        With Me  
            For i = 1 To iW  
                For j = 1 To iK  
                    a = a + 1  
                    Set objCB = .Controls.Add(bstrProgID:="Forms.CommandButton.1", _  
                                              Name:=CStr(a), _  
                                              Visible:=True)  
                    With objCB  
                        .Top = pozX: .Left = pozY  
                        .Height = sCtrH: .Width = sCtrW  
                        If a < iW * iK Then  
                            .Caption = tblLos(a)  
                        End If  
                        .Tag = i & ";" & j  
                    End With  
                      
                    Set objCButton = New clsTBEvents  
                    Set objCButton.CButton = objCB  
                    colCB.Add objCButton, objCB.Name  
                      
                    pozY = pozY + sCtrW  
                Next  
                pozX = pozX + sCtrW: pozY = pozYStart  
            Next  
            .TextBox3 = ilePoprawnych  
            .TextBox4 = "0"  
            lngKlikniec = 0  
            .ToggleButton1.Caption = "Reset"  
            .Label5.Caption = vbNullString  
        End With  
        Set objCButton = Nothing  
    Else  
        With Me  
            For i = 1 To iW  
                For j = 1 To iK  
                    a = a + 1  
                    .Controls.Remove CStr(a)  
                Next  
            Next  
            .TextBox3 = "0"  
            .TextBox4 = "0"  
            .ToggleButton1.Caption = "Start"  
            .Label5.Caption = vbNullString  
            Set colCB = Nothing  
        End With  
        bKoniec = False  
    End If  
End Sub  
 
Private Sub UserForm_Terminate()  
    Set colCB = Nothing  
End Sub  
 
Do ciekawszych elementów należą:  
 
        tblLos = SortujLosowo(1, iW * iK - 1)  
 
Funkcję SortujLosowo zapisałem w mod. Standardowym  
 
Public Function SortujLosowo(lngOd As Long, lngDo As Long) As Variant  
    Dim lngIle As Long  
    Dim tblLos() As Variant, iD As Long  
    Dim colUni As VBA.Collection, colItem As Variant  
    Dim tblWyniki() As Long  
      
    Set colUni = New VBA.Collection  
      
    lngIle = lngDo - lngOd + 1  
    ReDim tblLos(1 To lngIle)  
    ReDim tblWyniki(1 To lngIle)  
      
    Randomize  
    On Error Resume Next  
    For iD = 1 To lngIle  
        Do  
            colItem = Rnd()  
            colUni.Add colItem, CStr(colItem)  
            If Err.Number <> 0 Then  
                Err.Clear  
            Else  
                Exit Do  
            End If  
        Loop  
        tblLos(iD) = colItem  
    Next  
    On Error GoTo 0  
      
    For iD = 1 To lngIle  
        tblWyniki(iD) = lngOd + udfRank(tblLos(iD), tblLos, True) - 1  
    Next  
    SortujLosowo = tblWyniki  
End Function  
 
Function udfRank(Wert, Wertereihe, Optional aufsteigend = True)  
    'http://www.herber.de/forum/archiv/1124to1128/t1127582.htm  
    Dim dblW As Double, lngZ As Long, lngE As Long  
      
    For lngZ = LBound(Wertereihe) To UBound(Wertereihe)  
        If aufsteigend Then  
            If Wert >= Wertereihe(lngZ) Then lngE = lngE + 1  
        Else  
            If Wert < Wertereihe(lngZ) Then lngE = lngE + 1  
        End If  
    Next  
    udfRank = lngE  
End Function  
 
Jaka jest jej idea? Zadaniem funkcji powinno być utworzenie tablicy o określonej ilości elementów. Elementami tej tablicy powinny  
być wszystkie liczby całkowite z określonego zakresu ułożone w sposób losowy. Liczby nie mogą się powtarzać.  
     Jednym ze sposobów na realizację zadanie jest losowanie liczby Int(Rnd()*(iMax-iMin+1)+iMin) rodem z opisu w pomocy VBA dot. Funkcji Rnd  
i wrzucanie takich liczb do kolekcji. Jeżeli metoda nie zwróci błędu mamy unikat i trafia on do tablicy będącej wynikiem funkcji i tak losujemy aż  
uda się nam rozmieścić wszystkie liczby w sposób losowy w tablicy wyników. Sposób tem na jednak zasadniczą wadę. Pierwszy element na pewno  
będzie unikatowy ale każdy kolejny coraz ciężej będzie wylosować. Powiedzmy że mamy do wylosowania 24 liczby od 1 do 23. 23 elementy już mamy  
prawdopodobieństwo że trafimy w ostatni brakujący jest =1/24 (prawdopodobieństwo porażki = 23/24 -> kolejna próba) Takie losowanie może chwile  
potrwać.   
    Innym sposobem, wykorzystanym w w.w. funkcji, jest wylosowanie np.: 24 unikatowych liczb (niecałkowitych) ale z zakresu 0-1. Zauważmy że  
nie losujemy liczb od 1-24 a 24 dowolne unikatowe liczby które zwróci "goła" Rnd(). Oczywiście wyniki i tak przepuścimy przez kolekcję ale prawdo-  
podobieństwo wylosowanie jeszcze nie unikatowej liczby jest minimalne, a nawet jeżeli nastąpi do w kolejnym losowanie jest równie minimalne.  
Ok. mamy więc zestaw liczb. Jak teraz zamienić je na liczby od 1-24 których potrzebujemy? Ano określając POZYCJĘ każdego elementu tablicy z  
wylosowanymi liczbami, w tej tablicy. :-)  
    Można to wytłumaczyć formułami: w kom. wpisujemy =LOS() i przeciągamy na 24 komórki. Uzyskane wartości to liczby z zakresu 0-1. Powiedzmy  
że są unikalne. Tu tego nie gwarantują ale w swojej funkcji będę miał pewność poprzez zastosowanie kolekcji. I teraz... Uzyskane wyniki wklejam jako  
wartości - żeby się mi LOS() nie przeliczała i w kom. obok pierwszej wylosowanej liczby piszę =POZYCJA(kom;zakres;PRAWDA) formułę przeciągam  
w dół. Co otrzymuję? Liczby z zakresu od 1-24 będącymi pozycją danego wylosowanego elementu w zakresie liczb losowanych (ostatni arg. -> Prawda  
tj. Rosnąco). I tego właśnie potrzebujemy. :-)  
 
... dalej w procedurze ToggleButton1_Click  
 
        With Me  
            For i = 1 To iW  
                For j = 1 To iK  
                    a = a + 1  
                    Set objCB = .Controls.Add(bstrProgID:="Forms.CommandButton.1", _  
                                              Name:=CStr(a), _  
                                              Visible:=True)  
                    With objCB  
                        If a < iW * iK Then  
                            .Caption = tblLos(a)  
                        End If  
                        .Tag = i & ";" & j  
                    End With  
 
Każdemu elementowi planszy nadamy nazwę będącą kolejnym numerem a licząc rzędami. A więc nazwy Button'ów będą odpowiadać  
prawidłowemu ułożeniu elementów planszy. Ich Caption to będzie element a tablicy tblLos utworzonej w.w. Funkcją. Do właściwości   
Tag trafią współrzędne każdego elementu które pomogą nam w określeniu nazw sąsiadów danego elementu.  
 
    Potrzebę tworzenia mod. Class i kolekcji kontrolek colCB również bym pominął - starałem się to wyjaśnić opisując xlSpaer'a  
Tu pokażę jedynie oprogramowanie zdarzenia Click Klikniętego elementu planszy.  
 
Private Sub objCB_Click()  
    Dim tblSasiedzi As Variant, iSasiad As Byte  
    Dim objCtr As MSForms.Control, lngColor As Long  
      
    If Not bKoniec Then  
        tblSasiedzi = NazwySasiadow(objCB)  
          
        For iSasiad = 1 To UBound(tblSasiedzi)  
            Set objCtr = UserForm1.Controls(tblSasiedzi(iSasiad))  
            With objCtr  
                If Len(.Caption) = 0 Then  
                    .Caption = objCB.Caption  
                    objCB.Caption = vbNullString  
                    Exit For  
                End If  
            End With  
        Next  
        lngKlikniec = lngKlikniec + 1  
        With UserForm1  
            .TextBox3 = ilePoprawnych  
            If ilePoprawnych = iW * iK - 1 Then  
                bKoniec = True  
                UserForm1.Label5.Caption = "Wygrałeś!! :-) " & vbCr & "Koniec GRY"  
            End If  
            .TextBox4 = lngKlikniec  
        End With  
    End If  
End Sub  
 
Private Function NazwySasiadow(objCtr As MSForms.CommandButton) As Variant  
    Dim nr As Integer  
    Dim iKol As Integer, iWie As Integer  
    Dim i As Integer, j As Integer  
    Dim tblWyniki() As String, iTbl As Integer  
      
    With objCtr  
        nr = CInt(.Name)  
        iWie = CInt(Split(.Tag, ";")(0))  
        iKol = CInt(Split(.Tag, ";")(1))  
    End With  
      
    ' jedna w lewo  
    If iKol - 1 > 0 Then  
        iTbl = iTbl + 1  
        ReDim Preserve tblWyniki(iTbl)  
        tblWyniki(iTbl) = nr - 1  
    End If  
      
    ' jedna w prawo  
    If iKol + 1 <= iK Then  
        iTbl = iTbl + 1  
        ReDim Preserve tblWyniki(iTbl)  
        tblWyniki(iTbl) = nr + 1  
    End If  
      
    ' jedna w górę  
    If iWie - 1 > 0 Then  
        iTbl = iTbl + 1  
        ReDim Preserve tblWyniki(iTbl)  
        tblWyniki(iTbl) = nr - iK  
    End If  
      
    ' jedna w dół  
    If iWie + 1 <= iW Then  
        iTbl = iTbl + 1  
        ReDim Preserve tblWyniki(iTbl)  
        tblWyniki(iTbl) = nr + iK  
    End If  
      
    NazwySasiadow = tblWyniki  
End Function  
 
Zadaniem procedury jest zamiana miejscami opisów (Caption) elementów jeżeli jeden z nich nie ma opisu. W tym celu musimy poznać  
nazwy sąsiadów klikniętego przycisku. Są to elementy: jeden w lewo, w prawo, w górę i w dół. Trzeba jednak przypilnować żeby  
sąsiad istniał. Jednak znając współrzędne klikniętego przycisku i jego nazwę (liczbę a): jeden w lewo to nr - 1 itd... Wykonalne :-)  
    Jeżeli sąsiad klikniętego elementu nie ma opisu to kliknięty element zamienia się opisem z tym sąsiadem.  
    Po zamianie trzeba policzyć ile elementów jest już poprawnie ustawionych i jeżeli ta liczba będzie równa iW * iK - 1 to trzeba  
skończyć grę. Ile poprawnych zliczy nam funkcja ilePoprawnych  
 
Public Function ilePoprawnych() As Integer  
    Dim objCB As MSForms.Control  
    Dim a As Integer, intIle As Integer  
          
    For a = 1 To iW * iK  
        Set objCB = UserForm1.Controls(CStr(a))  
        With objCB  
            If .Caption = .Name Then  
                intIle = intIle + 1  
            End If  
            BackColorNr objCB  
        End With  
        Set objCB = Nothing  
    Next  
    ilePoprawnych = intIle  
End Function  
 
Rzecz dość prosta: zliczane są te kontrolki których .Caption = .Name dołożyłem jednak coś czego w funkcji raczej dokładać nie należy  
ale no tu mi najbardziej pasowało. Chodzi o zmianę koloru BackColor kontrolki. Wywołuję tą procedurę z funkcji co nie jest do końca   
poprawne ale co tam. :-) Chodzi o procedurę:  
 
Public Sub BackColorNr(objCB As MSForms.Control)  
    Const lngColor1 As Long = &H80C0FF     ' j.pomarańczowy  
    Const lngColor2 As Long = &HFFFFC0     ' j.niebieski  
    Const lngColor3 As Long = &H8000000F   ' szary  
      
    With objCB  
        If Len(.Caption) = 0 Then  
            .BackColor = lngColor3  
        Else  
            .BackColor = IIf(.Caption = .Name, lngColor2, lngColor1)  
        End If  
    End With  
End Sub  
 
Reszta to kosmetyka której ciekawi się doszukają: tj. Zakończenie gry i uniemożliwienie po tym zakończeniu mieszania na planszy,   
wyświetlanie wyników: ilość kliknięć, ilość poprawnie ustawionych elementów...