Órarendkészítés (TFOR)

Gépi tantárgyfelosztás- és órarendkészítő program

Alapvetések

Osztályszintű óraterv: egy olyan táblázat, amely azt tartalmazza, hogy egy adott osztálynak, valamely tantárgyból, hetente hány órája van. Minden tantárgynak annyi sora van a táblázatban, ahány csoportra bontva tartják. (Oszlopai az osztályok, sorai a tantárgyak, tartalma a tantárgy heti óraszáma.)

Osztály tantárgyfelosztás: egy olyan táblázat, mely minden osztályban, minden tantárgyhoz megmutatja, hogy melyik pedagógus tanítja. Minden tantárgynak annyi sora van a táblázatban, ahány csoportra bontva tartják. (Oszlopai az osztályok, sorai a tantárgyak, tartalma a pedagógus.)

Pedagógus órarend: olyan táblázat, mely a hét minden napjára és órájára megmutatja, hogy az adott pedagógus milyen tantárgyat, melyik osztálynak, melyik tanteremben tanítja. (Oszlopai a hét napjai és azon belül a napok órái, sorai az pedagógusok, tartalma a tantárgy, az osztály és a tanterem.)

Osztályórarend: olyan táblázat, mely a hét minden napjára és órájára megmutatja, hogy az adott osztályban milyen tantárgyat, ki vagy kik tanítanak, melyik tanteremben, illetve tantermekben. (Oszlopai a hét napjai és azon belül a napok órái, sorai az osztályok, tartalma a tantárgy, a pedagógus és a tanterem. Minden osztálynak annyi sora van, amennyi a csoportbontásban résztvevő pedagógusok száma.)

Tanteremórarend: olyan táblázat, mely a hét minden napjára és órájára megmutatja, hogy az adott tanteremben milyen tantárgyat, melyik osztálynak, melyik pedagógus tanítja. (Oszlopai a hét napjai és azon belül a napok órái, sorai a tantermek, tartalma a tantárgy, az osztály és a pedagógus.)

Elemzések: A fentebbi leírásokkal kapcsolatban a következő megállapítások tehetők.

1.) Az Osztályszintű óraterv és az Osztály tantárgyfelosztás nagyon hasonlít egymásra. Az óraterv kiegészíthető az óraszám mellett annak a pedagógusnak a nevével (illetve tömbindexével), aki azt a tantárgyat a kérdéses osztályban tanítja. A programban ezt az összekapcsolást alkalmazni is fogjuk.

2.) Ha az órarendek gépi feltöltésekor, az egyszerűség kedvéért, ragaszkodunk ahhoz, hogy valamely táblázatban egy elem tulajdonságait csak egy sor tartalmazza, akkor ilyen értelemben csak a Pedagógus órarend jöhet számításba az órarendkészítésnek ebben a fázisban. Ugyanis az Osztályórarendek egy osztályhoz több sort is tartalmazhatnak a csoportbontás miatt. A Teremórarendekkel meg az a bökkenő, hogy szintén a csoportbontások miatt, bizonyos órákhoz csak a feltöltés végén lehet tantermet rendelni, hiszen a feltöltés elején még nem rögzíthető minden bontott órára az, hogy melyik teremben kell tartani. Ehhez ugyanis minden szaktantermi órának ismerni kellene az időpontját, hiszen ezek biztosítják a szabad tantermeket a bontások számára. (Ilyenek: a testnevelés, ének, rajz, informatika, nyelvi labor órái, gyakorlati foglalkozások, stb.) Márpedig úgy órarendet generálni, hogy nem biztos az, hogy a kiválasztott teremben és időpontban egy adott osztálynak egyáltalán lehet-e órája vagy nem, nem lehet.

Következmény: marad az automatikus generálás idejére a Pedagógus órarend nézet.

Csoportbontás: Az eredményesebb oktató-nevelő munka érdekében gyakran előfordul, hogy az osztálykereteket megbontva, egy-egy tantárgyat kisebb csoportokban tanítunk. Ezekre az időpontokra az osztálykeretek megszűnnek, hiszen tanulói több pedagógushoz tartoznak. Ebben a programban csak a két legegyszerűbb lehetőség áll rendelkezésre.

Egyik lehetőség az, hogy egy adott tantárgy tanítási idejére két csoportot hozunk létre az osztályból, melynek két pedagógus és két teremigénye lesz. Bármely tantárggyal kapcsolatban megtehetjük például, hogy kezdő és haladó csoportokra bontjuk az osztályt, így alakítva ki két csoportot. De egyszerűen csak azért is bonthatjuk egy tantárgyból, például matematikából ketté az osztályt, hogy kisebb csoportokban eredményesebben dolgozhassunk. A testneveléssel kapcsolatban pedig majdnem törvényszerű, hogy a lányok és fiúk külön csoportot alkossanak, már csak anatómiai megfontolások miatt is.

A másik csoportbontási lehetőség az, amikor egy adott órában az osztály egyik felének például angol, a másik felének német órát tartunk, azaz két különböző tantárgy óráit. Az ilyen bontás alapja lehet például az, hogy az osztályfőnök angol szakos, és szeretné az osztály minden tanulóját tanítani. Természetesen bármely két tantárgy, aminek a heti óraszáma azonos, így párba állítható.

Időpont összevonás: Erre ebben a programban nincs lehetőség, de a teljesség kedvéért említést teszek róla. Pontosabban az alapértelmezett időpont összevonás a csoportbontás kezelésében megvalósul, vagyis a tantárgyfelosztásban lévő két tanítási tételt egy időpontban kell és lehet megtartani. Az általános időpont összevonás azt jelenti, hogy a tantárgyfelosztás bármely két, esetleg több tételét is összevonjuk, egy időpontban tartjuk. Erre tehát ez a program nem alkalmas.

Az összevonásra több ok miatt is szükség lehet. Ez első tehát az említett egyszerű csoportbontás. A másik a fakultáció. A tantárgyfelosztásban például szerepelhet öt tanítási tétel is a harmadik évfolyamon, melyet egy időpontban, a teljes évfolyamról származó tanulók részére szervezünk. Hasonló megoldásra van szükség, ha a testnevelési órákon a nemek aránya miatt egy teljes csoportot csak több osztályból lehet összehozni, akkor is szükség lehet időpont összevonásra (például: 1.a testnevelés lány, 1.b testnevelés lány és 1.ab testnevelés fiú formában). A következő igény akkor adódik időpont összevonásra, amikor az érintett tételeknek nincs is közük egymáshoz tanulói szinten, de ha például egy osztályban nyelvi bontás van, és ezért plusz tanteremigény jelentkezik, akkor legyen egy másik osztályban testnevelés vagy informatika óra, a teremgondok enyhítése miatt (az informatika teremben, vagy sportcsarnokban ugyanis nem lehet más órát tartani, mint informatikát, illetve testnevelést). Az időpont összevonás további gondokat vet fel abban az esetben, ha valódi csoportokkal dolgozik, de kevesebb pedagógussal, mint amennyi osztályból érkeznek a tanulók. Ilyenek lehetnek például a gyakorlati foglalkozások. Ezt az esetet meg kell oldani a programban kódolás szintjén, vagyis nyilván kell tartani azt is, hogy mely osztályokba tartoznak a csoport tanulói.

A feladat

Készítsünk olyan programot, amely az iskolai tantárgyfelosztás és órarendek elkészítésére alkalmas.

Programspecifikáció.

1. Általános követelmények.

A program kezeljen:

- osztályokat;

- tantárgyakat;

- osztályszintű óraterveket;

- pedagógusokat és

- tantermeket.

Input, output:

Az adatokat tipizált lemezes állományban tárolja. Indításkor az adatokat lemezről automatikusan töltse be, a programból való kilépéskor opcionálisan mentse ki. Lehessen tetszőleges alapadatokkal feltölteni a kezelhető adatállományokat. Minden adatbevitelre könnyen kezelhető beviteli felület álljon rendelkezésre. A tantárgyfelosztás és órarend készítése az alapadatok bevitele után csak hozzárendelésekkel valósuljon meg.

2. A program képességei:

- legyen alkalmas tantárgyfelosztás készítésére, annak iskolai szintű, pedagógusok szerinti összesítésére és Excel táblázatba való mentésére;

- lehessen tantárgyfelosztást lekérdezni tantárgyak szerint is;

- legyen alkalmas órarendkészítésre, ezen belül kézi és gépi feltöltésre;

- az órarendkészítésben kezeljen csoportbontást, azaz egy tantárgyat két pedagógus is taníthasson;

- lehessen a pedagógusoknak tiltott órái (amikor nem tud órát tartani) és gépi módosítás ellen védett (rögzített) órái;

- lehessen osztályonként és azon belül naponként megadni az osztály számára elfogadó időpontokat (az 1.-6. standard kiterjesztése);

- lehessen az órarendet osztályonként, pedagógusonként, tantermenként és tantárgyanként is Excel táblázatba menteni.

3. A program paraméterei:

Nem módosítható konstansok (a lemezes állomány rekordhosszát változtatja):

- maximum heti 5 nap: NaSz=5;

- maximum napi 10 óra: NOSz=10;

- maximum 50 óra hetente: HOSz=NaSz*NOSz=50;

- maximum 32 osztály: OMax=32;

- maximum 64 pedagógus: PMax=64;

- maximum 21 tantárgy: TMax=21;

- maximum 64 tanterem: HMax=64;

Módosítható konstansok:

- napok jelölése: Nap=’HKSCP’;

- párhuzamos osztályok száma egy évfolyamon: POSz=8;

- pedagógusoknak heti maximum 26 óra: OSzM=26;

- pedagógusok tanítási tételeinek maximuma: PTTM=32;

- tiltott pedagógusóra kódja: Tilt=99;

- kétórás tantárgy jelölő kódja: KetO=999;

- a megengedett beírási időpont jele a pedagógus órarendben: Jel=’___’.

4. Programkörnyezet, nyelvi megoldások:

- a programot Delphi nyelven kell megírni;

- mivel több beviteli és kezelő felületre van szükség, ezért MDI alkalmazást kell használni;

- a lemezes állományokra vonatkozó megkötés miatt, az adatszerkezet rekordokra épüljön (ugyanis erről könnyebb átírni adatbázis alapúra).

Programterv

1. A program alapelemei és azonosítói:

Név:	Azonosító:
Osztály	Oszt
Tantárgy	Tant
Pedagógus	Peda
Tanterem	Hely

2. Rekordleírás:

TTFOR:

TTFOR	Mezőnév	Tulajdonság
Időpont neve	INev	St2
Osztály neve	ONev	St3
Osztály osztályfőnöke	OOfo	Word
Osztály tanterme	OHel	Word
Osztály óraterve	OTer	Array[0..OMax,0..TMax,0..6] Of Word
Osztály lehetőségek	OLeh	Array[0..HOSz+1,0..2*OMax+1] Of Word
Tantárgy neve	TNev	St3
Tantárgy lehetőségek	TLeh	Array[0..HOSz+1,0..TMax+1] Of Word
Pedagógus neve	PNev	St36
Pedagógus rövidítése	PRov	St3
Pedagógus beosztása	PBeo	St3
Pedagógus kötelező-óraszáma	PKot	Word
Pedagógus nem óratervi órái	PNOT	Word
Pedagógus órarend	POra	Array[0..HOSz+1,0..PMax+1,0..4] Of Word
Tanterem neve	HNev	St3
Tanterem lehetőség	HLeh	Array[0..HOSz+1,0..HMax+1] Of Word

Az alkalmazott hivatkozások:

St2: 2 karakter hosszú szöveg.

St3: 3 karakter hosszú szöveg;

St36: 36 karakter hosszú szöveg.

Megjegyzések:

- A rekordnevek első T betűje a Type szokásos konvencióját jelenti.

- Az óraterv deklarációjában (OTer: Array[0..OMax,0..TMax,1..6] Of Word) az 1..6 index a kettős csoportbontást szolgálja: két óraszám, két pedagógus és két tanterem (mint a tanítási tétel tanterme, ha ezt meg szeretnénk adni).

- Minden névre hárombetűs rövidítéseket használunk, kivéve az időpontok neveit: H0,H1,H2..H9,K0,K1,K2… P8,P9, melyeket nem módosíthatjuk.

- A tantárgyneveket az Óratervi lapon, a pedagógusok nevének rövidítését a Pedagógus órarenden, az osztályok nevét az Osztályórarenden, míg tantermek nevét a Tanteremórarenden módosíthatjuk.

- Az osztályok osztályfőnökét és az osztály számára engedélyezett (lehetséges) időpontokat az Osztályórarend lapon beállíthatjuk.

- Az osztályok tantermét és a tanítási tételek tantermét (szaktantermét) az Óratervi lapon beállíthatjuk.

- A pedagógusok teljes nevét, nevének rövidítését, beosztását, túlóráinak számát, nem óratervi óráinak számát egy külön lapon beállíthatjuk, melyen különböző kimentek készítésére is lehetőség van Html és XLS formátumban.

A Formok várható listája:

fmTFOR - az alkalmazás főformja;

fmAdat - az adatállomány leírása;

fmModul - modulgyűjtemény;

fmOTer - az óraterv beviteli felülete;

fmPOR - a pedagógus órarend és tiltások bevitele, gépi órarendkészítés;

fmOOR - az osztályórarend lekérdezése, tiltások bevitele;

fmHOR - a teremórarend lekérdezése, tiltások bevitele.

fmMentMint – pedagógusok további adatai, a tantárgyfelosztás és az órarendek Html és XLS formátumban való nyomtatása.

Kódolás (1)

A kódolás első lépéseként hozzunk létre egy mappát projektünk számára (TFOR). Delphiben hozzuk létre alkalmazásunk főformját, az fmTFOR-t. Tulajdonságát FormStyle tulajdonságát állítsuk fsMDIForm-ra. Következő lépésben hozzuk létre mind a további 7 formot, melyek FormStyle tulajdonságát állítsuk fsMDIChild-re. Minden form WindowState tulajdonsága legyen wsMaximized. Az fmAdat és a fmModul kivételével mindegyikre helyezzünk el egy, a tartalmát leíró szöveget egy-egy Label elemen, és egy Kilépés feliratú nyomógombot. A nyomógomb Click határára zárja a formot: Close paranccsal. Minden utóbbi form onClose eseményébe írjuk be: Action:= caFree. Ezzel a formok elő vannak készítve az MDI kezelésre.

Következő lépésként helyezzünk a főform-ra egy főmenüt és a menüit alakítsuk ki a következő screenshot szerint:

A menük és a MDIChild formok összekapcsolását a menüpontok OnClick eseményének megírásával hozzuk létre (a form létrehozása és megjelenítése). A program indítás utáni képernyője:

A főform listája:

unit UTFOR;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms,
  UAdat, UModul, UOTer, UPOR, UOOR, UHOR, UMentMint,
  Dialogs, Menus, StdCtrls;

type
  TfmTFOR = class(TForm)
    mmTFOR: TMainMenu;
    miTFOR: TMenuItem;
    miOTer: TMenuItem;
    miPOR: TMenuItem;
    miOOR: TMenuItem;
    miHOR: TMenuItem;
    miNo1: TMenuItem;
    miExitNoSave: TMenuItem;
    miExit: TMenuItem;
    miMentes: TMenuItem;
    miMentesMint: TMenuItem;
    miNo2: TMenuItem;
procedure miOTerClick(Sender: TObject);
procedure miPORClick(Sender: TObject);
procedure miOORClick(Sender: TObject);
procedure miHORClick(Sender: TObject);
procedure miExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure miExitNoSaveClick(Sender: TObject);
procedure miMentesClick(Sender: TObject);
procedure miMentesMintClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmTFOR: TfmTFOR;

implementation

{$R *.dfm}

procedure TfmTFOR.miMentesClick(Sender: TObject);
begin
  Lemezre;
end;

procedure TfmTFOR.miExitNoSaveClick(Sender: TObject);
begin
  Close;
end;

procedure TfmTFOR.miExitClick(Sender: TObject);
begin
  Lemezre;
  Close;
end;

procedure TfmTFOR.miOTerClick(Sender: TObject);
begin
  fmOTer:= TfmOTer.Create(Self);
  fmOTer.Show;
end;

procedure TfmTFOR.miPORClick(Sender: TObject);
begin
  fmPOR:= TfmPOR.Create(Self);
  fmPOR.Show;
end;

procedure TfmTFOR.miOORClick(Sender: TObject);
begin
  fmOOR:= TfmOOR.Create(Self);
  fmOOR.Show;
end;

procedure TfmTFOR.miHORClick(Sender: TObject);
begin
  fmHOR:= TfmHOR.Create(Self);
  fmHOR.Show;
end;

procedure TfmTFOR.miMentesMintClick(Sender: TObject);
begin
  fmMentMint:= TfmMentMint.Create(Self);
  fmMentMint.Show;
end;

procedure TfmTFOR.FormCreate(Sender: TObject);
begin
  Randomize; DNev:= 'TFOR.tfo'; Lemezrol;
end;

end.

Kódolás (2)

Ebben a szakaszban az adatok tárolásával ismerkedhetünk meg. Egy minden Unitban használatba veendő Unitba helyeztük el az adatok leírását, így globális adatokként használja őket a program. A program korlátait jelentő konstansok is itt foglalnak helyet. A program minden adatát egyetlen, az ATFOR nevű rekordban tároljuk, mely a teljes lemezes adatállományt jelenti.

Az OTer mező tömbindexeinek jelentése:

0..OMax: osztály index

0..TMax: tantárgy index

0: használaton kívüli

1: a tantárgy első csoportjának (vagy az egyetlen csoportjának = teljes osztály) az óraszáma

2: a tantárgy második csoportjának (mely opcionális) az óraszáma

3: a tantárgy első csoportjának (vagy az egyetlen csoportjának = teljes osztály) a pedagógusa

4: a tantárgy második csoportjának (mely opcionális) a pedagógusa

5: az első csoport tanterme (opcionális, mert ha nincs megadva, akkor az osztály osztályterme)

6: a második csoport tanterme (opcionális, mert ha nincs megadva, akkor valamelyik üres terem)

A OLeh mező tömbindexeinek jelentése:

0..HOSz+1: a hét időpontjai

0..2*OMax+1: az osztályórarend sorai

0 érték: nem lehet óra

1 érték: lehet óra

A TLeh mező tömbindexeinek jelentése:

0..HOSz+1: a hét időpontjai

0..TMax+1: tantárgyak

0 érték: nem lehet óra

1 érték: lehet óra

A POra mező tömbindexeinek jelentése:

0: használaton kívüli

1: a tanítási óra tantárgya

2: a tanítási óra osztálya

3: a tanítási óra tanterme

4: az óra rögzítésének minősége:

0: nincs óra

1: kézzel rögzített, a gépi betöltő nem módosíthatja

2: gépi betöltővel rögzített, a gépi betöltő módosíthatja

A HLeh mező tömbindexeinek jelentése:

0..HOSz+1: a hét időpontjai

0..HMax+1: tantárgyak

0 érték: nem lehet óra

1 érték: lehet óra

Névhivatkozások:

INev: időpont neve (H0-tól P9-ig, mely nem változtatható meg)

ONev: osztályok neve

OOfo: osztály osztályfőnöke (pontosabban annak tömbindexe)

OHel: az osztály tanterme (pontosabban annak tömbindexe)

TNev: tantárgyak neve

PNev: pedagógusok neve

PRov: pedagógus nevének rövidítése

PBeo: pedagógus beosztása

PKot: pedagógus kötelező-óraszáma

PNOT: pedagógus nem óratervi órái

HNev: tantermek neve

Az UAdat Unit listája:

unit UAdat;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs;

Const
//nem módosíthatók, rekordhossz megváltozik, a lemezes állomány nem lesz
//olvasható
      OMax=32;
      PMax=64;
      TMax=21;
      HMax=64;
      NaSz=5;
      NOSz=10;
      HOSz=NaSz*NOSz;

//módosíthatók:
      Nap='HKSCP';
      POSz=8;
      OSzM=26;
      PTTM=32;
      Tilt=99;
      KetO=999;
      Jel='__';

type

  St2=String[2];
  St3=String[3];
  St12=String[12];
  St36=String[36];

  TfmAdat = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

  TTFOR=Record
    INev: Array[0..HOSz] Of St2;
    ONev: Array[0..OMax] Of St3;
    OOfo: Array[0..OMax] Of Word;
    OHel: Array[0..OMax] Of Word;
    OTer: Array[0..OMax,0..TMax,0..6] Of Word;
//OTer: 1:órasz(1), 2:órasz(2), 3:peda(1), 4:peda(2), 5:terem(1), 6:terem(2)
    OLeh: Array[0..HOSz+1,0..2*OMax+1] Of Word;
    TNev: Array[0..TMax] Of St3;
    TLeh: Array[0..HOSz+1,0..TMax+1] Of Word;
    PNev: Array[0..PMax] Of St36;
    PRov: Array[0..PMax] Of St3;
    PBeo: Array[0..PMax] Of St3;
    PKot: Array[0..PMax] Of Word;
    PNOT: Array[0..PMax] Of Word;
    POra: Array[0..HOSz+1,0..PMax+1,0..4] Of Word;
//POra: 1:tant, 2:oszt, 3:hely, 4:nincs(0)/kézi(1)/gépi(2)
    HNev: Array[0..HMax] Of St3;
    HLeh: Array[0..HOSz+1,0..HMax+1] Of Word;
End;

var
  fmAdat: TfmAdat;
  ACol, ARow: Integer;
  DNev: String;
  FTFOR: File Of TTFOR;
  FText: Text;
  PHOSz: Array[0..PMax+1] Of Word;
  ATFOR: TTFOR;
  AIdop, ATant, AOszt, APeda, AHely, MPeda: Word;
  NNev: Array[1..5] Of St12=('Hétfő', 'Kedd', 'Szerda', 'Csütörtök', 'Péntek');

implementation

{$R *.dfm}

end.

Az alapértelmezett adatok feltöltésére, adatmentésre és adatbetöltésre egy külön Unitot hozunk létre. Ide helyezzük a továbbiakban esetleg szükséges globális adatokon végzett műveletek, eljárások moduljait is. Ennek a Unitnak a neve UModul, a listája pedig:

unit UModul;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, Dialogs;

type
  TfmModul = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

