Unit uAmpel.pas
unit uAmpel;
interface
uses
Graphics; // für canvas usw.
type
TAmpel = class(TObject)
private
{ Private-Deklarationen }
public
class procedure zeichne_Ampel(canvas : TCanvas;
x,y,r,o : integer;rot,gelb,gruen : boolean);
class procedure zeichne_kleineAmpel(canvas : TCanvas;
x,y,r,o : integer;rot,gruen : boolean);
end;
implementation
const // Ampelfarben
grau = $00404040; // XBGR
rot_an = $000000FF;
rot_aus = $00000055;
gelb_an = $0000FFFF;
gelb_aus = $00005555;
gruen_an = $0000FF00;
gruen_aus = $00005500;
class procedure TAmpel.zeichne_Ampel(canvas : TCanvas;
x,y,r,o : integer;rot,gelb,gruen : boolean);
begin
with canvas do
case o of
0 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x,y,x+3*r,y+8*r);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x+round(0.5*r),y+round(0.5*r), x+round(2.5*r),y+round(2.5*r));
// Gelb-Licht
if gelb then Brush.Color := gelb_an else Brush.Color := gelb_aus;
Ellipse(x+round(0.5*r),y+3*r, x+round(2.5*r),y+5*r);
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x+round(0.5*r),y+round(5.5*r), x+round(2.5*r),y+round(7.5*r));
// Stange
Brush.Color := grau;
Rectangle(x+round(1.25*r),y+8*r,x+round(1.75*r),y+16*r);
end;
1 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x,y,x+8*r,y-3*r);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x+round(0.5*r),y-round(0.5*r), x+round(2.5*r),y-round(2.5*r));
// Gelb-Licht
if gelb then Brush.Color := gelb_an else Brush.Color := gelb_aus;
Ellipse(x+3*r,y-round(0.5*r), x+5*r,y-round(2.5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x+round(5.5*r),y-round(0.5*r), x+round(7.5*r),y-round(2.5*r));
// Stange
Brush.Color := grau;
Rectangle(x+8*r,y-round(1.25*r),x+16*r,y-round(1.75*r));
end;
2 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x-3*r,y,x,y-8*r);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x-round(2.5*r),y-round(0.5*r), x-round(0.5*r),y-round(2.5*r));
// Gelb-Licht
if gelb then Brush.Color := gelb_an else Brush.Color := gelb_aus;
Ellipse(x-round(2.5*r),y-round(3*r), x-round(0.5*r),y-round(5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x-round(2.5*r),y-round(5.5*r), x-round(0.5*r),y-round(7.5*r));
// Stange
Brush.Color := grau;
Rectangle(x-round(1.75*r),y-8*r,x-round(1.25*r),y-16*r);
end;
3 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x-8*r,y+3*r,x,y);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x-round(2.5*r),y+round(2.5*r), x-round(0.5*r),y+round(0.5*r));
// Gelb-Licht
if gelb then Brush.Color := gelb_an else Brush.Color := gelb_aus;
Ellipse(x-5*r,y+round(2.5*r), x-3*r,y+round(0.5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x-round(7.5*r),y+round(2.5*r), x-round(5.5*r),y+round(0.5*r));
// Stange
Brush.Color := grau;
Rectangle(x-16*r,y+round(1.75*r),x-8*r,y+round(1.25*r));
end;
end; // of case
end;
class procedure TAmpel.zeichne_kleineAmpel(canvas : TCanvas;
x,y,r,o : integer;rot,gruen : boolean);
begin
with canvas do
case o of
0 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x,y,x+3*r,y+round(6.5)*r);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x+round(0.5*r),y+round(0.5*r), x+round(2.5*r),y+round(2.5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x+round(0.5*r),y+3*r, x+round(2.5*r),y+5*r);
// Stange
Brush.Color := grau;
Rectangle(x+round(1.25*r),y+round(6.5)*r,x+round(1.75*r),y+16*r);
end;
1 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x,y,x+round(6.5)*r,y-3*r);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x+round(0.5*r),y-round(0.5*r), x+round(2.5*r),y-round(2.5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x+3*r,y-round(0.5*r), x+5*r,y-round(2.5*r));
// Stange
Brush.Color := grau;
Rectangle(x+round(6.5)*r,y-round(1.25*r),x+16*r,y-round(1.75*r));
end;
2 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x-3*r,y,x,y-round(6.5)*r);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x-round(2.5*r),y-round(0.5*r), x-round(0.5*r),y-round(2.5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x-round(2.5*r),y-round(3*r), x-round(0.5*r),y-round(5*r));
// Stange
Brush.Color := grau;
Rectangle(x-round(1.75*r),y-round(6.5)*r,x-round(1.25*r),y-16*r);
end;
3 : begin
// Ampelkasten
Brush.Color := grau; Rectangle(x-round(6.5)*r,y+3*r,x,y);
// Rot-Licht
if rot then Brush.Color := rot_an else Brush.Color := rot_aus;
Ellipse(x-round(2.5*r),y+round(2.5*r), x-round(0.5*r),y+round(0.5*r));
// Grün-Licht
if gruen then Brush.Color := gruen_an else Brush.Color := gruen_aus;
Ellipse(x-5*r,y+round(2.5*r), x-3*r,y+round(0.5*r));
// Stange
Brush.Color := grau;
Rectangle(x-16*r,y+round(1.75*r),x-round(6.5)*r,y+round(1.25*r));
end;
end; // of case
end;
end.
Unit1 :
uses uAmpel
//
procedure TForm1.Button1Click(Sender: TObject);
var
x,y,r,o : integer;
rot,gelb,gruen : boolean;
begin
x := StrToInt(Edit1.Text); y := StrToInt(Edit2.Text);
r := StrToInt(Edit3.Text); o := StrToInt(Edit4.Text);
rot := CheckBox1.Checked; gelb := CheckBox2.Checked; gruen := CheckBox3.Checked;
TAmpel.zeichne_Ampel(canvas,x, y, r, o ,rot, gelb, gruen);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
x,y,r,o : integer;
rot,gelb,gruen : boolean;
begin
x := StrToInt(Edit1.Text); y := StrToInt(Edit2.Text);
r := StrToInt(Edit3.Text); o := StrToInt(Edit4.Text);
rot := CheckBox1.Checked; gelb := CheckBox2.Checked; gruen := CheckBox3.Checked;
TAmpel.zeichne_kleineAmpel(canvas,x, y ,r, o, rot,gruen);
end;
Keine Kommentare:
Kommentar veröffentlichen