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

📄 shapes.pas

📁 delphi com深入编程,非常有收藏价值
💻 PAS
字号:
unit Shapes;

interface

uses
  Windows, IntfUnit, graphics, dialogs;

type
  TMark = class(TInterfacedObject, IColor, IPosition, IDraw)
  private
    FColor: TColor;
    FPoint: TPoint;
  public
    constructor Create(APoint: TPoint; AColor: TColor);
    function GetColor: TColor;
    procedure SetColor(AColor: TColor);
    function GetXY: TPoint;
    procedure SetXY(APoint: TPoint);
    procedure NudgeUp;
    procedure NudgeDown;
    procedure NudgeLeft;
    procedure NudgeRight;
    procedure Draw(ACanvas: TCanvas);
  end;

  TSquare = class(TMark, IColor, IPosition, ISize, IDraw)
  private
    FHeight: Integer;
    FWidth: Integer;
  public
    constructor Create(AUpLeft: TPoint; AHeight: Integer;
      AWidth: Integer; AColor: TColor);
    function GetWidth: Integer;
    function GetHeight: Integer;
    procedure SetWidth(AWidth: Integer);
    procedure SetHeight(AHeight: Integer);
    procedure Draw(ACanvas: TCanvas);
  end;

implementation

{ TMark }

constructor TMark.Create(APoint: TPoint; AColor: TColor);
begin
  inherited Create;

  FPoint := APoint;
  FColor := AColor;
end;

procedure TMark.Draw(ACanvas: TCanvas);
begin
  ACanvas.Pen.Color := FColor;
  ACanvas.MoveTo(FPoint.X - 2, FPoint.Y - 2);
  ACanvas.LineTo(FPoint.X + 3, FPoint.Y + 3);
  ACanvas.MoveTo(FPoint.X - 2, FPoint.Y + 2);
  ACanvas.LineTo(FPoint.X + 3, FPoint.Y - 3);
end;

function TMark.GetColor: TColor;
begin
  Result := FColor;
end;

function TMark.GetXY: TPoint;
begin
  Result := FPoint;
end;

procedure TMark.NudgeDown;
begin
  Inc(FPoint.Y);
end;

procedure TMark.NudgeLeft;
begin
  Dec(FPoint.X);
end;

procedure TMark.NudgeRight;
begin
  Inc(FPoint.X);
end;

procedure TMark.NudgeUp;
begin
  Dec(FPoint.Y);
end;

procedure TMark.SetColor(AColor: TColor);
begin
  FColor := AColor;
end;

procedure TMark.SetXY(APoint: TPoint);
begin
  FPoint := APoint;
end;

{ TSquare }

constructor TSquare.Create(AUpLeft: TPoint; AHeight: Integer;
  AWidth: Integer; AColor: TColor);
begin
  inherited Create(AUpLeft, AColor);

  FHeight := AHeight;
  FWidth := AWidth;
end;

procedure TSquare.Draw(ACanvas: TCanvas);
begin
  ACanvas.Pen.Color := FColor;
  ACanvas.Rectangle(FPoint.X, FPoint.Y, FPoint.X + FWidth,
    FPoint.Y + FHeight);
end;

function TSquare.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TSquare.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TSquare.SetHeight(AHeight: Integer);
begin
  FHeight := AHeight;
end;

procedure TSquare.SetWidth(AWidth: Integer);
begin
  FWidth := AWidth;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -