Aufgabe

Erweitere den vorhandenen 'Aufzug' um eine Aufzugssteuerung.

aufzug0.zip

unit uAufzug0_GUI;

interface

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

type
  TForm1 = class(TForm)
    bAuf: TButton;
    bStopp: TButton;
    bAb: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure bAufClick(Sender: TObject);
    procedure bStoppClick(Sender: TObject);
    procedure bAbClick(Sender: TObject);
  private
    aufzug : TAufzug;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  aufzug := TAufzug.Create(nil);
  aufzug.Visible := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  aufzug.Free;
end;

procedure TForm1.bAufClick(Sender: TObject);
begin
  aufzug.SetZustand(auf);
end;

procedure TForm1.bStoppClick(Sender: TObject);
begin
  aufzug.SetZustand(stopp);
end;

procedure TForm1.bAbClick(Sender: TObject);
begin
  aufzug.SetZustand(ab);
end;

end.

unit uAufzug0;

interface

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

type
  TZustand = (auf,ab,stopp);

  TAufzug = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    zustand : TZustand;
    x,y,h   : integer;
    sOben,
    sUnten  : boolean;
    timer   : TTimer;
    buffer  : TBitMap;
    procedure zeichneAufzug(x,y,h : integer; o,u : boolean; canvas : TCanvas);
    procedure update(Sender : TObject);
  public
    procedure SetZustand(zustand : TZustand);
    function GetZustand : TZustand;
    function GetUnten : boolean;
    function GetOben : boolean;
  end;

// Achtung : hier Vereinbarung 'Aufzug : TAufzug;' löschen

implementation

{$R *.dfm}

procedure TAufzug.zeichneAufzug(x,y,h : integer; o,u : boolean; canvas : TCanvas);
{ 0 <= h <= 308 }
const
  grau = $00808080;
begin
  with canvas do
  begin
    // alles löschen
    brush.Color := clSkyBlue; pen.Color := clSkyBlue;
    rectangle(0,0,300,449);
    // obere Plattform
    brush.Color := grau; pen.Color := clBlack;
    rectangle(x,y,x+200,y+25);
    // Boden
    rectangle(x-50,y+424,x+250,y+449);
    // Stab links
    brush.Color := clWhite; rectangle(x+20,y+24,x+37,y+425);
    // Stab rechts
    rectangle(x+163,y+24,x+180,y+425);
    // Schalter und Nocke oben
    brush.Color := clRed; ellipse(x+60,y+34,x+72,y+46);
    brush.Color := clBlack; rectangle(x+45,y+24,x+75,y+40);
    if sOben then
    begin
      brush.Color := clYellow; ellipse(x+52,y+28,x+58,y+34);
    end;
    // Schalter und Nocke unten
    brush.Color := clRed; ellipse(x+60,y+402,x+72,y+414);
    brush.Color := clBlack; rectangle(x+45,y+408,x+75,y+424);
    if sUnten then
    begin
      brush.Color := clYellow; ellipse(x+52,y+414,x+58,y+420);
    end;
    // Korb
    brush.Color := grau; rectangle(x+10,y+348-h,x+190,y+348-h+60);
  end;
end;

procedure TAufzug.SetZustand(zustand : TZustand);
begin
  self.zustand := zustand;
end;

function TAufzug.GetZustand : TZustand;
begin
  result := zustand;
end;

procedure TAufzug.update(Sender : TObject);
begin
  case zustand of
    auf   : if h < 308 then Inc(h) else windows.Beep(1000,50);
    ab    : if h > 0 then Dec(h) else windows.Beep(1000,50);
    stopp : ;
  end; // of case
  sOben := h > 303; sUnten := h < 5;
  // if sOben then windows.Beep(2000,20);
  // if sUnten then windows.Beep(400,20);
  zeichneAufzug(50,0,h,sOben,sUnten,buffer.Canvas);
  Canvas.Draw(x,y,buffer);
end;

function TAufzug.GetUnten : boolean;
begin
  result := sUnten;
end;

function TAufzug.GetOben : boolean;
begin
  result := sOben;
end;

procedure TAufzug.FormCreate(Sender: TObject);
begin
  x := 150; y := 40;          // Lage des Bildes
  timer := TTimer.Create(nil);
  timer.Interval := 25;
  timer.OnTimer := update;
  buffer := TBitMap.Create;
  buffer.Width := 300;
  buffer.Height := 449;
end;

procedure TAufzug.FormDestroy(Sender: TObject);
begin
  timer.Free;
  buffer.Free;
end;

end.

lokal