http://www.openoffice.cz/diskuse/diskuze-ke-clankum Oficiální portál pro uživatele OpenOffice.org Copyright © 2024 CCB spol. s r.o. webmaster@ccb.cz (OpenOffice.cz) webmaster@ccb.cz (OpenOffice.cz) XOOPS 2.2.4 / RSSFit 1.52 http://blogs.law.harvard.edu/tech/rss cs Thu, 30 Apr 2026 03:49:19 +0200 Thu, 28 Sep 2017 02:06:50 +0200 https://www.openoffice.cz/diskuse/diskuze-ke-clankum/programovanie-makier-v-20#post9297 https://www.openoffice.cz/diskuse/diskuze-ke-clankum/programovanie-makier-v-20#post9297 50 Then MsgBox "Zadal si mimo interval lotérie!" elseif not PosledniJeUnikatni(tipPole, 1, i) Then MsgBox "Tipy majú byť rozdielné!" else bVsazeno = true end if vstup = "" Loop Until bVsazeno Next Tah(lotoPole1, 1, 50) ' Prvni tah Tah(lotoPole2, 1, 50) ' Druhy tah ' Rozebereme tazena cisla lotoDodatkoveCislo1 = lotoPole1(7) lotoDodatkoveCislo2 = lotoPole2(7) ' Odebereme z tahu dodatkové číslo ReDim Preserve lotoPole1(1 to 6) ReDim Preserve lotoPole2(1 to 6) ' Setřídíme cisla BubbleSort(tipPole) BubbleSort(lotoPole1) BubbleSort(lotoPole2) ' Vyhodnocení ' 1. tah Dim Vyhry(0 to 6) Dim VyhryDod(0 to 6) Dim retazec1 as string Dim retazec2 as string ' Vyhry v prvnim tahu VyhryDod = Array(500000, 10000, 29.10, 17.60, 5.5, 0, 0 ) Vyhry = Array(500000, 2770.60, 29.10, 4.4, 0, 0, 0 ) retazec1 = VyhoceniTahu(1, tipPole, lotoPole1, lotoDodatkoveCislo1, VyhryDod, Vyhry) ' 2. tah ' Vyhry ve druhem tahu VyhryDod = Array(500000, 5000, 25, 10, 5, 0, 0 ) Vyhry = Array(500000, 250, 25, 3, 0, 0, 0 ) retazec2 = VyhoceniTahu(2, tipPole, lotoPole2, lotoDodatkoveCislo2, VyhryDod, Vyhry) REM a nakoniec vyvrcholenie programu MsgBox "Deň žrebovania: 27.08.2017" & Chr(10) & _ "Váš tip: " & Join(tipPole, " ") & " " & Chr(10) & _ "1. ťah: " & Join(lotoPole1, " ") & Chr(10) & _ "A dodatkové číslo k 1. ťahu: " & lotoDodatkoveCislo1 & Chr(10) & _ "2. ťah: " & Join(lotoPole2, " ") & Chr(10) & _ "A dodatkové číslo k 2. ťahu: " & lotoDodatkoveCislo2 & Chr(10) & Chr(10) & _ retazec1 & Chr(10) & _ retazec2 End Sub REM koniec procedúry ' Procedura naplní Cisla unikátními čísly od Prvni do Posledni Sub Tah(ByRef Cisla, prvni as integer, posledni as integer) ' Prvni nemusime testovat Cisla(1) = VybratCislo(prvni,posledni) For i = lbound(Cisla,1) + 1 To ubound(Cisla,1) Do Cisla(i) = VybratCislo(prvni,posledni) Loop Until PosledniJeUnikatni(Cisla, 1, i) Next end sub function VybratCislo(prvni as integer, posledni as integer) as integer VybratCislo = Int((posledni-1+prvni)*Rnd+1) end function ' Funkce testuje jestli je posledni cislo unikatni ' Nevim, který prvek je posledni, dám to jako parametr function PosledniJeUnikatni(Cisla, prvni, posledni) as boolean PosledniJeUnikatni = false For j = prvni To posledni-1 If Cisla(j) = Cisla(posledni) Then exit function next PosledniJeUnikatni = true end function Sub BubbleSort(ByRef Cisla) Dim pom as Integer Dim t as integer Dim N as integer N = UBound(Cisla, 1) Do t = 0 For j = LBound(Cisla, 1) To N - 1 If Cisla(j) > Cisla(j+1) then pom = Cisla(j) Do Cisla(j) = Cisla(j+1) j = j + 1 If j = N Then Exit Do Loop While pom > Cisla(j + 1) Cisla(j) = pom t = j End If Next N = t - 1 Loop Until t = 0 End Sub ' Funkce porovná dvě číselná pole a zjistí počet shod ' Predpokládá, že polej sou setříděná Function PocetShod(Tip As Variant, Tah As Variant) As Integer Dim i As Integer, j As Integer PocetShod = 0 j = 1 For i = 1 To 6 REM konečne sme sa dostali k vyhodnocovaniu Do While Tip(i) >= Tah(j) If Tip(i) = Tah(j) Then PocetShod = PocetShod + 1 end if j = j + 1 if j > 6 then exit for Loop Next End Function ' Opět, 2x stejné operace, dáme do procedury Function VyhoceniTahu(CisloTahu, tipPole, lotoPole1, DodatkoveCislo, VyhryDod, Vyhry) As String Dim Shody as Integer Dim Dodatek as Integer Shody = PocetShod(tipPole, lotoPole1) Dodatek = 0 For i = 1 To 6 If tipPole(i) = lotoDodatkoveCislo1 Then Dodatek = 1 Exit For End If Next VyhoceniTahu = "V " & CisloTahu & ". ťahu ste uhadli " & Shody & " čísla a " & Dodatek & " dodatkových čísel a vyhrávate " If Dodatek = 1 Then VyhoceniTahu = VyhoceniTahu & Format(VyhryDod(6 - Shody), "#,##0.00 ""€""") & "!" Else VyhoceniTahu = VyhoceniTahu & Format(VyhryDod(6 - Shody), "#,##0.00 ""€""") & "!" End If End Function]]> Thu, 28 Sep 2017 01:06:30 +0200 https://www.openoffice.cz/diskuse/diskuze-ke-clankum/programovanie-makier-v-20#post9296 https://www.openoffice.cz/diskuse/diskuze-ke-clankum/programovanie-makier-v-20#post9296 49 'Test na čísla větší nežli 49 rep = MsgBox(" Chyba bylo zadáno číslo mimo hrací pole. Postup opakujte," & _ " nebo zadávání ukončete." + Chr(13) + Chr (13) & _ "ANO - nová volba" + Chr(13) & _ "NE - ukončit volbu.",4,"CHYBA ZADÁNÍ") IF rep = 7 Then Exit Sub Else GoTo HopStart 'skok pro opakování volby End If Case Else 'Test na duplicitní zadání IF i > 1 Then For j = i-1 To 1 Step - 1 IF vstup = tipPole(j) Then rep = MsgBox(" Chyba bylo zadáno již dříve vybrané číslo. Postup opakujte," & _ " nebo zadávání ukončete." + Chr(13) + Chr (13) & _ "ANO - nová volba" + Chr(13) & _ "NE - ukončit volbu.",4,"CHYBA ZADÁNÍ") IF rep = 7 Then Exit Sub Else GoTo HopStart 'skok pro opakování volby End If End If next j End If tipPole(i) = vstup 'Vlastní uložení tipovaného čísla sInfo = sInfo & vstup & " + " End Select Next i For i = 1 To 6 SortPole(i) = tipPole(i) 'děláme pracovní kopii pole pro třídění sVar = svar & tipPole(i) & ", " 'text hlášení ZVOLENÁ ČÍSLA next i '------------------------Buble sort - plný cyklus bez kontroly konce For i = 6 To 2 Step - 1 For j = 1 To i-1 A = SortPole(j) B = SortPole(j+1) IF A > B Then swap = B B = A A = swap SortPole(j) = A SortPole(j+1) = B End If next j Next i For i = 1 To 6 'text hlášení PŘETŘÍDĚNÁ ČÍSLA sVal = sVal & SortPole(i) & ", " Next i MsgBox("Váš tip 6 čísel bez přetřídění" + Chr(13) & _ " " & svar + Chr(13) + Chr(13) & _ "Váš tip 6 čísel po přetřídění" + Chr(13) & _ " " & sval ,64, "ZVOLENÁ ČÍSLA") End Sub]]> Wed, 27 Sep 2017 19:05:53 +0200 https://www.openoffice.cz/diskuse/diskuze-ke-clankum/programovanie-makier-v-20#post9295 https://www.openoffice.cz/diskuse/diskuze-ke-clankum/programovanie-makier-v-20#post9295