📄 graphicsclassunit.pas
字号:
{ 设置线段的起始位置和终止位置 }
procedure TLine.SetBeginEndPoint(ABeginPoint, AEndPoint: TPoint);
var
temp: Integer;
begin
if (ABeginPoint.X >=0) and (ABeginPoint.Y >= 0) and
(AEndPoint.X >= 0) and (AEndPoint.Y >= 0) then
begin
FBeginPoint := ABeginPoint;
FEndPoint := AEndPoint;
if (FBeginPoint.X > FEndPoint.X) and (FBeginPoint.Y > FEndPoint.Y) then
begin
temp := FBeginPoint.X;
FBeginPoint.X := FEndPoint.X;
FEndPoint.X := temp;
temp := FBeginPoint.Y;
FBeginPoint.Y := FEndPoint.Y;
FEndPoint.Y := temp;
if Resizing then
begin
if FChangingBeginPoint then
begin
FChangingBeginPoint := False;
FChangingEndPoint := True;
end
else begin
FChangingBeginPoint := True;
FChangingEndPoint := False;
end;
end;
end;
FControlRect1 := Rect(FBeginPoint.X - 3, FBeginPoint.Y - 3,
FBeginPoint.X + 4, FBeginPoint.Y + 4);
FControlRect2 := Rect(FEndPoint.X - 3, FEndPoint.Y - 3,
FEndPoint.X + 4, FEndPoint.Y + 4);
end;
end;
////////////////////////////// Private //////////////////////////////
{ 设置线段的开始位置 }
procedure TLine.SetBeginPoint(Value: TPoint);
begin
if (Value.X <> FBeginPoint.X) or (Value.Y <> FBeginPoint.Y) then
SetBeginEndPoint(Value, FEndPoint);
end;
{ 设置线段的结束位置 }
procedure TLine.SetEndPoint(Value: TPoint);
begin
if (Value.X <> FEndPoint.X) or (Value.Y <> FEndPoint.Y) then
SetBeginEndPoint(FBeginPoint, Value);
end;
////////////////////////////// End //////////////////////////////
{ TRectangle }
////////////////////////////// Public //////////////////////////////
constructor TRectangle.Create(ALeftTopPoint, ARightBottomPoint: TPoint);
begin
SetPosition(ALeftTopPoint, ARightBottomPoint);
end;
{ 点是否在矩里面 }
function TRectangle.PointInside(APoint: TPoint): Boolean;
begin
Result := PtInRect(FRectSelf, APoint);
end;
{ 画矩形 }
procedure TRectangle.Paint(ACanvas: TCanvas);
begin
ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Mode := pmCopy;
ACanvas.Rectangle(FRectSelf);
inherited;
end;
{ 选中矩形 }
procedure TRectangle.Select;
begin
inherited;
end;
{ 不选中矩形 }
procedure TRectangle.UnSelect;
begin
inherited;
end;
{ 移动 }
procedure TRectangle.Move(ACanvas: TCanvas; offsetX, offsetY: Integer);
begin
ACanvas.Pen.Mode := pmNotXor;
{ 如果正在移动,则擦除上次画的矩形 }
if Moving then
ACanvas.Rectangle(FRectSelf);
{ 设置移动后的位置,并以虚线框画出来 }
SetPosition(Point(FLeftTopPoint.X + offsetX, FLeftTopPoint.Y + offsetY),
Point(FRightBottomPoint.X + offsetX, FRightBottomPoint.Y + offsetY));
ACanvas.Pen.Style := psDot;
ACanvas.Rectangle(FRectSelf);
Moving := True;
end;
{ 改变大小 }
procedure TRectangle.ReSize(ACanvas: TCanvas; CurPoint: TPoint);
begin
ACanvas.Pen.Mode := pmNotXor;
if Resizing then //如果正在改变大小,则擦除上次画的矩形
ACanvas.Rectangle(FRectSelf);
{ 如果是初次改变图形大小,则获取当前点在8个调整大小控制器中的哪一个 }
if not Resizing then
begin
ResizeControl := GetResizeControl(CurPoint);
end;
//根据当前的控制器位置和当前坐标改变矩形相应的坐标
SetPosition(ResizeControl, CurPoint);
{ 用虚线画矩形 }
ACanvas.Pen.Style := psDot;
ACanvas.Rectangle(FRectSelf);
Resizing := True;
end;
{ 设置矩形的位置 }
procedure TRectangle.SetPosition(ALeftTopPoint, ARightBottomPoint: TPoint);
var
temp: Integer;
begin
temp := -1;
if (ALeftTopPoint.X >= 0) and (ALeftTopPoint.Y >= 0) and
(ARightBottomPoint.X >= 0) and (ARightBottomPoint.Y >= 0) then
begin
FLeftTopPoint := ALeftTopPoint;
FRightBottomPoint := ARightBottomPoint;
{ 左上角X坐标必须小于右下角的X坐标 }
if FLeftTopPoint.X > FRightBottomPoint.X then
begin
temp := FLeftTopPoint.X;
FLeftTopPoint.X := FRightBottomPoint.X;
FRightBottomPoint.X := temp;
end;
{ 左上角Y坐标必须小于右下角的Y坐标 }
if FLeftTopPoint.Y > ARightBottomPoint.Y then
begin
temp := FLeftTopPoint.Y;
FLeftTopPoint.Y := FRightBottomPoint.Y;
FRightBottomPoint.Y := temp;
end;
{ 如果正在改变矩形大小的时候发生了坐标交换,则改变点在选择块的位置 }
if Resizing and (temp <> -1) then
ResizeControl := ReverseResizeControl(FResizeControl);
BuildRect;
end;
end;
////////////////////////////// Protected //////////////////////////////
{ 根据当前的控制器位置和当前坐标改变矩形相应的坐标 }
procedure TRectangle.SetPosition(AResizeControl: TResizeControl;
CurPoint: TPoint);
begin
{ 根据当前点在8个选择器中的哪一个,改变矩形的坐标 }
case AResizeControl of
rcLeftTop:
begin
SetLeftTopPoint(CurPoint);
end;
rcTopCenter:
begin
SetLeftTopPoint(Point(FLeft, CurPoint.Y));
end;
rcRightTop:
begin
SetLeftTopPoint(Point(FLeft, CurPoint.Y));
SetRightBottomPoint(Point(CurPoint.X, FTop + FHeight));
end;
rcLeftCenter:
begin
SetLeftTopPoint(Point(CurPoint.X, FTop));
end;
rcRightCenter:
begin
SetRightBottomPoint(Point(CurPoint.X, FTop + FHeight));
end;
rcLeftBottom:
begin
SetLeftTopPoint(Point(CurPoint.X, FTop));
SetRightBottomPoint(Point(FLeft + FWidth, CurPoint.Y));
end;
rcBottomCenter:
begin
SetRightBottomPoint(Point(FLeft + FWidth, CurPoint.Y));
end;
rcRightBottom:
begin
SetRightBottomPoint(CurPoint);
end;
end;
end;
////////////////////////////// Private //////////////////////////////
{ 生成矩形 }
procedure TRectangle.BuildRect;
begin
FRectSelf := Rect(FLeftTopPoint.X, FLeftTopPoint.Y,
FRightBottomPoint.X, FRightBottomPoint.Y);
FWidth := FRightBottomPoint.X - FLeftTopPoint.X;
FHeight := FRightBottomPoint.Y - FLeftTopPoint.Y;
FLeft := FLeftTopPoint.X;
FTop := FLeftTopPoint.Y;
DrawRect := FRectSelf;
end;
{ 设置左上角坐标 }
procedure TRectangle.SetLeftTopPoint(Value: TPoint);
begin
SetPosition(Value, FRightBottomPoint);
end;
{ 设置右下角坐标 }
procedure TRectangle.SetRightBottomPoint(Value: TPoint);
begin
SetPosition(FLeftTopPoint, Value);
end;
{ 改变左上角的X坐标 }
procedure TRectangle.SetLeft(Value: Integer);
begin
if Value <> FLeftTopPoint.X then
begin
FLeftTopPoint.X := Value;
SetPosition(FLeftTopPoint, FRightBottomPoint);
end;
end;
{ 改变左上角的Y坐标 }
procedure TRectangle.SetTop(Value: Integer);
begin
if Value <> FLeftTopPoint.Y then
begin
FLeftTopPoint.Y := Value;
SetPosition(FLeftTopPoint, FRightBottomPoint);
end;
end;
{ 设置宽度 }
procedure TRectangle.SetWidth(Value: Integer);
begin
if (Value <> FWidth) and (Value > 0) then
begin
FWidth := Value;
FRightBottomPoint.X := FLeft + FWidth;
SetPosition(FLeftTopPoint, FRightBottomPoint);
end;
end;
{ 设置高度 }
procedure TRectangle.SetHeight(Value: Integer);
begin
if (Value <> FHeight) and (Value > 0) then
begin
FHeight := Value;
FRightBottomPoint.Y := FTop + FHeight;
SetPosition(FLeftTopPoint, FRightBottomPoint);
end;
end;
{ TRoundRect }
////////////////////////////// Public //////////////////////////////
{ 点是否在圆角矩形里面 }
function TRoundRect.PointInside(APoint: TPoint): Boolean;
var
hRgn: Integer;
begin
Result := False;
hRgn := CreateRoundRectRgn(Left, Top, Left + Width, Top + Height,
Width div 2, Height div 2);
try
if hRgn <> 0 then
Result := PtInRegion(hRgn, APoint.X, APoint.Y);
finally
DeleteObject(hRgn);
end;
end;
{ 画圆形矩形 }
procedure TRoundRect.Paint(ACanvas: TCanvas);
begin
ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Mode := pmCopy;
ACanvas.RoundRect(Left, Top, Left + Width + 1, Top + Height + 1, Width div 2, Height div 2);
if Selected then
DrawResizeCtrlRects(ACanvas);
Moving := False;
Resizing := False;
end;
{ 移动 }
procedure TRoundRect.Move(ACanvas: TCanvas; offsetX, offsetY: Integer);
begin
ACanvas.Pen.Mode := pmNotXor;
{ 如果正在移动,则擦除上次画的矩形 }
if Moving then
ACanvas.RoundRect(Left, Top, Left + Width, Top + Height,
Width div 2, Height div 2);
{ 设置移动后的位置,并以虚线框画出来 }
SetPosition(Point(FLeftTopPoint.X + offsetX, FLeftTopPoint.Y + offsetY),
Point(FRightBottomPoint.X + offsetX, FRightBottomPoint.Y + offsetY));
ACanvas.Pen.Style := psDot;
ACanvas.RoundRect(Left, Top, Left + Width, Top + Height,
Width div 2, Height div 2);
Moving := True;
end;
{ 根据当前坐标改变大小 }
procedure TRoundRect.ReSize(ACanvas: TCanvas; CurPoint: TPoint);
begin
ACanvas.Pen.Mode := pmNotXor;
if Resizing then //如果正在移动,则擦除上次画的
ACanvas.RoundRect(Left, Top, Left + Width, Top + Height,
Width div 2, Height div 2);
if not Resizing then
begin
ResizeControl := GetResizeControl(CurPoint);
end;
SetPosition(ResizeControl, CurPoint);
ACanvas.Pen.Style := psDot;
ACanvas.RoundRect(Left, Top, Left + Width, Top + Height,
Width div 2, Height div 2);
Resizing := True;
end;
{ TEllipse }
////////////////////////////// Public //////////////////////////////
{ 判断坐标是否在椭圆里面 }
function TEllipse.PointInside(APoint: TPoint): Boolean;
var
hRgn: Integer;
begin
Result := False;
hRgn := CreateEllipticRgn(Left, Top, Left + Width, Top + Height);
if hRgn <> 0 then
try
Result := PtInRegion(hRgn, APoint.X, APoint.Y);
finally
DeleteObject(hRgn);
end;
end;
{ 绘制椭圆 }
procedure TEllipse.Paint(ACanvas: TCanvas);
begin
ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Mode := pmCopy;
ACanvas.Ellipse(Left, Top, Left + Width + 1, Top + Height + 1);
if Selected then
DrawResizeCtrlRects(ACanvas);
Moving := False;
Resizing := False;
end;
procedure TEllipse.Move(ACanvas: TCanvas; offsetX, offsetY: Integer);
begin
ACanvas.Pen.Mode := pmNotXor;
ACanvas.Pen.Style := psDot;
if Moving then //正在移动,擦除上次画的椭圆
ACanvas.Ellipse(Left, Top, Left + Width, Top + Height);
SetPosition(Point(Left + offsetX, Top + offsetY),
Point(Left + Width + offsetX, Top + Height + offsetY));
ACanvas.Ellipse(Left, Top, Left + Width, Top + Height);
Moving := True;
end;
{ 改变大小 }
procedure TEllipse.ReSize(ACanvas: TCanvas; CurPoint: TPoint);
begin
ACanvas.Pen.Mode := pmNotXor;
ACanvas.Pen.Style := psDot;
if Resizing then //正在改变大小,擦除上次画的椭圆
ACanvas.Ellipse(Left, Top, Left + Width, Top + Height)
else //首次改变大小,获取坐标在哪个ResizeControl上
ResizeControl := GetResizeControl(CurPoint);
//设置移动后的位置
SetPosition(ResizeControl, CurPoint);
ACanvas.Ellipse(Left, Top, Left + Width, Top + Height);
Resizing := True;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -