⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 graphicsclassunit.pas

📁 可以实现简单绘图
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -