next up previous contents
Nächste Seite: 9.2 Unit Glob Aufwärts: 9. Programmlisting Vorherige Seite: 9. Programmlisting   Inhalt

9.1 Programm CM


{-------------------------------------------------------------------}

{ Programm zur Messung der Kohaerenzlaenge von Laserstrahlung
  Diplomarbeit
  Fachhochschule Wedel
  Udo Becker
  26. August 1997 }
program CM;

{$X+}
{$S+}
{$M 65520,8192,655360}

{-------------------------------------------------------------------}

uses
  Anzeige,     { Grafische Ausgabe }
  ConvertU,    { Konvertierung von Plot-Daten }
  Etc,         { zusaetzliche Programmteile }
  Glob,        { Globale Deklarationen }
  MessU,       { Einlesen der Messdaten }
  MotorU,      { Motorsteuerung }

  { Turbo Pascal Standard Units }
  App, Drivers, Gadgets, Memory, Menus, Objects, Views;

type
  TCM = object(TApplication)
    Clock : PClockView;
    Heap  : PHeapView;
    constructor Init;
    procedure HandleEvent(var Event : TEvent); virtual;
    procedure Idle; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
  end;

const
  HeapSize = 48 * (1024 div 16); { 48k Heap }

{-------------------------------------------------------------------}

{ Initialisierung }
constructor TCM.Init;

var
  R : TRect;

begin
  MaxHeapSize := HeapSize;
  inherited Init;
  GetExtent(R);
  R.A.X := R.B.X - 9;
  R.B.Y := R.A.Y + 1;
  Clock := New(PClockView, Init(R));
  Insert(Clock);
  GetExtent(R);
  Dec(R.B.X);
  R.A.X := R.B.X - 9;
  R.A.Y := R.B.Y - 1;
  Heap := New(PHeapView, Init(R));
  Insert(Heap);
  Info;
end; { Init }

{-------------------------------------------------------------------}

{ Auswahl der Handlungsmoeglichkeiten }
procedure TCM.HandleEvent(var Event: TEvent);

begin
  inherited HandleEvent(Event);
  case Event.What of evCommand:
    begin
      case Event.Command of
        cmMessung : Messdialog;
        cmConvert : ConvertFile;
        cmAusgabe : Grafikausgabe;
        cmGamma   : LCDarstellung;
        cmMotor   : Motorsteuerung;
        cmRechner : Rechner;
        cmInfo    : Info;
      else
        Exit;
      end;
      ClearEvent(Event);
    end;
  end;
end; { HandleEvent }

{-------------------------------------------------------------------}

{ Uhrzeit und Speicherbelegung aktualisieren }
procedure TCM.Idle;

begin
  inherited Idle;
  Clock^.Update;
  Heap^.Update;
end; { Idle }

{-------------------------------------------------------------------}

{ Menueleiste }
procedure TCM.InitMenuBar;

var
  R : TRect;

begin
  GetExtent(R);
  R.B.Y := R.A.Y + 1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewItem('~M~essung', '', kbNoKey, cmMessung, hcMessung,
    NewItem('~K~onvertieren', '', kbNoKey, cmConvert, hcConvert,
    NewItem('~A~nzeige', '', kbNoKey, cmAusgabe, hcAusgabe,
    NewItem('~B~erechnung', '', kbNoKey, cmGamma, hcGamma,
    NewItem('Motor~s~teuerung', '', kbNoKey, cmMotor, hcMotor,
    NewSubMenu('~E~tc', hcNoContext, NewMenu(
      NewItem('~T~-Rechner', '', kbNoKey, cmRechner, hcRechner,
      NewItem('~I~nfo', '', kbNoKey, cmInfo, hcInfo,
      nil))),
    nil)))))))));
end; { InitMenuBar }

{-------------------------------------------------------------------}

{ Statuszeile }
procedure TCM.InitStatusLine;

var
  R : TRect;

begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
      NewStatusKey('~Esc~ Fenster schlieáen', kbEsc, cmClose,
      nil))),
    nil)));
end; { InitStatusLine }

{-------------------------------------------------------------------}

var
  ProgCM : TCM;

begin { CM }
  New(Imes);
  New(Itrans);
  New(IRe);
  New(IIm);
  with ProgCM do
  begin
    Init;
    Run;
    Done;
  end;
  Dispose(Imes);
  Dispose(Itrans);
  Dispose(IRe);
  Dispose(IIm);
end. { CM }

{-------------------------------------------------------------------}

next up previous contents
Nächste Seite: 9.2 Unit Glob Aufwärts: 9. Programmlisting Vorherige Seite: 9. Programmlisting   Inhalt
Udo Becker
2000-01-02