SelectionBox-Komponente?

[Bummi]

Als Schnellansatz, wenn Du es brauchbar findest kannst Du es ja in eine Komponente wickeln

Delphi-Quellcode:

unit Test;
//20120830 by Thomas Wassermann
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TSelection = Class(TGraphicControl)
  private
    FSelRect: Trect;
    FHitRegion: Integer;
    FHitPoint: TPoint;
  protected
    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Paint; override;
  public
    Constructor Create(AOwner: TComponent); override;
  End;

  TForm5 = class(TForm)
    procedure FormCreate(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form5: TForm5;

implementation

uses Math;
{$R *.dfm}
{ TSelection }

Const
  C_SIZE = 20;

procedure TSelection.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    Case FHitRegion of
      - 1:
        begin
          if (X > FSelRect.Left) and (Y > FSelRect.Top) then
          begin
            FSelRect.Right := X;
            FSelRect.Bottom := Y;

          end;
        end;
      0:
        begin
          FSelRect.Left := FSelRect.Left + X - FHitPoint.X;
          FSelRect.Right := FSelRect.Right + X - FHitPoint.X;
          FSelRect.Top := FSelRect.Top + Y - FHitPoint.Y;
          FSelRect.Bottom := FSelRect.Bottom + Y - FHitPoint.Y;
          FHitPoint := Point(X, Y);
        end;
      1:
        begin
          if (X > FSelRect.Left) and (Y > FSelRect.Top) then
            begin
            FSelRect.Right := FSelRect.Right + X - FHitPoint.X;
            FSelRect.Bottom := FSelRect.Bottom + Y - FHitPoint.Y;
            FHitPoint := Point(X, Y);
            end;
        end

    End;
  end
  else
  begin
    FHitRegion := -1;
    if ((X - FSelRect.Left) > 0) and ((X - FSelRect.Left) < C_SIZE) and ((Y - FSelRect.Top) > 0) and ((Y - FSelRect.Top) < C_SIZE) then
    begin
      FHitRegion := 0;

    end
    else if ((FSelRect.Right - X) > 0) and ((FSelRect.Right - X) < C_SIZE) and ((FSelRect.Bottom - Y) > 0) and ((FSelRect.Bottom - Y) < C_SIZE) then
    begin
      FHitRegion := 1;

    end
  end;
  invalidate;
end;

procedure TSelection.Paint;
var
  i: Integer;
  P: Array [0 .. 2] of TPoint;
  Size: Integer;
begin
  inherited;
  Size := Min(FSelRect.Right - FSelRect.Left, FSelRect.Bottom - FSelRect.Top);
  if Size > C_SIZE then
    Size := C_SIZE;
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(FSelRect);
  if FHitRegion = 0 then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlack;
    P[0].X := FSelRect.Left;
    P[0].Y := FSelRect.Top;
    P[1].X := FSelRect.Left + Size;
    P[1].Y := FSelRect.Top;
    P[2].X := FSelRect.Left;
    P[2].Y := FSelRect.Top + Size;
    Canvas.Polygon(P);
  end;
  if FHitRegion = 1 then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlue;
    P[0].X := FSelRect.Right - 1;
    P[0].Y := FSelRect.Bottom - 1;
    P[1].X := P[0].X - Size;
    P[1].Y := P[0].Y;
    P[2].X := P[0].X;
    P[2].Y := P[0].Y - Size;
    Canvas.Polygon(P);
  end;

end;

Procedure TSelection.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not PtInRect(FSelRect, Point(X, Y)) then
  begin
    FSelRect.Left := X;
    FSelRect.Top := Y;
    FSelRect.Right := FSelRect.Left;
    FSelRect.Bottom := FSelRect.Top;
    FHitRegion := -1;
    invalidate;
  end
  else
  begin
    if FHitRegion > -1 then
    begin
      FHitPoint := Point(X, Y);
    end;
  end;
end;

constructor TSelection.Create(AOwner: TComponent);
begin
  inherited;
  OnMouseDown := MouseDown;
  OnMouseMove := MouseMove;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  With TSelection.Create(self) do
  begin
    parent := self;
    Align := alClient;
  end;
end;

end.