Procedure Alap;
Function UpONev(Nev: St3): St3;
Function VoltOfo(P: Word): Boolean;
Procedure Lemezre;
Procedure Lemezrol;
Function INevToInd(Nev: St2): Word;
Function ONevToInd(Nev: St3): Word;
Function TNevToInd(Nev: St3): Word;
Function PRovToInd(Nev: St3): Word;
Function TTetToHely(O,T: Word): Word;
Function UresHely(I,H: Word): Boolean;
Function PORBeirt(P,T,O: Word): Word;
Function MaRovid: St4;

var
  fmModul: TfmModul;

implementation

{$R *.dfm}

Procedure Alap;
Var I, J, O, P, H: Word;
    St: St2;
Begin
With ATFOR Do
Begin
    INev[0]:= ''; For I:= 1 To NaSz Do For J:= 0 To NOSz-1 Do
    INev[(I-1)*NOSz+J+1]:= Nap[I]+IntToStr(J);
With ATFOR Do
Begin
      ONev[0]:= ''; For O:= 1 To OMax Do
      ONev[O]:= IntToStr(((O-1) Div POSz+1))+'.'+Chr(96+(O-1) Mod POSz+1);
End;
    TNev[ 0]:=   '-'; TNev[ 1]:= 'ofő'; TNev[ 2]:= 'mgy'; TNev[ 3]:= 'tör';
    TNev[ 4]:= 'tis'; TNev[ 5]:= 'eti'; TNev[ 6]:= 'fil'; TNev[ 7]:= 'an1';
    TNev[ 8]:= 'an2'; TNev[ 9]:= 'fra'; TNev[10]:= 'mat'; TNev[11]:= 'inf';
    TNev[12]:= 'fiz'; TNev[13]:= 'kém'; TNev[14]:= 'bio'; TNev[15]:= 'föl';
    TNev[16]:= 'éne'; TNev[17]:= 'raj'; TNev[18]:= 'tes'; TNev[19]:= 'tán';
    TNev[20]:= 'méd'; TNev[21]:= 'szv';
    PRov[0]:= '-'; For P:= 1 To PMax Do
    PRov[P]:= Chr((P-1) Div 26+65)+Chr((P-1) Mod 26+65)+Chr(97+Random(26));
    HNev[0]:= '-'; For I:= 1 To 2 Do For J:= 1 To 32 Do
Begin
      St:= IntToStr(J); If J<10 Then St:= '0'+St;
      HNev[(I-1)*32+J]:= Chr(64+I)+St;
End;
For I:= 0 To HOSz+1 Do For O:= 0 To 2*OMax+1 Do
If I In [2..7,12..17,22..27,32..37,42..47] Then OLeh[I,O]:= 1
Else OLeh[I,O]:= 0;
For I:= 0 To HOSz+1 Do For H:= 0 To HMax+1 Do
If I In [2..7,12..17,22..27,32..37,42..47] Then HLeh[I,H]:= 1
Else HLeh[I,H]:= 0;
End;
End;

Function UpONev(Nev: St3): St3;
Var St: St3;
Begin
  UpONev:= ''; If Nev='' Then Exit;
  St:= Nev; St[3]:= UpCase(St[3]); UpONev:= St;
End;

Function VoltOfo(P: Word): Boolean;
Var O: Word;
Begin
  VoltOfo:= False; If P=0 Then Exit;
With ATFOR Do
For O:= 1 To OMax Do If (OOfo[O]=P) Or (OTer[O,1,3]=P) Then
Begin VoltOfo:= True; Break End;
End;

Procedure Lemezre;
Begin
  AssignFile(FTFOR,DNev); ReWrite(FTFOR);
    Write(FTFOR,ATFOR);
  CloseFile(FTFOR);
End;

Procedure Lemezrol;
Begin
  AssignFile(FTFOR,DNev); {$I-}Reset(FTFOR){$I+};
If IOResult<>0 Then Begin ReWrite(FTFOR); Alap End Else Read(FTFOR,ATFOR);
  CloseFile(FTFOR);
End;

Function INevToInd(Nev: St2): Word;
Var I: Word;
Begin
  INevToInd:= 0; With ATFOR Do
For I:= 1 To HOSz Do If INev[I]=Nev Then Begin INevToInd:= I; Break End;
End;

Function ONevToInd(Nev: St3): Word;
Var O: Word;
Begin
  ONevToInd:= 0; With ATFOR Do
For O:= 1 To OMax Do If ONev[O]=Nev Then Begin ONevToInd:= O; Break End;
End;

Function TNevToInd(Nev: St3): Word;
Var T: Word;
Begin
  TNevToInd:= 0; With ATFOR Do
For T:= 1 To TMax Do If TNev[T]=Nev Then Begin TNevToInd:= T; Break End;
End;

Function PRovToInd(Nev: St3): Word;
Var P: Word;
Begin
  PRovToInd:= 0; With ATFOR Do
For P:= 1 To PMax Do If PRov[P]=Nev Then Begin PRovToInd:= P; Break End;
End;

Function TTetToHely(O,T: Word): Word;
Var H: Word;
Begin
With ATFOR Do
Begin
    H:= OTer[O,T,6];
If H=0 Then H:= OTer[O,T,5];
If H=0 Then H:= OHel[O];
End;
  TTetToHely:= H;
End;

Function UresHely(I,H: Word): Boolean;
Var P: Word;
Begin
  UresHely:= True;
With ATFOR Do For P:= 1 To PMax Do If POra[I,P,3]=H Then
Begin UresHely:= False; Break End;
End;

Function PORBeirt(P,T,O: Word): Word;
Var I, N: Word;
Begin
  N:= 0;
With ATFOR Do For I:= 1 To HOSz Do
If (POra[I,P,1]=T) And (POra[I,P,2]=O) Then Inc(N);
  PORBeirt:= N;
End;

Function MaRovid: St4;
Begin
  MaRovid:= Copy(DateToStr(Now),6,2)+Copy(DateToStr(Now),9,2);
End;

end.

Kódolás (3)

Most nézzük, hogyan használhatjuk a programot az Óraterv (Osztály tantárgyfelosztás) készítésére. Mint azt a Programtervben is leírtam, az Óratervi lapon a következők valósíthatók meg:

- A tantárgyak neve módosítható a beviteli mező segítségével. A kiválasztott sor tantárgya írható át. A tantárgy neve maximum 3 karakter lehet. A beírást Enter billentyűvel kell lezárni. Ha üres stringet adunk meg, akkor az egy ’-’ jelre módosul.

- Az alapértelmezett tantárgyak között van egy an1 és egy an2. Ezek az angol, német és első, valamint az angol, német és második idegen nyelv jelölésére szolgálnak, arra az esetre, ha az osztályokban nem mindenki az egyik nyelvet (pl. angolt) tanulja első idegen nyelvként. Ha az egész osztályban pl. angolt tanul első idegen nyelv, akkor a tantárgy ang-nak illetve ném-nek, egyébként pedig bárminek átnevezhető.

- A Óratervi lapon az óratervek, azaz az óraszámok bevitele nyomógombok segítségével történik. Az Inc feliratúval az óraszámot növelni, a Dec feliratúval csökkenteni lehet. Ha a heti óraszám 0, akkor rácsban nem jelenik meg. Mivel az osztályok óraszáma sokban hasonló, illetve azonos lehet, a gyors feltöltés érdekében van egy ToEnd feliratú gomb, mely megnyomására az aktuális óra az adott osztálytól kezdődően az utolsó osztályig beíródik. Természetesen, ha üres mezőn nyomunk ToEnd-et, akkor az törlést jelent. Például a második és harmadik évfolyamra, úgy lehet könnyen heti 3 órát beállítani, hogy ráállunk a tantárgy sorában a 2.a osztály oszlopára, ha üres volt háromszor Inc gombot nyomunk, majd ToEnd, aztán átmegyünk a 4.a oszlopára, Dec háromszor és ToEnd. Ezzel a módszerrel percek alatt a teljes iskola óraterv elkészíthető.

- Ha csak teszteljük a programot, akkor a tantárgyfelosztást, azaz az óraszámokhoz a pedagógusok hozzárendelését a RandomTF gomb segítségével a programra bízhatjuk. Ekkor nemcsak a tantárgyfelosztás, hanem az osztályok tanterme és osztályfőnöke és osztályfőnöki órája is automatikusan beállítódik.

- Ha valós órarendet szeretnénk készíteni, akkor természetesen egyenként kell a pedagógusokat a tételekhez hozzárendelni. Jobb oldalon három listadoboz található. A felső a pedagógusok nevét tartalmazza. Ha a rácsban a bevitel helyét kiválasztjuk, a listán pedig kettőt kattintunk a megfelelő pedagógus nevén, akkor a hozzárendelés megvalósul. Törlés a lista első (-) elemének kiválasztásával történik.

- A középső listadoboz tantermek jeleit tartalmazza, mely segítségével az osztályokhoz tantermeket lehet rendelni. A tantermek jele az osztályjelek alatt található. Természetesen ehhez az osztály oszlopát előzőleg ki kell választani.

- A harmadik (alsó) listadobozban újra teremnevek láthatók. Ennek segítségével az egyes tanítási tételekhez tantermeket (szaktantermet) rendelhetünk a fentebb leírt módon. Ez a rácsban nem jelenik meg, de ha ráállunk a tanítási tételre, akkor a listán kiválasztódik a hozzárendelt tanterem. Ez a visszajelzés nemcsak a szaktanteremre, hanem a pedagógusra és az osztályok osztálytermére is igaz.

- A bevitelek sajátossága még az, hogy nem enged két osztálynak ugyanazt az osztálytermet beírni, illetve nem írhatunk be két ugyanolyan nevű tantárgyat sem.

Az Óraterv beviteli képernyője:

Az UOTer Unit listája:

unit UOTer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, UModul,
  Dialogs, StdCtrls, Grids;

type
  TfmOTer = class(TForm)
    lbOTer: TLabel;
    btKilepes: TButton;
    sgTFOR: TStringGrid;
    ldPeda: TListBox;
    ldHely: TListBox;
    btInc: TButton;
    btDec: TButton;
    btToEnd: TButton;
    btRnd: TButton;
    lbTant: TLabel;
    edTant: TEdit;
    ldSzak: TListBox;
    lbPedaHelyek: TLabel;
Function VoltHelyNev(St: St3): Boolean;
Function VoltTantNev(St: St3): Boolean;
Procedure OTerKepre;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure sgTFORClick(Sender: TObject);
procedure btIncClick(Sender: TObject);
procedure btDecClick(Sender: TObject);
procedure btToEndClick(Sender: TObject);
procedure btRndClick(Sender: TObject);
procedure ldPedaDblClick(Sender: TObject);
procedure ldHelyDblClick(Sender: TObject);
procedure ldSzakDblClick(Sender: TObject);
procedure edTantKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmOTer: TfmOTer;

implementation

{$R *.dfm}

procedure TfmOTer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmOTer.btKilepesClick(Sender: TObject);
begin
  Close;
end;

Function TfmOTer.VoltHelyNev(St: St3): Boolean;
Var H: Word;
Begin
  VoltHelyNev:= False; If (St='-') Or (St='') Then Exit;
With sgTFOR Do For H:= 1 To ColCount-2 Do If St=Cells[H,1] Then
Begin VoltHelyNev:= True; Break End;
End;

Function TfmOTer.VoltTantNev(St: St3): Boolean;
Var T: Word;
Begin
  VoltTantNev:= False; If (St='-') Or (St='') Then Exit;
With sgTFOR Do For T:= 1 To RowCount-2 Do If St=Cells[0,T] Then
Begin VoltTantNev:= True; Break End;
End;

procedure TfmOTer.sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTFOR.Canvas.Brush Do
Begin
If (gdFixed In State) And ((Col=Acol) Or (Row=ARow)) Then
    Color:= clYellow Else Color:= clBtnFace;
If gdSelected In State Then Color:= clLime;
If Not((gdSelected In State) Or (gdFixed In State)) Then Color:= clWindow;
End;
  sgTFOR.Canvas.TextRect(Rect,Rect.Left+1,Rect.Top,sgTFOR.Cells[Col,Row]);
If gdFocused In State Then sgTFOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmOTer.sgTFORClick(Sender: TObject);
begin
With sgTFOR Do With ATFOR Do
Begin
If Col=ColCount-1 Then Col:= ColCount-2;
If Row=RowCount-1 Then Row:= RowCount-2;
    edTant.Text:= Cells[0,Row]; ACol:= Col; ARow:= Row; RePaint;
With ldPeda Do If Row Mod 2=0 Then
    ItemIndex:= OTer[Col,Row Div 2,3] Else
    ItemIndex:= OTer[Col,Row Div 2,4];
With ldHely Do ItemIndex:= OHel[Col];
With ldSzak Do If Row Mod 2=0 Then
    ItemIndex:= OTer[Col,Row Div 2,5] Else
    ItemIndex:= OTer[Col,Row Div 2,6];
End;
end;

procedure TfmOTer.FormCreate(Sender: TObject);
Var O, P, H: Word;
begin
  ACol:= 1; ARow:= 2;
With sgTFOR Do With ATFOR Do
Begin
    Cells[0,1]:= 'Ter:';
    Cells[ColCount-1,0]:= 'Sum'; Cells[0,RowCount-1]:= 'Sum';
For O:= 1 To OMax Do Cells[O,0]:= ONev[O];
End;
With ATFOR Do
Begin
With ldPeda Do For P:= 0 To PMax Do Items.Add(PRov[P]);
With ldHely Do For H:= 0 To HMax Do Items.Add(HNev[H]);
With ldSzak Do For H:= 0 To HMax Do Items.Add(HNev[H]);
End;
  OTerKepre; sgTFORClick(Sender);
end;

Procedure TfmOTer.OTerKepre;
Var O, T, S, Sz: Word;
Begin
With sgTFOR Do With ATFOR Do
Begin
For T:= 1 To TMax Do Cells[0,2*T]:= TNev[T];
For O:= 1 To OMax Do
Begin
      S:= 0;
For T:= 1 To TMax Do
Begin
        Cells[O,1]:= HNev[OHel[O]];
If OTer[O,T,1]>0 Then
        Cells[O,2*T  ]:= IntToStr(OTer[O,T,1])+':'+
        Copy(PRov[OTer[O,T,3]],1,2) Else
        Cells[O,2*T  ]:= ''; Inc(S,OTer[O,T,1]);
If OTer[O,T,2]>0 Then
        Cells[O,2*T+1]:= IntToStr(OTer[O,T,2])+':'+
        Copy(PRov[OTer[O,T,4]],1,2) Else
        Cells[O,2*T+1]:= ''; Inc(S,OTer[O,T,2]);
End;
      Cells[O,RowCount-1]:= IntToStr(S);
End;
    Sz:= 0;
For T:= 1 To TMax Do
Begin
      S:= 0;
For O:= 1 To OMax Do Inc(S,OTer[O,T,1]);
If S>0 Then Cells[ColCount-1,2*T]:= IntToStr(S) Else
      Cells[ColCount-1,2*T]:= ''; Inc(Sz,S);
      S:= 0;
For O:= 1 To OMax Do Inc(S,OTer[O,T,2]);
If S>0 Then Cells[ColCount-1,2*T+1]:= IntToStr(S) Else
      Cells[ColCount-1,2*T+1]:= ''; Inc(Sz,S);
End;
    Cells[ColCount-1,RowCount-1]:= IntToStr(Sz);
End;
End;

procedure TfmOTer.btIncClick(Sender: TObject);
begin
With sgTFOR Do With ATFOR Do
Begin
    ATant:= Row Div 2;
If Odd(Row) And (OTer[Col,ATant,1]>0) Then Inc(OTer[Col,ATant,2])
Else Inc(OTer[Col,ATant,1]);
If OTer[Col,ATant,1]>9 Then OTer[Col,ATant,1]:= 9;
If OTer[Col,ATant,2]>9 Then OTer[Col,ATant,2]:= 9;
End;
  OTerKepre;
end;

procedure TfmOTer.btDecClick(Sender: TObject);
begin
With sgTFOR Do With ATFOR Do
Begin
    ATant:= Row Div 2;
If Odd(Row) And (OTer[Col,ATant,1]>0) Then Dec(OTer[Col,ATant,2])
Else Dec(OTer[Col,ATant,1]);
If OTer[Col,ATant,1]>9 Then OTer[Col,ATant,1]:= 0;
If OTer[Col,ATant,2]>9 Then OTer[Col,ATant,2]:= 0;
End;
  OTerKepre
end;

procedure TfmOTer.btToEndClick(Sender: TObject);
Var O: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
    ATant:= Row Div 2;
If Not Odd(Row) Then For O:= Col+1 To OMax Do
    OTer[O,ATant,1]:= OTer[Col,ATant,1] Else
For O:= Col+1 To OMax Do OTer[O,ATant,2]:= OTer[Col,ATant,2];
End;
  OTerKepre;
end;

procedure TfmOTer.btRndClick(Sender: TObject);
Var O, P, T, H: Word;
begin
With ATFOR Do
Begin
For O:= 1 To OMax Do For T:= 1 To TMax Do
For P:= 3 To 6 Do OTer[O,T,P]:= 0;
For O:= 1 To Omax Do Begin OHel[O]:= 0; OOfo[O]:= 0 End;
End;
For P:= 1 To PMax Do PHOSz[P]:= 0;
With ATFOR Do For O:= 1 To OMax Do For T:= 2 To TMax Do
Begin
If OTer[O,T,1]>0 Then
Begin
      P:= Random(PMax)+1;
While PHOSz[P]+OTer[O,T,1]>OSzM-1 Do P:= Random(PMax)+1;
      Inc(PHOSz[P],OTer[O,T,1]); OTer[O,T,3]:= P;
End;
If OTer[O,T,2]>0 Then
Begin
      P:= Random(PMax)+1;
While (PHOSz[P]+OTer[O,T,2]>OSzM-1) Or (OTer[O,T,3]=P) Do
      P:= Random(PMax)+1;
      Inc(PHOSz[P],OTer[O,T,2]); OTer[O,T,4]:= P;
End;
End;
With sgTFOR Do With ATFOR Do For O:= 1 To OMax Do
Begin
    H:= Random(HMax)+1;
While VoltHelyNev(HNev[H]) Do H:= Random(HMax)+1;
    OHel[O]:= H; Cells[O,1]:= HNev[H];
    P:= Random(PMax)+1;
While VoltOfo(P) Do P:= Random(PMax)+1;
    OOfo[O]:= P; OTer[O,1,3]:= P;
End;
  OTerKepre; sgTFORClick(Sender);
end;

procedure TfmOTer.ldPedaDblClick(Sender: TObject);
begin
With sgTFOR Do With ldPeda Do With ATFOR Do
Begin
    ATant:= Row Div 2; If ATant=1 Then If VoltOfo(ItemIndex) Then Exit;
If Not Odd(Row) And (OTer[Col,ATant,1]>0) Then
    OTer[Col,ATant,3]:= ItemIndex;
If Odd(Row) And (OTer[Col,ATant,2]>0) Then OTer[Col,ATant,4]:= ItemIndex;
If Col<ColCount-2 Then Col:= Col+1;
End;
  OTerKepre;
end;

procedure TfmOTer.ldHelyDblClick(Sender: TObject);
begin
With sgTFOR Do With ldHely Do If Not VoltHelyNev(Items[ItemIndex]) Then
Begin
    Cells[Col,1]:= Items[ItemIndex]; ATFOR.OHel[Col]:= ItemIndex;
If Col<ColCount-2 Then Col:= Col+1;
End;
end;

procedure TfmOTer.ldSzakDblClick(Sender: TObject);
begin
With sgTFOR Do With ldSzak Do With ATFOR Do
Begin
    ATant:= Row Div 2;
If Not Odd(Row) And (OTer[Col,ATant,1]>0) Then
    OTer[Col,ATant,5]:= ItemIndex;
If Odd(Row) And (OTer[Col,ATant,2]>0) Then OTer[Col,ATant,6]:= ItemIndex;
If Col<ColCount-2 Then Col:= Col+1;
End;
  OTerKepre;
end;

procedure TfmOTer.edTantKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then
With sgTFOR Do With edTant Do If Not VoltTantNev(Text) Then
Begin
If Text='' Then Text:= '-'; Cells[0,2*(Row Div 2)]:= Text;
    ATFOR.TNev[Row Div 2]:= Text;
If Row<RowCount-2 Then Row:= Row+1;
End;
end;

end.

Kódolás (4)

Folytassuk a kódolást a géppel segített órarendkészítéssel, azon belül először a Pedagógus órarenddel. A Programtervben leírtaknak megfelelően a következőkre lesz lehetőségünk:

- A pedagógusok neve módosítható a beviteli mező segítségével. A kiválasztott sorban található pedagógus neve írható át. A pedagógus neve (itt inkább nevének a rövidítése) maximum 3 karakter lehet. A beírást Enter billentyűvel kell lezárni. Ha üres stringet adunk meg, akkor az egy ’-’ jelre módosul. Nem lehet két pedagógusnak ugyanaz a névrövidítése.

- Ha egy pedagógust kiválasztunk, (az órarend valamelyik sorába állunk) akkor egy táblázatban megjelenik a pedagógus tantárgyfelosztása. Azaz, hogy milyen tantárgyat, melyik osztályban, heti hány órában tanít. A tantárgyfelosztás táblázatának utolsó sorában jelenjen meg a pedagógus heti kötelező, nem óratervi és óratervi óráinak száma. A tantárgyfelosztáson mozogva a pedagógus órarenden aláhúzás karakterek jelennek meg azokban az órákban, ahova a tétel beírható. Ha egy tétel csoportbontásban szerepel, akkor a jelölés mindkét pedagógus órarendjében látható, valamint külön megjelenik a másik pedagógus neve. Ha egy tételből órák vannak beírva, akkor az órarendben a megfelelő óra lila háttérszínnel jelenik meg.

- A lehető legtöbb pedagógus órarendjét jelenítsük meg a képernyőn. Ezt úgy érjük el, hogy minden pedagógus órarend csak egy képernyő sorban fog megjelenni, és a megjelenő órarend csak az osztály jelét fogja tartalmazni. Ha a tantárgyra is kíváncsiak vagyunk, akkor kattintsunk a kérdéses órán, így a tantárgyfelosztáson a megfelelő tétel kiválasztódik, melyből a tétel óraszáma is látható. Szintén láthatóvá válik a tanterem is.

- Óra beírásának menete: válasszuk ki az órarendben a pedagógust és azon belül azt is, hogy mely időpontba szeretnénk órát beírni. Ekkor a tantárgyfelosztás táblázat a pedagógus tantárgyfelosztását fogja tartalmazni. Válasszuk ki a beírandó tételt a tantárgyfelosztásban. Ekkor láthatóvá válik, hogy mely időpontokba írható be a tétel. Nézzük meg, hogy az órarendben a kiválasztott helyen aláhúzás karakter látható-e, ez jelzi a beírhatóságot. Ha igen, akkor kettős kattintással a tételből egy óra a kiválasztott időpontra beírásra kerül. A tantárgyfelosztás felett látható, hogy a tételből hány óra van már Beírva. Természetesen a tétel óraszámánál több órát nem enged a program beírni.

- Órát törölni az órarendből úgy kell, hogy egy beírt órán kettőt kattintunk.

- Ha olyan helyen kattintunk kettőt az órarendben, ahol nincs óra, akkor az az óra tiltott óra lesz, jele: XX. Ha tiltott órán kattintunk kettőt, akkor a tiltás megszűnik. Ha egy nap első (0.) óráján kattintunk tiltás beállítása vagy visszavonása miatt, akkor a teljes napra megtörténik a beállítás illetve visszavonás, ha a nap minden órája üres volt, vagy tiltott.

- Mivel a gépi feltöltéskor is ezt a képernyőt (formot) fogjuk használni, a továbbiakban erre a képernyőre még visszatérünk.

Lássuk a Pedagógus órarend képernyőjét:

A Pedagógus órarendet az UPOR unit tartalmazza, melynek listája:

unit UPOR;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  UAdat, UModul,
  Dialogs, StdCtrls, Grids;

type
  TfmPOR = class(TForm)
    lbPOR: TLabel;
    btKilepes: TButton;
    sgTFOR: TStringGrid;
    edPeda: TEdit;
    lbPeda: TLabel;
    sgPTF: TStringGrid;
    lbBeirva: TLabel;
    lbBeirvaSz: TLabel;
    lbMPeda: TLabel;
    lbHely: TLabel;
    btUpLoad: TButton;
    btDelAll: TButton;
    lbKeszVege: TLabel;
    btRendez: TButton;
    lbMax: TLabel;
    edMax: TEdit;
    edLSz: TEdit;
    lbBad: TLabel;
    lbBest: TLabel;
    edBest: TEdit;
    lbStart: TLabel;
    edStart: TEdit;
    lbStop: TLabel;
    edStop: TEdit;
    lbH: TLabel;
    lbMP: TLabel;
    btDelXX: TButton;
    edRest: TEdit;
    lbR: TLabel;
    lbInfo: TLabel;
Function VoltPedaNev(St: St3): Boolean;
Procedure PORKepre;
Procedure PTFKepre(Peda: Word);
Function Utkozes(I,P: Word): Word;
Procedure Utkozesek;
Procedure UtkKepre;
Procedure Csere(I1,I2,P: Word);
Procedure Keveres(Sender: TObject);
Procedure Csoportok;
Function HibaLista: Word;
Procedure KetOra;
Procedure OsztOsz;
Procedure PHetiOSz;
Procedure HORend;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure sgTFORClick(Sender: TObject);
procedure edPedaKeyPress(Sender: TObject; var Key: Char);
procedure sgPTFClick(Sender: TObject);
procedure sgPTFDblClick(Sender: TObject);
procedure sgTFORDblClick(Sender: TObject);
procedure btUpLoadClick(Sender: TObject);
procedure btDelAllClick(Sender: TObject);
procedure btRendezClick(Sender: TObject);
procedure btDelXXClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmPOR: TfmPOR;
  Ind, Zero: Array[1..HOSz*PMax,1..2] Of Word;
  Lanc: Array[0..PMax+1] Of Word;
  PBeir, PUtk, Cso, PCso: Array[0..HOSz+1,0..PMax+1] Of Word;
  PPOR: Array[0..HOSz+1,0..PMax+1,0..4] Of Word;
  Leh, ULeh: Array[1..HOSz] Of Word;
  UtkOsz, OldUtkOSz, PUtkOSz, Rest, Valt: Word;
  LSz, LMax: LongInt;

implementation

{$R *.dfm}

procedure TfmPOR.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmPOR.btKilepesClick(Sender: TObject);
begin
  Close;
end;

Function TfmPOR.VoltPedaNev(St: St3): Boolean;
Var P: Word;
Begin
  VoltPedaNev:= False; If (St='-') Or (St='') Then Exit;
With sgTFOR Do For P:= 1 To RowCount-2 Do If St=Cells[0,P] Then
Begin VoltPedaNev:= True; Break End;
End;

procedure TfmPOR.sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTFOR.Canvas.Brush Do
Begin
If (gdFixed In State) And ((Col=Acol) Or (Row=ARow)) Then
    Color:= clYellow Else Color:= clBtnFace;
If gdSelected In State Then Color:= clLime;
If Not((gdSelected In State) Or (gdFixed In State)) Then
Begin
Case Col Of
        2..7,12..17,22..27,32..37,42..47: Color:= RGB(232,232,232);
Else Color:= clWindow;
End;
If PBeir[Col,Row]=1 Then Color:= clFuchsia Else
If PUtk[Col,Row]=KetO Then Color:= RGB($DF,$B0,$20) Else
If PUtk[Col,Row]>0 Then Color:= clRed;
End;
End;
  sgTFOR.Canvas.TextRect(Rect,Rect.Left,Rect.Top,sgTFOR.Cells[Col,Row]);
If gdFocused In State Then sgTFOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmPOR.sgTFORClick(Sender: TObject);
Var I, P, T: Word;
begin
With sgTFOR Do
Begin
If Col=ColCount-1 Then Col:= ColCount-2;
If Row=RowCount-1 Then Row:= RowCount-2;
For I:= 1 To HOSz Do For P:= 1 To PMax Do If Cells[I,P]=Jel
Then Cells[I,P]:= '';
    edPeda.Text:= Cells[0,Row]; ACol:= Col; ARow:= Row; RePaint;
    APeda:= Row; AIdop:= Col; PTFKepre(Row);
End;
With sgPTF Do With ATFOR Do If POra[AIdop,APeda,1] In [1..TMax] Then
Begin
For T:= 1 To RowCount-2 Do
If (POra[AIdop,APeda,1]=TNevToInd(Cells[0,T])) And
       (POra[AIdop,APeda,2]=ONevToInd(Cells[1,T])) Then
Begin Row:= T; Break End;
End;
  sgPTF.Repaint; lbMPeda.Repaint; edPeda.Repaint; lbHely.Repaint;
  sgPTFClick(Sender);
end;

procedure TfmPOR.FormCreate(Sender: TObject);
Var I, J: Word;
begin
  ACol:= 1; ARow:= 1; Valt:= 0; LMax:= 200000; PUtkOSz:= 65000;
For I:= 1 To HOSz*PMax Do For J:= 1 To 2 Do Zero[I,J]:= 0; Ind:= Zero;
For I:= 1 To HOSz Do Leh[I]:= 0; ULeh:= Leh;
With sgTFOR Do With ATFOR Do
Begin
    ColWidths[0]:= 25; ColWidths[ColCount-1]:= 24;
    Cells[ColCount-1,0]:= 'Sum'; Cells[0,RowCount-1]:= 'Sum';
For I:= 1 To HOSz Do Cells[I,0]:= INev[I];
End;
  Csoportok; PORKepre; sgTFORClick(Sender);
With sgPTF Do
Begin
    Cells[0,0]:= 'Tant'; Cells[1,0]:= 'Oszt'; Cells[2,0]:= 'Órsz';
End;
end;

Procedure TfmPOR.PORKepre;
Var I, P, S, Sz: Word;
    St: St3;
Begin
With sgTFOR Do With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do Cells[I,P]:= '';
For P:= 1 To PMax Do Cells[0,P]:= PRov[P];
For P:= 1 To PMax Do
Begin
      S:= 0;
For I:= 1 To HOSz Do
Begin
        St:= ONev[POra[I,P,2]]; If Cso[I,P]>0 Then St:= UpONev(St);
If POra[I,P,1]<>Tilt Then
        Cells[I,P]:= St Else Cells[I,P]:= 'XX';
If POra[I,P,1] In [1..TMax] Then Inc(S);
End; Cells[ColCount-1,P]:= IntToStr(S);
End;
    Sz:= 0;
For I:= 1 To HOSz Do
Begin
      S:= 0;
For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
Begin Inc(S); Inc(Sz) End; Cells[I,RowCount-1]:= IntToStr(S);
End; Cells[ColCount-1,RowCount-1]:= IntToStr(Sz);
End;
End;

Procedure TfmPOR.PTFKepre(Peda: Word);
Var O, T, S, Sz: Word;
Begin
With sgPTF Do With ATFOR Do
Begin
    S:= 0; Sz:= 0;
For O:= 0 To ColCount-1 Do For T:= 1 To RowCount-2 Do Cells[O,T]:= '';
For O:= 1 To OMax Do For T:= 1 To TMax Do
If OTer[O,T,1]<>0 Then If (OTer[O,T,3]=Peda) Or (OTer[O,T,4]=Peda) Then
Begin
      Inc(S); sgPTF.Cells[0,S]:= TNev[T]; sgPTF.Cells[1,S]:= ONev[O];
      sgPTF.Cells[2,S]:= IntToStr(OTer[O,T,1]); Inc(Sz,OTer[O,T,1]);
End;
With sgPTF Do
Begin
      Cells[0,RowCount-1]:= IntToStr(PKot[Peda]);
      Cells[1,RowCount-1]:= IntToStr(PNOT[Peda]);
      Cells[2,RowCount-1]:= IntToStr(Sz);
End;
End;
End;

Function TfmPOR.Utkozes(I,P: Word): Word;
Var K, KI, I1: Word;
Begin
With ATFOR Do
Begin
    PUtk[I,P]:= 0; Utkozes:= PUtk[I,P]; If POra[I,P,1] In [0,Tilt] Then Exit;
If (POra[I,P,1]<>0) And (OLeh[I,2*POra[I,P,2]-1]=0) Then Inc(PUtk[I,P],2);
For K:= 1 To PMax Do If (K<>P) And (POra[I,K,2]<>0) Then
Begin
If (Cso[I,K]=0) And (POra[I,K,2]=POra[I,P,2]) Then Inc(PUtk[I,P]) Else
If (K<>Cso[I,P]) And (POra[I,K,2]=POra[I,P,2]) Then Inc(PUtk[I,P]);
End;
    I1:= NOSz*((I-1) Div NOSz)+1;
For K:= I1 To I1+NOSz-1 Do If (K<>I) And (POra[K,P,1]<>0) Then
If (POra[K,P,1]=POra[I,P,1]) And (POra[K,P,2]=POra[I,P,2]) Then
    Inc(PUtk[I,P]);
If OTer[POra[I,P,2],POra[I,P,1],1]=2 Then
Begin
      KI:= 0;
For K:= 1 To HOSz Do If (K<>I) Then
If (POra[K,P,1]=POra[I,P,1]) And (POra[K,P,2]=POra[I,P,2]) Then
Begin KI:= K; Break End;
If Abs(((I-1) Div NOsz)-((KI-1) Div NOSz))=1 Then Inc(PUtk[I,P]);
End;
End; Utkozes:= PUtk[I,P];
End;

Procedure TfmPOR.Utkozesek;
Var I, P: Word;
Begin
  UtkOsz:= 0;
For I:= 1 To HOSz Do For P:= 1 To PMax Do Inc(UtkOsz,Utkozes(I,P));
End;

Procedure TfmPOR.UtkKepre;
Var I, P, Sz: Word;
Begin
With sgTFOR Do For I:= 1 To HOSz Do
Begin
    Sz:= 0; For P:= 1 To PMax Do Inc(Sz,PUtk[I,P]);
    Cells[I,RowCount-1]:= IntToStr(Sz);
End;
If Valt= 100 Then Valt:= 1;
If Valt>0 Then With sgPTF do
Begin
    Col:= (Valt-1) Mod 3;
    Row:= (Valt-1) Div 3+1;
    Cells[Col,Row]:= IntToStr(UtkOSz);
End; lbKeszVege.Caption:= IntToStr(UtkOSz);
End;

Procedure TfmPOR.Csere(I1,I2,P: Word);
Var K, Puf: Word;
    Lehet: Boolean;
Begin
With ATFOR Do
Begin
If (POra[I1,P,4]=1) Or (POra[I2,P,4]=1) Then Exit;
If (POra[I1,P,1]=POra[I2,P,1]) And (POra[I1,P,2]=POra[I2,P,2]) Then Exit;
If Cso[I1,P]+Cso[I2,P]=0 Then
Begin
      Puf:= POra[I1,P,1]; POra[I1,P,1]:= POra[I2,P,1]; POra[I2,P,1]:= Puf;
      Puf:= POra[I1,P,2]; POra[I1,P,2]:= POra[I2,P,2]; POra[I2,P,2]:= Puf;
      Puf:= POra[I1,P,4]; POra[I1,P,4]:= POra[I2,P,4]; POra[I2,P,4]:= Puf;
      Puf:= Cso[I1,P]; Cso[I1,P]:= Cso[I2,P]; Cso[I2,P]:= Puf; Exit;
End Else
Begin
For K:= 0 To PMax Do Lanc[K]:= 0; Lanc[P]:= 1;
      Puf:= Cso[I1,P]; K:= 1;
While (Puf<>0) And (K<=PMax) Do
Begin
        Lanc[Puf]:= 1;
If Odd(K) Then Puf:= Cso[I2,Puf] Else Puf:= Cso[I1,Puf]; Inc(K);
End;
      Puf:= Cso[I2,P]; K:= 1;
While (Puf<>0) And (K<=PMax) Do
Begin
        Lanc[Puf]:= 1;
If Odd(K) Then Puf:= Cso[I1,Puf] Else Puf:= Cso[I2,Puf]; Inc(K);
End;
      Lehet:= True;
For K:= 1 To PMax Do If Lanc[K]>0 Then
If (POra[I1,K,4]=1) Or (POra[I2,K,4]=1) Then
Begin Lehet:= False; Break End;
If Lehet Then For K:= 1 To PMax Do If Lanc[K]>0 Then
Begin
        Puf:= POra[I1,K,1]; POra[I1,K,1]:= POra[I2,K,1]; POra[I2,K,1]:= Puf;
        Puf:= POra[I1,K,2]; POra[I1,K,2]:= POra[I2,K,2]; POra[I2,K,2]:= Puf;
        Puf:= POra[I1,K,4]; POra[I1,K,4]:= POra[I2,K,4]; POra[I2,K,4]:= Puf;
        Puf:= Cso[I1,K]; Cso[I1,K]:= Cso[I2,K]; Cso[I2,K]:= Puf;
End;
End;
End;
End;

Procedure TfmPOR.Keveres(Sender: TObject);
Var K, I1, I2, P: Word;
Begin
If (Rest Mod NaSz)=0 Then btUpLoadClick(Sender) Else With ATFOR Do
For P:= 1 To PMax Do For K:= 1 To 2*(((Rest-1) Mod NaSz)+1) Do
Begin
    I1:= Random(HOsz)+1; I2:= Random(HOSz)+1;
If Rest Mod NaSz>2 Then While (POra[I1,P,4]=1) Or (POra[I2,P,4]=1) Do
Begin I1:= Random(HOsz)+1; I2:= Random(HOSz)+1 End Else
While (POra[I1,P,4]=1) Or (POra[I2,P,4]=1) Or
          (Cso[I1,P]>0) Or (Cso[I2,P]>0) Do
Begin I1:= Random(HOsz)+1; I2:= Random(HOSz)+1 End;
    Csere(I1,I2,P);
End;
End;

Procedure TfmPOR.Csoportok;
Var I, P, k: Word;
Begin
With sgTFOR Do With ATFOR Do
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
For K:= 1 To PMax Do If K<>P Then
If (POra[I,K,1]=POra[I,P,1]) And (POra[I,K,2]=POra[I,P,2]) Then Cso[I,P]:= K;
End;

Function TfmPOR.HibaLista: Word;
Var I, P, K: Word;
Begin
  Ind:= Zero; K:= 0; With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If (PUtk[I,P]>0) And (POra[I,P,4]<>1) Then
Begin Inc(K); Ind[K,1]:= I; Ind[K,2]:= P End; HibaLista:= K;
End;

procedure TfmPOR.edPedaKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then
With sgTFOR Do With edPeda Do If Not VoltPedaNev(Text) Then
Begin
If Text='' Then Text:= '-'; Cells[0,Row]:= Text; ATFOR.PRov[Row]:= Text;
If Row<RowCount-2 Then Row:= Row+1;
End;
end;

procedure TfmPOR.sgPTFClick(Sender: TObject);
Var I, P, P1, P2, PP, Sz: Word;
    Van: Boolean;
begin
With sgPTF Do Begin
If (Valt=0) And (Row=RowCount-1) Then Row:= RowCount-2 End;
  MPeda:= 0; Sz:= 0; lbBeirvaSz.Caption:= '0';
For I:= 0 To HOSz Do For P:= 0 To PMax+1 Do PBeir[I,P]:= 0;
With sgTFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do
If Cells[I,P]=Jel Then Cells[I,P]:= ''; P1:= Row;
End;
  P2:= 0; PP:= 0;
With sgPTF Do
Begin
    ATant:= TNevToInd(Cells[0,Row]); AOszt:= ONevToInd(Cells[1,Row]);
    lbHely.Caption:= ATFOR.HNev[TTetToHely(AOszt,ATant)];
End;
With ATFOR Do
If OTer[AOszt,ATant,1]*OTer[AOszt,ATant,2]>0 Then
Begin
If OTer[AOszt,ATant,3]=P1 Then Begin P2:= OTer[AOszt,ATant,4]; PP:= P2 End
Else If OTer[AOszt,ATant,4]=P1 Then
Begin P1:= OTer[AOszt,ATant,3]; PP:= P1; P2:= OTer[AOszt,ATant,4] End;
    lbMPeda.Caption:= ATFOR.PRov[PP];
End Else Begin P2:= 0; lbMPeda.Caption:= '-        ' End;
With sgPTF Do If Cells[0,Row]<>'' Then With ATFOR Do
Begin
For I:= 1 To HOSz Do
If (TNev[POra[I,P1,1]]= Cells[0,Row]) And (POra[I,P1,2]=AOszt) Then
Begin Inc(Sz); PBeir[I,P1]:= 1; If P2<>0 Then PBeir[I,P2]:= 1 End;
    lbBeirvaSz.Caption:= IntToStr(Sz);
If P2=0 Then
Begin
For I:= 1 To HOSz Do If POra[I,P1,1]=0 Then
Begin
        Van:= False; For P:= 1 To PMax Do If POra[I,P,2]=AOszt Then
Begin Van:= True; Break End;
If Not Van Then Begin sgTFOR.Cells[I,P1]:= Jel End;
End;
End Else
For I:= 1 To HOSz Do If (POra[I,P1,1]=0) And (POra[I,P2,1]=0) Then
Begin
      Van:= False; For P:= 1 To PMax Do If POra[I,P,2]=AOszt Then
Begin Van:= True; Break End; If Not Van Then
Begin sgTFOR.Cells[I,P1]:= Jel; sgTFOR.Cells[I,P2]:= Jel End;
End;
End; MPeda:= PP; sgTFOR.Repaint; lbBeirvaSz.Repaint; lbHely.Repaint;
end;

procedure TfmPOR.sgPTFDblClick(Sender: TObject);
begin
With sgPTF Do If lbBeirvaSz.Caption>=Cells[2,Row] Then Exit;
With sgTFOR Do If Cells[Col,Row]<>Jel Then Exit;
With sgTFOR Do With ATFOR Do
Begin
    POra[Col,Row,1]:= TNevToInd(sgPTF.Cells[0,sgPTF.Row]);
    POra[Col,Row,2]:= ONevToInd(sgPTF.Cells[1,sgPTF.Row]);
    POra[Col,Row,3]:= TTetToHely(POra[Col,Row,2],POra[Col,Row,1]);
    POra[Col,Row,4]:= 1;
If MPeda>0 Then
Begin
      POra[Col,MPeda,1]:= TNevToInd(sgPTF.Cells[0,sgPTF.Row]);
      POra[Col,MPeda,2]:= ONevToInd(sgPTF.Cells[1,sgPTF.Row]);
      POra[Col,MPeda,3]:= TTetToHely(POra[Col,MPeda,2],POra[Col,MPeda,1]);
      POra[Col,MPeda,4]:= 1;
      Cso[Col,APeda]:= MPeda; Cso[Col,MPeda]:= APeda;
End;
If Col<ColCount-2 Then Col:= Col+1;
End; PORKepre; sgPTFClick(Sender);
end;

procedure TfmPOR.sgTFORDblClick(Sender: TObject);
Var I, P, KI: Word;
    Mind: Boolean;
begin
With sgTFOR Do With ATFOR Do
Begin
Case POra[Col,Row,1] Of
            0: Begin
                 KI:= NOSz*((Col-1) Div NOSz)+1; Mind:= True;
For I:= KI To KI+NOSz-1 Do If POra[I,Row,1]<>0 Then
Begin Mind:= False; Break End;
If ((Col-1) Mod NOSz=0) And Mind Then
For I:= KI To KI+NOSz-1 Do
Begin POra[I,Row,1]:= Tilt; POra[I,Row,4]:= 1 End
Else Begin POra[Col,Row,1]:= Tilt; POra[Col,Row,4]:= 1 End;
End;
         Tilt: Begin
                 KI:= NOSz*((Col-1) Div NOSz)+1; Mind:= True;
For I:= KI To KI+NOSz-1 Do If POra[I,Row,1]<>Tilt Then
Begin Mind:= False; Break End;
If ((Col-1) Mod NOSz=0) And Mind Then
For I:= KI To KI+NOSz-1 Do
Begin POra[I,Row,1]:= 0; POra[I,Row,4]:= 0 End
Else Begin POra[Col,Row,1]:= 0; POra[Col,Row,4]:= 0 End;
End;
      1..TMax: Begin
               MPeda:= 0;
For P:= 1 To PMax Do If P<>Row Then
If (POra[Col,P,1]=POra[Col,Row,1]) And
                  (POra[Col,P,2]=POra[Col,Row,2]) Then
Begin MPeda:= P; Break End;
For I:= 1 To 4 Do POra[Col,Row,I]:= 0;
If MPeda<>0 Then For I:= 1 To 4 Do POra[Col,MPeda,I]:= 0;
End;
End; If Col<ColCount-2 Then Col:= Col+1;
End; PORKepre; sgPTFClick(Sender);
end;

procedure TfmPOR.btDelAllClick(Sender: TObject);
Var I, P, K: Word;
begin
With ATFOR Do For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do
Begin
    PBeir[I,P]:= 0; PUtk[I,P]:= 0;
If POra[I,P,4]=2 Then For K:= 0 To 4 Do POra[I,P,K]:= 0;
End; PORKepre;
end;

procedure TfmPOR.btDelXXClick(Sender: TObject);
Var I, P: Word;
begin
With ATFOR Do For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do
If POra[I,P,1]=Tilt Then POra[I,P,1]:= 0; PORKepre;
end;

procedure TfmPOR.btUpLoadClick(Sender: TObject);
Var O, T, P, I, N, S: Word;
begin
  Csoportok;
With sgTFOR Do With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,4]<>1 Then
Begin Cso[I,P]:= 0; For N:= 0 To 4 Do POra[I,P,N]:= 0 End;
For O:= 1 To OMax Do For T:= 1 To TMax Do
Begin
      APeda:= OTer[O,T,3]; MPeda:= OTer[O,T,4]; I:= Random(HOSz)+1;
If MPeda<>0 Then
Begin
        S:= OTer[O,T,1]-PORBeirt(APeda,T,O);
For N:= 1 To S Do
Begin
While (POra[I,APeda,1]<>0) Or (POra[I,MPeda,1]<>0) Do
          I:= Random(HOSz)+1;
          POra[I,APeda,1]:= T; POra[I,APeda,2]:= O; POra[I,APeda,4]:= 2;
          POra[I,MPeda,1]:= T; POra[I,MPeda,2]:= O; POra[I,MPeda,4]:= 2;
          Cso[I,APeda]:= MPeda; Cso[I,MPeda]:= APeda;
End;
End Else
If MPeda=0 Then
Begin
        S:= OTer[O,T,1]-PORBeirt(APeda,T,O);
For N:= 1 To S Do
Begin
While POra[I,APeda,1]<>0 Do I:= Random(HOsz)+1;
          POra[I,APeda,1]:= T; POra[I,APeda,2]:= O; POra[I,APeda,4]:= 2;
End;
End;
End;
End; Utkozesek; PORKepre; UtkKepre;
end;

Procedure TfmPOR.KetOra;
Var P, I, K: Word;
Begin
With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do PUtk[I,P]:= 0;
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
If OTer[POra[I,P,2],POra[I,P,1],1]=2 Then For K:= 1 To HOSz Do
If (POra[I,P,1]=POra[K,P,1]) And (POra[I,P,1]=POra[K,P,1]) Then
    PUtk[I,P]:= KetO;
End;
End;

Procedure TfmPOR.OsztOSz;
Var I, P, S: Word;
Begin
With sgTFOR Do For I:= 1 To HOSz Do
Begin
    S:= 0; For P:= 1 To PMax Do
If (Cells[I,P]<>'') And (Cells[I,P]<>'XX') Then Inc(S);
    Cells[I,RowCount-1]:= IntToStr(S);
End;
End;

Procedure TfmPOR.PHetiOSz;
Var O, T, P: Word;
Begin
For P:= 0 To PMax+1 Do PHOsz[P]:= 0; With ATFOR Do
For O:= 1 To OMax Do For T:= 1 To TMax Do If OTer[O,T,1]>0 Then
Begin
    Inc(PHOSz[OTer[O,T,3]],OTer[O,T,1]); Inc(PHOSz[OTer[O,T,4]],OTer[O,T,2]);
End;
End;

Procedure TfmPOR.HORend;
Var I, P, P1, K: Word;
    L: Integer;
Begin
With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do
Begin
      POra[I,P,3]:= 0; If POra[I,P,1] In [1..TMax] Then
      POra[I,P,3]:= TTetToHely(POra[I,P,2],POra[I,P,1]);
End;
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
For P1:= 1 To PMax Do If (P1<>P) And (POra[I,P1,3]=POra[I,P,3]) Then
Begin
      AHely:= Pora[I,P1,3]; POra[I,P1,3]:= 0;
For K:= 1 To HMax Div 2+1 Do
Begin
        L:= 0; If Odd(K) Then L:= AHely-K; If L<1 Then L:= HMax;
If Not Odd(K) Then L:= AHely+K; If L>HMax Then L:= 1;
If UresHely(I,L) Then POra[I,P1,3]:= L;
End;
End;
End;
End;

procedure TfmPOR.btRendezClick(Sender: TObject);
Var I, I1, P, K, A, Index, RIndex, Ismet, KIsm, VIsm: Word;
    Volt: Boolean;
begin
  PHetiOSz;
With sgPTF Do
Begin
    Row:= RowCount-2; sgPTFClick(Sender);
For I:= 0 To ColCount-1 Do For K:= 1 To RowCount-1 Do Cells[I,K]:= '';
    Valt:= 0; RePaint;
End;
  PUtkOSz:= 65000; edStart.Text:= TimeToStr(GetTime); edStart.Repaint;
  edStop.Text:= ''; edStop.Repaint;
  LSz:= 0; Volt:= False; OldUtkOSz:= 0; Ismet:= 0; Rest:= 0;
  lbKeszVege.Caption:= ''; Index:= HibaLista;
With ATFOR Do While (Index>0) And (LSz<LMax) Do
Begin
If OldUtkOSz=UtkOSz Then
Begin
      Inc(Ismet); If Ismet>2500 Then
Begin
        Ismet:= 0; If UtkOSz<=PUtkOSz Then
Begin
          PUtkOSz:= UtkOSz;
For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do For K:= 0 To 4 Do
          PPOR[I,P,K]:= POra[I,P,K]; PCSO:= CSO;
          edBest.Text:= IntToStr(PUtkOSz);
End;
        Inc(Rest); Inc(Valt); edRest.Text:= IntToStr(Rest+1); Keveres(Sender);
        Utkozesek; PORKepre; UtkKepre; edLSz.Text:= IntToStr(LSz); RePaint;
Index:= HibaLista;
End;
End Else Ismet:= 0; Inc(LSz);
//A<->b típusú csere
If Volt Then Index:= Hibalista; A:= UtkOSz; OldUtkOSz:= A;
    RIndex:= Random(Index)+1; I:= Ind[RIndex,1]; P:= Ind[RIndex,2];
For K:= 1 To 2 Do
If (Cso[I,P]=0) Or (OTer[POra[I,P,2],POra[I,P,1],1]<4) Or
       (PHOsz[P]<OSzM-4) Then
Begin RIndex:= Random(Index)+1; I:= Ind[RIndex,1]; P:= Ind[RIndex,2] End;
    Leh:= ULeh; KIsm:= 0; Leh[I]:= 1;
If UtkOSz<HOSz Then VIsm:= HOSz-UtkOSz Else VIsm:= 2;
While KIsm<VIsm Do
Begin
      Inc(KIsm); I1:= Random(HOsz)+1;
While (Leh[I1]=1) Or (I=I1) Do I1:= Random(HOsz)+1;
      Leh[I1]:= 1; Csere(I,I1,P); Utkozesek;
If UtkOSz>A Then Begin Csere(I,I1,P); Utkozesek; Volt:= False End
Else Begin KIsm:= HOSz; Volt:= True End;
End;
If LSz Mod 1000=0 Then
Begin
      PORKepre; Inc(Valt); UtkKepre; edLSz.Text:= IntToStr(LSz); Repaint;
End;
End;
With ATFOR Do If (UtkOSz>0) And (UtkOSz>=PUtkOSz) Then
Begin
    edBest.Text:= IntToStr(PUtkOSz);
For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do For K:= 0 To 4 Do
    POra[I,P,K]:= PPOR[I,P,K]; CSO:= PCSO; Utkozesek;
End
Else edBest.Text:= IntToStr(UtkOSz);
  PORKepre; UtkKepre; edLSz.Text:= IntToStr(LSz);
With lbKeszVege Do If UtkOSz=0 Then
Begin KetOra; OsztOSz; HORend; Caption:= 'OK' End Else Caption:= 'End';
  edStop.Text:= TimeToStr(GetTime); Valt:= 0;
end;

end.

Kódolás (5)

A géppel segített órarendkészítés másik beviteli felülete az Osztályórarend lesz. Ennek a felületnek a segítségével hasonló dolgokat végezhetünk, mint Pedagógus órarenddel:

- Az osztályok jele módosítható a beviteli mező segítségével. A kiválasztott sorban található osztály jele írható át. Az osztály jele maximum 3 karakter lehet. A beírást Enter billentyűvel kell lezárni. Ha üres stringet adunk meg, akkor az egy ’-’ jelre módosul. Nem lehet két osztálynak ugyanaz a jele.

- Az osztályok osztályfőnökének bevitelére egy legördülő lista áll rendelkezésre. Az osztályfőnök neve az órarendben az osztály jele alatt látható.

- Ha egy osztályt kiválasztunk, (az órarend valamelyik sorába állunk) akkor egy táblázatban megjelenik az osztály tantárgyfelosztása. Azaz, hogy az egyes tantárgyakat, ki tanítja, és heti hány órában. A tantárgyfelosztás táblázatának utolsó sorában jelenjen meg az osztályban hetente tartott összes pedagógus óra. A tantárgyfelosztáson mozogva az osztályórarenden aláhúzás karakterek jelennek meg azokban az órákban, ahova a tétel beírható. Ha egy tétel csoportbontásban szerepel, akkor a jelölés az osztályórarend mindkét sorában látható, valamint külön megjelenik a másik pedagógus neve. Ha egy tételből órák vannak beírva, akkor az órarendben a megfelelő óra lila háttérszínnel jelenik meg.

- Az osztályok órarendjét két sorban jelenítsük meg a képernyőn. A két sorra a csoportbontás miatt van szükség. A képernyőn csak a pedagógusok nevének rövidítése fog megjelenni (csoportbontáskor kettő). Ha a tantárgyra is kíváncsiak vagyunk, akkor kattintsunk a kérdéses órán, így a tantárgyfelosztáson a megfelelő tétel kiválasztódik, melyből a tétel óraszáma is látható.

- Óra beírásának menete: válasszuk ki az órarendben az osztályt és azon belül azt is, hogy mely időpontba szeretnénk órát beírni. Ekkor a tantárgyfelosztás táblázat a kiválasztott osztály tantárgyfelosztását fogja tartalmazni. Válasszuk ki a beírandó tételt a tantárgyfelosztásban. Ekkor láthatóvá válik, hogy mely időpontokba írható be a tétel. Nézzük meg, hogy az órarendben a kiválasztott helyen aláhúzás karakter látható-e, ez jelzi a beírhatóságot. Ha igen, akkor kettős kattintással a tételből egy óra a kiválasztott időpontra beírásra kerül. A tantárgyfelosztás felett látható, hogy a tételből hány óra van már Beírva. Természetesen a tétel óraszámánál több órát nem enged a program beírni.

- Órát törölni az órarendből úgy kell, hogy egy beírt órán kettőt kattintunk.

- Ha olyan helyen kattintunk kettőt az órarendben, ahol nincs óra, akkor az az óra tiltott óra lesz, melyet az órarend fehér háttérszínnel jelöl, míg a megengedett órák jelölése szürke háttérszínnel történik. Ha tiltott órán kattintunk kettőt, akkor a tiltás megszűnik. Ha több osztályra szeretnénk tiltást beállítani vagy megszüntetni, akkor álljunk egy olyan osztályra és órára, amelyiktől, és amelyik órára a beállítás vonatkozik, kettős kattintással állítsuk be a szükséges állapotot, lépjünk vissza a kérdéses helyre, majd nyomjuk meg a ToEnd nyomógombot, melynek hatására a kérdéses osztálytól az utolsó osztályig a beállítás érvényes lesz. (Hasonlóan az óratervben alkalmazható ToEnd feltöltéshez.) Az órarendből látható, hogy az első évfolyamnak C6 és P6 órája, a második évfolyamnak P6, míg a negyedik évfolyamnak C6 órája nem lehet.

Lássuk az Osztályórarend képernyőjét:

Az Osztályórarendet az UOOR unit tartalmazza, melynek listája:

unit UPOR;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, UModul,
  Dialogs, StdCtrls, Grids;

type
  TfmPOR = class(TForm)
    lbPOR: TLabel;
    btKilepes: TButton;
    sgTFOR: TStringGrid;
    edPeda: TEdit;
    lbPeda: TLabel;
    sgPTF: TStringGrid;
    lbBeirva: TLabel;
    lbBeirvaSz: TLabel;
    lbMPeda: TLabel;
    lbHely: TLabel;
    btUpLoad: TButton;
    btDelAll: TButton;
    lbKeszVege: TLabel;
    btRendez: TButton;
    lbMax: TLabel;
    edMax: TEdit;
    edLSz: TEdit;
    lbBad: TLabel;
    lbBest: TLabel;
    edBest: TEdit;
    lbStart: TLabel;
    edStart: TEdit;
    lbStop: TLabel;
    edStop: TEdit;
    lbH: TLabel;
    lbMP: TLabel;
    btDelXX: TButton;
    edRest: TEdit;
    lbR: TLabel;
    lbInfo: TLabel;
Function VoltPedaNev(St: St3): Boolean;
Procedure PORKepre;
Procedure PTFKepre(Peda: Word);
Function Utkozes(I,P: Word): Word;
Procedure Utkozesek;
Procedure UtkKepre;
Procedure Csere(I1,I2,P: Word);
Procedure Keveres(Sender: TObject);
Procedure Csoportok;
Function HibaLista: Word;
Procedure KetOra;
Procedure OsztOsz;
Procedure PHetiOSz;
Procedure HORend;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure sgTFORClick(Sender: TObject);
procedure edPedaKeyPress(Sender: TObject; var Key: Char);
procedure sgPTFClick(Sender: TObject);
procedure sgPTFDblClick(Sender: TObject);
procedure sgTFORDblClick(Sender: TObject);
procedure btUpLoadClick(Sender: TObject);
procedure btDelAllClick(Sender: TObject);
procedure btRendezClick(Sender: TObject);
procedure btDelXXClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmPOR: TfmPOR;
  Ind, Zero: Array[1..HOSz*PMax,1..2] Of Word;
  Lanc: Array[0..PMax+1] Of Word;
  PBeir, PUtk, Cso, PCso: Array[0..HOSz+1,0..PMax+1] Of Word;
  PPOR: Array[0..HOSz+1,0..PMax+1,0..4] Of Word;
  Leh, ULeh: Array[1..HOSz] Of Word;
  UtkOsz, OldUtkOSz, PUtkOSz, Rest, Valt: Word;
  LSz, LMax: LongInt;

implementation

{$R *.dfm}

procedure TfmPOR.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmPOR.btKilepesClick(Sender: TObject);
begin
  Close;
end;

Function TfmPOR.VoltPedaNev(St: St3): Boolean;
Var P: Word;
Begin
  VoltPedaNev:= False; If (St='-') Or (St='') Then Exit;
With sgTFOR Do For P:= 1 To RowCount-2 Do If St=Cells[0,P] Then
Begin VoltPedaNev:= True; Break End;
End;

procedure TfmPOR.sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTFOR.Canvas.Brush Do
Begin
If (gdFixed In State) And ((Col=Acol) Or (Row=ARow)) Then
    Color:= clYellow Else Color:= clBtnFace;
If gdSelected In State Then Color:= clLime;
If Not((gdSelected In State) Or (gdFixed In State)) Then
Begin
Case Col Of
        2..7,12..17,22..27,32..37,42..47: Color:= RGB(232,232,232);
Else Color:= clWindow;
End;
If PBeir[Col,Row]=1 Then Color:= clFuchsia Else
If PUtk[Col,Row]=KetO Then Color:= RGB($DF,$B0,$20) Else
If PUtk[Col,Row]>0 Then Color:= clRed;
End;
End;
  sgTFOR.Canvas.TextRect(Rect,Rect.Left,Rect.Top,sgTFOR.Cells[Col,Row]);
If gdFocused In State Then sgTFOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmPOR.sgTFORClick(Sender: TObject);
Var I, P, T: Word;
begin
With sgTFOR Do
Begin
If Col=ColCount-1 Then Col:= ColCount-2;
If Row=RowCount-1 Then Row:= RowCount-2;
For I:= 1 To HOSz Do For P:= 1 To PMax Do If Cells[I,P]=Jel
Then Cells[I,P]:= '';
    edPeda.Text:= Cells[0,Row]; ACol:= Col; ARow:= Row; RePaint;
    APeda:= Row; AIdop:= Col; PTFKepre(Row);
End;
With sgPTF Do With ATFOR Do If POra[AIdop,APeda,1] In [1..TMax] Then
Begin
For T:= 1 To RowCount-2 Do
If (POra[AIdop,APeda,1]=TNevToInd(Cells[0,T])) And
       (POra[AIdop,APeda,2]=ONevToInd(Cells[1,T])) Then
Begin Row:= T; Break End;
End;
  sgPTF.Repaint; lbMPeda.Repaint; edPeda.Repaint; lbHely.Repaint;
  sgPTFClick(Sender);
end;

procedure TfmPOR.FormCreate(Sender: TObject);
Var I, J: Word;
begin
  ACol:= 1; ARow:= 1; Valt:= 0; LMax:= 200000; PUtkOSz:= 65000;
For I:= 1 To HOSz*PMax Do For J:= 1 To 2 Do Zero[I,J]:= 0; Ind:= Zero;
For I:= 1 To HOSz Do Leh[I]:= 0; ULeh:= Leh;
With sgTFOR Do With ATFOR Do
Begin
    ColWidths[0]:= 25; ColWidths[ColCount-1]:= 24;
    Cells[ColCount-1,0]:= 'Sum'; Cells[0,RowCount-1]:= 'Sum';
For I:= 1 To HOSz Do Cells[I,0]:= INev[I];
End;
  Csoportok; PORKepre; sgTFORClick(Sender);
With sgPTF Do
Begin
    Cells[0,0]:= 'Tant'; Cells[1,0]:= 'Oszt'; Cells[2,0]:= 'Órsz';
End;
end;

Procedure TfmPOR.PORKepre;
Var I, P, S, Sz: Word;
    St: St3;
Begin
With sgTFOR Do With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do Cells[I,P]:= '';
For P:= 1 To PMax Do Cells[0,P]:= PRov[P];
For P:= 1 To PMax Do
Begin
      S:= 0;
For I:= 1 To HOSz Do
Begin
        St:= ONev[POra[I,P,2]]; If Cso[I,P]>0 Then St:= UpONev(St);
If POra[I,P,1]<>Tilt Then
        Cells[I,P]:= St Else Cells[I,P]:= 'XX';
If POra[I,P,1] In [1..TMax] Then Inc(S);
End; Cells[ColCount-1,P]:= IntToStr(S);
End;
    Sz:= 0;
For I:= 1 To HOSz Do
Begin
      S:= 0;
For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
Begin Inc(S); Inc(Sz) End; Cells[I,RowCount-1]:= IntToStr(S);
End; Cells[ColCount-1,RowCount-1]:= IntToStr(Sz);
End;
End;

Procedure TfmPOR.PTFKepre(Peda: Word);
Var O, T, S, Sz: Word;
Begin
With sgPTF Do With ATFOR Do
Begin
    S:= 0; Sz:= 0;
For O:= 0 To ColCount-1 Do For T:= 1 To RowCount-2 Do Cells[O,T]:= '';
For O:= 1 To OMax Do For T:= 1 To TMax Do
If OTer[O,T,1]<>0 Then If (OTer[O,T,3]=Peda) Or (OTer[O,T,4]=Peda) Then
Begin
      Inc(S); sgPTF.Cells[0,S]:= TNev[T]; sgPTF.Cells[1,S]:= ONev[O];
      sgPTF.Cells[2,S]:= IntToStr(OTer[O,T,1]); Inc(Sz,OTer[O,T,1]);
End;
With sgPTF Do
Begin
      Cells[0,RowCount-1]:= IntToStr(PKot[Peda]);
      Cells[1,RowCount-1]:= IntToStr(PNOT[Peda]);
      Cells[2,RowCount-1]:= IntToStr(Sz);
End;
End;
End;

Function TfmPOR.Utkozes(I,P: Word): Word;
Var K, KI, I1: Word;
Begin
With ATFOR Do
Begin
    PUtk[I,P]:= 0; Utkozes:= PUtk[I,P]; If POra[I,P,1] In [0,Tilt] Then Exit;
If (POra[I,P,1]<>0) And (OLeh[I,2*POra[I,P,2]-1]=0) Then Inc(PUtk[I,P],2);
For K:= 1 To PMax Do If (K<>P) And (POra[I,K,2]<>0) Then
Begin
If (Cso[I,K]=0) And (POra[I,K,2]=POra[I,P,2]) Then Inc(PUtk[I,P]) Else
If (K<>Cso[I,P]) And (POra[I,K,2]=POra[I,P,2]) Then Inc(PUtk[I,P]);
End;
    I1:= NOSz*((I-1) Div NOSz)+1;
For K:= I1 To I1+NOSz-1 Do If (K<>I) And (POra[K,P,1]<>0) Then
If (POra[K,P,1]=POra[I,P,1]) And (POra[K,P,2]=POra[I,P,2]) Then
    Inc(PUtk[I,P]);
If OTer[POra[I,P,2],POra[I,P,1],1]=2 Then
Begin
      KI:= 0;
For K:= 1 To HOSz Do If (K<>I) Then
If (POra[K,P,1]=POra[I,P,1]) And (POra[K,P,2]=POra[I,P,2]) Then
Begin KI:= K; Break End;
If Abs(((I-1) Div NOsz)-((KI-1) Div NOSz))=1 Then Inc(PUtk[I,P]);
End;
End; Utkozes:= PUtk[I,P];
End;

Procedure TfmPOR.Utkozesek;
Var I, P: Word;
Begin
  UtkOsz:= 0;
For I:= 1 To HOSz Do For P:= 1 To PMax Do Inc(UtkOsz,Utkozes(I,P));
End;

Procedure TfmPOR.UtkKepre;
Var I, P, Sz: Word;
Begin
With sgTFOR Do For I:= 1 To HOSz Do
Begin
    Sz:= 0; For P:= 1 To PMax Do Inc(Sz,PUtk[I,P]);
    Cells[I,RowCount-1]:= IntToStr(Sz);
End;
If Valt= 100 Then Valt:= 1;
If Valt>0 Then With sgPTF do
Begin
    Col:= (Valt-1) Mod 3;
    Row:= (Valt-1) Div 3+1;
    Cells[Col,Row]:= IntToStr(UtkOSz);
End; lbKeszVege.Caption:= IntToStr(UtkOSz);
End;

Procedure TfmPOR.Csere(I1,I2,P: Word);
Var K, Puf: Word;
    Lehet: Boolean;
Begin
With ATFOR Do
Begin
If (POra[I1,P,4]=1) Or (POra[I2,P,4]=1) Then Exit;
If (POra[I1,P,1]=POra[I2,P,1]) And (POra[I1,P,2]=POra[I2,P,2]) Then Exit;
If Cso[I1,P]+Cso[I2,P]=0 Then
Begin
      Puf:= POra[I1,P,1]; POra[I1,P,1]:= POra[I2,P,1]; POra[I2,P,1]:= Puf;
      Puf:= POra[I1,P,2]; POra[I1,P,2]:= POra[I2,P,2]; POra[I2,P,2]:= Puf;
      Puf:= POra[I1,P,4]; POra[I1,P,4]:= POra[I2,P,4]; POra[I2,P,4]:= Puf;
      Puf:= Cso[I1,P]; Cso[I1,P]:= Cso[I2,P]; Cso[I2,P]:= Puf; Exit;
End Else
Begin
For K:= 0 To PMax Do Lanc[K]:= 0; Lanc[P]:= 1;
      Puf:= Cso[I1,P]; K:= 1;
While (Puf<>0) And (K<=PMax) Do
Begin
        Lanc[Puf]:= 1;
If Odd(K) Then Puf:= Cso[I2,Puf] Else Puf:= Cso[I1,Puf]; Inc(K);
End;
      Puf:= Cso[I2,P]; K:= 1;
While (Puf<>0) And (K<=PMax) Do
Begin
        Lanc[Puf]:= 1;
If Odd(K) Then Puf:= Cso[I1,Puf] Else Puf:= Cso[I2,Puf]; Inc(K);
End;
      Lehet:= True;
For K:= 1 To PMax Do If Lanc[K]>0 Then
If (POra[I1,K,4]=1) Or (POra[I2,K,4]=1) Then
Begin Lehet:= False; Break End;
If Lehet Then For K:= 1 To PMax Do If Lanc[K]>0 Then
Begin
        Puf:= POra[I1,K,1]; POra[I1,K,1]:= POra[I2,K,1]; POra[I2,K,1]:= Puf;
        Puf:= POra[I1,K,2]; POra[I1,K,2]:= POra[I2,K,2]; POra[I2,K,2]:= Puf;
        Puf:= POra[I1,K,4]; POra[I1,K,4]:= POra[I2,K,4]; POra[I2,K,4]:= Puf;
        Puf:= Cso[I1,K]; Cso[I1,K]:= Cso[I2,K]; Cso[I2,K]:= Puf;
End;
End;
End;
End;

Procedure TfmPOR.Keveres(Sender: TObject);
Var K, I1, I2, P: Word;
Begin
If (Rest Mod NaSz)=0 Then btUpLoadClick(Sender) Else With ATFOR Do
For P:= 1 To PMax Do For K:= 1 To 2*(((Rest-1) Mod NaSz)+1) Do
Begin
    I1:= Random(HOsz)+1; I2:= Random(HOSz)+1;
If Rest Mod NaSz>2 Then While (POra[I1,P,4]=1) Or (POra[I2,P,4]=1) Do
Begin I1:= Random(HOsz)+1; I2:= Random(HOSz)+1 End Else
While (POra[I1,P,4]=1) Or (POra[I2,P,4]=1) Or
          (Cso[I1,P]>0) Or (Cso[I2,P]>0) Do
Begin I1:= Random(HOsz)+1; I2:= Random(HOSz)+1 End;
    Csere(I1,I2,P);
End;
End;

Procedure TfmPOR.Csoportok;
Var I, P, k: Word;
Begin
With sgTFOR Do With ATFOR Do
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
For K:= 1 To PMax Do If K<>P Then
If (POra[I,K,1]=POra[I,P,1]) And (POra[I,K,2]=POra[I,P,2]) Then Cso[I,P]:= K;
End;

Function TfmPOR.HibaLista: Word;
Var I, P, K: Word;
Begin
  Ind:= Zero; K:= 0; With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If (PUtk[I,P]>0) And (POra[I,P,4]<>1) Then
Begin Inc(K); Ind[K,1]:= I; Ind[K,2]:= P End; HibaLista:= K;
End;

procedure TfmPOR.edPedaKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then
With sgTFOR Do With edPeda Do If Not VoltPedaNev(Text) Then
Begin
If Text='' Then Text:= '-'; Cells[0,Row]:= Text; ATFOR.PRov[Row]:= Text;
If Row<RowCount-2 Then Row:= Row+1;
End;
end;

procedure TfmPOR.sgPTFClick(Sender: TObject);
Var I, P, P1, P2, PP, Sz: Word;
    Van: Boolean;
begin
With sgPTF Do Begin
If (Valt=0) And (Row=RowCount-1) Then Row:= RowCount-2 End;
  MPeda:= 0; Sz:= 0; lbBeirvaSz.Caption:= '0';
For I:= 0 To HOSz Do For P:= 0 To PMax+1 Do PBeir[I,P]:= 0;
With sgTFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do
If Cells[I,P]=Jel Then Cells[I,P]:= ''; P1:= Row;
End;
  P2:= 0; PP:= 0;
With sgPTF Do
Begin
    ATant:= TNevToInd(Cells[0,Row]); AOszt:= ONevToInd(Cells[1,Row]);
    lbHely.Caption:= ATFOR.HNev[TTetToHely(AOszt,ATant)];
End;
With ATFOR Do
If OTer[AOszt,ATant,1]*OTer[AOszt,ATant,2]>0 Then
Begin
If OTer[AOszt,ATant,3]=P1 Then Begin P2:= OTer[AOszt,ATant,4]; PP:= P2 End
Else If OTer[AOszt,ATant,4]=P1 Then
Begin P1:= OTer[AOszt,ATant,3]; PP:= P1; P2:= OTer[AOszt,ATant,4] End;
    lbMPeda.Caption:= ATFOR.PRov[PP];
End Else Begin P2:= 0; lbMPeda.Caption:= '-        ' End;
With sgPTF Do If Cells[0,Row]<>'' Then With ATFOR Do
Begin
For I:= 1 To HOSz Do
If (TNev[POra[I,P1,1]]= Cells[0,Row]) And (POra[I,P1,2]=AOszt) Then
Begin Inc(Sz); PBeir[I,P1]:= 1; If P2<>0 Then PBeir[I,P2]:= 1 End;
    lbBeirvaSz.Caption:= IntToStr(Sz);
If P2=0 Then
Begin
For I:= 1 To HOSz Do If POra[I,P1,1]=0 Then
Begin
        Van:= False; For P:= 1 To PMax Do If POra[I,P,2]=AOszt Then
Begin Van:= True; Break End;
If Not Van Then Begin sgTFOR.Cells[I,P1]:= Jel End;
End;
End Else
For I:= 1 To HOSz Do If (POra[I,P1,1]=0) And (POra[I,P2,1]=0) Then
Begin
      Van:= False; For P:= 1 To PMax Do If POra[I,P,2]=AOszt Then
Begin Van:= True; Break End; If Not Van Then
Begin sgTFOR.Cells[I,P1]:= Jel; sgTFOR.Cells[I,P2]:= Jel End;
End;
End; MPeda:= PP; sgTFOR.Repaint; lbBeirvaSz.Repaint; lbHely.Repaint;
end;

procedure TfmPOR.sgPTFDblClick(Sender: TObject);
begin
With sgPTF Do If lbBeirvaSz.Caption>=Cells[2,Row] Then Exit;
With sgTFOR Do If Cells[Col,Row]<>Jel Then Exit;
With sgTFOR Do With ATFOR Do
Begin
    POra[Col,Row,1]:= TNevToInd(sgPTF.Cells[0,sgPTF.Row]);
    POra[Col,Row,2]:= ONevToInd(sgPTF.Cells[1,sgPTF.Row]);
    POra[Col,Row,3]:= TTetToHely(POra[Col,Row,2],POra[Col,Row,1]);
    POra[Col,Row,4]:= 1;
If MPeda>0 Then
Begin
      POra[Col,MPeda,1]:= TNevToInd(sgPTF.Cells[0,sgPTF.Row]);
      POra[Col,MPeda,2]:= ONevToInd(sgPTF.Cells[1,sgPTF.Row]);
      POra[Col,MPeda,3]:= TTetToHely(POra[Col,MPeda,2],POra[Col,MPeda,1]);
      POra[Col,MPeda,4]:= 1;
      Cso[Col,APeda]:= MPeda; Cso[Col,MPeda]:= APeda;
End;
If Col<ColCount-2 Then Col:= Col+1;
End; PORKepre; sgPTFClick(Sender);
end;

procedure TfmPOR.sgTFORDblClick(Sender: TObject);
Var I, P, KI: Word;
    Mind: Boolean;
begin
With sgTFOR Do With ATFOR Do
Begin
Case POra[Col,Row,1] Of
            0: Begin
                 KI:= NOSz*((Col-1) Div NOSz)+1; Mind:= True;
For I:= KI To KI+NOSz-1 Do If POra[I,Row,1]<>0 Then
Begin Mind:= False; Break End;
If ((Col-1) Mod NOSz=0) And Mind Then
For I:= KI To KI+NOSz-1 Do
Begin POra[I,Row,1]:= Tilt; POra[I,Row,4]:= 1 End
Else Begin POra[Col,Row,1]:= Tilt; POra[Col,Row,4]:= 1 End;
End;
         Tilt: Begin
                 KI:= NOSz*((Col-1) Div NOSz)+1; Mind:= True;
For I:= KI To KI+NOSz-1 Do If POra[I,Row,1]<>Tilt Then
Begin Mind:= False; Break End;
If ((Col-1) Mod NOSz=0) And Mind Then
For I:= KI To KI+NOSz-1 Do
Begin POra[I,Row,1]:= 0; POra[I,Row,4]:= 0 End
Else Begin POra[Col,Row,1]:= 0; POra[Col,Row,4]:= 0 End;
End;
      1..TMax: Begin
               MPeda:= 0;
For P:= 1 To PMax Do If P<>Row Then
If (POra[Col,P,1]=POra[Col,Row,1]) And
                  (POra[Col,P,2]=POra[Col,Row,2]) Then
Begin MPeda:= P; Break End;
For I:= 1 To 4 Do POra[Col,Row,I]:= 0;
If MPeda<>0 Then For I:= 1 To 4 Do POra[Col,MPeda,I]:= 0;
End;
End; If Col<ColCount-2 Then Col:= Col+1;
End; PORKepre; sgPTFClick(Sender);
end;

procedure TfmPOR.btDelAllClick(Sender: TObject);
Var I, P, K: Word;
begin
With ATFOR Do For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do
Begin
    PBeir[I,P]:= 0; PUtk[I,P]:= 0;
If POra[I,P,4]=2 Then For K:= 0 To 4 Do POra[I,P,K]:= 0;
End; PORKepre;
end;

procedure TfmPOR.btDelXXClick(Sender: TObject);
Var I, P: Word;
begin
With ATFOR Do For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do
If POra[I,P,1]=Tilt Then POra[I,P,1]:= 0; PORKepre;
end;

procedure TfmPOR.btUpLoadClick(Sender: TObject);
Var O, T, P, I, N, S: Word;
begin
  Csoportok;
With sgTFOR Do With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,4]<>1 Then
Begin Cso[I,P]:= 0; For N:= 0 To 4 Do POra[I,P,N]:= 0 End;
For O:= 1 To OMax Do For T:= 1 To TMax Do
Begin
      APeda:= OTer[O,T,3]; MPeda:= OTer[O,T,4]; I:= Random(HOSz)+1;
If MPeda<>0 Then
Begin
        S:= OTer[O,T,1]-PORBeirt(APeda,T,O);
For N:= 1 To S Do
Begin
While (POra[I,APeda,1]<>0) Or (POra[I,MPeda,1]<>0) Do
          I:= Random(HOSz)+1;
          POra[I,APeda,1]:= T; POra[I,APeda,2]:= O; POra[I,APeda,4]:= 2;
          POra[I,MPeda,1]:= T; POra[I,MPeda,2]:= O; POra[I,MPeda,4]:= 2;
          Cso[I,APeda]:= MPeda; Cso[I,MPeda]:= APeda;
End;
End Else
If MPeda=0 Then
Begin
        S:= OTer[O,T,1]-PORBeirt(APeda,T,O);
For N:= 1 To S Do
Begin
While POra[I,APeda,1]<>0 Do I:= Random(HOsz)+1;
          POra[I,APeda,1]:= T; POra[I,APeda,2]:= O; POra[I,APeda,4]:= 2;
End;
End;
End;
End; Utkozesek; PORKepre; UtkKepre;
end;

Procedure TfmPOR.KetOra;
Var P, I, K: Word;
Begin
With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do PUtk[I,P]:= 0;
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
If OTer[POra[I,P,2],POra[I,P,1],1]=2 Then For K:= 1 To HOSz Do
If (POra[I,P,1]=POra[K,P,1]) And (POra[I,P,1]=POra[K,P,1]) Then
    PUtk[I,P]:= KetO;
End;
End;

Procedure TfmPOR.OsztOSz;
Var I, P, S: Word;
Begin
With sgTFOR Do For I:= 1 To HOSz Do
Begin
    S:= 0; For P:= 1 To PMax Do
If (Cells[I,P]<>'') And (Cells[I,P]<>'XX') Then Inc(S);
    Cells[I,RowCount-1]:= IntToStr(S);
End;
End;

Procedure TfmPOR.PHetiOSz;
Var O, T, P: Word;
Begin
For P:= 0 To PMax+1 Do PHOsz[P]:= 0; With ATFOR Do
For O:= 1 To OMax Do For T:= 1 To TMax Do If OTer[O,T,1]>0 Then
Begin
    Inc(PHOSz[OTer[O,T,3]],OTer[O,T,1]); Inc(PHOSz[OTer[O,T,4]],OTer[O,T,2]);
End;
End;

Procedure TfmPOR.HORend;
Var I, P, P1, K: Word;
    L: Integer;
Begin
With ATFOR Do
Begin
For I:= 1 To HOSz Do For P:= 1 To PMax Do
Begin
      POra[I,P,3]:= 0; If POra[I,P,1] In [1..TMax] Then
      POra[I,P,3]:= TTetToHely(POra[I,P,2],POra[I,P,1]);
End;
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,1] In [1..TMax] Then
For P1:= 1 To PMax Do If (P1<>P) And (POra[I,P1,3]=POra[I,P,3]) Then
Begin
      AHely:= Pora[I,P1,3]; POra[I,P1,3]:= 0;
For K:= 1 To HMax Div 2+1 Do
Begin
        L:= 0; If Odd(K) Then L:= AHely-K; If L<1 Then L:= HMax;
If Not Odd(K) Then L:= AHely+K; If L>HMax Then L:= 1;
If UresHely(I,L) Then POra[I,P1,3]:= L;
End;
End;
End;
End;

procedure TfmPOR.btRendezClick(Sender: TObject);
Var I, I1, P, K, A, Index, RIndex, Ismet, KIsm, VIsm: Word;
    Volt: Boolean;
begin
  PHetiOSz;
With sgPTF Do
Begin
    Row:= RowCount-2; sgPTFClick(Sender);
For I:= 0 To ColCount-1 Do For K:= 1 To RowCount-1 Do Cells[I,K]:= '';
    Valt:= 0; RePaint;
End;
  PUtkOSz:= 65000; edStart.Text:= TimeToStr(GetTime); edStart.Repaint;
  edStop.Text:= ''; edStop.Repaint;
  LSz:= 0; Volt:= False; OldUtkOSz:= 0; Ismet:= 0; Rest:= 0;
  lbKeszVege.Caption:= ''; Index:= HibaLista;
With ATFOR Do While (Index>0) And (LSz<LMax) Do
Begin
If OldUtkOSz=UtkOSz Then
Begin
      Inc(Ismet); If Ismet>2500 Then
Begin
        Ismet:= 0; If UtkOSz<=PUtkOSz Then
Begin
          PUtkOSz:= UtkOSz;
For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do For K:= 0 To 4 Do
          PPOR[I,P,K]:= POra[I,P,K]; PCSO:= CSO;
          edBest.Text:= IntToStr(PUtkOSz);
End;
        Inc(Rest); Inc(Valt); edRest.Text:= IntToStr(Rest+1); Keveres(Sender);
        Utkozesek; PORKepre; UtkKepre; edLSz.Text:= IntToStr(LSz); RePaint;
Index:= HibaLista;
End;
End Else Ismet:= 0; Inc(LSz);
//A<->b típusú csere
If Volt Then Index:= Hibalista; A:= UtkOSz; OldUtkOSz:= A;
    RIndex:= Random(Index)+1; I:= Ind[RIndex,1]; P:= Ind[RIndex,2];
For K:= 1 To 2 Do
If (Cso[I,P]=0) Or (OTer[POra[I,P,2],POra[I,P,1],1]<4) Or
       (PHOsz[P]<OSzM-4) Then
Begin RIndex:= Random(Index)+1; I:= Ind[RIndex,1]; P:= Ind[RIndex,2] End;
    Leh:= ULeh; KIsm:= 0; Leh[I]:= 1;
If UtkOSz<HOSz Then VIsm:= HOSz-UtkOSz Else VIsm:= 2;
While KIsm<VIsm Do
Begin
      Inc(KIsm); I1:= Random(HOsz)+1;
While (Leh[I1]=1) Or (I=I1) Do I1:= Random(HOsz)+1;
      Leh[I1]:= 1; Csere(I,I1,P); Utkozesek;
If UtkOSz>A Then Begin Csere(I,I1,P); Utkozesek; Volt:= False End
Else Begin KIsm:= HOSz; Volt:= True End;
End;
If LSz Mod 1000=0 Then
Begin
      PORKepre; Inc(Valt); UtkKepre; edLSz.Text:= IntToStr(LSz); Repaint;
End;
End;
With ATFOR Do If (UtkOSz>0) And (UtkOSz>=PUtkOSz) Then
Begin
    edBest.Text:= IntToStr(PUtkOSz);
For I:= 0 To HOSz+1 Do For P:= 0 To PMax+1 Do For K:= 0 To 4 Do
    POra[I,P,K]:= PPOR[I,P,K]; CSO:= PCSO; Utkozesek;
End
Else edBest.Text:= IntToStr(UtkOSz);
  PORKepre; UtkKepre; edLSz.Text:= IntToStr(LSz);
With lbKeszVege Do If UtkOSz=0 Then
Begin KetOra; OsztOSz; HORend; Caption:= 'OK' End Else Caption:= 'End';
  edStop.Text:= TimeToStr(GetTime); Valt:= 0;
end;

end.

Kódolás (6)

Folytassuk a kódolást a Tanteremórarenddel. Ezen a felületen a következő beavatkozások lehetségesek:

- Az tantermek jele módosítható a beviteli mező segítségével. A kiválasztott sorban található tanterem jele írható át. Az tanterem jele maximum 3 karakter lehet. A beírást Enter billentyűvel kell lezárni. Ha üres stringet adunk meg, akkor az egy ’-’ jelre módosul. Nem lehet két tanteremnek ugyanaz a jele.

- Minden tanterem órarendje egyetlen sorban jelenik meg a képernyőn. Az órát leíró azonosítókból csak a pedagógus neve látható. Ha a teljes tétel leírását meg szeretnénk tudni, akkor kattintani kell a kérdéses órán, aminek hatására a képernyő jobb oldalán az megjelenik (tantárgy, osztály, pedagógus).

- Mivel a gépi betöltő a bizonytalan tantermű tételekhez csak az órarend elkészítése végén keres tantermet, lehet, hogy a kézi betöltés ideje alatt még két pedagógus (azaz tétel) is kerülhet egy tanterembe, ugyanarra az időpontra. Ezeket a helyeket az órarendben lila háttérszín jelöli. Egy ilyen helyre kattintva a tétel részletezésekor két pedagógus nevét látjuk, a másodikat piros színnel.

- Ha a tanteremórarenden kettőt kattintunk, akkor a következők történhetnek: ha az adott helyen nem volt bejegyzés, akkor a terem időponttiltása ellenkezőjére változik (ha nem volt tiltott, akkor tiltott lesz, ha tiltott volt, akkor nem lesz tiltás). A tiltott óra háttérszíne fehér, a nem tiltotté szürke. Itt is lehetőség van (az óraterv és az osztályórarendhez hasonlóan) a ToEnd gomb segítségéve egy adott időpontban az aktuális tanteremtől az utolsó tanteremig a tiltás beállítására illetve feloldására. Ha pedig volt pedagógusnév az órarendben, akkor a megfelelő tételnek, a kiválasztott időpontra nem lesz beosztott tanterme. A tanteremórarend lapon további beavatkozásra nincs (egyelőre) lehetőség.

A Tanteremórarend képernyője:

A Tanteremórarendet az UHOR Unit tartalmazza, melynek listája:

unit UHOR;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, UModul, Dialogs, StdCtrls, Grids;

type
  TfmHOR = class(TForm)
    lbHOR: TLabel;
    btKilepes: TButton;
    sgTFOR: TStringGrid;
    edHely: TEdit;
    lbHely: TLabel;
    lbTant: TLabel;
    lbOszt: TLabel;
    lbPeda: TLabel;
    lbMPeda: TLabel;
    btToEnd: TButton;
