deklarácie:

Daný je binárny súbor studenti.dat, v ktorom sú uložené vety tohoto typu:

kružok - ročník a kód kombinácie, napr. 3MI1, 1i1, 4bi

type
  veta = record
    meno: string[10];
    priezv: string[15];
    mesto: string[15];
    rok_nar:1980..1990;
    kruzok: string[5];
    znamky: string;    // napr. 'ABAFD'
  end;

urob, ak platí...

Vytvorte triedu TSZoznam (zoznam študentov), ktorá bude môcť uchovávať údaje z daného súboru v spájanom zozname. Zadefinujte jej metódy (použite procedurálne parametre a flitre), pomocou ktorých:

• Vytvoríte zoznam študentov načítaním ich údajov zo súboru.
• Prebehnete celý zoznam a každému študentovi, ktorý nemá medzi známkami F, zvýši číslo ročníka o jedna.

type
  proc=procedure(v:TSVrchol);
  filter=function(v:TSVrchol):boolean;

procedure zvysRocnik(v:TSVrchol);
begin
  if v.kruzok[1]<'5' then
    v.kruzok[1]:=chr(ord(v.kruzok[1])+1);
end;

function trebaZvysitRocnik(v:TSVrchol):boolean;
var
  i:integer;
begin
  Result:=true;
  for i:=1 to high(v.znamky) do
    if v.znamky[i]='F' then Result:=false;
end;
   
procedure TSZoznam.urobAKplati(p:proc; f:filter);
var
  pom:TSVrchol;
begin
  if z<>nil then begin
    pom:=z;
    while (pom<>nil) do begin
      if not assigned(f) or f(pom) then p(pom);
      pom:=pom.next;
    end;
  end;
end;

filtrovaný výpis do súboru:

Vypíšete do súboru mená a priezviská všetkých študentov, ktorí sú starší ako 20 rokov, tých, ktorí sú z Bratislavy, ...

type
  filter=function(v:TSVrchol):boolean;

function starsiAko20(v:TSVrchol):boolean;
begin
  Result:=v.rok_nar<1982;
end;

function Blavaci(v:TSVrchol):boolean;
begin
  Result:=v.mesto='Bratislava ';
end;

procedure TSZoznam.vypisDoSuboru(f:filter);
var
  fs:TStream;
  p:TSVrchol;
begin
  if z<> nil then begin
    fs:=TFileStream.Create
           ('Niektoristudenti.dat',fmCreate);
    p:=z;
    while p<>nil do begin
      if not assigned(f) or f(p) then begin
        fs.Write(p.meno,sizeof(p.meno));
        fs.Write(p.priezv,sizeof(p.priezv));
      end;
      p:=p.next;
    end;
    fs.Free;
  end;
end;

filtrovaný podzoznam:

Vytvoríte nový zoznam, ktorý bude obsahovať len tých študentov, ktorých študijný priemer je <1.5. Tento zoznam vráti metóda ako svoju hodnotu.

type
  filter=function(v:TSVrchol):boolean;

function PriemPod1_5(v:TSVrchol):boolean;
begin
  ...
end;

function TSZoznam.vytvorZoz(f:filter):TSZoznam;
var
  p:TSVrchol;
  v:veta;
begin
  Result:=TSZoznam.Create;
  p:=z;
  while p<>nil do begin
    if not assigned(f) or f(p) then Result.pridajK(v);
    p:=p.next;
  end;
end;

// potom mozno vypisovat napr. takto

procedure TForm1.Button1Click(Sender: TObject);
var
  nz:TSZoznam;
begin
  nz:=zoz.vytvorZoz(PriemPod1_5);
  Memo1.Lines.Add(nz.vypis);
  nz.Free;
end;

malý grafický editor:

v ktorom bude aj skupina 3 radioButtonov:
Ak bude stlačený prvý, budete pri pohybe myšou a stlačenom ľavom tlačidle myši do plochy kresliť krúžky, ak bude stlačený druhý rádiobutton - elipsy, k bude stlačený tretí - šikmé čiarky. Použite procedurálny typ.

kresliKruzky, kresliElipsy a kresliCiarky sú procedury typu proc

