Changeset 30

Timestamp:

Apr 18, 2015, 6:17:34 PM (10 years ago)

Author:

chronos

Message:

• Added: Automatic zooming to all existed map stations. This solve problem if too many stations were existed and some of them appeared behind window border.
• Added: Much of used TCanvas functions are now available through TMetaCanvas.

Location:

trunk

Files:

• UEngine.pas (modified) (24 diffs)
• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (4 diffs)
• UGeometric.pas (modified) (2 diffs)
• UMetaCanvas.pas (modified) (7 diffs)

trunk/UEngine.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs, Graphics, Controls, ExtCtrls, Math, DateUtils;
+  Classes, SysUtils, Contnrs, Graphics, Controls, ExtCtrls, Math, DateUtils,
+  UMetaCanvas;
 
 type
@@ -209 +210 @@
   private
     FDestRect: TRect;
+    FSourceRect: TRect;
     FZoom: Double;
     procedure SetDestRect(AValue: TRect);
+    procedure SetSourceRect(AValue: TRect);
     procedure SetZoom(AValue: Double);
   public
-    SourceRect: TRect;
+    function PointDestToSrc(Pos: TPoint): TPoint;
+    function PointSrcToDest(Pos: TPoint): TPoint;
     constructor Create;
+    property SourceRect: TRect read FSourceRect write SetSourceRect;
     property DestRect: TRect read FDestRect write SetDestRect;
     property Zoom: Double read FZoom write SetZoom;
@@ -237 +242 @@
     FTime: TDateTime;
     FLastTime: TDateTime;
+    MetaCanvas: TMetaCanvas;
+    procedure ResizeView;
     function GetExistStationShapes: TStationShapeSet;
     function GetStationOnPos(Pos: TPoint): TMapStation;
@@ -273 +280 @@
     constructor Create;
     destructor Destroy; override;
-    procedure Paint(Canvas: TCanvas);
+    procedure Paint(TargetCanvas: TCanvas);
     property Time: TDateTime read FTime;
   end;
@@ -307 +314 @@
   NewTrainPeriod = 7; // Each week
   NewPassengerPeriod = 0.3 * OneSecond;
-  NewPassengerProbability = 0.002;
+  NewPassengerProbability = 0.003;
   VisiblePassengersPerLine = 6;
 
@@ -350 +357 @@
     Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
   FDestRect := AValue;
-  SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
+  FSourceRect := Bounds(FSourceRect.Left + Diff.X, FSourceRect.Top + Diff.Y,
     Trunc((DestRect.Right - DestRect.Left) / Zoom),
     Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
+end;
+
+procedure TView.SetSourceRect(AValue: TRect);
+var
+  ZX: Double;
+  ZY: Double;
+begin
+  if RectEquals(FSourceRect, AValue) then Exit;
+  FSourceRect := AValue;
+  ZX := (FDestRect.Right - FDestRect.Left) / (FSourceRect.Right - FSourceRect.Left);
+  ZY := (FDestRect.Bottom - FDestRect.Top) / (FSourceRect.Bottom - FSourceRect.Top);
+  if  ZX > ZY then
+    Zoom := ZY
+    else Zoom := ZX;
 end;
 
@@ -361 +382 @@
     raise Exception.Create(SZeroZoomNotAlowed);
   FZoom := AValue;
-  SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
-    Trunc(SourceRect.Top +  (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
+  FSourceRect := Bounds(Trunc(FSourceRect.Left + (FSourceRect.Right - FSourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
+    Trunc(FSourceRect.Top +  (FSourceRect.Bottom - FSourceRect.Top) div 2 - (FDestRect.Bottom - DestRect.Top) / Zoom / 2),
     Trunc((DestRect.Right - DestRect.Left) / Zoom),
     Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
 end;
 
+function TView.PointDestToSrc(Pos: TPoint): TPoint;
+begin
+  Result := Point(Trunc(Pos.X / FZoom + FSourceRect.Left),
+    Trunc(Pos.Y / FZoom + FSourceRect.Top));
+end;
+
+function TView.PointSrcToDest(Pos: TPoint): TPoint;
+begin
+  Result := Point(Trunc((Pos.X - FSourceRect.Left) * FZoom),
+    Trunc((Pos.Y - FSourceRect.Top) * FZoom));
+end;
+
 constructor TView.Create;
 begin
-  Zoom := 1.5;
+  Zoom := 1;
 end;
 
@@ -1083 +1116 @@
 
 { TEngine }
+
+procedure TEngine.ResizeView;
+var
+  StationRect: TRect;
+  NewPoint: TPoint;
+begin
+  // Need to see all stations on screen
+  View.SourceRect := RectEnlarge(Stations.GetRect, 100);
+
+  NewPoint := Point(
+    Trunc((View.SourceRect.Left + (View.SourceRect.Right - View.SourceRect.Left) / 2) -
+    (View.DestRect.Left + (View.DestRect.Right - View.DestRect.Left) / 2 / View.Zoom)),
+    Trunc((View.SourceRect.Top + (View.SourceRect.Bottom - View.SourceRect.Top) / 2) -
+    (View.DestRect.Top + (View.DestRect.Bottom - View.DestRect.Top) / 2 / View.Zoom)));
+  View.SourceRect := Bounds(NewPoint.X, NewPoint.Y, Trunc((View.DestRect.Right - View.DestRect.Left) / View.Zoom),
+    Trunc((View.DestRect.Bottom - View.DestRect.Top) / View.Zoom));
+end;
 
 function TEngine.GetExistStationShapes: TStationShapeSet;
@@ -1618 +1668 @@
     LastNewStationTime := Time;
     Stations.AddNew;
-    // Need to see all stations on screen
-    View.SourceRect := RectEnlarge(Stations.GetRect, 70);
+    ResizeView;
   end;
 
@@ -1676 +1725 @@
   LastMousePos := Position;
   if MouseHold then begin
-      FocusedStation := GetStationOnPos(Position);
+      FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
       Line := nil;
       if Assigned(TrackStationDown) then Line := TrackStationDown.Line;
@@ -1728 +1777 @@
         SelectedTrain.Line := nil;
       end;
-      FocusedTrack := GetTrackOnPos(Position);
+      FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position));
       if Assigned(FocusedTrack.PointDown) then begin
         SelectedTrain.Line := FocusedTrack.PointDown.Line;
@@ -1781 +1830 @@
 
     // Train selection
-    SelectedTrain := GetTrainOnPos(Position);
+    SelectedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
     if Assigned(SelectedTrain) then begin
       Exit;
@@ -1795 +1844 @@
 
     // Line selection
-    Track := GetTrackOnPos(Position);
+    Track := GetTrackOnPos(View.PointDestToSrc(Position));
     if Assigned(Track) and Assigned(Track.PointDown) and Assigned(Track.PointUp) then begin
       SelectedLine := Track.PointDown.Line;
@@ -1820 +1869 @@
 
     // New track creation from selected station as start
-    Station := GetStationOnPos(Position);
+    Station := GetStationOnPos(View.PointDestToSrc(Position));
     if Assigned(Station) then begin
       if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then NewLine := SelectedLine
@@ -1862 +1911 @@
     Trains.Add(NewTrain);
   end;
+
+  ResizeView;
 
   SelectedLine := nil;
@@ -1891 +1942 @@
   if FileExists(ImageLocomotiveName) then
     ImageLocomotive.Picture.LoadFromFile(ImageLocomotiveName);
+  MetaCanvas := TMetaCanvas.Create;
 end;
 
 destructor TEngine.Destroy;
 begin
+  MetaCanvas.Free;
   Trains.Free;
   ImageLocomotive.Free;
@@ -1906 +1959 @@
 end;
 
-procedure TEngine.Paint(Canvas: TCanvas);
+procedure TEngine.Paint(TargetCanvas: TCanvas);
 var
   I: Integer;
@@ -1915 +1968 @@
   Text: string;
   Angle: Double;
-  EndPoint: TPoint;
   PassengerPos: TPoint;
   Direction: Integer;
   Points: array of TPoint;
+  Canvas: TMetaCanvas;
 const
   GameOverText = 'Game Over';
@@ -1924 +1977 @@
   GameOverStatistic = '%d passengers travelled on your metro over %d days.';
 begin
-  Canvas.Brush.Color := $eff0e0;
-  Canvas.Brush.Style := bsSolid;
-  Canvas.Clear;
+  Canvas := MetaCanvas;
+  Canvas.SetSize(Point(TargetCanvas.Width, TargetCanvas.Height));
+  Canvas.Reset;
 
   // Draw station passenger overload
@@ -1988 +2041 @@
     Canvas.Pen.Color := TrackStationDown.Line.Color;
     Canvas.MoveTo(TrackStationDown.LineStation.TrackPoint.Position);
-    DrawLine(Canvas, LastMousePos);
+    DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
   end;
   if Assigned(TrackStationUp) and Assigned(TrackStationUp.LineStation) then begin
     Canvas.Pen.Color := TrackStationUp.Line.Color;
     Canvas.MoveTo(TrackStationUp.LineStation.TrackPoint.Position);
-    DrawLine(Canvas, LastMousePos);
+    DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
   end;
 
@@ -2006 +2059 @@
       Canvas.Brush.Style := bsClear;
       Canvas.Pen.Color := SelectedLine.Color;
-      DrawShape(Canvas, Position, Shape, StationSize + Canvas.Pen.Width + 6, 0);
+      DrawShape(Canvas, Position, Shape, StationSize + Canvas.Pen.Width + 4, 0);
     end;
 
@@ -2046 +2099 @@
   end;
 
+  // Clear background
+  TargetCanvas.Brush.Color := $eff0e0;
+  TargetCanvas.Brush.Style := bsSolid;
+  TargetCanvas.Clear;
+
+  MetaCanvas.Move(Point(-View.SourceRect.Left, -View.SourceRect.Top));
+  MetaCanvas.Zoom(View.Zoom);
+
+  // Draw meta canvas to real target canvas
+  MetaCanvas.DrawTo(TargetCanvas);
+
   // Line selection
   for I := 0 to High(LineColors) do begin
     if Assigned(Lines.SearchByColor(LineColors[I])) then begin
-      Canvas.Brush.Color := LineColors[I];
+      TargetCanvas.Brush.Color := LineColors[I];
       Size := 15;
     end else begin
-      Canvas.Brush.Color := clSilver;
+      TargetCanvas.Brush.Color := clSilver;
       Size := 5;
     end;
-    Canvas.Pen.Color := clBlack;
+    TargetCanvas.Pen.Color := clBlack;
     if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin
-      Canvas.Pen.Style := psSolid;
+      TargetCanvas.Pen.Style := psSolid;
     end else begin
-      Canvas.Pen.Style := psClear;
-    end;
-
-    Canvas.EllipseC(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
-      Canvas.Height - LineColorsDist, Size, Size);
+      TargetCanvas.Pen.Style := psClear;
+    end;
+
+    TargetCanvas.EllipseC(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
+      TargetCanvas.Height - LineColorsDist, Size, Size);
   end;
 
   // Draw unused trains
   Text := IntToStr(Trains.GetUnusedCount);
-  Canvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
-    Canvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap);
-  Canvas.Brush.Style := bsClear;
-  Canvas.TextOut(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - Canvas.TextWidth(Text),
-    Canvas.Height - LineColorsDist - Canvas.TextHeight(Text) div 2, Text);
-
+  TargetCanvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
+    TargetCanvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap);
+  TargetCanvas.Brush.Style := bsClear;
+  TargetCanvas.TextOut(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - TargetCanvas.TextWidth(Text),
+    TargetCanvas.Height - LineColorsDist - TargetCanvas.TextHeight(Text) div 2, Text);
 
   // Status interface
   Text := IntToStr(ServedPassengerCount);
-  Canvas.Draw(Canvas.Width - 140, 20, ImagePassenger.Picture.Bitmap);
-  Canvas.Brush.Style := bsClear;
-  Canvas.TextOut(Canvas.Width - 146 - Canvas.TextWidth(Text), 25, Text);
-
-  DrawClock(Canvas);
-
+  TargetCanvas.Draw(TargetCanvas.Width - 140, 20, ImagePassenger.Picture.Bitmap);
+  TargetCanvas.Brush.Style := bsClear;
+  TargetCanvas.TextOut(TargetCanvas.Width - 146 - TargetCanvas.TextWidth(Text), 25, Text);
+
+  DrawClock(TargetCanvas);
+
+  // Show grabbed train by mouse
   if Assigned(SelectedTrain) then begin
-    Canvas.Brush.Color := clBlack; //SelectedTrain.Line.Color;
-    Canvas.Brush.Style := bsSolid;
-    Canvas.Pen.Style := psClear;
+    TargetCanvas.Brush.Color := clBlack; //SelectedTrain.Line.Color;
+    TargetCanvas.Brush.Style := bsSolid;
+    TargetCanvas.Pen.Style := psClear;
     Pos := LastMousePos;
     Angle := 0;
@@ -2095 +2159 @@
     Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
     Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
-    Canvas.Polygon(Points);
+    TargetCanvas.Polygon(Points);
   end;
 
@@ -2101 +2165 @@
   if State = gsGameOver then
   begin
-    Canvas.Font.Size := 40;
-    Canvas.Font.Color := clBlack;
-    Canvas.TextOut((Canvas.Width - Canvas.TextWidth(GameOverText)) div 2, 100, GameOverText);
-    Canvas.Font.Size := 14;
-    Canvas.TextOut((Canvas.Width - Canvas.TextWidth(GameOverReason)) div 2, 160, GameOverReason);
+    TargetCanvas.Font.Size := 40;
+    TargetCanvas.Font.Color := clBlack;
+    TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(GameOverText)) div 2, 100, GameOverText);
+    TargetCanvas.Font.Size := 14;
+    TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(GameOverReason)) div 2, 160, GameOverReason);
     Text := Format(GameOverStatistic, [ServedPassengerCount, Trunc(Time)]);
-    Canvas.TextOut((Canvas.Width - Canvas.TextWidth(Text)) div 2, 180, Text);
+    TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(Text)) div 2, 180, Text);
   end;
 end;

trunk/UFormMain.lfm

@@ -22 +22 @@
     OnMouseMove = PaintBox1MouseMove
     OnMouseUp = PaintBox1MouseUp
+    OnMouseWheelDown = PaintBox1MouseWheelDown
+    OnMouseWheelUp = PaintBox1MouseWheelUp
     OnPaint = PaintBox1Paint
     OnResize = PaintBox1Resize

trunk/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
-  ExtCtrls, UEngine, LCLType;
+  ExtCtrls, UEngine, LCLType, types;
 
 type
@@ -26 +26 @@
     procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
+    procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
+    procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
     procedure PaintBox1Paint(Sender: TObject);
     procedure PaintBox1Resize(Sender: TObject);
@@ -68 +72 @@
   Randomize;
   Engine.Map.Size := Point(PaintBox1.Width, PaintBox1.Height);
+  Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
   Engine.Reset;
 end;
@@ -87 +92 @@
 begin
   Engine.MouseUp(Button, Point(X, Y));
+end;
+
+procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
+  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+  Engine.View.Zoom := Engine.View.Zoom * 1.2;
+end;
+
+procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+  MousePos: TPoint; var Handled: Boolean);
+begin
+  Engine.View.Zoom := Engine.View.Zoom / 1.2;
 end;
 

trunk/UGeometric.pas

@@ -24 +24 @@
 function RectEquals(A, B: TRect): Boolean;
 function RectEnlarge(Rect: TRect; Value: Integer): TRect;
+function ShiftRect(ARect: TRect; Delta: TPoint): TRect;
 
 implementation
@@ -135 +136 @@
 function RectEnlarge(Rect: TRect; Value: Integer): TRect;
 begin
-  Rect.Left := Rect.Left - Value;
-  Rect.Right := Rect.Right + Value;
-  Rect.Top := Rect.Top - Value;
-  Rect.Bottom := Rect.Bottom + Value;
+  Result.Left := Rect.Left - Value;
+  Result.Right := Rect.Right + Value;
+  Result.Top := Rect.Top - Value;
+  Result.Bottom := Rect.Bottom + Value;
+end;
+
+function ShiftRect(ARect: TRect; Delta: TPoint): TRect;
+begin
+  Result := Rect(ARect.Left + Delta.X, ARect.Top + Delta.Y,
+    ARect.Right + Delta.X, ARect.Bottom + Delta.Y);
 end;
 

trunk/UMetaCanvas.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Graphics, Contnrs;
+  Classes, SysUtils, Graphics, Contnrs, GraphMath, Types;
 
 type
+  TArrayOfPoint = array of TPoint;
 
   { TCanvasObject }
