shapes.~pas

《Kylix程序设计》一书中附带的例程源代码

unit Shapes;

interface

uses
  SysUtils, Classes, Types, QGraphics;

type
  TGeoShape = class( TObject )
  public
    procedure Draw( Canvas: TCanvas );
  end;

  TGeoPoint = class( TGeoShape )
//  protected
  public
    FPoint: TPoint;
  public
    constructor Create(); overload;
    constructor Create( X, Y: Integer ); overload;
    constructor Create( Point: TPoint ); overload;
    procedure Draw( Canvas: TCanvas );
    procedure MoveTo( Canvas: TCanvas ); overload;
    procedure MoveTo( Canvas: TCanvas; X, Y: Integer ); overload;
    procedure MoveTo( Canvas: TCanvas; Point: TPoint ); overload;
    function GetPoint(): TPoint; overload;
    procedure GetPoint( var X, Y: Integer ); overload;
    procedure GetPoint( var Point: TPoint ); overload;
  end;

  TGeoLine = class( TGeoPoint )
//  protected
  public
    FToPoint: TPoint;
  public
    constructor Create(); overload;
    constructor Create( X1, Y1, X2, Y2: Integer ); overload;
    constructor Create( FromPoint, ToPoint: TPoint ); overload;
    procedure Draw( Canvas: TCanvas ); overload;
    procedure LineTo( Canvas: TCanvas ); overload;
    procedure LineTo( Canvas: TCanvas; X, Y: Integer ); overload;
    procedure LineTo( Canvas: TCanvas; ToPoint: TPoint ); overload;
    function GetToPoint(): TPoint; overload;
    procedure GetToPoint( var X, Y: Integer ); overload;
    procedure GetToPoint( var ToPoint: TPoint ); overload;
  end;

  TGeoRect = class( TGeoShape )
//  protected
  public
    FRect: TRect;
  public
    procedure Draw( Canvas: TCanvas );
//    procedure
  end;
{
var
  Shape: TGeoShape;
  Point: TGeoPoint;
  Line: TGeoLine;
  Rect: TGeoRect;
}
implementation

{ TGeoShape }

procedure TGeoShape.Draw(Canvas: TCanvas);
begin
  // Do nothing.
  Canvas.TextOut( 200, 200, 'Just show a text.' );
end;

{ TGeoPoint }

constructor TGeoPoint.Create;
begin
  Inherited Create();
end;

constructor TGeoPoint.Create(X, Y: Integer);
begin
  Inherited Create();
  FPoint.X := X;
  FPoint.Y := Y;
end;

constructor TGeoPoint.Create(Point: TPoint);
begin
  Inherited Create();
  FPoint := Point;
end;

procedure TGeoPoint.Draw(Canvas: TCanvas);
begin
//  Inherited Draw( Canvas );
  Canvas.DrawPoint( FPoint );
end;

function TGeoPoint.GetPoint: TPoint;
begin
  Result := FPoint;
end;

procedure TGeoPoint.GetPoint(var Point: TPoint);
begin
  Point := FPoint;
end;

procedure TGeoPoint.GetPoint(var X, Y: Integer);
begin
  X := FPoint.X;
  Y := FPoint.Y;
end;

procedure TGeoPoint.MoveTo(Canvas: TCanvas);
begin
  Canvas.MoveTo( FPoint.X, FPoint.Y );
end;

procedure TGeoPoint.MoveTo(Canvas: TCanvas; Point: TPoint);
begin
  FPoint := Point;
  Canvas.MoveTo( FPoint.X, FPoint.Y );
end;

procedure TGeoPoint.MoveTo(Canvas: TCanvas; X, Y: Integer);
begin
  FPoint.X := X;
  FPoint.Y := Y;
  Canvas.MoveTo( X, Y );
end;

{ TGeoLine }

constructor TGeoLine.Create;
begin
  Inherited Create();
end;

constructor TGeoLine.Create(X1, Y1, X2, Y2: Integer);
begin
  Inherited Create( X1, Y2 );
  FToPoint.X := X2;
  FToPoint.Y := Y2;
end;

constructor TGeoLine.Create(FromPoint, ToPoint: TPoint);
begin
  Inherited Create( FromPoint );
  FToPoint := ToPoint;
end;

procedure TGeoLine.Draw(Canvas: TCanvas);
begin
  Canvas.MoveTo( FPoint.X, FPoint.Y );
  Canvas.LineTo( FToPoint.X, FToPoint.Y );
end;

function TGeoLine.GetToPoint: TPoint;
begin
  Result := FToPoint;
end;

procedure TGeoLine.GetToPoint(var X, Y: Integer);
begin
  X := FToPoint.X;
  Y := FToPoint.Y;
end;

procedure TGeoLine.GetToPoint(var ToPoint: TPoint);
begin
  ToPoint := FToPoint;
end;

procedure TGeoLine.LineTo(Canvas: TCanvas);
begin
  Canvas.LineTo( FToPoint.X, FToPoint.Y );
end;

procedure TGeoLine.LineTo(Canvas: TCanvas; X, Y: Integer);
begin
  FToPoint.X := X;
  FToPoint.Y := Y;
  Canvas.LineTo( FToPoint.X, FToPoint.Y );
end;

procedure TGeoLine.LineTo(Canvas: TCanvas; ToPoint: TPoint);
begin
  FToPoint := ToPoint;
  Canvas.LineTo( FToPoint.X, FToPoint.Y );
end;

{ TGeoRect }

procedure TGeoRect.Draw(Canvas: TCanvas);
begin
  Canvas.DrawFocusRect( FRect );
end;

end.