Einzelnen Beitrag anzeigen

Blup

Registriert seit: 7. Aug 2008
Ort: Brandenburg
1.429 Beiträge
 
Delphi 10.4 Sydney
 
#19

AW: Prozedur von Unit2 auf Unit1 ausführen?

  Alt 31. Aug 2015, 12:55
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.
  Mit Zitat antworten Zitat