TPaintObject ist jetzt noch ziemlich abstrakt. Ich würde zumindest ein Property vorsehen, um ein Objekt ausblenden zu können, ohne es gleich zu löschen:
Delphi-Quellcode:
{ Basisklasse zum Zeichnen }
TPaintObject = class abstract
private
FVisible: Boolean;
protected
procedure DoPaintOn( ACanvas: TCanvas ); virtual; abstract;
public
constructor Create;
procedure PaintOn( ACanvas: TCanvas );
published
property Visible: Boolean read FVisible write FVisible default True;
end;
constructor TPaintObject.Create;
begin
inherited;
FVisible := True;
end;
procedure TPaintObject.PaintOn( ACanvas: TCanvas );
begin
if Visible then
DoPaintOn( ACanvas );
end;
Eine Zeichnung besteht ja aus mehreren Objekten.
Dafür würde ich ein Klasse vereinbaren, die als Container für andere PaintObjekte dient und diese alle zeichnet.
Delphi-Quellcode:
TPaintObjectList = class(TPaintObject)
private
FObjects: TObjectList;
protected
procedure DoPaintOn( ACanvas: TCanvas ); override;
public
constructor Create;
destructor Destroy; override;
published
property Objects: TObjectList read FObjects;
end;
constructor TPaintObjectList.Create;
begin
inherited;
FObjects := TObjectList.Create;
end;
destructor TPaintObjectList.Destroy;
begin
FObjects.Free;
inherited;
end;
procedure TPaintObjectList.DoPaintOn( ACanvas: TCanvas );
begin
for i := 0 to FObjects.Count - 1 do
TPaintObject(FObjects[i]).PaintOn(ACanvas);
end;
Da TPaintObjectList die Eigenschaft Visible von TPaintObject erbt, kann man so komplexe Teile einer Zeichnung (z.B. eine Ebene, oder ein Haus) ein- und ausblenden.
Aber zurück erst mal zum Rechteck:
Delphi-Quellcode:
TRechteck = class(TPaintObject)
private
FPen: TPen;
FRect: TRect;
protected
procedure DoPaintOn( ACanvas: TCanvas ); override;
procedure SetPen(AValue: TPen);
public
constructor Create;
destructor Destroy; override;
published
property Pen: TPen read FPen write SetPen;
property Rect: TRect read FRect write FRect;
end;
constructor TRechteck.Create;
begin
inherited;
FPen := TPen.Create;
end;
destructor TRechteck.Destroy;
begin
FPen.Free;
inherited;
end;
procedure TRechteck.SetPen(AValue: TPen);
begin
FPen.Assigned(AValue);
end;
procedure TRechteck.DoPaintOn( ACanvas: TCanvas );
begin
ACanvas.Pen := Pen;
ACanvas.Rectangle(Rect);
end;
Damit haben wir das Verhalten einiger Klassen definiert, genug um damit in Form1 eine Zeichnung aus mehreren Rechtecken zu erstellen.
Das Erzeugen und Freigeben der Liste FPaintObjectList muss noch ergänzt werden:
Delphi-Quellcode:
uses
{...}
{Wir benutzen Objekte deren Klasse und Verhalten in Unit2 deklariert wurde:}
Unit2;
type
TForm1 = class(TForm)
Panel1: TPanel;
PaintBox1: TPaintBox;
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private-Deklarationen }
{Liste aller zu zeichnenden Objekte, im OnCreate erzeugen und im OnDestroy freigeben !}
FPaintObjectList: TPaintObjectList;
{das letzte Zeichenobjekt in Bearbeitung}
FPaintObject: TPaintObject;
procedure BewegeRechteck(ARechteck: TRechteck; x1, y1, x2, y2: Integer);
function NeuesRechteck(x1, y1, x2, y2: Integer): TRechteck;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
Paintbox1.Canvas.Brush.Color := clWhite;
Paintbox1.Canvas.FillRect(Paintbox1.ClientRect);
FPaintObjectList.PaintOn(Paintbox1.Canvas);
end;
procedure TForm1.BewegeRechteck(ARechteck: TRechteck; x1, y1, x2, y2: Integer);
begin
ARechteck.Rect := TRect(x1, y1, x2, y2);
PaintBox1.Invalidate;
end;
function TForm1.NeuesRechteck(x1, y1, x2, y2: Integer): TRechteck;
begin
Result := TRechteck.Create;
BewegeRechteck(Result, x1, y1, x2, y2);
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FPaintObject := NeuesRechteck(x, y, x, y);
FPaintObjectList.Objects.Add(FPaintObject);
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
r: TRect;
begin
if FPaintObject is TRechteck then
begin
r := TRechteck(FPaintObject).Rect;
BewegeRechteck(TRechteck(FPaintObject), r.Lect, r.Top, x, y);
end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FPaintObject := nil;
end;
end.
Das Ganze ist natürlich nicht perfekt und auch nicht getestet, sondern soll erst mal dem Verständnis dienen.