@@ -14 +15 @@
   TCanvasObject = class
     procedure Paint(Canvas: TCanvas); virtual;
+    procedure Zoom(Factor: Double); virtual;
+    procedure Move(Delta: TPoint); virtual;
   end;
 
@@ -19 +22 @@
 
   TCanvasText = class(TCanvasObject)
+    Brush: TBrush;
+    Font: TFont;
     Position: TPoint;
     Text: string;
     procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasRectangle }
+
+  TCanvasRectangle = class(TCanvasObject)
+    Pen: TPen;
+    Brush: TBrush;
+    BoundingRect: TRect;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasLine }
+
+  TCanvasLine = class(TCanvasObject)
+    Pen: TPen;
+    P1, P2: TPoint;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasPolygon }
+
+  TCanvasPolygon = class(TCanvasObject)
+    Pen: TPen;
+    Brush: TBrush;
+    Points: array of TPoint;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasEllipse }
+
+  TCanvasEllipse = class(TCanvasObject)
+    Pen: TPen;
+    Brush: TBrush;
+    BoundingRect: TRect;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasPie }
+
+  TCanvasPie = class(TCanvasObject)
+    Pen: TPen;
+    Brush: TBrush;
+    BoundingRect: TRect;
+    StartPoint: TPoint;
+    EndPoint: TPoint;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TCanvasStretchDraw }
+
+  TCanvasStretchDraw = class(TCanvasObject)
+    SrcGraphic: TGraphic;
+    DestRect: TRect;
+    procedure Paint(Canvas: TCanvas); override;
+    procedure Zoom(Factor: Double); override;
+    procedure Move(Delta: TPoint); override;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -28 +115 @@
   TMetaCanvas = class(TCanvas)
   private
-
+    FSize: TPoint;
+    FPenPos: TPoint;
+  protected
+    procedure SetHeight(AValue: Integer); override;
+    function GetHeight: Integer; override;
+    procedure SetWidth(AValue: Integer); override;
+    function GetWidth: Integer; override;
+    procedure DoLine (x1,y1,x2,y2:integer); override;
+    procedure DoTextOut(X, Y: Integer; Text: string); override;
+    procedure TextOut(X,Y: Integer; const Text: String); override;
+    procedure DoRectangle(const Bounds: TRect); override;
+    procedure DoRectangleFill(const Bounds: TRect); override;
+    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;
+    procedure DoPolygon(const Points: array of TPoint); override;
+    procedure CreateHandle; override;
+    procedure Ellipse(x1, y1, x2, y2: Integer); override;
+    procedure DoEllipse(const Bounds: TRect); override;
+    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
+    function TextExtent(const Text: string): TSize; override;
+    procedure DoMoveTo(X, Y: Integer); override;
+    procedure DoLineTo(X, Y: Integer); override;
+    procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
+      StartX, StartY, EndX, EndY: Integer); override;
   public
     Objects: TObjectList;
+    procedure SetSize(Size: TPoint);
     procedure Reset;
     procedure DrawTo(Canvas: TCanvas);
+    procedure Zoom(Factor: Double);
+    procedure Move(Delta: TPoint);
     constructor Create;
     destructor Destroy; override;
@@ -39 +151 @@
 implementation
 
+uses
+  UGeometric;
+
+{ TCanvasPie }
+
+procedure TCanvasPie.Paint(Canvas: TCanvas);
+begin
+  Canvas.Brush.Assign(Brush);
+  Canvas.Pen.Assign(Pen);
+  Canvas.Pie(BoundingRect.Left, BoundingRect.Top,
+    BoundingRect.Right, BoundingRect.Bottom, StartPoint.X, StartPoint.Y,
+    EndPoint.X, EndPoint.Y);
+end;
+
+procedure TCanvasPie.Zoom(Factor: Double);
+begin
+  BoundingRect := Rect(Trunc(BoundingRect.Left * Factor),
+    Trunc(BoundingRect.Top * Factor),
+    Trunc(BoundingRect.Right * Factor),
+    Trunc(BoundingRect.Bottom * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+  StartPoint := Point(Trunc(StartPoint.X * Factor), Trunc(StartPoint.Y * Factor));
+  EndPoint := Point(Trunc(EndPoint.X * Factor), Trunc(EndPoint.Y * Factor));
+end;
+
+procedure TCanvasPie.Move(Delta: TPoint);
+begin
+  BoundingRect := ShiftRect(BoundingRect, Delta);
+  StartPoint := AddPoint(StartPoint, Delta);
+  EndPoint := AddPoint(EndPoint, Delta);
+end;
+
+constructor TCanvasPie.Create;
+begin
+  Pen := TPen.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasPie.Destroy;
+begin
+  Pen.Free;
+  Brush.Free;
+  inherited Destroy;
+end;
+
+{ TCanvasStretchDraw }
+
+procedure TCanvasStretchDraw.Paint(Canvas: TCanvas);
+begin
+  Canvas.StretchDraw(DestRect, SrcGraphic);
+end;
+
+procedure TCanvasStretchDraw.Zoom(Factor: Double);
+begin
+  DestRect := Rect(Trunc(DestRect.Left * Factor),
+    Trunc(DestRect.Top * Factor),
+    Trunc(DestRect.Right * Factor),
+    Trunc(DestRect.Bottom * Factor));
+end;
+
+procedure TCanvasStretchDraw.Move(Delta: TPoint);
+begin
+  DestRect := ShiftRect(DestRect, Delta);
+end;
+
+constructor TCanvasStretchDraw.Create;
+begin
+  SrcGraphic := nil;
+end;
+
+destructor TCanvasStretchDraw.Destroy;
+begin
+  inherited Destroy;
+end;
+
+{ TCanvasEllipse }
+
+procedure TCanvasEllipse.Paint(Canvas: TCanvas);
+begin
+  Canvas.Pen.Assign(Pen);
+  Canvas.Brush.Assign(Brush);
+  Canvas.Ellipse(BoundingRect);
+end;
+
+procedure TCanvasEllipse.Zoom(Factor: Double);
+begin
+  BoundingRect := Rect(Trunc(BoundingRect.Left * Factor),
+    Trunc(BoundingRect.Top * Factor),
+    Trunc(BoundingRect.Right * Factor),
+    Trunc(BoundingRect.Bottom * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+end;
+
+procedure TCanvasEllipse.Move(Delta: TPoint);
+begin
+  BoundingRect := ShiftRect(BoundingRect, Delta);
+end;
+
+constructor TCanvasEllipse.Create;
+begin
+  Pen := TPen.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasEllipse.Destroy;
+begin
+  Pen.Free;
+  Brush.Free;
+  inherited Destroy;
+end;
+
+{ TCanvasPolygon }
+
+procedure TCanvasPolygon.Paint(Canvas: TCanvas);
+begin
+  Canvas.Pen.Assign(Pen);
+  Canvas.Brush.Assign(Brush);
+  Canvas.Polygon(Points);
+end;
+
+procedure TCanvasPolygon.Zoom(Factor: Double);
+var
+  I: Integer;
+begin
+  for I := 0 to High(Points) do
+    Points[I] := Point(Trunc(Points[I].X * Factor),
+      Trunc(Points[I].Y * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+end;
+
+procedure TCanvasPolygon.Move(Delta: TPoint);
+var
+  I: Integer;
+begin
+  for I := 0 to High(Points) do
+    Points[I] := AddPoint(Points[I], Delta);
+end;
+
+constructor TCanvasPolygon.Create;
+begin
+  Pen := TPen.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasPolygon.Destroy;
+begin
+  Brush.Free;
+  Pen.Free;
+  inherited Destroy;
+end;
+
+{ TCanvasLine }
+
+procedure TCanvasLine.Paint(Canvas: TCanvas);
+begin
+  Canvas.Pen.Assign(Pen);
+  Canvas.Line(P1, P2);
+end;
+
+procedure TCanvasLine.Zoom(Factor: Double);
+begin
+  P1 := Point(Trunc(P1.X * Factor), Trunc(P1.Y * Factor));
+  P2 := Point(Trunc(P2.X * Factor), Trunc(P2.Y * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+end;
+
+procedure TCanvasLine.Move(Delta: TPoint);
+begin
+  P1 := AddPoint(P1, Delta);
+  P2 := AddPoint(P2, Delta);
+end;
+
+constructor TCanvasLine.Create;
+begin
+  Pen := TPen.Create;
+end;
+
+destructor TCanvasLine.Destroy;
+begin
+  Pen.Free;
+  inherited Destroy;
+end;
+
+{ TCanvasRectangle }
+
+procedure TCanvasRectangle.Paint(Canvas: TCanvas);
+begin
+  Canvas.Pen.Assign(Pen);
+  Canvas.Brush.Assign(Brush);
+  Canvas.Rectangle(BoundingRect);
+end;
+
+procedure TCanvasRectangle.Zoom(Factor: Double);
+begin
+  BoundingRect := Rect(Trunc(BoundingRect.Left * Factor),
+    Trunc(BoundingRect.Top * Factor),
+    Trunc(BoundingRect.Right * Factor),
+    Trunc(BoundingRect.Bottom * Factor));
+  Pen.Width := Trunc(Pen.Width * Factor);
+end;
+
+procedure TCanvasRectangle.Move(Delta: TPoint);
+begin
+  ShiftRect(BoundingRect, Delta);
+end;
+
+constructor TCanvasRectangle.Create;
+begin
+  Pen := TPen.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasRectangle.Destroy;
+begin
+  Pen.Free;
+  Brush.Free;
+  inherited Destroy;
+end;
+
 { TCanvasText }
 
 procedure TCanvasText.Paint(Canvas: TCanvas);
 begin
+  Canvas.Brush.Assign(Brush);
+  Canvas.Font.Assign(Font);
   Canvas.TextOut(Position.X, Position.Y, Text);
 end;
 
+procedure TCanvasText.Zoom(Factor: Double);
+begin
+  Position := Point(Trunc(Position.X * Factor), Trunc(Position.Y * Factor));
+  Font.Size := Trunc(Font.Size * Factor);
+end;
+
+procedure TCanvasText.Move(Delta: TPoint);
+begin
+  Position := AddPoint(Position, Delta);
+end;
+
+constructor TCanvasText.Create;
+begin
+  Font := TFont.Create;
+  Brush := TBrush.Create;
+end;
+
+destructor TCanvasText.Destroy;
+begin
+  Brush.Free;
+  Font.Free;
+  inherited Destroy;
+end;
+
 { TCanvasObject }
 
@@ -53 +410 @@
 end;
 
+procedure TCanvasObject.Zoom(Factor: Double);
+begin
+
+end;
+
+procedure TCanvasObject.Move(Delta: TPoint);
+begin
+end;
+
 { TMetaCanvas }
+
+procedure TMetaCanvas.SetHeight(AValue: Integer);
+begin
+  FSize.Y := AValue;
+end;
+
+function TMetaCanvas.GetHeight: Integer;
+begin
+  Result := FSize.Y;
+end;
+
+procedure TMetaCanvas.SetWidth(AValue: Integer);
+begin
+  FSize.X := AValue;
+end;
+
+function TMetaCanvas.GetWidth: Integer;
+begin
+  Result := FSize.X;
+end;
+
+procedure TMetaCanvas.DoLine(x1, y1, x2, y2: integer);
+var
+  NewObj: TCanvasLine;
+begin
+  NewObj := TCanvasLine.Create;
+  NewObj.Pen.Assign(Pen);
+  NewObj.P1 := Point(X1, Y1);
+  NewObj.P2 := Point(X2, Y2);
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.DoTextOut(X, Y: Integer; Text: string);
+var
+  NewObj: TCanvasText;
+begin
+  NewObj := TCanvasText.Create;
+  NewObj.Font.Assign(Font);
+  NewObj.Brush.Assign(Brush);
+  NewObj.Position := Point(X, Y);
+  NewObj.Text := Text;
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.TextOut(X, Y: Integer; const Text: String);
+begin
+  DoTextOut(X, Y, Text);
+end;
+
+procedure TMetaCanvas.DoRectangle(const Bounds: TRect);
+var
+  NewObj: TCanvasRectangle;
+begin
+  NewObj := TCanvasRectangle.Create;
+  NewObj.Pen.Assign(Pen);
+  NewObj.BoundingRect := Bounds;
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.DoRectangleFill(const Bounds: TRect);
+var
+  NewObj: TCanvasRectangle;
+begin
+  NewObj := TCanvasRectangle.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  NewObj.BoundingRect := Bounds;
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: boolean
+  );
+var
+  APoints: array of TPoint;
+  I: Integer;
+begin
+  SetLength(APoints, NumPts);
+  for I := 0 to High(APoints) do
+    APoints[I] := Points[I];
+  DoPolygon(APoints);
+end;
+
+procedure TMetaCanvas.DoPolygon(const Points: array of TPoint);
+var
+  NewObj: TCanvasPolygon;
+  I: Integer;
+begin
+  NewObj := TCanvasPolygon.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  SetLength(NewObj.Points, Length(Points));
+  for I := 0 to High(Points) do
+    NewObj.Points[I] := Points[I];
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.CreateHandle;
+begin
+end;
+
+procedure TMetaCanvas.Ellipse(x1, y1, x2, y2: Integer);
+begin
+  DoEllipse(Rect(X1, Y1, X2, Y2));
+end;
+
+procedure TMetaCanvas.DoEllipse(const Bounds: TRect);
+var
+  NewObj: TCanvasEllipse;
+begin
+  NewObj := TCanvasEllipse.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  NewObj.BoundingRect := Bounds;
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
+var
+  NewObj: TCanvasStretchDraw;
+begin
+  NewObj := TCanvasStretchDraw.Create;
+  NewObj.SrcGraphic := SrcGraphic;
+  NewObj.DestRect := DestRect;
+  Objects.Add(NewObj);
+end;
+
+function TMetaCanvas.TextExtent(const Text: string): TSize;
+begin
+  Result := Size(0, 0);
+end;
+
+procedure TMetaCanvas.DoMoveTo(X, Y: Integer);
+begin
+  FPenPos := Point(X, Y);
+end;
+
+procedure TMetaCanvas.DoLineTo(X, Y: Integer);
+begin
+  DoLine(FPenPos.X, FPenPos.Y, X, Y);
+  DoMoveTo(X, Y);
+end;
+
+procedure TMetaCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,
+  StartY, EndX, EndY: Integer);
+var
+  NewObj: TCanvasPie;
+begin
+  NewObj := TCanvasPie.Create;
+  NewObj.Brush.Assign(Brush);
+  NewObj.Pen.Assign(Pen);
+  NewObj.BoundingRect := Rect(EllipseX1, EllipseY1, EllipseX2, EllipseY2);
+  NewObj.StartPoint := Point(StartX, StartY);
+  NewObj.EndPoint := Point(EndX, EndY);
+  Objects.Add(NewObj);
+end;
+
+procedure TMetaCanvas.SetSize(Size: TPoint);
+begin
+  FSize := Size;
+end;
 
 procedure TMetaCanvas.Reset;
@@ -68 +594 @@
 end;
 
+procedure TMetaCanvas.Zoom(Factor: Double);
+var
+  I: Integer;
+begin
+  for I := 0 to Objects.Count - 1 do
+    TCanvasObject(Objects[I]).Zoom(Factor);
+end;
+
+procedure TMetaCanvas.Move(Delta: TPoint);
+var
+  I: Integer;
+begin
+  for I := 0 to Objects.Count - 1 do
+    TCanvasObject(Objects[I]).Move(Delta);
+end;
+
 constructor TMetaCanvas.Create;
 begin
+  inherited;
+  FPenPos := Point(0, 0);
   Objects := TObjectList.Create;
 end;