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

📄 graphicsclassunit.pas

📁 可以实现简单绘图
💻 PAS
📖 第 1 页 / 共 2 页
字号:

{ 设置线段的起始位置和终止位置 }
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 + -