Function VoltHelyNev(St: St3): Boolean;
Procedure HORKepre;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure sgTFORDblClick(Sender: TObject);
procedure sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure sgTFORClick(Sender: TObject);
procedure edHelyKeyPress(Sender: TObject; var Key: Char);
procedure btToEndClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmHOR: TfmHOR;
  HUtkz: Array[0..HOSz+1,0..HMax+1] Of Word;

implementation

{$R *.dfm}

procedure TfmHOR.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmHOR.btKilepesClick(Sender: TObject);
begin
  Close;
end;

Function TfmHOR.VoltHelyNev(St: St3): Boolean;
Var H: Word;
Begin
  VoltHelyNev:= False; If (St='-') Or (St='') Then Exit;
With sgTFOR Do For H:= 1 To RowCount-2 Do If St=Cells[0,H] Then
Begin VoltHelyNev:= True; Break End;
End;

procedure TfmHOR.sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTFOR.Canvas.Brush Do
Begin
If (gdFixed In State) And ((Col=Acol) Or (Row=ARow)) Then
    Color:= clYellow Else Color:= clBtnFace;
If gdSelected In State Then Color:= clLime;
If Not((gdSelected In State) Or (gdFixed In State)) Then With ATFOR Do
Begin
If HLeh[Col,Row]=1 Then Color:= RGB(232,232,232) Else Color:= clWindow;
If HUtkz[Col,Row]=1 Then Color:= clFuchsia;
End;
End;
  sgTFOR.Canvas.TextRect(Rect,Rect.Left+1,Rect.Top,sgTFOR.Cells[Col,Row]);
If gdFocused In State Then sgTFOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmHOR.FormCreate(Sender: TObject);
Var I: Word;
begin
  ACol:= 1; ARow:= 1;
With sgTFOR Do With ATFOR Do
Begin
    ColWidths[0]:= 25; ColWidths[ColCount-1]:= 24;
    Cells[ColCount-1,0]:= 'Sum'; Cells[0,RowCount-1]:= 'Sum';
For I:= 1 To HOSz Do Cells[I,0]:= INev[I];
End;
  HORKepre; sgTFORClick(Sender);
end;

Procedure TfmHOR.HORKepre;
Var I, P, H, S: Word;
Begin
With sgTFOR Do With ATFOR Do
Begin
For I:= 1 To HOSz Do For H:= 1 To HMax Do Cells[I,H]:= '';
For I:= 0 To HOSz+1 Do For H:= 0 To HMax+1 Do HUtkz[I,H]:= 0;
For H:= 1 To HMax Do Cells[0,H]:= HNev[H];
For P:= 1 To PMax Do For I:= 1 To HOSz Do
If POra[I,P,1] In [1..TMax] Then
Begin
If Cells[I,POra[I,P,3]]='' Then Cells[I,POra[I,P,3]]:= PNev[P] Else
      HUtkz[I,POra[I,P,3]]:= 1;
End;
For I:= 1 To HOSz Do
Begin
      S:= 0; For H:= 1 To HMax Do If Cells[I,H]<>'' Then Inc(S);
      Cells[I,RowCount-1]:= IntToStr(S);
End;
For H:= 1 To HMax Do
Begin
      S:= 0; For I:= 1 To HOSz Do If Cells[I,H]<>'' Then Inc(S);
      Cells[ColCount-1,H]:= IntToStr(S);
End;
    S:= 0; For I:= 1 To HOSz Do Inc(S,StrToInt(Cells[I,RowCount-1]));
    Cells[ColCount-1,RowCount-1]:= IntToStr(S);
End;
End;

procedure TfmHOR.sgTFORClick(Sender: TObject);
Var P: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
If Col=ColCount-1 Then Col:= ColCount-2;
If Row=RowCount-1 Then Row:= RowCount-2;
    edHely.Text:= Cells[0,Row]; ACol:= Col; ARow:= Row; RePaint;
    APeda:= PNevToInd(Cells[Col,Row]); AIdop:= Col;
    lbTant.Caption:= TNev[POra[AIdop,APeda,1]];
If POra[AIdop,APeda,2]<>0 Then
    lbOszt.Caption:= ONev[POra[AIdop,APeda,2]] Else lbOszt.Caption:= '-';
    lbPeda.Caption:= PNev[APeda];
    lbMPeda.Caption:= '-';
If HUtkz[Col,Row]=1 Then
For P:= 1 To PMax Do If P<>APeda Then If POra[Col,P,3]=Row Then
Begin lbMPeda.Caption:= PNev[P]; Break End;
End;
end;

procedure TfmHOR.edHelyKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then
With sgTFOR Do With edHely Do If Not VoltHelyNev(Text) Then
Begin
If Text='' Then Text:= '-'; Cells[0,Row]:= Text; ATFOR.HNev[Row]:= Text;
If Row<RowCount-2 Then Row:= Row+1;
End;
end;

procedure TfmHOR.sgTFORDblClick(Sender: TObject);
begin
With sgTFOR Do With ATFOR Do
Begin
If Cells[Col,Row]='' Then HLeh[Col,Row]:= 1-HLeh[Col,Row] Else
    POra[Col,PNevToInd(Cells[Col,Row]),3]:= 0;
If Col<ColCount-2 Then Col:= Col+1;
End;
  HORKepre;
end;

procedure TfmHOR.btToEndClick(Sender: TObject);
Var H: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
If Row=RowCount-2 Then Exit;
For H:= Row+1 To HMax Do HLeh[Col,H]:= HLeh[Col,Row];
    RePaint;
End;
end;

end.

Kódolás (7)

Térjünk vissza a Pedagógus órarendre. A program legizgalmasabb része, a gépi órarend generálás következik. A gépi feltöltésre átalakított Pedagógus órarend formja, melyen néhány óra kézzel lett beírva, valamint a tiltások be vannak állítva:

A kibővített képernyő új elemeinek magyarázata:

- DelAll nyomógomb: megnyomva az órarend gépi betöltővel beírt órái törlődnek.

- DelXX nyomógomb: az órarend foglalt óráinak foglaltsága megszűnik.

- UpLoad nyomógomb: az órarendben még nem szereplő órák bekerülnek az órarendbe. Helyük véletlen lesz, de a csoportbontásos órák egy időpontban lesznek.

- Max: utáni beviteli mezőbe beírhatjuk, hogy maximálisan hány iterációs lépést engedünk végrehajtani megállás nélkül a rendező algoritmusnak.

- < Sort > nyomógomb: ezzel a gombbal indíthatjuk a rendezést.

- A következő Edit mezőben jelenik meg, hogy hányadik lépésben jár az algoritmus (minden ezrediket írja ki és ekkor frissíti a képernyőt).

- R: utáni mezőben jelenik meg, hogy hányszor történt jelentős visszalépés (vagy újrakezdés) a rendezésben.

- Bad: utáni címke tartalma az utolsó frissítéskor érvényes hibapontok száma. Ez a rendezés során nem nőhet és a pontszámítási eljárás miatt csak páros lehet. Ezen a helyen jelenik meg az algoritmus végén az OK felírat, ha sikerült a rendezés, ha pedig nem (ütközéses maradt az órarend), akkor End feíratot láthatjuk.

- Best: utáni mezőben a mentett legjobb órarend hibapontjainak számát láthatjuk. Ha nem sikerül a teljes rendezés, akkor ezt az órarendet látjuk az algoritmus leállása után.

- Start: utáni mezőben a rendezés kezdő időpontja látható.

- Stop: utáni mezőben a rendezés befejezésének időpontját láthatjuk.

- Rendezés közben a pedagógus tantárgyfelosztása helyén az ezer lépésenkénti hibapont-értékek jelennek meg, sorfolytonosan. Ha vége a rendezésnek és kattintunk az órarenden, akkor újra a tantárgyfelosztás látható.

A képernyő az UpLoad megnyomása után, amikor minden óra véletlen helyre bekerül az órarendbe:

Leolvasható a képernyőről a 2266 ütközési szám. A piros háttérrel rendelkező helyek a hibásak. Vagy nem megengedett helyen vannak (olyan időpontban, amikor az osztálynak már nem lehet órája), vagy ütköznek (két pedagógus van egy osztályban, de nem csoportbontás miatt), vagy kétórás tantárgy és egymás utáni napon van a két óra, vagy egyszerűen csak két ugyanolyan óra van egy napon. A csoportbontásos órák az osztály jelben nagybetűvel van jelölve.

Másfél perc alatt elkészült az órarend, ehhez 21228 lépésre volt szükség. Ezt egyetlen menetben, visszalépés nélkül sikerült előállítani. Ez természetesn nem mindig van így. A jelentős visszalépést jelentős számú cserét, minden ötödik visszalépés pedig teljes újratöltést jelent. Az újrakezdések kezdőszámai a tantárgyfelosztás táblázatából lehetne kiolvasni. Most csak a minden ezredik lépés utáni hibapontszámok sorozatát látjuk ebben a táblázatban. Az órarendben az arany háttérszínnel jelölt órák heti óraszáma kettő (így könnyebben ellenőrizhető, hogy kétórás tárgyakat nem tesz két egymás utáni napra).

Nézzük meg, hogy ez az órarend hogyan néz ki Osztályórarendben:

Most pedig lássuk, milyen lett a Teremórarend:

Egy másik feltöltés, ahol 2332 a kezdeti ütközési szám:

A generáláshos most három perc és 41125 lépésre volt szükség. A generálás kétszer lépet vissza, újrakezdési ütközési számok: 188 és 316.

Ezen az utóbbi fejlesztés nyomait láthatjuk az előző állapothoz képest. Ha olyan tanterem, sorában állunk, amely valamely osztálynak a tanterme, akkor az osztály neve megjelenik a táblázat felett (pl.: 1.a). A következő változás: jobb oldalt megjelent egy táblázat, melyben azokat az órákat láthatjuk, amelyekhez nincs tanterem hozzárendelve. Most csak a bemutatás kedvéért töröltem három óra tantermét az 1.a osztályban. Ha a teremhiány valamely nem üres során duplán kattintunk, akkor a teremórarendbe beírhatjuk az érintett órát, feltéve, ha a kiválasztott terem a kérdéses időpontban üres volt.

A másik fejlesztés az Up és Down feliratú gombokkal használhatók. Az Up gomb megnyomására a program fölfelé (az első termek felé) keres üres helyet, és ha talál, akkor ebbe a terembe áthelyezi a kiválasztott órát. A Downn ellenkezőleg, az utolsó termek felé keres üres helyet, és ha van, akkor oda helyezi át az órát. Így tanteremcseréket is megvalósíthatunk, ha egy időpontban van legalább egy üres terem.

Az UHOR megváltozott listája:

unit UHOR;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, UModul,
  Dialogs, StdCtrls, Grids;

type
  TfmHOR = class(TForm)
    lbHOR: TLabel;
    btKilepes: TButton;
    sgTFOR: TStringGrid;
    edHely: TEdit;
    lbHely: TLabel;
    lbTant: TLabel;
    lbOszt: TLabel;
    lbPeda: TLabel;
    lbMPeda: TLabel;
    btToEnd: TButton;
    lbHiany: TLabel;
    sgHiany: TStringGrid;
    btUp: TButton;
    btDown: TButton;
    lbOsztaly: TLabel;
Function VoltHelyNev(St: St3): Boolean;
Function HToOszt(H: Word): Word;
Procedure HORKepre;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure sgTFORDblClick(Sender: TObject);
procedure sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure sgTFORClick(Sender: TObject);
procedure edHelyKeyPress(Sender: TObject; var Key: Char);
procedure btToEndClick(Sender: TObject);
procedure btUpClick(Sender: TObject);
procedure btDownClick(Sender: TObject);
procedure sgHianyDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmHOR: TfmHOR;
  HUtkz: Array[0..HOSz+1,0..HMax+1] Of Word;

implementation

{$R *.dfm}

procedure TfmHOR.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmHOR.btKilepesClick(Sender: TObject);
begin
  Close;
end;

Function TfmHOR.VoltHelyNev(St: St3): Boolean;
Var H: Word;
Begin
  VoltHelyNev:= False; If (St='-') Or (St='') Then Exit;
With sgTFOR Do For H:= 1 To RowCount-2 Do If St=Cells[0,H] Then
Begin VoltHelyNev:= True; Break End;
End;

Function TfmHOR.HToOszt(H: Word): Word;
Var O: Word;
Begin
  HToOszt:= 0; If H=0 Then Exit; With ATFOR Do
For O:= 1 To OMax Do If OHel[O]=H Then Begin HToOszt:= O; Break End;
End;

procedure TfmHOR.sgTFORDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTFOR.Canvas.Brush Do
Begin
If (gdFixed In State) And ((Col=Acol) Or (Row=ARow)) Then
    Color:= clYellow Else Color:= clBtnFace;
If gdSelected In State Then Color:= clLime;
If Not((gdSelected In State) Or (gdFixed In State)) Then With ATFOR Do
Begin
If HLeh[Col,Row]=1 Then Color:= RGB(232,232,232) Else Color:= clWindow;
If HUtkz[Col,Row]=1 Then Color:= clFuchsia;
End;
End;
  sgTFOR.Canvas.TextRect(Rect,Rect.Left+1,Rect.Top,sgTFOR.Cells[Col,Row]);
If gdFocused In State Then sgTFOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmHOR.FormCreate(Sender: TObject);
Var I: Word;
begin
  ACol:= 1; ARow:= 1;
With sgTFOR Do With ATFOR Do
Begin
    ColWidths[0]:= 25; ColWidths[ColCount-1]:= 24;
    Cells[ColCount-1,0]:= 'Sum'; Cells[0,RowCount-1]:= 'Sum';
For I:= 1 To HOSz Do Cells[I,0]:= INev[I];
End;
With sgHiany Do
Begin
    Cells[0,0]:= 'Idő';
    Cells[1,0]:= 'Ped';
    Cells[2,0]:= 'Tan';
    Cells[3,0]:= 'Osz';
End;
  HORKepre; sgTFORClick(Sender);
end;

Procedure TfmHOR.HORKepre;
Var I, P, H, S: Word;
Begin
With sgTFOR Do With ATFOR Do
Begin
For I:= 1 To HOSz Do For H:= 1 To HMax Do Cells[I,H]:= '';
For I:= 0 To HOSz+1 Do For H:= 0 To HMax+1 Do HUtkz[I,H]:= 0;
For H:= 1 To HMax Do Cells[0,H]:= HNev[H];
For P:= 1 To PMax Do For I:= 1 To HOSz Do
If POra[I,P,1] In [1..TMax] Then
Begin
If Cells[I,POra[I,P,3]]='' Then Cells[I,POra[I,P,3]]:= PRov[P] Else
      HUtkz[I,POra[I,P,3]]:= 1;
End;
For I:= 1 To HOSz Do
Begin
      S:= 0; For H:= 1 To HMax Do If Cells[I,H]<>'' Then Inc(S);
      Cells[I,RowCount-1]:= IntToStr(S);
End;
For H:= 1 To HMax Do
Begin
      S:= 0; For I:= 1 To HOSz Do If Cells[I,H]<>'' Then Inc(S);
      Cells[ColCount-1,H]:= IntToStr(S);
End;
    S:= 0; For I:= 1 To HOSz Do Inc(S,StrToInt(Cells[I,RowCount-1]));
    Cells[ColCount-1,RowCount-1]:= IntToStr(S);
End;
With sgHiany Do
For I:= 0 To ColCount-1 Do For S:= 1 To RowCount-1 Do Cells[I,S]:= '';
  S:= 0;
With sgHiany Do With ATFOR Do
For I:= 1 To HOSz Do For P:= 1 To PMax Do
If (POra[I,P,1] In [1..TMax]) And (POra[I,P,3]=0) Then
Begin
    Inc(S);
    Cells[0,S]:= INev[I];
    Cells[1,S]:= PRov[P];
    Cells[2,S]:= TNev[POra[I,P,1]];
    Cells[3,S]:= ONev[POra[I,P,2]];
End;
End;

procedure TfmHOR.sgTFORClick(Sender: TObject);
Var P: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
If Col=ColCount-1 Then Col:= ColCount-2;
If Row=RowCount-1 Then Row:= RowCount-2;
    edHely.Text:= Cells[0,Row]; ACol:= Col; ARow:= Row; RePaint;
    APeda:= PRovToInd(Cells[Col,Row]); AIdop:= Col;
    lbTant.Caption:= TNev[POra[AIdop,APeda,1]];
    LbOsztaly.Caption:= ONev[HToOszt(Row)];
If POra[AIdop,APeda,2]<>0 Then
    lbOszt.Caption:= ONev[POra[AIdop,APeda,2]] Else lbOszt.Caption:= '-';
    lbPeda.Caption:= PRov[APeda];
    lbMPeda.Caption:= '-';
If HUtkz[Col,Row]=1 Then
For P:= 1 To PMax Do If P<>APeda Then If POra[Col,P,3]=Row Then
Begin lbMPeda.Caption:= PRov[P]; Break End;
End;
end;

procedure TfmHOR.edHelyKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then
With sgTFOR Do With edHely Do If Not VoltHelyNev(Text) Then
Begin
If Text='' Then Text:= '-'; Cells[0,Row]:= Text; ATFOR.HNev[Row]:= Text;
If Row<RowCount-2 Then Row:= Row+1;
End;
end;

procedure TfmHOR.sgTFORDblClick(Sender: TObject);
begin
With sgTFOR Do With ATFOR Do
Begin
If Cells[Col,Row]='' Then HLeh[Col,Row]:= 1-HLeh[Col,Row] Else
    POra[Col,PRovToInd(Cells[Col,Row]),3]:= 0;
If Col<ColCount-2 Then Col:= Col+1;
End;
  HORKepre;
end;

procedure TfmHOR.btToEndClick(Sender: TObject);
Var H: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
If Row=RowCount-2 Then Exit;
For H:= Row+1 To HMax Do HLeh[Col,H]:= HLeh[Col,Row];
    RePaint;
End;
end;

procedure TfmHOR.btUpClick(Sender: TObject);
Var S: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
If (Cells[Col,Row]='') Or (Row=1) Then Exit;
    APeda:= PRovToInd(Cells[Col,Row]); S:= Row;
If S>1 Then
Begin
While (Cells[Col,S-1]<>'') And (S>1) Do Dec(S); Dec(S);
If (S>0) And (Cells[Col,S]='') Then
Begin POra[Col,APeda,3]:= S; Row:= S End;
End;
End;
  HORKepre;
end;

procedure TfmHOR.btDownClick(Sender: TObject);
Var S: Word;
begin
With sgTFOR Do With ATFOR Do
Begin
If (Cells[Col,Row]='') Or (Row=RowCount-2) Then Exit;
    APeda:= PRovToInd(Cells[Col,Row]); S:= Row;
If S<RowCount-2 Then
Begin
While (Cells[Col,S+1]<>'') And (S<RowCount-2) Do Inc(S); Inc(S);
If (S<RowCount-1) And (Cells[Col,S]='') Then
Begin POra[Col,APeda,3]:= S; Row:= S End;
End;
End;
  HORKepre;
end;

procedure TfmHOR.sgHianyDblClick(Sender: TObject);
begin
With sgHiany Do With ATFOR Do
Begin
If Cells[0,Row]='' Then Exit;
    AIdop:= INevToInd(Cells[0,Row]);
If sgTFOR.Cells[AIdop,sgTFOR.Row]<>'' Then Exit;
    APeda:= PRovToInd(Cells[1,Col]);
    POra[AIdop,APeda,3]:= sgTFOR.Row;
End;
  HORKepre;
end;

end.

Kódolás (8)

A gépi órarendkészítés

Az általam ismert gépi algoritmusok közül az ütközésmentesítő algoritmust építettem be a programba. Azért esett a választás erre az algoritmusra, mert gyors, könnyen kódolható és a végén esetleg maradó hibák ellenére az elkészített órarendet gyakorlatilag változtatás nélkül használni lehet, hiszen csak az fordulhat elő, hogy osztályok szerint nem lesz tömör az órarend, vagyis néhány óra nincs az engedélyezett időkeretben. Azt, hogy könnyen tömöríthető-e az így elkészült órarend, mindig a konkrét órarendnél kell megvizsgálni. A próbafuttatások alatt egyébként legalább 95%-ban a generálást a program teljesen be tudta fejezni.

A generálás első lépéseként a tantárgyfelosztás és az előkészített órarend alapján a még be nem írt órákat az UpLoad megnyomására a program elhelyezi az órarendben. Természetesen az elhelyezéskor figyeli a csoportbontásokat, olyan helyre teszi a bontott órákat, hol mindkét pedagógus ráér. Mivel egy tételből csak részórák is elhelyezhetők a kézi betöltés idején, a gépi betöltő először megállapítja, hogy hány óra nincs még beírva, és csak annyit helyez el az órarendben, amennyi kézzel még nem volt beírva. Egyébként a beírási helyeket véletlenszerűen választja, hiszen ekkor nincs semmi prekoncepció az órák végleges helyét illetően. Mivel a véletlen választásnál egyáltalán nem figyel egy másik, már beírt tételre, természetes, hogy ütközéses órarend áll elő ebben a fázisban. Erre a véletlen feltöltésre a csoportbontás miatt csak akkor van lehetőség, ha az órarendben vannak olyan időpontok is, amelyekre nem, vagy csak kivételes esetekben kerül véglegesen tanóra (ilyenek a 0. és a 7.-9. órák).

Az ütközések büntetőpontjait a program a következőképpen számolja: minden pedagógusnak, minden órájára összeszámolja, hogy hány osztállyal van ütközésben. Ebből származik a büntetőpontok első része. A második hiba, amivel számol az algoritmus, a nem megengedett helyen lévő óra, melynek büntetési tétele két pont. A harmadik típusú hiba a kétórás tárgyakra vonatkozik. Ha egy kétórás tantárgy két órája egymás utáni napon van, akkor azért is büntetőpont jár. Ezen típusú pontok összege adja egy adott óra hibapontját, a teljes órarendét pedig az egyes órák hibapontjainak az összege. Mivel az ütközés kölcsönös, a nem megengedett hely miatt két pont jár, a kétórás tantárgy rossz elhelyezés esetén szintén két hibapontot kaphat, a teljes hibapontok száma biztosan páros. A konkrét órarendben így az 1192 darab óra véletlen elhelyezésekor 2200-2400 hibapont keletkezik. A rendező algoritmusnak ezt kell a nullára csökkenteni.

Az általam használt ütközésmentesítő algoritmus a következő lépésekből áll:

1. megállapítja a teljes órarend hibapontjainak számát,

2. véletlenül kiválaszt egy hibaponttal rendelkező órát,

3. véletlenül választ egy másik időpontot a 2. pontban kiválasztott pedagógusnál,

4. felcseréli a két órát,

5. újra megállapítja a teljes órarend hibapontjainak számát,

6. ha az új hibapontok száma 0, akkor vége az algoritmusnak,

7. ha az újabb hibapont nem 0 és nem nagyobb az 1. pontban megállapítottnál, akkor az algoritmus az 2. pontban folytatódik,

8. ha az újabb hibapont nagyobb az 1. pontban megállapítottnál, akkor a 4. pontban felcserélt két órát visszacseréli és visszatér az 1. pontra.

A lépések részletezése:

1. A hibapontszámítást az előző bekezdés tartalmazza.

2. A program nem válogat az adott időpont hibapontjainak száma szerint. Csak az a lényeges, hogy az óra hibaponttal rendelkezik. Előnyben részesíti viszont a csoportbontásban lévő és a négy- vagy ötórás órákat.

3. A második időpont kiválasztása ugyanarra a pedagógusra vonatkozik, akinek a 2. pontban a hibaponttal rendelkező óráját megtaláltuk. Azért nem órát, hanem időpontot keres, mert lehet, hogy itt a pedagógusnak nincs is órája. Ha itt is órát feltételeznénk, akkor az algoritmus a kezdeti órarenden semmit nem tudna tömöríteni. Az intenzív tömörítést a tiltott időpontra alkalmazott két hibapont is biztosítja. Az, hogy a második időpontban is ütközéses óra legyen szintén értelmét veszti a rendezés végén, mert szinte biztos, hogy egy pedagógusnak csak egyetlen ütközéses órája van.

4. Ha csoportbontás nem lenne, akkor ennél a pontnál nem kellene magyarázkodni, felcseréljük a két órát (időpontot) és kész. A csoportbontás viszont a csere végrehajtását megnehezíti. Nem teheti meg ugyanis az algoritmus azt, hogy a csoportbontásban szereplő órákat szétszakítja. A cserében mindig két időpont szerepel, és indulásként egy pedagógus. A csoportbontás akár mindkét időpontban újabb pedagógus bekapcsolását eredményezheti a cserébe, sőt az új pedagógus továbbiakat is bevonhat a cserébe. Ennek kódolása nagy odafigyelést igényel, sőt gyorsnak sem árt lenni, hiszen nagyon sokszor végre kell hajtani.

5. A hibapontszámítást már leírtam, ugyanaz, mint az első.

6. Természetes a nulla hibapont csak kívánatos eset. Könnyen meglehet, hogy ennek elérése csak értelmetlenül hosszú futási idő esetén lehetséges. Ennek a problémának a kezelésére két megoldás van beépítve az algoritmusba. Az egyik azt figyeli, hogy hány lépésen keresztül nem változott az órarend összesített hibapontja. Ha ez az érték több ezerre rúg, akkor véletlen választásokkal megkeveri az órarendet a program, természetesen ezzel jelentősen megnövelve az ütközések számát, ugyanakkor egy reménybeli megoldás közelében maradva. Minél többször kell visszalépnie az algoritmusnak a látszólagos leállás miatt, annál nagyobb lépésszámban kever. Ha az ilyen visszalépések száma eléri a hatot, akkor egy teljes feltöltéssel a kezdeti állapotnak megfelelő helyzetből indul újra a rendezés. A másik korlátot egy maximális lépésszám jelenti, ha ezt eléri az algoritmus, akkor leáll. Ez alapértelmezésben 200000, mely természetesen az algoritmus elején megváltoztatható. Nem biztos azonban, hogy ekkor (a maximális lépésszám elérésekor) a teljes algoritmus során létrejött órarendek közül a legjobbal dolgozik a program. Ennek a problémának megoldása az, hogy minden visszalépésnél megnézi a program, nem jobb-e az aktuális órarend az eddig mentetteknél, mert ha igen, akkor ezt jegyzi meg, és ha a végén nem nulla hibapont miatt áll le a generálás, akkor ezt adja vissza a megoldásként.

7. Ebben a lépésben nem követeljük meg, hogy jobb állapot jöjjön létre az elfogadáshoz. A tapasztalatok azt mutatják, hogy ha ezt tennénk, akkor 15-25%-os hibapontérték környékén az algoritmus leállna, a végcél nem lenne elérhető.

8. A visszacserélés a cserélő eljárás újbóli meghívását jelenti ugyanazokkal a paraméterekkel.

Hogy értékelni tudjuk az algoritmus hatékonyságát, összesítsük a beírt órákat és nézzük meg, hány százaléka csoportbontásos, mert azt hiszem ezek az értékek elég magasak:

Összes óraszám osztályok szerint: 8*28+8*29+8*30+8*29 = 928 – 100%

Egyedi óraszám osztályok szerint: 664 – 71,5%.

Csoportbontásos óra osztályok szerint: 264 – 28,5%.

Összes óraszám pedagógusok szerint: 1192 – 100%.

Egyedi pedagógus óraszám: 664 – 55,7%.

Csoportbontásos pedagógus óraszám: 528 –44,3%.

Az ütközésmentesítő algoritmus a leírt hibapontszámítás mellett, alapból védekezik az ellen, hogy a csoportbontásos órákat sokat mozgassa. Az algoritmus elején még inkább, de később egyáltalán nem nyúl hozzájuk. Ha egy csoportbontásos óra a végén kint marad a nem megengedett időpontokra, akkor az keverés (visszalépés) nélkül már nem szokott a megengedett időpontokra visszakerülni. Ezért ha nagy gond van a végén, akkor olyan nagy visszalépésre van szükség, melyben a csoportbontásos órák keverése is megvalósul.

A másik jellegzetessége az algoritmusnak, hogy a végére általában olyan hibapontos órák maradnak, melyek a nem megengedett időpontokból származnak, így az órarend még hibapont esetén is ütközésmentes, ha tehát mégis megengedünk ilyen időpontokban órákat, akkor azonnal használható még az ilyen, az algoritmus szerint hibás órarend is.

Kódolás (9)

Az elkészült órarendek használhatóságát nagyban meghatározza az, hogy a program milyen dokumentumokat tud előállítani, adatait milyen nyomtatható formába tudja ölteni. A programot kétféle dokumentum előállítására tesszük alkalmassá. Gondolva az internetre is, minden egyedi órarendet Html oldalon fogunk megjeleníteni. Az összesített órarendeket célszerű nagyméretű táblázatokba helyezni, így erre az XLS formátum a kézenfekvő megoldás. A pedagógusoknak az összesített tantárgyfelosztáshoz szükséges további adatait és a dokumentumok előállítására alkalmas környezetet egy külön formon, az fmMentMint nevűn helyeztem el. Ennek futtatási képe:

Az egyedi órarendek nyomtatásakor Pedagógus esetén az előválasztás a táblázat megfelelő sorának kiválasztásával történik. Az egyedi osztály- és tanteremórarend esetén a listadobozok segítségével állíthatjuk be a kívánt elemet. Arra is van lehetőség, hogy az egyedi órarendek mindegyikét egy menetben a program elkészítse. Ez a funkció a P-All, T-All, O-All és H-All feliratú nyomógombok segítéségével érhető el. Az összesített XLS táblázatokban minden kiválasztás szerinti elem szerepel.

A nyomógombok feliratának magyarázata:

- Peda –> Html: a kiválasztott pedagógus órarendje,

- P–All: minden pedagógusnak az egyedi órarendje,

- Tant –> Html: a kiválasztott tantárgy órarendje,

- T–All: minden tantárgy az egyedi órarendje,

- Oszt –> Html: a kiválasztott osztály órarendje,

- O–All: minden osztálynak az egyedi órarendje,

- Hely –> Html: a kiválasztott tanterem órarendje,

- H–All: minden tanterem egyedi órarendje,

- PTF –> XLS: pedagógusok iskolai szintű összesített tantárgyfelosztása,

- POR –> XLS: pedagógusok órarendje,

- OOR –> XLS: osztályok órarendje,

- HOR –> XLS: tantermek órarendje,

- TOR –> XLS: tantárgyak órarendje.

Az UMentMint listája (még a mentések kidolgozása nélkül):

unit UMentMint;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, UModul,
  Dialogs, StdCtrls, Grids;

type
  TfmMentMint = class(TForm)
    lbMentMint: TLabel;
    btKilepes: TButton;
    sgPeda: TStringGrid;
    lbPeda: TLabel;
    lbEgyedi: TLabel;
    lbOsszes: TLabel;
    ldOszt: TListBox;
    ldHely: TListBox;
    btPedaHtml: TButton;
    btOsztHtml: TButton;
    btHelyHtml: TButton;
    btPTFXLS: TButton;
    btPORXLS: TButton;
    btOORXLS: TButton;
    btHORXLS: TButton;
    btTORXLS: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgPedaKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmMentMint: TfmMentMint;

implementation

{$R *.dfm}

procedure TfmMentMint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmMentMint.btKilepesClick(Sender: TObject);
Var I: Word;
    Kod: Integer;
begin
With sgPeda Do With ATFOR Do
For I:= 1 To PMax Do
Begin
    PNev[I]:= Cells[1,I];
    PRov[I]:= Cells[2,I];
    PBeo[I]:= Cells[3,I];
    Val(Cells[4,I],PKot[I],Kod);
    Val(Cells[5,I],PNOT[I],Kod);
End;
  Close;
end;

procedure TfmMentMint.FormCreate(Sender: TObject);
Var I: Word;
begin
With sgPeda Do With ATFOR Do
Begin
    ColWidths[0]:= 24;
    ColWidths[1]:= 160;
    RowCount:= PMax+1;
    Cells[1,0]:= 'Pedagógus';
    Cells[2,0]:= 'NévRöv';
    Cells[3,0]:= 'Beosztás';
    Cells[4,0]:= 'KötÓra';
    Cells[5,0]:= 'NemÓratervi';
For I:= 1 To PMax Do
Begin
      Cells[0,I]:= IntToStr(I)+'.';
      Cells[1,I]:= PNev[I];
      Cells[2,I]:= PRov[I];
      Cells[3,I]:= PBeo[I];
      Cells[4,I]:= IntToStr(PKot[I]);
      Cells[5,I]:= IntToStr(PNOT[I]);
End;
End;
With ldOszt Do With ATFOR Do
Begin
For I:= 0 To OMax Do Items.Add(ONev[I]);
    ItemIndex:= 0;
End;
With ldHely Do With ATFOR Do
Begin
For I:= 0 To HMax Do Items.Add(HNev[I]);
    ItemIndex:= 0;
End;

end;

procedure TfmMentMint.sgPedaKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
If Key=13 Then With sgPeda Do If Row<RowCount-1 Then Row:= Row+1;
end;

end.

Kódolás (10)

Elkészültek az egyedi órarendeket tartalmazó kimenetek. Egy pedagógus órarendje Html formátumban:

Egy tantárgy órarendje Html formátumban:

Egy osztály órarendje Html formátumban:

Egy terem órarendje Html formátumban:

A megváltozott UMentMint Unit listája:

unit UMentMint;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, UAdat, UModul,
  Dialogs, StdCtrls, Grids;

type
  TfmMentMint = class(TForm)
    lbMentMint: TLabel;
    btKilepes: TButton;
    sgPeda: TStringGrid;
    lbPeda: TLabel;
    lbEgyedi: TLabel;
    lbOsszes: TLabel;
    ldOszt: TListBox;
    ldHely: TListBox;
    btPedaHtml: TButton;
    btOsztHtml: TButton;
    btHelyHtml: TButton;
    btPTFXLS: TButton;
    btPORXLS: TButton;
    btOORXLS: TButton;
    btHORXLS: TButton;
    btTORXLS: TButton;
    btPAll: TButton;
    btOAll: TButton;
    btHAll: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgPedaKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
procedure btPedaHtmlClick(Sender: TObject);
procedure ldOsztClick(Sender: TObject);
procedure ldHelyClick(Sender: TObject);
procedure btOsztHtmlClick(Sender: TObject);
procedure btHelyHtmlClick(Sender: TObject);
procedure btPAllClick(Sender: TObject);
procedure btOAllClick(Sender: TObject);
procedure btHAllClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmMentMint: TfmMentMint;
  O: Array[0..NaSz,0..2*NOSz] Of St12;

implementation

{$R *.dfm}

procedure TfmMentMint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmMentMint.btKilepesClick(Sender: TObject);
Var I: Word;
    Kod: Integer;
begin
With sgPeda Do With ATFOR Do
For I:= 1 To PMax Do
Begin
    PNev[I]:= Cells[1,I];
    PRov[I]:= Cells[2,I];
    PBeo[I]:= Cells[3,I];
    Val(Cells[4,I],PKot[I],Kod);
    Val(Cells[5,I],PNOT[I],Kod);
End;
  Close;
end;

procedure TfmMentMint.FormCreate(Sender: TObject);
Var I: Word;
begin
With sgPeda Do With ATFOR Do
Begin
    ColWidths[0]:= 24;
    ColWidths[1]:= 160;
    RowCount:= PMax+1;
    Cells[1,0]:= 'Pedagógus';
    Cells[2,0]:= 'NévRöv';
    Cells[3,0]:= 'Beosztás';
    Cells[4,0]:= 'KötÓra';
    Cells[5,0]:= 'NemÓratervi';
For I:= 1 To PMax Do
Begin
      Cells[0,I]:= IntToStr(I)+'.';
      Cells[1,I]:= PNev[I];
      Cells[2,I]:= PRov[I];
      Cells[3,I]:= PBeo[I];
      Cells[4,I]:= IntToStr(PKot[I]);
      Cells[5,I]:= IntToStr(PNOT[I]);
End;
End;
With ldOszt Do With ATFOR Do
Begin
For I:= 0 To OMax Do Items.Add(ONev[I]);
    ItemIndex:= 0;
End;
With ldHely Do With ATFOR Do
Begin
For I:= 0 To HMax Do Items.Add(HNev[I]);
    ItemIndex:= 0;
End;
  btOsztHtml.Enabled:= False; btHelyHtml.Enabled:= False;
end;

procedure TfmMentMint.sgPedaKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
If Key=13 Then With sgPeda Do If Row<RowCount-1 Then Row:= Row+1;
end;

procedure TfmMentMint.btPedaHtmlClick(Sender: TObject);
Var I, J: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-'; APeda:= sgPeda.Row;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do
Case POra[I,APeda,1] Of
    1..TMax: O[(I-1) Div NOSz+1,(I-1) Mod NOSz+1]:= TNev[POra[I,APeda,1]]+'-'+
                                                    ONev[POra[I,APeda,2]]+'-'+
                                                    HNev[POra[I,APeda,3]];
       Tilt: O[(I-1) Div NOSz+1,(I-1) Mod NOSz+1]:= 'XX';
End;
With ATFOR Do
Begin
    DNev:= PRov[APeda]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',PNev[APeda],' (',PRov[APeda],')','</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
               1: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
            2..7: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                    Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.ldOsztClick(Sender: TObject);
begin
With ldOszt Do btOsztHtml.Enabled:= ItemIndex>0;
end;

procedure TfmMentMint.ldHelyClick(Sender: TObject);
begin
With ldHely Do btHelyHtml.Enabled:= ItemIndex>0;
end;

procedure TfmMentMint.btOsztHtmlClick(Sender: TObject);
Var I, J, P: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-';
With ldOszt Do AOszt:= ItemIndex;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,2*J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If POra[I,P,2]=AOszt Then
If O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]='-' Then
  O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]:= TNev[POra[I,P,1]]+'-'+
                                             PRov[P]+'-'+
                                             HNev[POra[I,P,3]] Else
  O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2]:= TNev[POra[I,P,1]]+'-'+
                                             PRov[P]+'-'+
                                             HNev[POra[I,P,3]];
With ldOszt Do With ATFOR Do
Begin
    DNev:= ONev[AOszt]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',ONev[AOszt],' (Ofő: ',PNev[OOfo[AOSzt]],')',
                     '</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To 2*NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
            1..2: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
           3..14: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                   Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.btHelyHtmlClick(Sender: TObject);
Var I, J, P: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-';
With ldHely Do AHely:= ItemIndex;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If POra[I,P,3]=AHely Then
  O[(I-1) Div NOSz+1,(I-1) Mod NOSz+1]:= TNev[POra[I,P,1]]+'-'+
ONev[POra[I,P,2]]+'-'+
                                         PRov[P];
With ATFOR Do
Begin
    DNev:= HNev[AHely]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',HNev[AHely],'</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
               1: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
            2..7: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                    Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.btPAllClick(Sender: TObject);
Var P: Word;
begin
With sgPeda Do For P:= 1 To PMax Do
Begin Row:= P; btPedaHtmlClick(Sender) End;
end;

procedure TfmMentMint.btOAllClick(Sender: TObject);
Var O: Word;
begin
With ldOszt Do For O:= 1 To OMax Do
Begin ItemIndex:= O; btOsztHtmlClick(Sender) End;
end;

procedure TfmMentMint.btHAllClick(Sender: TObject);
Var H: Word;
begin
With ldHely Do For H:= 1 To HMax Do
Begin ItemIndex:= H; btHelyHtmlClick(Sender) End;
end;

end.

Kódolás (11)

Lassan a kódolás végére érünk. Elkészült a pedagógusok tantárgyfelosztása az intézményi összesítéssel. Mint ahogy azt fentebb leírtam, egy ekkora táblázat megjelenítésére az Excel a legkézenfekvőbb. A 12 oldalnyi táblázatnak az első 33 sora:

A 12. oldal, mely a lista végét tartalmazza, valamint az intézmény szintű összeszést:

Az egyes pedagógusok tantárgyfelosztásának utolsó sorában (Össz: -al kezdődik) a következő számértékek találhatók:

- a pedagógus teljes heti óraszáma (óratervi és nem óratervi órák összege),

- a pedagógus nem óratervi óráinak száma,

- a pedagógus óratervi (a TFOR által beírandó) óráinak száma (a felette lévő tanítási tételek óraszámának összege),

- a pedagógus kötelező-óráinak száma,

- a pedagógus túlórája.

Az intézményi összesenben ugyanezek az órák vannak összesítve. A túlóra összesítésében a negatív túlórákat nem összegzi.

Ugyancsak elkészült a pedagógusok összesített órarendjének Excel táblázatba való mentése. Ez szintén 12 oldal terjedelmű. A formázásnál a fő óráknak (1.-6.) megfelelő cellák háttérszínét, valamint minden második pedagógusnak az órarendjét barackszínnel jelöltük a könnyebb olvashatóság kevéért. Egymás melleti A4-es lapok száma három és a lista olyan hosszú, hogy négy A4-es lapra fér el (3*4=12 lap). A balfelső sarok így néz ki:

Az előző terület 70%-os megjelenítésben:

Az osztályok órarendjének Excel táblázatba való mentése:

Ugyanez 70%-os megjelenítésben:

Végül a Teremórarend:

Ugyanez 70%-os megjelenítésben:

Természetesen az UMentMint listája ismét változott, íme:

unit UMentMint;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

aphics, Controls, Forms, UAdat, UModul,
  Dialogs, StdCtrls, Grids, OleServer, Excel97, ActiveX, ExcelXP;

type
  TfmMentMint = class(TForm)
    lbMentMint: TLabel;
    btKilepes: TButton;
    sgPeda: TStringGrid;
    lbPeda: TLabel;
    lbEgyedi: TLabel;
    lbOsszes: TLabel;
    ldOszt: TListBox;
    ldHely: TListBox;
    btPedaHtml: TButton;
    btOsztHtml: TButton;
    btHelyHtml: TButton;
    btPTFXLS: TButton;
    btPORXLS: TButton;
    btOORXLS: TButton;
    btHORXLS: TButton;
    btPAll: TButton;
    btOAll: TButton;
    btHAll: TButton;
    svExAlk: TExcelApplication;
    svExMFuzet: TExcelWorkbook;
    svExMLap: TExcelWorksheet;
    btMentes: TButton;
    btTantHtml: TButton;
    btTAll: TButton;
    ldTant: TListBox;
Procedure Mentes;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgPedaKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
procedure btPedaHtmlClick(Sender: TObject);
procedure ldOsztClick(Sender: TObject);
procedure ldHelyClick(Sender: TObject);
procedure btOsztHtmlClick(Sender: TObject);
procedure btHelyHtmlClick(Sender: TObject);
procedure btPAllClick(Sender: TObject);
procedure btOAllClick(Sender: TObject);
procedure btHAllClick(Sender: TObject);
procedure btPTFXLSClick(Sender: TObject);
procedure btPORXLSClick(Sender: TObject);
procedure btOORXLSClick(Sender: TObject);
procedure btHORXLSClick(Sender: TObject);
procedure btMentesClick(Sender: TObject);
procedure ldTantClick(Sender: TObject);
procedure btTantHtmlClick(Sender: TObject);
procedure btTAllClick(Sender: TObject);
procedure sgPedaClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmMentMint: TfmMentMint;
  O: Array[0..NaSz,0..2*NOSz] Of St36;

implementation

{$R *.dfm}

Procedure TfmMentMint.Mentes;
Var I: Word;
    Kod: Integer;
Begin
With sgPeda Do With ATFOR Do
For I:= 1 To PMax Do
Begin
    PNev[I]:= Cells[1,I];
    PRov[I]:= Cells[2,I];
    PBeo[I]:= Cells[3,I];
    Val(Cells[4,I],PKot[I],Kod);
    Val(Cells[5,I],PNOT[I],Kod);
End;
End;

procedure TfmMentMint.btMentesClick(Sender: TObject);
begin
  Mentes;
end;

procedure TfmMentMint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmMentMint.btKilepesClick(Sender: TObject);
begin
  Mentes;
  Close;
end;

