📄 graphicsclassunit.pas
字号:
unit GraphicsClassUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Math, Forms, Dialogs;
Type
//用来改变图形大小的控制器
TResizeControl = (rcLeftTop, rcTopCenter, rcRightTop, rcLeftCenter,
rcRightCenter, rcLeftBottom, rcBottomCenter, rcRightBottom);
{ 图形抽象类,是所有图形的基类 }
TGraphics = class
private
FSelected: Boolean;
FMoving: Boolean;
FResizing: Boolean;
procedure SetSelected(Value: Boolean);
protected
property Moving: Boolean read FMoving write FMoving;
property Resizing: Boolean read FResizing write FResizing;
public
function PointInside(APoint: TPoint): Boolean; virtual; abstract;
function PointInResizeControl(APoint: TPoint): Boolean; virtual; abstract;
function GetResizeCursor(APoint: TPoint): TCursor; virtual; abstract;
procedure Paint(ACanvas: TCanvas); virtual; abstract;
procedure Select; virtual;
procedure UnSelect; virtual;
procedure Move(ACanvas: TCanvas; offsetX, offsetY: Integer); virtual; abstract;
procedure ReSize(ACanvas: TCanvas; CurPoint: TPoint); virtual; abstract;
property Selected: Boolean read FSelected write SetSelected;
end;
{ 拥有8个改变图形大小控制器的图形类 }
TMultiResizeControlGraphics = class(TGraphics)
private
FResizeControl: TResizeControl;
FDrawRect: TRect;
FResizeCtrlRect1, FResizeCtrlRect2, FResizeCtrlRect3, FResizeCtrlRect4: TRect;
FResizeCtrlRect5, FResizeCtrlRect6, FResizeCtrlRect7, FResizeCtrlRect8: TRect;
procedure SetDrawRect(Value: TRect);
protected
function GetResizeControl(CurPoint: TPoint): TResizeControl;
function ReverseResizeControl(ResizeControl: TResizeControl): TResizeControl;
procedure DrawResizeCtrlRects(ACanvas: TCanvas);
public
function PointInResizeControl(APoint: TPoint): Boolean; override;
function GetResizeCursor(APoint: TPoint): TCursor; override;
procedure Paint(ACanvas: TCanvas); override;
property ResizeControl: TResizeControl read FResizeControl write FResizeControl;
property DrawRect: TRect read FDrawRect write SetDrawRect;
end;
{ 线段类 }
TLine = class(TGraphics)
private
FBeginPoint, FEndPoint: TPoint; //开始和结束位置
FControlRect1, FControlRect2: TRect; //两个可用来改变大小的控制块矩形
FChangingBeginPoint, FChangingEndPoint: Boolean; //改变坐标标志
procedure SetBeginPoint(Value: TPoint);
procedure SetEndPoint(Value: TPoint);
public
constructor Create(ABeginPoint, AEndPoint: TPoint);
function PointInside(APoint: TPoint): Boolean; override;
function PointInResizeControl(APoint: TPoint): Boolean; override;
function GetResizeCursor(APoint: TPoint): TCursor; override;
procedure Paint(ACanvas: TCanvas); override;
procedure Select; override;
procedure UnSelect; override;
procedure Move(ACanvas: TCanvas; offsetX, offsetY: Integer); override;
procedure ReSize(ACanvas: TCanvas; CurPoint: TPoint); override;
procedure SetBeginEndPoint(ABeginPoint, AEndPoint: TPoint);
property BeginPoint: TPoint read FBeginPoint write SetBeginPoint;
property EndPoint: TPoint read FEndPoint write SetEndPoint;
end;
{ 矩形类 }
TRectangle = class(TMultiResizeControlGraphics)
private
FRectSelf: TRect;
FLeftTopPoint, FRightBottomPoint: TPoint; //左上角和右下角坐标
FLeft, FTop, FWidth, FHeight: Integer;
procedure BuildRect;
procedure SetLeftTopPoint(Value: TPoint);
procedure SetRightBottomPoint(Value: TPoint);
procedure SetLeft(Value: Integer);
procedure SetTop(Value: Integer);
procedure SetWidth(Value: Integer);
procedure SetHeight(Value: Integer);
protected
procedure SetPosition(AResizeControl: TResizeControl; CurPoint: TPoint); overload;
public
constructor Create(ALeftTopPoint, ARightBottomPoint: TPoint);
function PointInside(APoint: TPoint): Boolean; override;
procedure Paint(ACanvas: TCanvas); override;
procedure Select; override;
procedure UnSelect; override;
procedure Move(ACanvas: TCanvas; offsetX, offsetY: Integer); override;
procedure ReSize(ACanvas: TCanvas; CurPoint: TPoint); override;
procedure SetPosition(ALeftTopPoint, ARightBottomPoint: TPoint); overload;
property LeftTopPoint: TPoint read FLeftTopPoint write SetLeftTopPoint;
property RightBottomPoint: TPoint read FRightBottomPoint write SetRightBottomPoint;
property Left: Integer read FLeft write SetLeft;
property Top: Integer read FTop write SetTop;
property Width: Integer read FWidth write SetWidth;
property Height: Integer read FHeight write SetHeight;
end;
{ 圆角矩形类 }
TRoundRect = class(TRectangle)
public
function PointInside(APoint: TPoint): Boolean; override;
procedure Paint(ACanvas: TCanvas); override;
procedure Move(ACanvas: TCanvas; offsetX, offsetY: Integer); override;
procedure ReSize(ACanvas: TCanvas; CurPoint: TPoint); override;
end;
{ 椭圆类 }
TEllipse = class(TRectangle)
public
function PointInside(APoint: TPoint): Boolean; override;
procedure Paint(ACanvas: TCanvas); override;
procedure Move(ACanvas: TCanvas; offsetX, offsetY: Integer); override;
procedure ReSize(ACanvas: TCanvas; CurPoint: TPoint); override;
end;
implementation
{ TGraphics }
////////////////////////////// Public //////////////////////////////
procedure TGraphics.Select;
begin
FSelected := True;
end;
procedure TGraphics.UnSelect;
begin
FSelected := False;
end;
////////////////////////////// Private //////////////////////////////
procedure TGraphics.SetSelected(Value: Boolean);
begin
if Value <> FSelected then Select;
end;
{ TMultiResizeControlGraphics }
////////////////////////////// Public //////////////////////////////
{ 判断坐标是否在ResizeControl中 }
function TMultiResizeControlGraphics.PointInResizeControl(APoint: TPoint): Boolean;
begin
Result := PtInRect(FResizeCtrlRect1, APoint) or PtInRect(FResizeCtrlRect2, APoint) or
PtInRect(FResizeCtrlRect3, APoint) or PtInRect(FResizeCtrlRect4, APoint) or
PtInRect(FResizeCtrlRect5, APoint) or PtInRect(FResizeCtrlRect6, APoint) or
PtInRect(FResizeCtrlRect7, APoint) or PtInRect(FResizeCtrlRect8, APoint);
end;
{ 根据坐标在哪个ResizeControl中得到相应的光标 }
function TMultiResizeControlGraphics.GetResizeCursor(APoint: TPoint): TCursor;
begin
Result := Screen.Cursor;
if PtInRect(FResizeCtrlRect1, APoint) or PtInRect(FResizeCtrlRect8, APoint) then
Result := crSizeNWSE
else if PtInRect(FResizeCtrlRect2, APoint) or PtInRect(FResizeCtrlRect7, APoint) then
Result := crSizeNS
else if PtInRect(FResizeCtrlRect3, APoint) or PtInRect(FResizeCtrlRect6, APoint) then
Result := crSizeNESW
else if PtInRect(FResizeCtrlRect4, APoint) or PtInRect(FResizeCtrlRect5, APoint) then
Result := crSizeWE;
end;
procedure TMultiResizeControlGraphics.Paint(ACanvas: TCanvas);
begin
if Selected then
begin
ACanvas.Pen.Mode := pmNotXor;
DrawResizeCtrlRects(ACanvas);
end;
Moving := False;
Resizing := False;
end;
////////////////////////////// Protected //////////////////////////////
{ 根据当前的ResizeControl获得相反的ResizeControl }
function TMultiResizeControlGraphics.ReverseResizeControl(ResizeControl: TResizeControl): TResizeControl;
begin
case ResizeControl of
rcLeftTop: Result := rcRightBottom;
rcTopCenter: Result := rcBottomCenter;
rcRightTop: Result := rcLeftBottom;
rcLeftCenter: Result := rcRightCenter;
rcRightCenter: Result := rcLeftCenter;
rcLeftBottom: Result := rcRightTop;
rcBottomCenter: Result := rcTopCenter;
rcRightBottom: Result := rcLeftTop;
end;
end;
procedure TMultiResizeControlGraphics.DrawResizeCtrlRects(ACanvas: TCanvas);
var
oldColor: TColor;
begin
oldColor := ACanvas.Brush.Color;
ACanvas.Brush.Color := clBlack;
ACanvas.Rectangle(FResizeCtrlRect1);
ACanvas.Rectangle(FResizeCtrlRect2);
ACanvas.Rectangle(FResizeCtrlRect3);
ACanvas.Rectangle(FResizeCtrlRect4);
ACanvas.Rectangle(FResizeCtrlRect5);
ACanvas.Rectangle(FResizeCtrlRect6);
ACanvas.Rectangle(FResizeCtrlRect7);
ACanvas.Rectangle(FResizeCtrlRect8);
ACanvas.Brush.Color := oldColor;
end;
{ 根据当前坐标得相应的ResizeControl }
function TMultiResizeControlGraphics.GetResizeControl(CurPoint: TPoint): TResizeControl;
begin
if PtInRect(FResizeCtrlRect1, CurPoint) then
Result := rcLeftTop
else if PtInRect(FResizeCtrlRect2, CurPoint) then
Result := rcTopCenter
else if PtInRect(FResizeCtrlRect3, CurPoint) then
Result := rcRightTop
else if PtInRect(FResizeCtrlRect4, CurPoint) then
Result := rcLeftCenter
else if PtInRect(FResizeCtrlRect5, CurPoint) then
Result := rcRightCenter
else if PtInRect(FResizeCtrlRect6, CurPoint) then
Result := rcLeftBottom
else if PtInRect(FResizeCtrlRect7, CurPoint) then
Result := rcBottomCenter
else if PtInRect(FResizeCtrlRect8, CurPoint) then
Result := rcRightBottom;
end;
////////////////////////////// Private //////////////////////////////
procedure TMultiResizeControlGraphics.SetDrawRect(Value: TRect);
var
iLeft, iTop, iWidth, iHeight: Integer;
begin
FDrawRect := Value;
iLeft := FDrawRect.Left;
iTop := FDrawRect.Top;
iWidth := FDrawRect.Right - iLeft;
iHeight := FDrawRect.Bottom - iTop;
FResizeCtrlRect1 := Rect(iLeft - 3, iTop - 3, iLeft + 3, iTop + 3);
FResizeCtrlRect2 := Rect(iLeft + iWidth div 2 - 3, iTop - 3,
iLeft + iWidth div 2 + 3, iTop + 3);
FResizeCtrlRect3 := Rect(iLeft + iWidth - 3, iTop - 3,
iLeft + iWidth + 3, iTop + 3);
FResizeCtrlRect4 := Rect(iLeft - 3, iTop + iHeight div 2 - 3,
iLeft + 3, iTop + iHeight div 2 + 3);
FResizeCtrlRect5 := Rect(iLeft + iWidth - 3, iTop + iHeight div 2 - 3,
iLeft + iWidth + 3, iTop + iHeight div 2 + 3);
FResizeCtrlRect6 := Rect(iLeft - 3, iTop + iHeight - 3,
iLeft + 3, iTop + iHeight + 3);
FResizeCtrlRect7 := Rect(iLeft + iWidth div 2 - 3, iTop + iHeight - 3,
iLeft + iWidth div 2 + 3, iTop + iHeight + 3);
FResizeCtrlRect8 := Rect(iLeft + iWidth - 3, iTop + iHeight - 3,
iLeft + iWidth + 3, iTop + iHeight + 3);
end;
{ TLine }
////////////////////////////// Public //////////////////////////////
constructor TLine.Create(ABeginPoint, AEndPoint: TPoint);
begin
SetBeginEndPoint(ABeginPoint, AEndPoint);
end;
{ 判断点是否在直线里面 }
function TLine.PointInside(APoint: TPoint): Boolean;
var
iMaxX, iMinX: Integer;
iMaxY, iMinY: Integer;
k, b: Real;
begin
iMaxX := Max(FBeginPoint.X, FEndPoint.X);
iMinX := Min(FBeginPoint.X, FEndPoint.X);
iMaxY := Max(FBeginPoint.Y, FEndPoint.Y);
iMinY := Min(FBeginPoint.Y, FEndPoint.Y);
{ 如果是垂直线 }
if iMaxX - iMinX <= 5 then
begin
Result := (Abs(APoint.X - iMaxX) <= 5) and (APoint.Y >= iMinY) and (APoint.Y <= iMaxY);
end
{ 如果是水平线 }
else if iMaxY - iMinY <=5 then
begin
Result := (Abs(APoint.Y - iMaxY) <=5 ) and (APoint.X >= iMinX) and (APoint.X <= iMaxX);
end
{ 根据公式判断 }
else begin
{ 判断公式为:y = k * x + b 斜率:k = (y2 - y1) / (x2 - x1) y轴截距:b = y1 - k * x1 }
k := (FEndPoint.Y - FBeginPoint.Y) / (FEndPoint.X - FBeginPoint.X);
b := FBeginPoint.Y - k * FBeginPoint.X;
Result := (APoint.Y <= round(k * APoint.X + b) + 5) and
(APoint.Y >= round(k * APoint.X + b) - 5);
if Result then
Result := (APoint.X >= iMinX) and (APoint.X <= iMaxX) and
(APoint.Y >= iMinY) and (APoint.Y <= iMaxY);
end;
end;
{ 判断点坐标是否在线段的选择块里面 }
function TLine.PointInResizeControl(APoint: TPoint): Boolean;
begin
Result := PtInRect(FControlRect1, APoint) or PtInRect(FControlRect2, APoint);
end;
{ 根据点坐标在哪个选择块中,得到改变大小的光标类型 }
function TLine.GetResizeCursor(APoint: TPoint): TCursor;
begin
Result := Screen.Cursor;
if PointInResizeControl(APoint) then
begin
//垂直线
if FBeginPoint.X = FEndPoint.X then
Result := crSizeNS
//水平线
else if FBeginPoint.Y = FEndPoint.Y then
Result := crSizeWE
//右下斜线
else if (FBeginPoint.X - FEndPoint.X < 0) and (FBeginPoint.Y - FEndPoint.Y < 0) then
Result := crSizeNWSE
//右上斜线
else if (FBeginPoint.X - FEndPoint.X < 0) and (FBeginPoint.Y - FEndPoint.Y > 0) then
Result := crSizeNESW
//左下斜线
else if (FBeginPoint.X - FEndPoint.X > 0) and (FBeginPoint.Y - FEndPoint.Y < 0) then
Result := crSizeNWSE
//右上斜线
else if (FBeginPoint.X - FEndPoint.X > 0) and (FBeginPoint.Y - FEndPoint.Y > 0) then
Result := crSizeNWSE
end;
end;
{ 画线段 }
procedure TLine.Paint(ACanvas: TCanvas);
var
oldColor: TColor;
begin
ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Mode := pmCopy;
ACanvas.MoveTo(FBeginPoint.X, FBeginPoint.Y);
ACanvas.LineTo(FEndPoint.X, FEndPoint.Y);
if Selected then
begin
oldColor := ACanvas.Brush.Color;
ACanvas.Pen.Mode := pmNotXor;
ACanvas.Brush.Color := clBlack;
ACanvas.Rectangle(FControlRect1);
ACanvas.Rectangle(FControlRect2);
ACanvas.Brush.Color := oldColor;
end;
Moving := False;
Resizing := False;
FChangingBeginPoint := False;
FChangingEndPoint := False;
end;
{ 选中线段 }
procedure TLine.Select;
begin
inherited;
end;
{ 不选中线段 }
procedure TLine.UnSelect;
begin
inherited;
end;
{ 移动 }
procedure TLine.Move(ACanvas: TCanvas; offsetX, offsetY: Integer);
begin
ACanvas.Pen.Mode := pmNotXor;
{ 如果正在移动,则擦除原来的线段 }
if Moving then
begin
ACanvas.MoveTo(FBeginPoint.X, FBeginPoint.Y);
ACanvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
{ 设置移动后的线段位置,并以虚线画出来 }
SetBeginEndPoint(Point(FBeginPoint.X + offsetX, FBeginPoint.Y + offsetY),
Point(FEndPoint.X + offsetX, FEndPoint.Y + offsetY));
ACanvas.Pen.Style := psDot;
ACanvas.MoveTo(FBeginPoint.X, FBeginPoint.Y);
ACanvas.LineTo(FEndPoint.X, FEndPoint.Y);
Moving := True;
end;
{ 根据当前坐标位置改变线段大小 }
procedure TLine.ReSize(ACanvas: TCanvas; CurPoint: TPoint);
begin
ACanvas.Pen.Mode := pmNotXor;
{ 擦除上次画的线段 }
if Resizing then
begin
ACanvas.MoveTo(FBeginPoint.X, FBeginPoint.Y);
ACanvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
if (not FChangingBeginPoint) and (not FChangingEndPoint) then
FChangingBeginPoint := PtInRect(FControlRect1, CurPoint);
if (not FChangingEndPoint) and (not FChangingBeginPoint) then
FChangingEndPoint := PtInRect(FControlRect2, CurPoint);
if FChangingBeginPoint then SetBeginPoint(CurPoint);
if FChangingEndPoint then SetEndPoint(CurPoint);
ACanvas.Pen.Style := psDot;
ACanvas.MoveTo(FBeginPoint.X, FBeginPoint.Y);
ACanvas.LineTo(FEndPoint.X, FEndPoint.Y);
Resizing := True;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -