//------------------------------------------------------------------------------
// 2016.07.19 Editor by Aone -
// 2016.10.11 修正等比问题 -
// -
// 本控件修改自 Delphi Berlin 10.1 的 TSelection (FMX.Controls.pas) -
// -
// 修改重点: -
// 1. 移动点显示在上方 -
// 2. 增加(左中,上中,右中,下中)控制点,含原来的总共有 8 个控制点 -
// -
// 代码说明: -
// 1. 代码内 {+++> 代表我增加的代码 -
// 2. 代码内 {---> 代表我删除的代码 -
// 3. 未来新版 Delphi 可以自己将 {+++> {---> 移植到新版代码内 -
// 4. 本控件不含 Register; 若需要请自行加入 -
//------------------------------------------------------------------------------
// http://www.cnblogs.com/onechen/ -
//------------------------------------------------------------------------------
unit ONE.Objects;
interface
uses
System.Classes, System.Types, System.UITypes, System.SysUtils,
{+++>}System.Math,
System.UIConsts, System.Math.Vectors, FMX.Types, FMX.Graphics, FMX.Controls;
type
{ TOneSelection }
TOneSelection = class(TControl)
public const
DefaultColor = $FF1072C5;
public type
TGrabHandle = (None, LeftTop, RightTop, LeftBottom, RightBottom{+++>}, CenterLeft, CenterTop, CenterRight, CenterBottom{<+++});
private
FParentBounds: Boolean;
FOnChange: TNotifyEvent;
FHideSelection: Boolean;
FMinSize: Integer;
FOnTrack: TNotifyEvent;
FProportional: Boolean;
FGripSize: Single;
FRatio: Single;
FActiveHandle: TGrabHandle;
FHotHandle: TGrabHandle;
FDownPos: TPointF;
FShowHandles: Boolean;
FColor: TAlphaColor;
procedure SetHideSelection(const Value: Boolean);
procedure SetMinSize(const Value: Integer);
procedure SetGripSize(const Value: Single);
procedure ResetInSpace(const ARotationPoint: TPointF; ASize: TPointF);
function GetProportionalSize(const ASize: TPointF): TPointF;
function GetHandleForPoint(const P: TPointF): TGrabHandle;
procedure GetTransformLeftTop(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
procedure GetTransformLeftBottom(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
procedure GetTransformRightTop(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
procedure GetTransformRightBottom(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
procedure MoveHandle(AX, AY: Single);
procedure SetShowHandles(const Value: Boolean);
procedure SetColor(const Value: TAlphaColor);
protected
function DoGetUpdateRect: TRectF; override;
{---> procedure Paint; override;
{+++>}procedure AfterPaint; override;
///Draw grip handle
procedure DrawHandle(const Canvas: TCanvas; const Handle: TGrabHandle; const Rect: TRectF); virtual;
///Draw frame rectangle
procedure DrawFrame(const Canvas: TCanvas; const Rect: TRectF); virtual;
public
function PointInObjectLocal(X, Y: Single): Boolean; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure DoMouseLeave; override;
///Grip handle where mouse is hovered
property HotHandle: TGrabHandle read FHotHandle;
published
property Align;
property Anchors;
property ClipChildren default False;
property ClipParent default False;
property Cursor default crDefault;
///Selection frame and handle's border color
property Color: TAlphaColor read FColor write SetColor default DefaultColor;
property DragMode default TDragMode.dmManual;
property EnableDragHighlight default True;
property Enabled default True;
property GripSize: Single read FGripSize write SetGripSize;
property Locked default False;
property Height;
property HideSelection: Boolean read FHideSelection write SetHideSelection;
property HitTest default True;
property Padding;
property MinSize: Integer read FMinSize write SetMinSize default 15;
property Opacity;
property Margins;
property ParentBounds: Boolean read FParentBounds write FParentBounds default True;
property Proportional: Boolean read FProportional write FProportional;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
///Indicates visibility of handles
property ShowHandles: Boolean read FShowHandles write SetShowHandles;
property Visible default True;
property Width;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
{Drag and Drop events}
property OnDragEnter;
property OnDragLeave;
property OnDragOver;
property OnDragDrop;
property OnDragEnd;
{Mouse events}
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseEnter;
property OnMouseLeave;
property OnPainting;
property OnPaint;
property OnResize;
property OnTrack: TNotifyEvent read FOnTrack write FOnTrack;
end;
implementation
{ TOneSelection }
constructor TOneSelection.Create(AOwner: TComponent);
begin
inherited;
AutoCapture := True;
ParentBounds := True;
FColor := DefaultColor;
FShowHandles := True;
FMinSize := 15;
FGripSize := 3;
SetAcceptsControls(False);
end;
destructor TOneSelection.Destroy;
begin
inherited;
end;
function TOneSelection.GetProportionalSize(const ASize: TPointF): TPointF;
begin
Result := ASize;
{---> if FRatio * Result.Y > Result.X then
{+++>}
if ((FRatio * Result.Y > Result.X) and
not (FActiveHandle in [TGrabHandle.CenterTop, TGrabHandle.CenterBottom])) or
(FActiveHandle in [TGrabHandle.CenterLeft, TGrabHandle.CenterRight]) then
{<+++}
begin
if Result.X < FMinSize then
Result.X := FMinSize;
Result.Y := Result.X / FRatio;
if Result.Y < FMinSize then
begin
Result.Y := FMinSize;
Result.X := FMinSize * FRatio;
end;
end
else
begin
if Result.Y < FMinSize then
Result.Y := FMinSize;
Result.X := Result.Y * FRatio;
if Result.X < FMinSize then
begin
Result.X := FMinSize;
Result.Y := FMinSize / FRatio;
end;
end;
end;
function TOneSelection.GetHandleForPoint(const P: TPointF): TGrabHandle;
var
{+++>}w, h: Single;
Local, R: TRectF;
begin
Local := LocalRect;
R := TRectF.Create(Local.Left - GripSize, Local.Top - GripSize, Local.Left + GripSize, Local.Top + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.LeftTop);
R := TRectF.Create(Local.Right - GripSize, Local.Top - GripSize, Local.Right + GripSize, Local.Top + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.RightTop);
R := TRectF.Create(Local.Right - GripSize, Local.Bottom - GripSize, Local.Right + GripSize, Local.Bottom + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.RightBottom);
R := TRectF.Create(Local.Left - GripSize, Local.Bottom - GripSize, Local.Left + GripSize, Local.Bottom + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.LeftBottom);
{+++>}
w := (Local.Right - Local.Left) / 2;
h := (Local.Bottom - Local.Top) / 2;
R := TRectF.Create(Local.Left - GripSize, (Local.Top + h) - GripSize, Local.Left + GripSize, (Local.Top + h) + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.CenterLeft);
R := TRectF.Create((Local.Left + w) - GripSize, Local.Top - GripSize, (Local.Left + w) + GripSize, Local.Top + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.CenterTop);
R := TRectF.Create(Local.Right - GripSize, (Local.Top + h) - GripSize, Local.Right + GripSize, (Local.Top + h) + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.CenterRight);
R := TRectF.Create((Local.Left + w) - GripSize, Local.Bottom - GripSize, (Local.Left + w) + GripSize, Local.Bottom + GripSize);
if R.Contains(P) then
Exit(TGrabHandle.CenterBottom);
{<+++}
Result := TGrabHandle.None;
end;
procedure TOneSelection.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
// this line may be necessary because TOneSelection is not a styled control;
// must further investigate for a better fix
if not Enabled then
Exit;
inherited;
FDownPos := TPointF.Create(X, Y);
if Button = TMouseButton.mbLeft then
begin
FRatio := Width / Height;
FActiveHandle := GetHandleForPoint(FDownPos);
end;
end;
procedure TOneSelection.MouseMove(Shift: TShiftState; X, Y: Single);
var
P, OldPos: TPointF;
MoveVector: TVector;
MovePos: TPointF;
GrabHandle: TGrabHandle;
begin
// this line may be necessary because TOneSelection is not a styled control;
// must further investigate for a better fix
if not Enabled then
Exit;
inherited;
MovePos := TPointF.Create(X, Y);
if not Pressed then
begin
// handle painting for hotspot mouse hovering
GrabHandle := GetHandleForPoint(MovePos);
if GrabHandle <> FHotHandle then
Repaint;
FHotHandle := GrabHandle;
end
else if ssLeft in Shift then
begin
if FActiveHandle = TGrabHandle.None then
begin
MoveVector := LocalToAbsoluteVector(TVector.Create(X - FDownPos.X, Y - FDownPos.Y));
if ParentControl <> nil then
MoveVector := ParentControl.AbsoluteToLocalVector(MoveVector);
Position.Point := Position.Point + TPointF(MoveVector);
if ParentBounds then
begin
if Position.X < 0 then
Position.X := 0;
if Position.Y < 0 then
Position.Y := 0;
if ParentControl <> nil then
begin
if Position.X + Width > ParentControl.Width then
Position.X := ParentControl.Width - Width;
if Position.Y + Height > ParentControl.Height then
Position.Y := ParentControl.Height - Height;
end
else
if Canvas <> nil then
begin
if Position.X + Width > Canvas.Width then
Position.X := Canvas.Width - Width;
if Position.Y + Height > Canvas.Height then
Position.Y := Canvas.Height - Height;
end;
end;
if Assigned(FOnTrack) then
FOnTrack(Self);
Exit;
end;
OldPos := Position.Point;
P := LocalToAbsolute(MovePos);
if ParentControl <> nil then
P := ParentControl.AbsoluteToLocal(P);
if ParentBounds then
begin
if P.Y < 0 then
P.Y := 0;
if P.X < 0 then
P.X := 0;
if ParentControl <> nil then
begin
if P.X > ParentControl.Width then
P.X := ParentControl.Width;
if P.Y > ParentControl.Height then
P.Y := ParentControl.Height;
end
else
if Canvas <> nil then
begin
if P.X > Canvas.Width then
P.X := Canvas.Width;
if P.Y > Canvas.Height then
P.Y := Canvas.Height;
end;
end;
MoveHandle(X, Y);
end;
end;
function TOneSelection.PointInObjectLocal(X, Y: Single): Boolean;
begin
Result := inherited or (GetHandleForPoint(TPointF.Create(X, Y)) <> TGrabHandle.None);
end;
procedure TOneSelection.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
// this line may be necessary because TOneSelection is not a styled control;
// must further investigate for a better fix
if not Enabled then
Exit;
inherited;
if Assigned(FOnChange) then
FOnChange(Self);
FActiveHandle := TGrabHandle.None;
end;
procedure TOneSelection.DrawFrame(const Canvas: TCanvas; const Rect: TRectF);
begin
Canvas.DrawDashRect(Rect, 0, 0, AllCorners, AbsoluteOpacity, FColor);
end;
procedure TOneSelection.DrawHandle(const Canvas: TCanvas; const Handle: TGrabHandle; const Rect: TRectF);
var
Fill: TBrush;
Stroke: TStrokeBrush;
begin
Fill := TBrush.Create(TBrushKind.Solid, claWhite);
Stroke := TStrokeBrush.Create(TBrushKind.Solid, FColor);
try
if Enabled then
if FHotHandle = Handle then
Canvas.Fill.Color := claRed
else
Canvas.Fill.Color := claWhite
else
Canvas.Fill.Color := claGrey;
Canvas.FillEllipse(Rect, AbsoluteOpacity, Fill);
Canvas.DrawEllipse(Rect, AbsoluteOpacity, Stroke);
finally
Fill.Free;
Stroke.Free;
end;
end;
{---> procedure TOneSelection.Paint;
{+++>}procedure TOneSelection.AfterPaint;
var
{+++>}w, h: Single;
R: TRectF;
begin
if FHideSelection then
Exit;
R := LocalRect;
R.Inflate(-0.5, -0.5);
DrawFrame(Canvas, R);
if ShowHandles then
begin
R := LocalRect;
DrawHandle(Canvas, TGrabHandle.LeftTop, TRectF.Create(R.Left - GripSize, R.Top - GripSize, R.Left + GripSize,
R.Top + GripSize));
DrawHandle(Canvas, TGrabHandle.RightTop, TRectF.Create(R.Right - GripSize, R.Top - GripSize, R.Right + GripSize,
R.Top + GripSize));
DrawHandle(Canvas, TGrabHandle.LeftBottom, TRectF.Create(R.Left - GripSize, R.Bottom - GripSize, R.Left + GripSize,
R.Bottom + GripSize));
DrawHandle(Canvas, TGrabHandle.RightBottom, TRectF.Create(R.Right - GripSize, R.Bottom - GripSize,
R.Right + GripSize, R.Bottom + GripSize));
{+++>}
w := (R.Right - R.Left) / 2;
h := (R.Bottom - R.Top) / 2;
DrawHandle(Canvas, TGrabHandle.CenterLeft, TRectF.Create( R.Left - GripSize, (R.Top + h) - GripSize, R.Left + GripSize, (R.Top + h) + GripSize));
DrawHandle(Canvas, TGrabHandle.CenterTop, TRectF.Create((R.Left + w) - GripSize, R.Top - GripSize, (R.Left + w) + GripSize, R.Top + GripSize));
DrawHandle(Canvas, TGrabHandle.CenterRight, TRectF.Create( R.Right - GripSize, (R.Top + h) - GripSize, R.Right + GripSize, (R.Top + h) + GripSize));
DrawHandle(Canvas, TGrabHandle.CenterBottom, TRectF.Create((R.Left + w) - GripSize, R.Bottom - GripSize, (R.Left + w) + GripSize, R.Bottom + GripSize));
{<+++}
end;
end;
function TOneSelection.DoGetUpdateRect: TRectF;
begin
Result := inherited;
Result.Inflate((FGripSize + 1) * Scale.X, (FGripSize + 1) * Scale.Y);
end;
procedure TOneSelection.ResetInSpace(const ARotationPoint: TPointF; ASize: TPointF);
var
LLocalPos: TPointF;
LAbsPos: TPointF;
begin
LAbsPos := LocalToAbsolute(ARotationPoint);
if ParentControl <> nil then
begin
LLocalPos := ParentControl.AbsoluteToLocal(LAbsPos);
LLocalPos.X := LLocalPos.X - ASize.X * RotationCenter.X * Scale.X;
LLocalPos.Y := LLocalPos.Y - ASize.Y * RotationCenter.Y * Scale.Y;
if ParentBounds then
begin
if LLocalPos.X < 0 then
begin
ASize.X := ASize.X + LLocalPos.X;
LLocalPos.X := 0;
end;
if LLocalPos.Y < 0 then
begin
ASize.Y := ASize.Y + LLocalPos.Y;
LLocalPos.Y := 0;
end;
if LLocalPos.X + ASize.X > ParentControl.Width then
ASize.X := ParentControl.Width - LLocalPos.X;
if LLocalPos.Y + ASize.Y > ParentControl.Height then
ASize.Y := ParentControl.Height - LLocalPos.Y;
end;
end
else
begin
LLocalPos.X := LAbsPos.X - ASize.X * RotationCenter.X * Scale.X;
LLocalPos.Y := LAbsPos.Y - ASize.Y * RotationCenter.Y * Scale.Y;
end;
{+++>}if not FProportional or (FProportional and SameValue(ASize.X / ASize.Y, FRatio, 0.0001{SingleResolution})) then // 修正如果等比时,超界不会变形 by Aone @ 2016.10.11
SetBounds(LLocalPos.X, LLocalPos.Y, ASize.X, ASize.Y);
end;
procedure TOneSelection.GetTransformLeftTop(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
var
LCorrect: TPointF;
begin
{+++>}
if FActiveHandle = TGrabHandle.CenterTop then AX := 0 else
if FActiveHandle = TGrabHandle.CenterLeft then AY := 0;
{+++>}
NewSize := Size.Size - TSizeF.Create(AX, AY);
if NewSize.Y < FMinSize then
begin
AY := Height - FMinSize;
NewSize.Y := FMinSize;
end;
if NewSize.X < FMinSize then
begin
AX := Width - FMinSize;
NewSize.X := FMinSize;
end;
if FProportional then
begin
LCorrect := NewSize;
NewSize := GetProportionalSize(NewSize);
{+++>}if not (FActiveHandle in [TGrabHandle.CenterTop, TGrabHandle.CenterLeft]) then begin
LCorrect := LCorrect - NewSize;
AX := AX + LCorrect.X;
AY := AY + LCorrect.Y;
{+++>}end;
end;
Pivot := TPointF.Create(Width * RotationCenter.X + AX * (1 - RotationCenter.X),
Height * RotationCenter.Y + AY * (1 - RotationCenter.Y));
end;
procedure TOneSelection.GetTransformLeftBottom(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
var
LCorrect: TPointF;
begin
{+++>}if FActiveHandle = TGrabHandle.CenterBottom then AX := 0;
NewSize := TPointF.Create(Width - AX, AY);
if NewSize.Y < FMinSize then
begin
AY := FMinSize;
NewSize.Y := FMinSize;
end;
if NewSize.X < FMinSize then
begin
AX := Width - FMinSize;
NewSize.X := FMinSize;
end;
if FProportional then
begin
LCorrect := NewSize;
NewSize := GetProportionalSize(NewSize);
{+++>}if FActiveHandle <> TGrabHandle.CenterBottom then begin
LCorrect := LCorrect - NewSize;
AX := AX + LCorrect.X;
{---> AY := AY + LCorrect.Y;
{+++>}AY := AY - LCorrect.Y; // 修正等比缩放时,拉动左下角,右上角会跟着移动 by Aone @ 2016.10.10
{+++>}end;
end;
Pivot := TPointF.Create(Width * RotationCenter.X + AX * (1 - RotationCenter.X),
Height * RotationCenter.Y + (AY - Height) * RotationCenter.Y);
end;
procedure TOneSelection.GetTransformRightTop(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
var
LCorrect: TPointF;
begin
{+++>}if FActiveHandle = TGrabHandle.CenterRight then AY := 0;
NewSize := TPointF.Create(AX, Height - AY);
if NewSize.Y < FMinSize then
begin
AY := Height - FMinSize;
NewSize.Y := FMinSize;
end;
if AX < FMinSize then
begin
AX := FMinSize;
NewSize.X := FMinSize;
end;
if FProportional then
begin
LCorrect := NewSize;
NewSize := GetProportionalSize(NewSize);
{+++>}if FActiveHandle <> TGrabHandle.CenterRight then begin
LCorrect := LCorrect - NewSize;
AX := AX - LCorrect.X;
AY := AY + LCorrect.Y;
{+++>}end;
end;
Pivot := TPointF.Create(Width * RotationCenter.X + (AX - Width) * RotationCenter.X,
Height * RotationCenter.Y + AY * (1 - RotationCenter.Y));
end;
procedure TOneSelection.GetTransformRightBottom(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF);
var
LCorrect: TPointF;
begin
NewSize := TPointF.Create(AX, AY);
if NewSize.Y < FMinSize then
begin
AY := FMinSize;
NewSize.Y := FMinSize;
end;
if NewSize.X < FMinSize then
begin
AX := FMinSize;
NewSize.X := FMinSize;
end;
if FProportional then
begin
LCorrect := NewSize;
NewSize := GetProportionalSize(NewSize);
LCorrect := LCorrect - NewSize;
AX := AX - LCorrect.X;
AY := AY - LCorrect.Y;
end;
Pivot := TPointF.Create(Width * RotationCenter.X + (AX - Width) * RotationCenter.X,
Height * RotationCenter.Y + (AY - Height) * RotationCenter.Y);
end;
procedure TOneSelection.MoveHandle(AX, AY: Single);
var
NewSize, Pivot: TPointF;
begin
case FActiveHandle of
TOneSelection.TGrabHandle.LeftTop: GetTransformLeftTop(AX, AY, NewSize, Pivot);
TOneSelection.TGrabHandle.LeftBottom: GetTransformLeftBottom(AX, AY, NewSize, Pivot);
TOneSelection.TGrabHandle.RightTop: GetTransformRightTop(AX, AY, NewSize, Pivot);
TOneSelection.TGrabHandle.RightBottom: GetTransformRightBottom(AX, AY, NewSize, Pivot);
{+++>}
TOneSelection.TGrabHandle.CenterLeft: GetTransformLeftTop(AX, AY, NewSize, Pivot);
TOneSelection.TGrabHandle.CenterTop: GetTransformLeftTop(AX, AY, NewSize, Pivot);
TOneSelection.TGrabHandle.CenterRight: GetTransformRightTop(AX, AY, NewSize, Pivot);
TOneSelection.TGrabHandle.CenterBottom: GetTransformLeftBottom(AX, AY, NewSize, Pivot);
{<+++}
end;
ResetInSpace(Pivot, NewSize);
if Assigned(FOnTrack) then
FOnTrack(Self);
end;
procedure TOneSelection.DoMouseLeave;
begin
inherited;
FHotHandle := TGrabHandle.None;
Repaint;
end;
procedure TOneSelection.SetHideSelection(const Value: Boolean);
begin
if FHideSelection <> Value then
begin
FHideSelection := Value;
Repaint;
end;
end;
procedure TOneSelection.SetMinSize(const Value: Integer);
begin
if FMinSize <> Value then
begin
FMinSize := Value;
if FMinSize < 1 then
FMinSize := 1;
end;
end;
procedure TOneSelection.SetShowHandles(const Value: Boolean);
begin
if FShowHandles <> Value then
begin
FShowHandles := Value;
Repaint;
end;
end;
procedure TOneSelection.SetColor(const Value: TAlphaColor);
begin
if FColor <> Value then
begin
FColor := Value;
Repaint;
end;
end;
procedure TOneSelection.SetGripSize(const Value: Single);
begin
if FGripSize <> Value then
begin
if Value < FGripSize then
Repaint;
FGripSize := Value;
if FGripSize > 20 then
FGripSize := 20;
if FGripSize < 1 then
FGripSize := 1;
HandleSizeChanged;
Repaint;
end;
end;
end.