procedure TfmMentMint.FormCreate(Sender: TObject);
Var I, O, P, T, H, S: Word;
begin
With sgPeda Do With ATFOR Do
Begin
    ColWidths[0]:= 24;
    ColWidths[1]:= 150;
    RowCount:= PMax+1;
    Cells[1,0]:= 'Pedagógus';
    Cells[2,0]:= 'NévRöv';
    Cells[3,0]:= 'Beosztás';
    Cells[4,0]:= 'KötÓra';
    Cells[5,0]:= 'NemÓrat';
    Cells[6,0]:= 'Óratervi';
For P:= 1 To PMax Do
Begin
      S:= 0;
      Cells[0,P]:= IntToStr(P)+'.';
      Cells[1,P]:= PNev[P];
      Cells[2,P]:= PRov[P];
      Cells[3,P]:= PBeo[P];
      Cells[4,P]:= IntToStr(PKot[P]);
      Cells[5,P]:= IntToStr(PNOT[P]);
For I:= 1 To HOSz Do If POra[I,P,2]>0 Then Inc(S);
      Cells[6,P]:= IntToStr(S);
End;
End;
With ldTant Do With ATFOR Do
Begin
For T:= 0 To TMax Do Items.Add(TNev[T]);
    ItemIndex:= 0;
End;
With ldOszt Do With ATFOR Do
Begin
For O:= 0 To OMax Do Items.Add(ONev[O]);
    ItemIndex:= 0;
End;
With ldHely Do With ATFOR Do
Begin
For H:= 0 To HMax Do Items.Add(HNev[H]);
    ItemIndex:= 0;
End;
  btTantHtml.Enabled:= False;
  btOsztHtml.Enabled:= False;
  btHelyHtml.Enabled:= False;
end;

procedure TfmMentMint.sgPedaClick(Sender: TObject);
begin
With sgPeda Do If Col=6 Then Col:= 5;
end;

procedure TfmMentMint.sgPedaKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
If Key=13 Then With sgPeda Do If Row<RowCount-1 Then Row:= Row+1;
end;

procedure TfmMentMint.btPedaHtmlClick(Sender: TObject);
Var I, J: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-'; APeda:= sgPeda.Row;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do
Case POra[I,APeda,1] Of
    1..TMax: O[(I-1) Div NOSz+1,(I-1) Mod NOSz+1]:= TNev[POra[I,APeda,1]]+'-'+
                                                    ONev[POra[I,APeda,2]]+'-'+
                                                    HNev[POra[I,APeda,3]];
       Tilt: O[(I-1) Div NOSz+1,(I-1) Mod NOSz+1]:= 'XX';
End;
With ATFOR Do
Begin
    DNev:= PRov[APeda]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',PNev[APeda],' (',PRov[APeda],')','</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
               1: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
            2..7: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                    Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.ldTantClick(Sender: TObject);
begin
With ldTant Do btTantHtml.Enabled:= ItemIndex>0;
end;

procedure TfmMentMint.ldOsztClick(Sender: TObject);
begin
With ldOszt Do btOsztHtml.Enabled:= ItemIndex>0;
end;

procedure TfmMentMint.ldHelyClick(Sender: TObject);
begin
With ldHely Do btHelyHtml.Enabled:= ItemIndex>0;
end;

procedure TfmMentMint.btTantHtmlClick(Sender: TObject);
Var I, J, P: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-';
With ldTant Do ATant:= ItemIndex;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,2*J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If POra[I,P,1]=ATant Then
If O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]='-' Then
  O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]:= ONev[POra[I,P,2]]+',' Else
Begin
If Length(O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1])<20 Then
    O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]:=
    O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]+ONev[POra[I,P,2]]+',' Else
If O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2]='-' Then
    O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2]:= ONev[POra[I,P,2]]+',' Else
If Length(O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2])<20 Then
    O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2]:=
    O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2]+ONev[POra[I,P,2]]+',';
End;
With ATFOR Do
Begin
    DNev:= TNev[ATant]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',TNev[ATant],
                     '</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To 2*NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
            1..2: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
           3..14: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                   Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.btOsztHtmlClick(Sender: TObject);
Var I, J, P: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-';
With ldOszt Do AOszt:= ItemIndex;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,2*J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If POra[I,P,2]=AOszt Then
If O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]='-' Then
  O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+1]:= TNev[POra[I,P,1]]+'-'+
                                             PRov[P]+'-'+
                                             HNev[POra[I,P,3]] Else
  O[(I-1) Div NOSz+1,2*((I-1) Mod NOSz)+2]:= TNev[POra[I,P,1]]+'-'+
                                             PRov[P]+'-'+
                                             HNev[POra[I,P,3]];
With ATFOR Do
Begin
    DNev:= ONev[AOszt]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',ONev[AOszt],' (Ofő: ',PNev[OOfo[AOSzt]],')',
                     '</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To 2*NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
            1..2: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
           3..14: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                   Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.btHelyHtmlClick(Sender: TObject);
Var I, J, P: Word;
begin
For I:= 0 To NaSz Do For J:= 0 To 2*NOSz Do O[I,J]:= '-';
With ldHely Do AHely:= ItemIndex;
  O[0,0]:= '*'; For I:= 1 To NaSz Do O[I,0]:= NNev[I];
For J:= 0 To NOSz-1 Do O[0,J+1]:= IntToStr(J)+'.';
With ATFOR Do For I:= 1 To HOSz Do For P:= 1 To PMax Do
If POra[I,P,3]=AHely Then
  O[(I-1) Div NOSz+1,(I-1) Mod NOSz+1]:= TNev[POra[I,P,1]]+'-'+
                                         ONev[POra[I,P,2]]+'-'+
                                         PRov[P];
With ATFOR Do
Begin
    DNev:= HNev[AHely]+'.html';
    AssignFile(FText,DNev); ReWrite(FText);
      WriteLn(FText, '<HTML>','<BODY>');
      WriteLn(FText, '<p align=center>',
                     '<Font size=6>',
                     '<u>','<b>',HNev[AHely],'</b>','</u>',
                     '</Font>','</p>');
      WriteLn(FText, '<p align=center>',
                     '<Font face=courier>');
      WriteLn(FText, '<TABLE border=1 cellpadding=5 cellspacing=0>');
For J:= 0 To NOSz Do
Begin
        WriteLn(FText,'<tr>');
For I:= 0 To NaSz Do
Begin
Case J Of
               0: Write(FText, '<th>');
               1: If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
            2..7: Begin
If I=0 Then Write(FText, '<th') Else Write(FText, '<td');
                    Write(FText, ' bgcolor=#ddeeff>');
End;
Else
Begin
If I=0 Then Write(FText, '<th>') Else Write(FText, '<td>');
End;
End;
          WriteLn(FText,O[I,J]);
If J=0 Then Write(FText, '</th>') Else Write(FText, '</td>');
End;
        WriteLn(FText,'</tr>');
End;
      WriteLn(FText,'</table>','</font>','</p>');
      WriteLn(FText,'<br>','<br>');
      WriteLn(FText,'<font size=1 color=blue>');
      WriteLn(FText,'<center>');
      WriteLn(FText,'<u>','Created by TFOR System (GM-Soft) ',
                    DateToStr(Now),'-',TimeToStr(Time),
                    '</u></center>');
      WriteLn(FText,'</Body></HTML>');
    CloseFile(Ftext);
End;
end;

procedure TfmMentMint.btPAllClick(Sender: TObject);
Var P: Word;
begin
With sgPeda Do For P:= 1 To PMax Do
Begin Row:= P; btPedaHtmlClick(Sender) End;
end;

procedure TfmMentMint.btTAllClick(Sender: TObject);
Var T: Word;
begin
With ldTant Do For T:= 1 To TMax Do
Begin ItemIndex:= T; btTantHtmlClick(Sender) End;
end;

procedure TfmMentMint.btOAllClick(Sender: TObject);
Var O: Word;
begin
With ldOszt Do For O:= 1 To OMax Do
Begin ItemIndex:= O; btOsztHtmlClick(Sender) End;
end;

procedure TfmMentMint.btHAllClick(Sender: TObject);
Var H: Word;
begin
With ldHely Do For H:= 1 To HMax Do
Begin ItemIndex:= H; btHelyHtmlClick(Sender) End;
end;

procedure TfmMentMint.btPTFXLSClick(Sender: TObject);
Var O, P, T, S, OTSz, TOTSz, TNOT, TOSz, TKot, TTul: Word;
    LCID: Integer;
    Ws: String;
begin
  GetDir(0,Ws);
  LCID:= GetUserDefaultLCID;
With svExAlk Do
Begin
    Connect; Visible[LCID]:= True; DisplayAlerts[LCID]:= False;
    svExMFuzet.ConnectTo(WorkBooks.Add(TOleEnum(xlWBATWorkSheet),LCID));
End;
With svExMLap Do With ATFOR Do
Begin
    ConnectTo(svExMFuzet.Worksheets[1] As _WorkSheet);
    PageSetup.Orientation:= 1;
    Range['A1','A1'].Select;
With Cells Do
Begin
      Item[1,2].Value:= 'Pedagógus:';
With Range['B1','B1'] Do Begin Select; Font.Bold:= True End;
      TOTSz:= 0; TNOT:= 0;  TOSz:= 0; TKot:= 0;  TTul:= 0;
      S:= 1;
For P:= 1 To PMax Do
Begin
        OTSz:= 0;
        Inc(S);
With Range['A'+IntToStr(S),'A'+IntToStr(S)] Do
Begin Select; NumberFormat:='@' End;
        Item[S,1].Value:= IntToStr(P)+'.';
        Item[S,2].Value:= PNev[P];
        Item[S,3].Value:= PRov[P];
        Item[S,4].Value:= PBeo[P];
        Item[S,5].Value:= 'Össz';
        Item[S,6].Value:= 'Köt';
        Item[S,7].Value:= 'Túl';
With Range['A'+IntToStr(S),'G'+IntToStr(S)] Do
Begin Select; Font.Bold:= True End;
For O:= 1 To OMax Do For T:= 1 To TMax Do
Begin
If OTer[O,T,3]=P Then
Begin
            Inc(S);
            Item[S,3]:= TNev[T]; Item[S,4]:= ONev[O]; Item[S,5]:= OTer[O,T,1];
            Inc(OTSz,OTer[O,T,1]);
End;
If OTer[O,T,4]=P Then
Begin
            Inc(S);
            Item[S,3]:= TNev[T]; Item[S,4]:= ONev[O]; Item[S,5]:= OTer[O,T,2];
            Inc(OTSz,OTer[O,T,2]);
End;
End;
        Inc(S);
With Range['A'+IntToStr(S),'G'+IntToStr(S)] Do
Begin Select; Font.Bold:= True End;
        Item[S,2]:= 'Össz:';
With Range['B'+IntToStr(S),'B'+IntToStr(S)] Do
Begin Select; HorizontalAlignment:= xlHAlignRight End;
        Item[S,3]:= PNOT[P]+OTSz;         Inc(TOSz,PNOT[P]+OTSz);
        Item[S,4]:= PNOT[P];              Inc(TNOT,PNOT[P]);
        Item[S,5]:= OTSz;                 Inc(TOTSz,OTSz);
        Item[S,6]:= PKot[P];              Inc(TKot,PKot[P]);
        Item[S,7]:= PNOT[P]+OTSz-PKot[P];
If PNOT[P]+OTSz-PKot[P]>0 Then    Inc(TTul,PNOT[P]+OTSz-PKot[P]);
End;
With Range['A1','G'+IntToStr(S)] Do
Begin Select; Borders.LineStyle:= xlContinuous End;
      Inc(S,2);
With Range['A'+IntToStr(S),'G'+IntToStr(S+8)] Do
Begin Select; Font.Bold:= True End;
      Item[S,2]:= 'Intézményi összesen:';
      Inc(S); Item[S,2]:= 'Teljes óraszám:'; Item[S,3]:= TOSz;
      Inc(S); Item[S,2]:= 'Nem óratervi órák:'; Item[S,3]:= TNOT;
      Inc(S); Item[S,2]:= 'Óratervi órák:'; Item[S,3]:= TOTSz;
      Inc(S); Item[S,2]:= 'Kötelező órák száma:'; Item[S,3]:= TKot;
      Inc(S); Item[S,2]:= 'Túlórák száma:'; Item[S,3]:= TTul;
      Inc(S,2); Item[S,2]:= DateToStr(Now);
End;
    svExMLap.Cells.EntireColumn.AutoFit;
    Range['A1','A1'].Select;
    SaveAs(Ws+'\PTF-'+MaRovid);
End;
  svExMLap.Disconnect;
  svExMFuzet.Disconnect;
  svExAlk.Quit;
  svExAlk.Disconnect;
end;

procedure TfmMentMint.btPORXLSClick(Sender: TObject);
Var I, P, J, S: Word;
    LCID: Integer;
    Ws: String;
begin
  GetDir(0,Ws);
  LCID:= GetUserDefaultLCID;
With svExAlk Do
Begin
    Connect; Visible[LCID]:= True; DisplayAlerts[LCID]:= False;
    svExMFuzet.ConnectTo(WorkBooks.Add(TOleEnum(xlWBATWorkSheet),LCID));
End;
With svExMLap Do With ATFOR Do
Begin
    ConnectTo(svExMFuzet.Worksheets[1] As _WorkSheet);
    PageSetup.Orientation:= 1;
With Range['B2','AY2'] Do Begin Select; NumberFormat:='@' End;
    Range['A1','A1'].Select;
With Cells Do
Begin
      Item[2,1].Value:= 'Ped:';
For I:= 1 To NaSz Do
Begin
        Item[1,(I-1)*NOSz+2].Value:= NNev[I];
For J:= 0 To NOSz-1 Do Item[2,(I-1)*NOSz+2+J].Value:= IntToStr(J)+'.';
End;
      S:= 2;
For P:= 1 To PMax Do
Begin
        Inc(S); Item[S,1].Value:= PNev[P];
For I:= 1 To HOSz Do If POra[I,P,1] In [1..TMax] Then
        Item[S,I+1].Value:= TNev[POra[I,P,1]] Else Item[S,I+1]:= '-';
        Inc(S); Item[S,1].Value:= PRov[P];
For I:= 1 To HOSz Do If POra[I,P,2] In [1..OMax] Then
        Item[S,I+1].Value:= ONev[POra[I,P,2]] Else Item[S,I+1]:= '-';
        Inc(S); Item[S,1].Value:= PBeo[P];
For I:= 1 To HOSz Do If POra[I,P,3] In [1..HMax] Then
        Item[S,I+1].Value:= HNev[POra[I,P,3]] Else Item[S,I+1]:= '-';
End;
End;
With Range['A1','AY2'] Do
Begin
      Select;
      Font.Bold:= True;
      HorizontalAlignment:= xlHAlignCenter;
End;
With Range['A1','A'+IntToStr(3*PMax+2)] Do
Begin
      Select;
      Font.Bold:= True;
End;
With Range['A3','AY'+IntToStr(3*PMax+2)] Do
Begin
      Select;
      Borders.LineStyle:= xlContinuous;
End;
With svExMLap.Application Do
Begin
      Range['B1','K1'].MergeCells:= True;
      Range['L1','U1'].MergeCells:= True;
      Range['V1','AE1'].MergeCells:= True;
      Range['AF1','AO1'].MergeCells:= True;
      Range['AP1','AY1'].MergeCells:= True;
      Cells.EntireColumn.AutoFit;
For P:= 1 To PMax Do If (P Mod 2)=1 Then
      Range['A'+IntToStr(3*P),
            'AY'+IntToStr(3*P+2)].Interior.ColorIndex:= 40;
      Range['C3','H'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['M3','R'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['W3','AB'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['AG3','AL'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['AQ3','AV'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
End;
    Range['A1','A1'].Select;
    SaveAs(Ws+'\POR-'+MaRovid);
End;
  svExMLap.Disconnect;
  svExMFuzet.Disconnect;
  svExAlk.Quit;
  svExAlk.Disconnect;
end;

procedure TfmMentMint.btOORXLSClick(Sender: TObject);
Var I, O, P, J, S: Word;
    LCID: Integer;
    Ws: String;
begin
  GetDir(0,Ws);
  LCID:= GetUserDefaultLCID;
With svExAlk Do
Begin
    Connect; Visible[LCID]:= True; DisplayAlerts[LCID]:= False;
    svExMFuzet.ConnectTo(WorkBooks.Add(TOleEnum(xlWBATWorkSheet),LCID));
End;
With svExMLap Do With ATFOR Do
Begin
    ConnectTo(svExMFuzet.Worksheets[1] As _WorkSheet);
    PageSetup.Orientation:= 1;
With Range['B2','AY2'] Do Begin Select; NumberFormat:='@' End;
    Range['A1','A1'].Select;
With Cells Do
Begin
      Item[2,1].Value:= 'Oszt:';
For I:= 1 To NaSz Do
Begin
        Item[1,(I-1)*NOSz+2].Value:= NNev[I];
For J:= 0 To NOSz-1 Do Item[2,(I-1)*NOSz+2+J].Value:= IntToStr(J)+'.';
End;
      S:= 2;
For O:= 1 To OMax Do
Begin
        Inc(S); Item[S,1].Value:= ONev[O];
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,2]=O Then
If Item[S,I+1].Value='' Then
Begin
          Item[S,  I+1].Value:= TNev[POra[I,P,1]];
          Item[S+1,I+1].Value:= PRov[P];
          Item[S+2,I+1].Value:= HNev[POra[I,P,3]];
End Else
Begin
          Item[S+3,I+1].Value:= TNev[POra[I,P,1]];
          Item[S+4,I+1].Value:= PRov[P];
          Item[S+5,I+1].Value:= HNev[POra[I,P,3]];
End;
        Inc(S,5);
End;
End;
With Range['A1','AY2'] Do
Begin
      Select;
      Font.Bold:= True;
      HorizontalAlignment:= xlHAlignCenter;
End;
With Range['A1','A'+IntToStr(6*OMax+2)] Do
Begin
      Select;
      Font.Bold:= True;
End;
With Range['A3','AY'+IntToStr(6*OMax+2)] Do
Begin
      Select;
      Borders.LineStyle:= xlContinuous;
End;
With svExMLap.Application Do
Begin
      Range['B1','K1'].MergeCells:= True;
      Range['L1','U1'].MergeCells:= True;
      Range['V1','AE1'].MergeCells:= True;
      Range['AF1','AO1'].MergeCells:= True;
      Range['AP1','AY1'].MergeCells:= True;
      Cells.EntireColumn.AutoFit;
For O:= 1 To OMax Do If (O Mod 2)=1 Then
      Range['A'+IntToStr(6*O-3),
            'AY'+IntToStr(6*O+2)].Interior.ColorIndex:= 40;
      Range['C3','H'+IntToStr(6*OMax+2)].Interior.ColorIndex:= 40;
      Range['M3','R'+IntToStr(6*OMax+2)].Interior.ColorIndex:= 40;
      Range['W3','AB'+IntToStr(6*OMax+2)].Interior.ColorIndex:= 40;
      Range['AG3','AL'+IntToStr(6*OMax+2)].Interior.ColorIndex:= 40;
      Range['AQ3','AV'+IntToStr(6*OMax+2)].Interior.ColorIndex:= 40;
End;
    Range['A1','A1'].Select;
    SaveAs(Ws+'\OOR-'+MaRovid);
End;
  svExMLap.Disconnect;
  svExMFuzet.Disconnect;
  svExAlk.Quit;
  svExAlk.Disconnect;
end;

procedure TfmMentMint.btHORXLSClick(Sender: TObject);
Var I, H, P, J, S: Word;
    LCID: Integer;
    Ws: String;
begin
  GetDir(0,Ws);
  LCID:= GetUserDefaultLCID;
With svExAlk Do
Begin
    Connect; Visible[LCID]:= True; DisplayAlerts[LCID]:= False;
    svExMFuzet.ConnectTo(WorkBooks.Add(TOleEnum(xlWBATWorkSheet),LCID));
End;
With svExMLap Do With ATFOR Do
Begin
    ConnectTo(svExMFuzet.Worksheets[1] As _WorkSheet);
    PageSetup.Orientation:= 1;
With Range['B2','AY2'] Do Begin Select; NumberFormat:='@' End;
    Range['A1','A1'].Select;
With Cells Do
Begin
      Item[2,1].Value:= 'Hely:';
For I:= 1 To NaSz Do
Begin
        Item[1,(I-1)*NOSz+2].Value:= NNev[I];
For J:= 0 To NOSz-1 Do Item[2,(I-1)*NOSz+2+J].Value:= IntToStr(J)+'.';
End;
      S:= 2;
For H:= 1 To HMax Do
Begin
        Inc(S); Item[S,1].Value:= HNev[H];
For I:= 1 To HOSz Do For P:= 1 To PMax Do If POra[I,P,3]=H Then
Begin
          Item[S,  I+1].Value:= TNev[POra[I,P,1]];
          Item[S+1,I+1].Value:= ONev[POra[I,P,2]];
          Item[S+2,I+1].Value:= PRov[P];
End;
        Inc(S,2);
End;
End;
With Range['A1','AY2'] Do
Begin
      Select;
      Font.Bold:= True;
      HorizontalAlignment:= xlHAlignCenter;
End;
With Range['A1','A'+IntToStr(3*PMax+2)] Do
Begin
      Select;
      Font.Bold:= True;
End;
With Range['A3','AY'+IntToStr(3*PMax+2)] Do
Begin
      Select;
      Borders.LineStyle:= xlContinuous;
End;
With svExMLap.Application Do
Begin
      Range['B1','K1'].MergeCells:= True;
      Range['L1','U1'].MergeCells:= True;
      Range['V1','AE1'].MergeCells:= True;
      Range['AF1','AO1'].MergeCells:= True;
      Range['AP1','AY1'].MergeCells:= True;
      Cells.EntireColumn.AutoFit;
For P:= 1 To PMax Do If (P Mod 2)=1 Then
      Range['A'+IntToStr(3*P),
            'AY'+IntToStr(3*P+2)].Interior.ColorIndex:= 40;
      Range['C3','H'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['M3','R'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['W3','AB'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['AG3','AL'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
      Range['AQ3','AV'+IntToStr(3*PMax+2)].Interior.ColorIndex:= 40;
End;
    Range['A1','A1'].Select;
    SaveAs(Ws+'\HOR-'+MaRovid);
End;
  svExMLap.Disconnect;
  svExMFuzet.Disconnect;
  svExAlk.Quit;
  svExAlk.Disconnect;
end;

end.

2011. november 20. (The end.)