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