type
  proc = procedure(X,Y: Integer);  

var
  p:proc;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  p:= kresliKruzky;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  p:= kresliElipsy;
end;

procedure TForm1.RadioButton3Click(Sender: TObject);
begin
  p:=kresliCiarky;
end;

procedure TForm1.Image1MouseMove(...);
begin
  if ssLeft in Shift then p(X,Y);
end;

inak:

metóda kruzky musí byť rovnakého typu ako Image1MouseMove

procedure TForm1.kruzky(Sender:TObject;
                     Shift:TShiftState; X,Y:Integer);
begin
  if ssLeft in Shift then
    Image1.Canvas.Ellipse(x-3,y-3,x+3,y+3);
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
  Image1.OnMouseMove:=kruzky;
end;

deklarácie:

Máme dané deklarácie pre dvojsmerného spájaného zoznamu

napíšte metódy pre dvojsmerný spájaný zoznam

type
  prvok = integer;
  TVrchol = class
    info:prvok;
    prev,next:TVrchol;
    constructor Create(i:prvok; p,n:TVrchol);
    function vypis:string; virtual;
  end;

  TZoznam = class
  private
    z:TVrchol;
    k:TVrchol;
  public
    constructor Create;
    destructor Destroy; override;
    ...
  end;

metóda dvoj - opraví zoznam:

z dvojsmerného spájaného zoznamu, ktorý má zatiaľ všetkých prev = nil, vytvorí "pospájaný" dvojsmerný spájaný zoznam

procedure TZoznam.dvoj;
var
  p:TVrchol;
begin
  if z<>nil then begin
    p:=z;
    while p.next<>nil do begin
      p.next.prev:=p;
      p:=p.next;
    end;
  end;
end;

pridaj vrchol na začiatok:

procedure TZoznam.pridajZ(v:TVrchol);
begin
  v.prev:=nil; v.next:=z;
  if k=nil then k:=v
  else z.prev:=v;
  z:=v;
end;

pridaj vrchol pred iný vrchol:

procedure TZoznam.vsunPred(pred,v:TVrchol);
begin
  if pred=z then pridajZ(v)
  else if pred=nil then pridajK(v)
  else begin
    v.prev:=pred.prev; pred.prev:=v; v.next:=pred;
    v.prev.next:=v;
  end;
end;

vyhoď vrchol:

procedure TZoznam.vyhod(v:TVrchol);
begin
  if v=nil then           // nič
  else if z=v then begin
    z:=z.next;
    if z<>nil then z.prev:=nil else k:=nil;
    v.Free;
  end
  else begin
    v.prev.next:=v.next;
    if v.next<>nil then v.next.prev:=v.prev
    else k:=v.prev;
    v.Free;
  end;
end;

otočí zoznam:

(vyskúšajte to aj rekurzívne)

procedure TZoznam.otoc;
var
  p,q:TVrchol;
begin
  if z<>nil then begin
    k:=z;
    p:=z;
    while p<>nil do begin
      q:=p.next;
      p.next:=p.prev;
      p.prev:=q;
      z:=p;
      p:=q;
    end;
  end;
end;

vráti minimálny vrchol:

test z=k znamená, že je zoznam prázdny alebo jednoprvkový

function TZoznam.min:TVrchol;
var
  p:TVrchol;
begin
  Result:=z; if z=k then exit;
  p:=z.next;
  while p<>nil do begin
    if p.info<Result.info then Result:=p;
    p:=p.next;
  end;
end;

minsort:

• nájde minimálny prvok a presťahuje ho na začiatok
• v zvyšku zoznamu nájde minimálny a zaradí ho za minimálny
• atď.

function TZoznam.minsort:TZoznam;
begin
end;

deklarácie:

Zadefinujme triedu pre cyklický zoznam, v ktorom

• posledný prvok odkazuje na prvý
• ak je zoznam neprázdny, tak neobsahuje nil
• treba správne rozpoznať koniec zoznamu (napr. pre výpis, všetky, hľadanie hodnoty a pod.)
• môžeme použiť len jediný smerník a to na posledný prvok (premenná k - nasledovníkom k je začiatok zoznamu), teda netreba potom udržiavať dva smerníky

type 
  TCyklZoznam = class
  private
    k:TVrchol;  // koniec zoznamu, k.next je začiatok

  public
    constructor Create;
    destructor Destroy; override;
    function vypis:string;
    procedure pridajZ(i:prvok);
    procedure pridajK(i:prvok);
    procedure vsun(pred:integer; i:prvok);
    function pocet:integer;
    function ity(i:integer):TVrchol;
    procedure ZrusZ;
    procedure ZrusK;
    procedure vyhod(p:TVrchol);
  end;

constructor TCyklZoznam.Create;
begin
  k:=nil;
end;

deštruktor:

destructor TCyklZoznam.Destroy;
var
  p:TVrchol;
begin
  if k<>nil then begin
    while k.next<>k do begin
      p:=k.next; k.next:=p.next; p.Free;
    end;
    k.Free;
  end;
end;

výpis:

function TCyklZoznam.vypis:string;
var
  p:TVrchol;
begin
  Result:='';
  if k<>nil then begin
    p:=k;
    repeat
      p:=p.next;
      Result:=Result+p.vypis;
    until p=k;
  end;
end;

pridaj na začiatok:

procedure TCyklZoznam.pridajZ(i:prvok);
begin
  if k=nil then begin
    k:=TVrchol.Create(i,nil);
    k.next:=k;
  end
  else k.next:=TVrchol.Create(i,k.next);
end;

pridaj na koniec:

procedure TCyklZoznam.pridajK(i:prvok);
begin
  if k=nil then begin
    k:=TVrchol.Create(i,nil);
    k.next:=k;
  end
  else begin
    k.next:=TVrchol.Create(i,k.next);
    k:=k.next;
  end;
end;

pridaj na koniec - inak, pomocou pridajZ:

procedure TCyklZoznam.pridajK(i:prvok);
begin
  pridajZ(i);
  k:=k.next;
end;

počet prvkov:

function TCyklZoznam.pocet:integer;
var
  p:TVrchol;
begin
  Result:=0;
  if k<>nil then begin
    p:=k;
    repeat
      p:=p.next;
      inc(Result);
    until p=k;
  end;
end;

í-ty prvok zoznamu:

function TCyklZoznam.ity(i:integer):TVrchol;
begin
  if k=nil then Result:=nil
  else begin
    Result:=k.next;
    while (Result<>k) and (i>1) do begin
      Result:=Result.next;
      dec(i);
    end;
  end;
end;

vsuň pred prvok:

procedure TCyklZoznam.vsun(pred:integer; i:prvok);
var
  p,q:TVrchol;
begin
  if (pred<2) or (k=nil) then pridajZ(i)
  else begin
    q:=k.next;
    while (q<>k) and (pred>2) do begin
      dec(pred);
      q:=q.next;
    end;
    if q=k then pridajK(i)
    else q.next:=TVrchol.Create(i,q.next);
  end;
end;

zruš prvý prvok:

procedure TCyklZoznam.zrusZ;
var
  p:TVrchol;
begin
  if k<>nil then
    if k=k.next then begin k.free; k:=nil; end
    else begin
      p:=k.next; k.next:=p.next; p.Free;
    end;
end;

zruš posledný prvok:

aby sme mohli zrušiť posledný, musíme nájsť predposledný

procedure TCyklZoznam.zrusK;
var
  p:TVrchol;
begin
  if k<>nil then
    if k=k.next then begin k.free; k:=nil; end
    else begin
      p:=k.next; while p.next<>k do p:=p.next;
      p.next:=k.next; k.Free; k:=p;
    end;
end;

vyhoď prvok zoznamu:

treba dať pozor na to, že ak p nie je prvkom zoznamu, aby sa to nezacyklilo hľadaním p

procedure TCyklZoznam.vyhod(p:TVrchol);
var
  q:TVrchol;
begin
  if k=nil then exit;
  if p=k.next then ZrusZ
  else begin
    q:=k.next;
    while (q<>k) and (q.next<>p) do q:=q.next;
    if q<>k then begin
      q.next:=p.next;
      if k=p then k:=q;
      p.Free;
    end;
  end;
end;