Stian Søiland, IT 112, øvingsgruppe 15 (stud.ass. Helle Haugenes)

Delphi - Øving 1 - Oppgave 2

unit Unit1;

// Har utvidet Oppgave 1 til sirkulær dobbeltlenket liste
// (Dobbeltlenket for morros skyld)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Unit2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    hode: figurlistepeker;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// Prosedyre for registrering
procedure TForm1.Button1Click(Sender: TObject);

  // Prosedyre for å slette eventuell eksisterende liste
  procedure slettliste(var hode:figurlistepeker);
   // bruker nå to temp-pekere
   var temp1,temp2:figurlistepeker;
   begin
     // Gjennomløper hele den lenkede listen. Er listen tom, gjøres ingenting.
     // Til slutt vil hodet være NIL
    temp1 := hode;
    // endret sløyfestruktur
     if hode <> nil then
     
     repeat
       begin
        temp2 := temp1;
        temp1 := temp1^.neste;
        dispose(temp2);
       end;
     // når temp1 er hode, er vi gått igjennom hele den sirkulære listen
     // og det er ingen noder igjen i den sirkulære listen
     until temp1 = hode;
     hode := nil;
   end;

  // Prosedyre for å registrere figurer
  procedure registrer;
    begin
     Form1.Enabled := False;
     Form2.Visible := True;
    end;

begin
 slettliste(hode);
 listbox1.clear;
 registrer;
end;

// Prosedyre for å skrive ut listen
procedure TForm1.Button2Click(Sender: TObject);
 procedure skrivut(hode:figurlistepeker);
  var neste : figurlistepeker;
  begin
    neste := hode;
    // Gjennomløper hele den lenkede listen
    listbox1.clear;
    // endret sløyfestruktur
    if hode <> NIL then
    repeat
      begin
        with neste^ do
        begin
        case figurtype of
          linje: begin
                   listbox1.items.add('Linje med lengde '
                   + FloatToStr(lengde));
                 end;
        trekant: begin
                  listbox1.items.add('Trekant med høyde '
                  + FloatToStr(hoyde) + ' og bredde '
                  + FloatToStr(bredde));
                 end;
        firkant: begin
                  listbox1.items.add('Firkant med høyde '
                  + FloatToStr(hoyde) + ' og bredde '
                  + FloatToStr(bredde));
                 end;
         sirkel: begin
                  listbox1.items.add('Sirkel med radius '
                  + FloatToStr(radius));
                 end;
            end; // end case
         end; // end with
        neste := neste^.neste;
      end; // end until
    until neste = hode;
    // Hele den sirkulære listen er skrevet ut, vi er tilbake på begynnelsen
  end; // end skrivutprosedyre

begin
 skrivut(hode);
end;

// Kjøres ved oppstart for å nullstille den globale variabelen hode
procedure TForm1.FormCreate(Sender: TObject);
begin
 hode := nil;
end;

end.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
     figurer = (linje,trekant,firkant,sirkel);
     figurlistepeker = ^figurlistetype;
     figurlistetype = record
         // lagt til forrige for sirkulær lenket liste
         neste,forrige:figurlistepeker;

        case figurtype:figurer of
                 linje: (lengde:real);
       trekant,firkant: (hoyde,bredde:real);
                sirkel: (radius:real);
                   end;
  TForm2 = class(TForm)
    RadioGroup1: TRadioGroup;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure Reset;
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  neste: figurlistepeker;

implementation

uses Unit1;

{$R *.DFM}

procedure Tform2.Reset;
begin
      RadioGroup1.Itemindex := -1;
      Edit1.Visible := False;
      Edit2.Visible := False;
      Edit1.Text := '';
      Edit2.Text := '';
      Label1.Visible := False;
      Label2.Visible := False;
end;

procedure TForm2.Button1Click(Sender: TObject);
  procedure nynode(var hode,neste:figurlistepeker);
    var temp:figurlistepeker;
    begin
      if hode = nil then
        begin
         new(hode);
         neste := hode;
        end
       else
        begin
         new(temp);
        // lagt til forrige-peker
         neste^.neste := temp;
         temp^.forrige := neste;
         neste := neste^.neste;
        end;
      // endret fra nil til hode
      neste^.neste := hode;
    end;

begin
  if RadioGroup1.ItemIndex > -1 then
    begin
      nynode(form1.hode,neste);
      with neste^ do
      begin
      case RadioGroup1.ItemIndex of
      0: begin
           figurtype := linje;
           lengde := StrToFloat(Edit1.text);
         end;
      1: begin
           figurtype := trekant;
           hoyde := StrToFloat(Edit1.text);
           bredde := StrToFloat(Edit2.text);
         end;
      2: begin
           figurtype := firkant;
           hoyde := StrToFloat(Edit1.text);
           bredde := StrToFloat(Edit2.text);
         end;
      3: begin
           figurtype := sirkel;
           radius := StrToFloat(Edit1.text);
         end;
      end; // slutt case of
      end; // slutt with
      reset;
    end;
end;

procedure TForm2.RadioGroup1Click(Sender: TObject);
begin
      case RadioGroup1.ItemIndex of
        0: begin
             Edit2.Visible := False;
             Label2.Visible := False;
             Label1.Caption := 'Lengde:';
             Edit1.Visible := True;
           end;
      1,2: begin
             Label1.Caption := 'Lengde:';
             Label2.Visible := True;
             Edit2.Visible := True;
           end;
        3: begin
             Edit2.Visible := False;
             Label2.Visible := False;
             Label1.Caption := 'Radius:';
           end;
        end;
        Edit1.Visible := True;
        Label1.Visible := True;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
 Form2.Visible := False;
 Form1.Enabled := True;
 reset;
end;

end.