V diskusii k OpenOffice.org sa objavila zaujímavá požiadavka – funkcia pre OpenOffice.org Calc, pomocou ktorej by sa dal vygenerovať rozpis zápasov typu „každý s každým“. Z uvedeného dôvodu si v tomto dieli ukážeme, ako takéto makro naprogramujeme. Pri jeho programovaní budeme predpokladať, že väčšina používateľov bude potrebovať zoznam, v ktorom budú definované aj názvy súťažiacich.
Pre jednoduchosť budeme predpokladať, že používateľ označí v module Calc bunky, v ktorých sú tieto názvy definované. Aby nebol obmedzovaný, umožníme, aby ich zadal či už do jedného riadku alebo jedného stĺpca. Pravdaže, pokiaľ niektorý názov nebude definovaný, nahradíme ho poradovým číslom, aby v zozname nechýbal žiaden zápas. Ak používateľ neoznačí žiadne bunky, budeme predpokladať, že chce zadať počet družstiev manuálne, čo mu umožníme pomocou dialógového okna (v tomto prípade budeme názvy súťažiacich automaticky nahrádzať ich poradovým číslom).
Pretože pri mnohých takýchto zápasoch sa nehrá iba jeden zápas, ale aj odvetný zápas, naprogramujeme makro tak, aby prehadzovalo názvy súťažiacich podľa toho, o aký typ generovania sa bude jednať. Nakoniec, pravdaže, makro umožníme aj jazykovo lokalizovať.
Vlastný algoritmus generovania je dobre popísaný na stránkach Tomáša Kota, takže sa mu nemusíme podrobnejšie venovať a môžeme priamo uviesť makro:
Dim Nazvy(0) ' Názvy družstiev
Dim NazovKolo as String
Dim dlg as object
REM Funkcia zistí, či je číslo párne alebo nie
function parne (cislo as integer) as boolean
parne=((cislo mod 2)=0)
end function
REM Procedúra pre generovanie rozpisu zápasov
REM Postavená na algoritme Tomáša Kota – http://www.tom-kot.cz/clanky/generovani-rozpisu-zapasu-v-systemu-kazdy-s-kazdym/
sub GenerujRozpis(pocet, zosit, riadok, stlpec as integer, odveta as boolean)
dim dokument, list, bunka as object
dim kolko, kolo, zapasov, krok as integer
dim i, j, x, y, Druzstvo1, Druzstvo2 as integer
dim poradie as boolean
dokument=stardesktop.currentcomponent
list=dokument.sheets(zosit) ' Rozpis vkladáme na list "zosit"
poradie=odveta ' Podľa toho, či je odveta alebo nie, striedame "domácich" a "hostí" aj pre posledné (ak je párne) družstvo
kolko=pocet
if not parne(pocet) then kolko=kolko+1 ' Úprava na párne číslo, lebo počet zápasov na jedno kolo je počet/2
kolo=kolko-1 'počet kôl
zapasov=kolko/2 'počet zápasov na jedno kolo
y=0 ' Posun riadku, odkiaľ vkladáme rozpis
for i = 1 to kolo ' pre všetky kolá
x=0 ' Posun stĺpca, odkiaľ vkladáme rozpis
bunka=list.GetCellByPosition(stlpec+x,riadok+y) ' Rozpis vkladáme od bunky s adresu "stlpec" a "riadok"
bunka.string=str(y+1)+" "+NazovKolo+":" ' 1 kolo:, 2 kolo: ...
x=1
if parne(pocet) then ' Ak je párny počet družstiev
bunka=list.GetCellByPosition(stlpec+x,riadok+y)
if poradie then ' Aby sa striedalo aj posledné (kolko) družstvo ako domáci/hosť – vylepšenie algoritmu T. Kota
bunka.string=Nazvy(i)+" – "+Nazvy(kolko) ' Vkladáme "Názov družstva B – Názov družstva A"
else
bunka.string=Nazvy(kolko)+" – "+Nazvy(i) ' Vkladáme "Názov družstva A – Názov družstva B"
end if
x=x+1
poradie=not poradie
end if
for j = 1 to zapasov-1 ' Pre všetky zápasy na jedno kolo
Druzstvo1=((kolko – j + i – 2) mod kolo) + 1 ' Algoritmus T. Kota
Druzstvo2=((i + j – 1) mod kolo) + 1
bunka=list.GetCellByPosition(stlpec+x,riadok+y)
if odveta then ' Podľa toho, či je odveta alebo nie, striedame "domácich" a "hostí"
bunka.string=Nazvy(Druzstvo2)+" – "+Nazvy(Druzstvo1) ' Vkladáme "Názov družstva B – Názov družstva A"
else
bunka.string=Nazvy(Druzstvo1)+" – "+Nazvy(Druzstvo2) ' Vkladáme "Názov družstva A – Názov družstva B"
endif
x=x+1
next j
y=y+1
next i
end sub
REM Procesúra pre zistenie veľkosti označenej oblasti, nastavenie počtu a názvov súťažiacich družstiev
sub GenerujZapazy (odveta as boolean)
dim Dokument, Bunka as object
dim Riadok, Stlpec, Zosit, Pocet as Integer
dim NazvyStlpce as boolean
Dokument=ThisComponent.getCurrentSelection() ' Aktuálny výber
REM Zistenie adresy bunky, kde sa nachádzame
bunka=dokument.getCellByPosition(0,0)
Zosit=bunka.CellAddress.Sheet
Stlpec=bunka.CellAddress.Column
Riadok=bunka.CellAddress.Row
jazyk=left(bunka.CharLocale.Language,2) ' Jazyk bunky (sk, cs, ...)
REM Predpokladáme, že názvy sú v jednom riadku – preto nás zaujíma počet stĺpcov výberu
NazvyStlpce=true
Pocet=dokument.getcolumns().Count ' Počet stĺpcov výberu
if Pocet<2 then ' Ak je vybraný iba jeden stĺpec, názvy sú v riadkov
NazvyStlpce=false ' Predpokladáme, že názvy sú v jednom stĺpci – preto nás zaujíma počet riadkov výberu
Pocet=dokument.getrows().Count ' Počet riadkov výberu
end if
if Pocet>1 then ' Ak je označených viac ako jedna bunka
if NazvyStlpce then ' Ak sú nadpisy v jednom riadku, budeme generovať pod tento riadok
Riadok=Riadok+1
else ' inak vedľa stĺpca s názvami
Stlpec=Stlpec+1
endif
redim preserve Nazvy(Pocet) ' Zmena definície Názvov družstiev podľa ich skutočného počtu
for i=1 to Pocet ' Pre všetky názvy
if NazvyStlpce then ' Podľa toho, kde sú názvy, adresujeme príslušný stĺpec alebo riadok
bunka=dokument.getCellByPosition(i-1,0)
else
bunka=dokument.getCellByPosition(0,i-1)
endif
Nazvy(i)=trim(bunka.GetString) ' Nastavenie názvu i-teho družstva
if Nazvy(i)="" then Nazvy(i)=str(i) ' Ak názov nie je zadaný, tak vložíme poradové číslo
next i
else
NazvyStlpce=true ' Ak neboli zadané názvy, budeme vkladať od aktuálnej bunky
Pocet=ZadajPocetZapasov ' Zadanie počtu družstiev
redim preserve Nazvy(pocet)
for i=1 to Pocet
Nazvy(i)=str(i) ' Vygenerovanie názvov družstiev (poradové číslo)
next i
end if
if Pocet>1 and Pocet<=500 then ' Generujeme iba v rozsahu <2,500> družstiev
NazovKolo="kolo"
kde=basiclibraries.getLibraryLinkURL("JP_generuj_zapasy") ' Adresár, kde je rozšírenie nainštalované
nazov=left(kde,len(kde)-10)+"JP_generuj_zapasy_"+jazyk+".txt" ' Súbor s jazykovou lokalizáciou
Set_jazyk_dialogu(dlg, nazov, "Dialog_rozpis") ' Nastavenie jazyka dialógu
GenerujRozpis(pocet, zosit, riadok, stlpec, odveta)
end if
end sub
REM Funkcia pre zistenie jazyka OO.o
function Jazyk_OOo as string
dim ConfigProvider, MasterKey as object
dim NodePath(0) as new com.sun.star.beans.PropertyValue
NodePath(0).Name = "nodepath"
NodePath(0).Value = "org.openoffice.Setup/L10N/"
ConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")
MasterKey = ConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", NodePath())
Jazyk_OOo = left(MasterKey.getByName("ooLocale"),2) '"sk", "cs", ...
end function
REM Procedúra pre nastavenie jazyka dialógu a názvu textu "kolo"
Sub Set_jazyk_dialogu(oDlg, sNazov, sZahlavie)
dim riadok, premenna, definicia as string
dim rovna as integer
dim sf, inStream, inFile ' Pre čítanie z lokalizačného súboru
on error resume next
if fileexists(sNazov) then ' Ak lokalizačný súbor existuje, tak načítame definície do premenných
sf = createUnoService("com.sun.star.ucb.SimpleFileAccess")
inStream = sf.openFileRead(sNazov)
inFile = createUnoService("com.sun.star.io.TextInputStream")
inFile.InputStream = inStream
inFile.Encoding = "UTF-8" ' lokalizačný súbor musí byť v UTF-8, inak nebude dobrá diakritika
Do While not inFile.IsEOF
riadok = trim(inFile.readLine) ' Načítanie riadku z definičného súboru
rovna=instr(riadok,"=")
if rovna<>0 then
premenna=trim(left(riadok,rovna-1)) ' Budeme ignorovať medzery
definicia=trim(right(riadok,len(riadok)-rovna))
if premenna=sZahlavie then
oDlg.Title=definicia
else
oDlg.model.getByName(premenna).setpropertyvalue("Label",definicia)
endif
if premenna="Kolo" then NazovKolo=definicia
end if
loop
' Zatvorenie definičného súboru
inStream.closeInput
inFile.closeInput
end if
end sub
REM Funkcia na zadanie počtu družstiev
function ZadajPocetZapasov as integer
dim Pocet as integer
Pocet=0
DialogLibraries.LoadLibrary("JP_generuj_zapasy")
dlg=CreateUnoDialog(DialogLibraries.JP_generuj_zapasy.Dialog_rozpis) ' Sprístupnenie dialógu
kde=basiclibraries.getLibraryLinkURL("JP_generuj_zapasy") ' Adresár, kde je rozšírenie nainštalované
nazov=left(kde,len(kde)-10)+"JP_generuj_zapasy_"+Jazyk_OOo+".txt" ' Súbor s jazykovou lokalizáciou
Set_jazyk_dialogu(dlg, nazov, "Dialog_rozpis") ' Nastavenie jazyka dialógu
if dlg.execute() then
Pocet=dlg.model.Pocet.value
end if
ZadajPocetZapasov=Pocet
end function
REM Generovanie "základných" zápasov
Sub Zapas_Normal
GenerujZapazy (false)
end sub
REM Generovanie "odviet"
Sub Zapas_Odveta
GenerujZapazy (true)
end sub
