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.