Beim Click eines Buttons OnMouseDown ausführen

[Sir Rufo]

Hierfür wäre das Strategy-Pattern perfekt - Sinn und Zweck soll ja auch der Lerneffekt sein.

Damit man einen ungefähren Anhaltspunkt hat, wie man so etwas umsetzt, hier ein kleines Beispiel:

Die Form ist relativ übersichtlich:

Delphi-Quellcode:

unit Forms_MainForm;

interface

uses
  PaintStrategy,

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Panel1: TPanel;
    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 );
    procedure PaintBox1Paint( Sender: TObject );
    procedure Button1Click( Sender: TObject );
    procedure Button2Click( Sender: TObject );
    procedure Button3Click( Sender: TObject );
    procedure Button4Click( Sender: TObject );
  private
    FNullPaintStrategy   : TPaintStrategy;
    FCurrentPaintStrategy: TPaintStrategy;
    procedure SetCurrentPaintStrategy( const Value: TPaintStrategy );
    function GetCurrentPaintStrategy: TPaintStrategy;
  protected
    property CurrentPaintStrategy: TPaintStrategy read GetCurrentPaintStrategy write SetCurrentPaintStrategy;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ TForm1 }

procedure TForm1.AfterConstruction;
begin
  inherited;
  FNullPaintStrategy := TNullPaintStrategy.Create;
end;

procedure TForm1.BeforeDestruction;
begin
  FNullPaintStrategy.Free;
  CurrentPaintStrategy := nil;
  inherited;
end;

procedure TForm1.Button1Click( Sender: TObject );
begin
  CurrentPaintStrategy := nil;
end;

procedure TForm1.Button2Click( Sender: TObject );
begin
  CurrentPaintStrategy := TLinePaintStrategy.Create;
end;

procedure TForm1.Button3Click( Sender: TObject );
begin
  CurrentPaintStrategy := TRectanglePaintStrategy.Create;
end;

procedure TForm1.Button4Click( Sender: TObject );
begin
  CurrentPaintStrategy := TEllipsePaintStrategy.Create;
end;

function TForm1.GetCurrentPaintStrategy: TPaintStrategy;
begin
  if not Assigned( FCurrentPaintStrategy )
  then
    Result := FNullPaintStrategy
  else
    Result := FCurrentPaintStrategy;
end;

procedure TForm1.PaintBox1MouseDown( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer );
begin
  CurrentPaintStrategy.MouseDown( Button, Shift, X, Y );
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1MouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
begin
  CurrentPaintStrategy.MouseMove( Shift, X, Y );
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1MouseUp( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer );
begin
  CurrentPaintStrategy.MouseUp( Button, Shift, X, Y );
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint( Sender: TObject );
begin
  CurrentPaintStrategy.PaintOn( TPaintBox( Sender ).Canvas );
end;

procedure TForm1.SetCurrentPaintStrategy( const Value: TPaintStrategy );
begin
  if Value <> FCurrentPaintStrategy
  then
    begin
      FreeAndNil( FCurrentPaintStrategy );
      FCurrentPaintStrategy := Value;
    end;
end;

end.

und hier das Strategy-Pattern:

Delphi-Quellcode:

unit PaintStrategy;

interface

uses
  System.Classes,
  System.UITypes,
  System.Types,
  Vcl.Graphics;

type
  TPaintStrategy = class abstract
  public
    procedure MouseDown(
      Button: TMouseButton;
      Shift : TShiftState;
      X, Y  : Integer ); virtual;
    procedure MouseMove(
      Shift: TShiftState;
      X, Y : Integer ); virtual;
    procedure MouseUp(
      Button: TMouseButton;
      Shift : TShiftState;
      X, Y  : Integer ); virtual;
    procedure PaintOn( const ACanvas: TCanvas ); virtual; abstract;
  end;

  TNullPaintStrategy = class( TPaintStrategy )
  public
    procedure PaintOn( const ACanvas: TCanvas ); override;
  end;

  TTwoPointPaintStratgy = class( TPaintStrategy )
  protected
    FIsActive: Boolean;
    FStart   : TPoint;
    FCurrent : TPoint;
  public
    procedure MouseDown(
      Button: TMouseButton;
      Shift : TShiftState;
      X     : Integer;
      Y     : Integer ); override;
    procedure MouseMove(
      Shift: TShiftState;
      X    : Integer;
      Y    : Integer ); override;
    procedure MouseUp(
      Button: TMouseButton;
      Shift : TShiftState;
      X     : Integer;
      Y     : Integer ); override;
  end;

  TLinePaintStrategy = class( TTwoPointPaintStratgy )
  public
    procedure PaintOn( const ACanvas: TCanvas ); override;
  end;

  TRectanglePaintStrategy = class( TTwoPointPaintStratgy )
  public
    procedure PaintOn( const ACanvas: TCanvas ); override;
  end;

  TEllipsePaintStrategy = class( TTwoPointPaintStratgy )
  public
    procedure PaintOn( const ACanvas: TCanvas ); override;
  end;

implementation

{ TPaintStrategy }

procedure TPaintStrategy.MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
end;

procedure TPaintStrategy.MouseMove( Shift: TShiftState; X, Y: Integer );
begin
end;

procedure TPaintStrategy.MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
end;

{ TTwoPointPaintStratgy }

procedure TTwoPointPaintStratgy.MouseDown(
  Button: TMouseButton;
  Shift : TShiftState;
  X, Y  : Integer );
begin
  inherited;
  FIsActive := True;
  FStart.X  := X;
  FStart.Y  := Y;
  FCurrent  := FStart;
end;

procedure TTwoPointPaintStratgy.MouseMove(
  Shift: TShiftState;
  X, Y : Integer );
begin
  inherited;
  if FIsActive
  then
    begin
      FCurrent.X := X;
      FCurrent.Y := Y;
    end;
end;

procedure TTwoPointPaintStratgy.MouseUp(
  Button: TMouseButton;
  Shift : TShiftState;
  X, Y  : Integer );
begin
  inherited;
  if FIsActive
  then
    begin
      FIsActive := False;
    end;
end;

{ TNullPaintStrategy }

procedure TNullPaintStrategy.PaintOn( const ACanvas: TCanvas );
begin
end;

{ TRectanglePaintStrategy }

procedure TRectanglePaintStrategy.PaintOn( const ACanvas: TCanvas );
begin
  inherited;
  if FIsActive
  then
    begin
      ACanvas.Rectangle( FStart.X, FStart.Y, FCurrent.X, FCurrent.Y );
    end;
end;

{ TEllipsePaintStrategy }

procedure TEllipsePaintStrategy.PaintOn( const ACanvas: TCanvas );
begin
  inherited;
  if FIsActive
  then
    begin
      ACanvas.Ellipse( FStart.X, FStart.Y, FCurrent.X, FCurrent.Y );
    end;
end;

{ TLinePaintStrategy }

procedure TLinePaintStrategy.PaintOn( const ACanvas: TCanvas );
begin
  inherited;
  if FIsActive
  then
    begin
      ACanvas.MoveTo( FStart.X, FStart.Y );
      ACanvas.LineTo( FCurrent.X, FCurrent.Y );
    end;
end;

end.

Die Strategien sind natürlich noch nicht komplett. Denn am Ende benötigt man eine Liste von Paint-Objekten, die man aber nun leicht von der jeweiligen Strategie erzeugen lassen kann.

Kompletter Source und EXE jetzt im Anhang

[Neutral General]

Zitat von Sir Rufo:

Hierfür wäre das Stretegy-Pattern perfekt - Sinn und Zweck soll ja auch der Lerneffekt sein.

Nichts gegen deinen Vorschlag oder Code, aber ich glaube GroZ mangelt es momentan noch sehr an den Grundlagen und daher glaube ich nicht dass er mit deinem Vorschlag/Code in naher Zukunft etwas sinnvolles anfangen kann

[Sir Rufo]

Zitat von Neutral General:

Zitat von Sir Rufo:

Hierfür wäre das Stretegy-Pattern perfekt - Sinn und Zweck soll ja auch der Lerneffekt sein.

Nichts gegen deinen Vorschlag oder Code, aber ich glaube GroZ mangelt es momentan noch sehr an den Grundlagen und daher glaube ich nicht dass er mit deinem Vorschlag/Code in naher Zukunft etwas sinnvolles anfangen kann

Wieso nicht? In einer anderen Frage hat er quasi etwas ähnliches auch schon gezeigt. Das hier ist einfach nur konsequent weitergedacht und simpelstes OOP.

Zudem hat er jetzt mehrere Lösungsansätze und kann sich einen aussuchen.

[GroZ]

Danke an alle ich werd mir das alles mal genauer anschauen