Changeset 30


Ignore:
Timestamp:
Apr 18, 2015, 6:17:34 PM (9 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:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/UEngine.pas

    r29 r30  
    66
    77uses
    8   Classes, SysUtils, Contnrs, Graphics, Controls, ExtCtrls, Math, DateUtils;
     8  Classes, SysUtils, Contnrs, Graphics, Controls, ExtCtrls, Math, DateUtils,
     9  UMetaCanvas;
    910
    1011type
     
    209210  private
    210211    FDestRect: TRect;
     212    FSourceRect: TRect;
    211213    FZoom: Double;
    212214    procedure SetDestRect(AValue: TRect);
     215    procedure SetSourceRect(AValue: TRect);
    213216    procedure SetZoom(AValue: Double);
    214217  public
    215     SourceRect: TRect;
     218    function PointDestToSrc(Pos: TPoint): TPoint;
     219    function PointSrcToDest(Pos: TPoint): TPoint;
    216220    constructor Create;
     221    property SourceRect: TRect read FSourceRect write SetSourceRect;
    217222    property DestRect: TRect read FDestRect write SetDestRect;
    218223    property Zoom: Double read FZoom write SetZoom;
     
    237242    FTime: TDateTime;
    238243    FLastTime: TDateTime;
     244    MetaCanvas: TMetaCanvas;
     245    procedure ResizeView;
    239246    function GetExistStationShapes: TStationShapeSet;
    240247    function GetStationOnPos(Pos: TPoint): TMapStation;
     
    273280    constructor Create;
    274281    destructor Destroy; override;
    275     procedure Paint(Canvas: TCanvas);
     282    procedure Paint(TargetCanvas: TCanvas);
    276283    property Time: TDateTime read FTime;
    277284  end;
     
    307314  NewTrainPeriod = 7; // Each week
    308315  NewPassengerPeriod = 0.3 * OneSecond;
    309   NewPassengerProbability = 0.002;
     316  NewPassengerProbability = 0.003;
    310317  VisiblePassengersPerLine = 6;
    311318
     
    350357    Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
    351358  FDestRect := AValue;
    352   SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
     359  FSourceRect := Bounds(FSourceRect.Left + Diff.X, FSourceRect.Top + Diff.Y,
    353360    Trunc((DestRect.Right - DestRect.Left) / Zoom),
    354361    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
     362end;
     363
     364procedure TView.SetSourceRect(AValue: TRect);
     365var
     366  ZX: Double;
     367  ZY: Double;
     368begin
     369  if RectEquals(FSourceRect, AValue) then Exit;
     370  FSourceRect := AValue;
     371  ZX := (FDestRect.Right - FDestRect.Left) / (FSourceRect.Right - FSourceRect.Left);
     372  ZY := (FDestRect.Bottom - FDestRect.Top) / (FSourceRect.Bottom - FSourceRect.Top);
     373  if  ZX > ZY then
     374    Zoom := ZY
     375    else Zoom := ZX;
    355376end;
    356377
     
    361382    raise Exception.Create(SZeroZoomNotAlowed);
    362383  FZoom := AValue;
    363   SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
    364     Trunc(SourceRect.Top +  (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
     384  FSourceRect := Bounds(Trunc(FSourceRect.Left + (FSourceRect.Right - FSourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
     385    Trunc(FSourceRect.Top +  (FSourceRect.Bottom - FSourceRect.Top) div 2 - (FDestRect.Bottom - DestRect.Top) / Zoom / 2),
    365386    Trunc((DestRect.Right - DestRect.Left) / Zoom),
    366387    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
    367388end;
    368389
     390function TView.PointDestToSrc(Pos: TPoint): TPoint;
     391begin
     392  Result := Point(Trunc(Pos.X / FZoom + FSourceRect.Left),
     393    Trunc(Pos.Y / FZoom + FSourceRect.Top));
     394end;
     395
     396function TView.PointSrcToDest(Pos: TPoint): TPoint;
     397begin
     398  Result := Point(Trunc((Pos.X - FSourceRect.Left) * FZoom),
     399    Trunc((Pos.Y - FSourceRect.Top) * FZoom));
     400end;
     401
    369402constructor TView.Create;
    370403begin
    371   Zoom := 1.5;
     404  Zoom := 1;
    372405end;
    373406
     
    10831116
    10841117{ TEngine }
     1118
     1119procedure TEngine.ResizeView;
     1120var
     1121  StationRect: TRect;
     1122  NewPoint: TPoint;
     1123begin
     1124  // Need to see all stations on screen
     1125  View.SourceRect := RectEnlarge(Stations.GetRect, 100);
     1126
     1127  NewPoint := Point(
     1128    Trunc((View.SourceRect.Left + (View.SourceRect.Right - View.SourceRect.Left) / 2) -
     1129    (View.DestRect.Left + (View.DestRect.Right - View.DestRect.Left) / 2 / View.Zoom)),
     1130    Trunc((View.SourceRect.Top + (View.SourceRect.Bottom - View.SourceRect.Top) / 2) -
     1131    (View.DestRect.Top + (View.DestRect.Bottom - View.DestRect.Top) / 2 / View.Zoom)));
     1132  View.SourceRect := Bounds(NewPoint.X, NewPoint.Y, Trunc((View.DestRect.Right - View.DestRect.Left) / View.Zoom),
     1133    Trunc((View.DestRect.Bottom - View.DestRect.Top) / View.Zoom));
     1134end;
    10851135
    10861136function TEngine.GetExistStationShapes: TStationShapeSet;
     
    16181668    LastNewStationTime := Time;
    16191669    Stations.AddNew;
    1620     // Need to see all stations on screen
    1621     View.SourceRect := RectEnlarge(Stations.GetRect, 70);
     1670    ResizeView;
    16221671  end;
    16231672
     
    16761725  LastMousePos := Position;
    16771726  if MouseHold then begin
    1678       FocusedStation := GetStationOnPos(Position);
     1727      FocusedStation := GetStationOnPos(View.PointDestToSrc(Position));
    16791728      Line := nil;
    16801729      if Assigned(TrackStationDown) then Line := TrackStationDown.Line;
     
    17281777        SelectedTrain.Line := nil;
    17291778      end;
    1730       FocusedTrack := GetTrackOnPos(Position);
     1779      FocusedTrack := GetTrackOnPos(View.PointDestToSrc(Position));
    17311780      if Assigned(FocusedTrack.PointDown) then begin
    17321781        SelectedTrain.Line := FocusedTrack.PointDown.Line;
     
    17811830
    17821831    // Train selection
    1783     SelectedTrain := GetTrainOnPos(Position);
     1832    SelectedTrain := GetTrainOnPos(View.PointDestToSrc(Position));
    17841833    if Assigned(SelectedTrain) then begin
    17851834      Exit;
     
    17951844
    17961845    // Line selection
    1797     Track := GetTrackOnPos(Position);
     1846    Track := GetTrackOnPos(View.PointDestToSrc(Position));
    17981847    if Assigned(Track) and Assigned(Track.PointDown) and Assigned(Track.PointUp) then begin
    17991848      SelectedLine := Track.PointDown.Line;
     
    18201869
    18211870    // New track creation from selected station as start
    1822     Station := GetStationOnPos(Position);
     1871    Station := GetStationOnPos(View.PointDestToSrc(Position));
    18231872    if Assigned(Station) then begin
    18241873      if Assigned(SelectedLine) and (SelectedLine.LineStations.Count = 0) then NewLine := SelectedLine
     
    18621911    Trains.Add(NewTrain);
    18631912  end;
     1913
     1914  ResizeView;
    18641915
    18651916  SelectedLine := nil;
     
    18911942  if FileExists(ImageLocomotiveName) then
    18921943    ImageLocomotive.Picture.LoadFromFile(ImageLocomotiveName);
     1944  MetaCanvas := TMetaCanvas.Create;
    18931945end;
    18941946
    18951947destructor TEngine.Destroy;
    18961948begin
     1949  MetaCanvas.Free;
    18971950  Trains.Free;
    18981951  ImageLocomotive.Free;
     
    19061959end;
    19071960
    1908 procedure TEngine.Paint(Canvas: TCanvas);
     1961procedure TEngine.Paint(TargetCanvas: TCanvas);
    19091962var
    19101963  I: Integer;
     
    19151968  Text: string;
    19161969  Angle: Double;
    1917   EndPoint: TPoint;
    19181970  PassengerPos: TPoint;
    19191971  Direction: Integer;
    19201972  Points: array of TPoint;
     1973  Canvas: TMetaCanvas;
    19211974const
    19221975  GameOverText = 'Game Over';
     
    19241977  GameOverStatistic = '%d passengers travelled on your metro over %d days.';
    19251978begin
    1926   Canvas.Brush.Color := $eff0e0;
    1927   Canvas.Brush.Style := bsSolid;
    1928   Canvas.Clear;
     1979  Canvas := MetaCanvas;
     1980  Canvas.SetSize(Point(TargetCanvas.Width, TargetCanvas.Height));
     1981  Canvas.Reset;
    19291982
    19301983  // Draw station passenger overload
     
    19882041    Canvas.Pen.Color := TrackStationDown.Line.Color;
    19892042    Canvas.MoveTo(TrackStationDown.LineStation.TrackPoint.Position);
    1990     DrawLine(Canvas, LastMousePos);
     2043    DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
    19912044  end;
    19922045  if Assigned(TrackStationUp) and Assigned(TrackStationUp.LineStation) then begin
    19932046    Canvas.Pen.Color := TrackStationUp.Line.Color;
    19942047    Canvas.MoveTo(TrackStationUp.LineStation.TrackPoint.Position);
    1995     DrawLine(Canvas, LastMousePos);
     2048    DrawLine(Canvas, View.PointDestToSrc(LastMousePos));
    19962049  end;
    19972050
     
    20062059      Canvas.Brush.Style := bsClear;
    20072060      Canvas.Pen.Color := SelectedLine.Color;
    2008       DrawShape(Canvas, Position, Shape, StationSize + Canvas.Pen.Width + 6, 0);
     2061      DrawShape(Canvas, Position, Shape, StationSize + Canvas.Pen.Width + 4, 0);
    20092062    end;
    20102063
     
    20462099  end;
    20472100
     2101  // Clear background
     2102  TargetCanvas.Brush.Color := $eff0e0;
     2103  TargetCanvas.Brush.Style := bsSolid;
     2104  TargetCanvas.Clear;
     2105
     2106  MetaCanvas.Move(Point(-View.SourceRect.Left, -View.SourceRect.Top));
     2107  MetaCanvas.Zoom(View.Zoom);
     2108
     2109  // Draw meta canvas to real target canvas
     2110  MetaCanvas.DrawTo(TargetCanvas);
     2111
    20482112  // Line selection
    20492113  for I := 0 to High(LineColors) do begin
    20502114    if Assigned(Lines.SearchByColor(LineColors[I])) then begin
    2051       Canvas.Brush.Color := LineColors[I];
     2115      TargetCanvas.Brush.Color := LineColors[I];
    20522116      Size := 15;
    20532117    end else begin
    2054       Canvas.Brush.Color := clSilver;
     2118      TargetCanvas.Brush.Color := clSilver;
    20552119      Size := 5;
    20562120    end;
    2057     Canvas.Pen.Color := clBlack;
     2121    TargetCanvas.Pen.Color := clBlack;
    20582122    if Assigned(SelectedLine) and (SelectedLine.Color = LineColors[I]) then begin
    2059       Canvas.Pen.Style := psSolid;
     2123      TargetCanvas.Pen.Style := psSolid;
    20602124    end else begin
    2061       Canvas.Pen.Style := psClear;
    2062     end;
    2063 
    2064     Canvas.EllipseC(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
    2065       Canvas.Height - LineColorsDist, Size, Size);
     2125      TargetCanvas.Pen.Style := psClear;
     2126    end;
     2127
     2128    TargetCanvas.EllipseC(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist + I * LineColorsDist,
     2129      TargetCanvas.Height - LineColorsDist, Size, Size);
    20662130  end;
    20672131
    20682132  // Draw unused trains
    20692133  Text := IntToStr(Trains.GetUnusedCount);
    2070   Canvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
    2071     Canvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap);
    2072   Canvas.Brush.Style := bsClear;
    2073   Canvas.TextOut(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - Canvas.TextWidth(Text),
    2074     Canvas.Height - LineColorsDist - Canvas.TextHeight(Text) div 2, Text);
    2075 
     2134  TargetCanvas.Draw(Canvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 100,
     2135    TargetCanvas.Height - LineColorsDist - ImageLocomotive.Picture.Bitmap.Height div 2, ImageLocomotive.Picture.Bitmap);
     2136  TargetCanvas.Brush.Style := bsClear;
     2137  TargetCanvas.TextOut(TargetCanvas.Width div 2 - Length(LineColors) div 2 * LineColorsDist - 50 - TargetCanvas.TextWidth(Text),
     2138    TargetCanvas.Height - LineColorsDist - TargetCanvas.TextHeight(Text) div 2, Text);
    20762139
    20772140  // Status interface
    20782141  Text := IntToStr(ServedPassengerCount);
    2079   Canvas.Draw(Canvas.Width - 140, 20, ImagePassenger.Picture.Bitmap);
    2080   Canvas.Brush.Style := bsClear;
    2081   Canvas.TextOut(Canvas.Width - 146 - Canvas.TextWidth(Text), 25, Text);
    2082 
    2083   DrawClock(Canvas);
    2084 
     2142  TargetCanvas.Draw(TargetCanvas.Width - 140, 20, ImagePassenger.Picture.Bitmap);
     2143  TargetCanvas.Brush.Style := bsClear;
     2144  TargetCanvas.TextOut(TargetCanvas.Width - 146 - TargetCanvas.TextWidth(Text), 25, Text);
     2145
     2146  DrawClock(TargetCanvas);
     2147
     2148  // Show grabbed train by mouse
    20852149  if Assigned(SelectedTrain) then begin
    2086     Canvas.Brush.Color := clBlack; //SelectedTrain.Line.Color;
    2087     Canvas.Brush.Style := bsSolid;
    2088     Canvas.Pen.Style := psClear;
     2150    TargetCanvas.Brush.Color := clBlack; //SelectedTrain.Line.Color;
     2151    TargetCanvas.Brush.Style := bsSolid;
     2152    TargetCanvas.Pen.Style := psClear;
    20892153    Pos := LastMousePos;
    20902154    Angle := 0;
     
    20952159    Points[2] := RotatePoint(Pos, Point(Pos.X + TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
    20962160    Points[3] := RotatePoint(Pos, Point(Pos.X - TrainSize div 2, Pos.Y + TrainSize div 3), Angle);
    2097     Canvas.Polygon(Points);
     2161    TargetCanvas.Polygon(Points);
    20982162  end;
    20992163
     
    21012165  if State = gsGameOver then
    21022166  begin
    2103     Canvas.Font.Size := 40;
    2104     Canvas.Font.Color := clBlack;
    2105     Canvas.TextOut((Canvas.Width - Canvas.TextWidth(GameOverText)) div 2, 100, GameOverText);
    2106     Canvas.Font.Size := 14;
    2107     Canvas.TextOut((Canvas.Width - Canvas.TextWidth(GameOverReason)) div 2, 160, GameOverReason);
     2167    TargetCanvas.Font.Size := 40;
     2168    TargetCanvas.Font.Color := clBlack;
     2169    TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(GameOverText)) div 2, 100, GameOverText);
     2170    TargetCanvas.Font.Size := 14;
     2171    TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(GameOverReason)) div 2, 160, GameOverReason);
    21082172    Text := Format(GameOverStatistic, [ServedPassengerCount, Trunc(Time)]);
    2109     Canvas.TextOut((Canvas.Width - Canvas.TextWidth(Text)) div 2, 180, Text);
     2173    TargetCanvas.TextOut((TargetCanvas.Width - TargetCanvas.TextWidth(Text)) div 2, 180, Text);
    21102174  end;
    21112175end;
  • trunk/UFormMain.lfm

    r28 r30  
    2222    OnMouseMove = PaintBox1MouseMove
    2323    OnMouseUp = PaintBox1MouseUp
     24    OnMouseWheelDown = PaintBox1MouseWheelDown
     25    OnMouseWheelUp = PaintBox1MouseWheelUp
    2426    OnPaint = PaintBox1Paint
    2527    OnResize = PaintBox1Resize
  • trunk/UFormMain.pas

    r28 r30  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    9   ExtCtrls, UEngine, LCLType;
     9  ExtCtrls, UEngine, LCLType, types;
    1010
    1111type
     
    2626    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
    2727      Shift: TShiftState; X, Y: Integer);
     28    procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
     29      MousePos: TPoint; var Handled: Boolean);
     30    procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
     31      MousePos: TPoint; var Handled: Boolean);
    2832    procedure PaintBox1Paint(Sender: TObject);
    2933    procedure PaintBox1Resize(Sender: TObject);
     
    6872  Randomize;
    6973  Engine.Map.Size := Point(PaintBox1.Width, PaintBox1.Height);
     74  Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
    7075  Engine.Reset;
    7176end;
     
    8792begin
    8893  Engine.MouseUp(Button, Point(X, Y));
     94end;
     95
     96procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
     97  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     98begin
     99  Engine.View.Zoom := Engine.View.Zoom * 1.2;
     100end;
     101
     102procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
     103  MousePos: TPoint; var Handled: Boolean);
     104begin
     105  Engine.View.Zoom := Engine.View.Zoom / 1.2;
    89106end;
    90107
  • trunk/UGeometric.pas

    r29 r30  
    2424function RectEquals(A, B: TRect): Boolean;
    2525function RectEnlarge(Rect: TRect; Value: Integer): TRect;
     26function ShiftRect(ARect: TRect; Delta: TPoint): TRect;
    2627
    2728implementation
     
    135136function RectEnlarge(Rect: TRect; Value: Integer): TRect;
    136137begin
    137   Rect.Left := Rect.Left - Value;
    138   Rect.Right := Rect.Right + Value;
    139   Rect.Top := Rect.Top - Value;
    140   Rect.Bottom := Rect.Bottom + Value;
     138  Result.Left := Rect.Left - Value;
     139  Result.Right := Rect.Right + Value;
     140  Result.Top := Rect.Top - Value;
     141  Result.Bottom := Rect.Bottom + Value;
     142end;
     143
     144function ShiftRect(ARect: TRect; Delta: TPoint): TRect;
     145begin
     146  Result := Rect(ARect.Left + Delta.X, ARect.Top + Delta.Y,
     147    ARect.Right + Delta.X, ARect.Bottom + Delta.Y);
    141148end;
    142149
  • trunk/UMetaCanvas.pas

    r29 r30  
    66
    77uses
    8   Classes, SysUtils, Graphics, Contnrs;
     8  Classes, SysUtils, Graphics, Contnrs, GraphMath, Types;
    99
    1010type
     11  TArrayOfPoint = array of TPoint;
    1112
    1213  { TCanvasObject }
     
    1415  TCanvasObject = class
    1516    procedure Paint(Canvas: TCanvas); virtual;
     17    procedure Zoom(Factor: Double); virtual;
     18    procedure Move(Delta: TPoint); virtual;
    1619  end;
    1720
     
    1922
    2023  TCanvasText = class(TCanvasObject)
     24    Brush: TBrush;
     25    Font: TFont;
    2126    Position: TPoint;
    2227    Text: string;
    2328    procedure Paint(Canvas: TCanvas); override;
     29    procedure Zoom(Factor: Double); override;
     30    procedure Move(Delta: TPoint); override;
     31    constructor Create;
     32    destructor Destroy; override;
     33  end;
     34
     35  { TCanvasRectangle }
     36
     37  TCanvasRectangle = class(TCanvasObject)
     38    Pen: TPen;
     39    Brush: TBrush;
     40    BoundingRect: TRect;
     41    procedure Paint(Canvas: TCanvas); override;
     42    procedure Zoom(Factor: Double); override;
     43    procedure Move(Delta: TPoint); override;
     44    constructor Create;
     45    destructor Destroy; override;
     46  end;
     47
     48  { TCanvasLine }
     49
     50  TCanvasLine = class(TCanvasObject)
     51    Pen: TPen;
     52    P1, P2: TPoint;
     53    procedure Paint(Canvas: TCanvas); override;
     54    procedure Zoom(Factor: Double); override;
     55    procedure Move(Delta: TPoint); override;
     56    constructor Create;
     57    destructor Destroy; override;
     58  end;
     59
     60  { TCanvasPolygon }
     61
     62  TCanvasPolygon = class(TCanvasObject)
     63    Pen: TPen;
     64    Brush: TBrush;
     65    Points: array of TPoint;
     66    procedure Paint(Canvas: TCanvas); override;
     67    procedure Zoom(Factor: Double); override;
     68    procedure Move(Delta: TPoint); override;
     69    constructor Create;
     70    destructor Destroy; override;
     71  end;
     72
     73  { TCanvasEllipse }
     74
     75  TCanvasEllipse = class(TCanvasObject)
     76    Pen: TPen;
     77    Brush: TBrush;
     78    BoundingRect: TRect;
     79    procedure Paint(Canvas: TCanvas); override;
     80    procedure Zoom(Factor: Double); override;
     81    procedure Move(Delta: TPoint); override;
     82    constructor Create;
     83    destructor Destroy; override;
     84  end;
     85
     86  { TCanvasPie }
     87
     88  TCanvasPie = class(TCanvasObject)
     89    Pen: TPen;
     90    Brush: TBrush;
     91    BoundingRect: TRect;
     92    StartPoint: TPoint;
     93    EndPoint: TPoint;
     94    procedure Paint(Canvas: TCanvas); override;
     95    procedure Zoom(Factor: Double); override;
     96    procedure Move(Delta: TPoint); override;
     97    constructor Create;
     98    destructor Destroy; override;
     99  end;
     100
     101  { TCanvasStretchDraw }
     102
     103  TCanvasStretchDraw = class(TCanvasObject)
     104    SrcGraphic: TGraphic;
     105    DestRect: TRect;
     106    procedure Paint(Canvas: TCanvas); override;
     107    procedure Zoom(Factor: Double); override;
     108    procedure Move(Delta: TPoint); override;
     109    constructor Create;
     110    destructor Destroy; override;
    24111  end;
    25112
     
    28115  TMetaCanvas = class(TCanvas)
    29116  private
    30 
     117    FSize: TPoint;
     118    FPenPos: TPoint;
     119  protected
     120    procedure SetHeight(AValue: Integer); override;
     121    function GetHeight: Integer; override;
     122    procedure SetWidth(AValue: Integer); override;
     123    function GetWidth: Integer; override;
     124    procedure DoLine (x1,y1,x2,y2:integer); override;
     125    procedure DoTextOut(X, Y: Integer; Text: string); override;
     126    procedure TextOut(X,Y: Integer; const Text: String); override;
     127    procedure DoRectangle(const Bounds: TRect); override;
     128    procedure DoRectangleFill(const Bounds: TRect); override;
     129    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;
     130    procedure DoPolygon(const Points: array of TPoint); override;
     131    procedure CreateHandle; override;
     132    procedure Ellipse(x1, y1, x2, y2: Integer); override;
     133    procedure DoEllipse(const Bounds: TRect); override;
     134    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
     135    function TextExtent(const Text: string): TSize; override;
     136    procedure DoMoveTo(X, Y: Integer); override;
     137    procedure DoLineTo(X, Y: Integer); override;
     138    procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
     139      StartX, StartY, EndX, EndY: Integer); override;
    31140  public
    32141    Objects: TObjectList;
     142    procedure SetSize(Size: TPoint);
    33143    procedure Reset;
    34144    procedure DrawTo(Canvas: TCanvas);
     145    procedure Zoom(Factor: Double);
     146    procedure Move(Delta: TPoint);
    35147    constructor Create;
    36148    destructor Destroy; override;
     
    39151implementation
    40152
     153uses
     154  UGeometric;
     155
     156{ TCanvasPie }
     157
     158procedure TCanvasPie.Paint(Canvas: TCanvas);
     159begin
     160  Canvas.Brush.Assign(Brush);
     161  Canvas.Pen.Assign(Pen);
     162  Canvas.Pie(BoundingRect.Left, BoundingRect.Top,
     163    BoundingRect.Right, BoundingRect.Bottom, StartPoint.X, StartPoint.Y,
     164    EndPoint.X, EndPoint.Y);
     165end;
     166
     167procedure TCanvasPie.Zoom(Factor: Double);
     168begin
     169  BoundingRect := Rect(Trunc(BoundingRect.Left * Factor),
     170    Trunc(BoundingRect.Top * Factor),
     171    Trunc(BoundingRect.Right * Factor),
     172    Trunc(BoundingRect.Bottom * Factor));
     173  Pen.Width := Trunc(Pen.Width * Factor);
     174  StartPoint := Point(Trunc(StartPoint.X * Factor), Trunc(StartPoint.Y * Factor));
     175  EndPoint := Point(Trunc(EndPoint.X * Factor), Trunc(EndPoint.Y * Factor));
     176end;
     177
     178procedure TCanvasPie.Move(Delta: TPoint);
     179begin
     180  BoundingRect := ShiftRect(BoundingRect, Delta);
     181  StartPoint := AddPoint(StartPoint, Delta);
     182  EndPoint := AddPoint(EndPoint, Delta);
     183end;
     184
     185constructor TCanvasPie.Create;
     186begin
     187  Pen := TPen.Create;
     188  Brush := TBrush.Create;
     189end;
     190
     191destructor TCanvasPie.Destroy;
     192begin
     193  Pen.Free;
     194  Brush.Free;
     195  inherited Destroy;
     196end;
     197
     198{ TCanvasStretchDraw }
     199
     200procedure TCanvasStretchDraw.Paint(Canvas: TCanvas);
     201begin
     202  Canvas.StretchDraw(DestRect, SrcGraphic);
     203end;
     204
     205procedure TCanvasStretchDraw.Zoom(Factor: Double);
     206begin
     207  DestRect := Rect(Trunc(DestRect.Left * Factor),
     208    Trunc(DestRect.Top * Factor),
     209    Trunc(DestRect.Right * Factor),
     210    Trunc(DestRect.Bottom * Factor));
     211end;
     212
     213procedure TCanvasStretchDraw.Move(Delta: TPoint);
     214begin
     215  DestRect := ShiftRect(DestRect, Delta);
     216end;
     217
     218constructor TCanvasStretchDraw.Create;
     219begin
     220  SrcGraphic := nil;
     221end;
     222
     223destructor TCanvasStretchDraw.Destroy;
     224begin
     225  inherited Destroy;
     226end;
     227
     228{ TCanvasEllipse }
     229
     230procedure TCanvasEllipse.Paint(Canvas: TCanvas);
     231begin
     232  Canvas.Pen.Assign(Pen);
     233  Canvas.Brush.Assign(Brush);
     234  Canvas.Ellipse(BoundingRect);
     235end;
     236
     237procedure TCanvasEllipse.Zoom(Factor: Double);
     238begin
     239  BoundingRect := Rect(Trunc(BoundingRect.Left * Factor),
     240    Trunc(BoundingRect.Top * Factor),
     241    Trunc(BoundingRect.Right * Factor),
     242    Trunc(BoundingRect.Bottom * Factor));
     243  Pen.Width := Trunc(Pen.Width * Factor);
     244end;
     245
     246procedure TCanvasEllipse.Move(Delta: TPoint);
     247begin
     248  BoundingRect := ShiftRect(BoundingRect, Delta);
     249end;
     250
     251constructor TCanvasEllipse.Create;
     252begin
     253  Pen := TPen.Create;
     254  Brush := TBrush.Create;
     255end;
     256
     257destructor TCanvasEllipse.Destroy;
     258begin
     259  Pen.Free;
     260  Brush.Free;
     261  inherited Destroy;
     262end;
     263
     264{ TCanvasPolygon }
     265
     266procedure TCanvasPolygon.Paint(Canvas: TCanvas);
     267begin
     268  Canvas.Pen.Assign(Pen);
     269  Canvas.Brush.Assign(Brush);
     270  Canvas.Polygon(Points);
     271end;
     272
     273procedure TCanvasPolygon.Zoom(Factor: Double);
     274var
     275  I: Integer;
     276begin
     277  for I := 0 to High(Points) do
     278    Points[I] := Point(Trunc(Points[I].X * Factor),
     279      Trunc(Points[I].Y * Factor));
     280  Pen.Width := Trunc(Pen.Width * Factor);
     281end;
     282
     283procedure TCanvasPolygon.Move(Delta: TPoint);
     284var
     285  I: Integer;
     286begin
     287  for I := 0 to High(Points) do
     288    Points[I] := AddPoint(Points[I], Delta);
     289end;
     290
     291constructor TCanvasPolygon.Create;
     292begin
     293  Pen := TPen.Create;
     294  Brush := TBrush.Create;
     295end;
     296
     297destructor TCanvasPolygon.Destroy;
     298begin
     299  Brush.Free;
     300  Pen.Free;
     301  inherited Destroy;
     302end;
     303
     304{ TCanvasLine }
     305
     306procedure TCanvasLine.Paint(Canvas: TCanvas);
     307begin
     308  Canvas.Pen.Assign(Pen);
     309  Canvas.Line(P1, P2);
     310end;
     311
     312procedure TCanvasLine.Zoom(Factor: Double);
     313begin
     314  P1 := Point(Trunc(P1.X * Factor), Trunc(P1.Y * Factor));
     315  P2 := Point(Trunc(P2.X * Factor), Trunc(P2.Y * Factor));
     316  Pen.Width := Trunc(Pen.Width * Factor);
     317end;
     318
     319procedure TCanvasLine.Move(Delta: TPoint);
     320begin
     321  P1 := AddPoint(P1, Delta);
     322  P2 := AddPoint(P2, Delta);
     323end;
     324
     325constructor TCanvasLine.Create;
     326begin
     327  Pen := TPen.Create;
     328end;
     329
     330destructor TCanvasLine.Destroy;
     331begin
     332  Pen.Free;
     333  inherited Destroy;
     334end;
     335
     336{ TCanvasRectangle }
     337
     338procedure TCanvasRectangle.Paint(Canvas: TCanvas);
     339begin
     340  Canvas.Pen.Assign(Pen);
     341  Canvas.Brush.Assign(Brush);
     342  Canvas.Rectangle(BoundingRect);
     343end;
     344
     345procedure TCanvasRectangle.Zoom(Factor: Double);
     346begin
     347  BoundingRect := Rect(Trunc(BoundingRect.Left * Factor),
     348    Trunc(BoundingRect.Top * Factor),
     349    Trunc(BoundingRect.Right * Factor),
     350    Trunc(BoundingRect.Bottom * Factor));
     351  Pen.Width := Trunc(Pen.Width * Factor);
     352end;
     353
     354procedure TCanvasRectangle.Move(Delta: TPoint);
     355begin
     356  ShiftRect(BoundingRect, Delta);
     357end;
     358
     359constructor TCanvasRectangle.Create;
     360begin
     361  Pen := TPen.Create;
     362  Brush := TBrush.Create;
     363end;
     364
     365destructor TCanvasRectangle.Destroy;
     366begin
     367  Pen.Free;
     368  Brush.Free;
     369  inherited Destroy;
     370end;
     371
    41372{ TCanvasText }
    42373
    43374procedure TCanvasText.Paint(Canvas: TCanvas);
    44375begin
     376  Canvas.Brush.Assign(Brush);
     377  Canvas.Font.Assign(Font);
    45378  Canvas.TextOut(Position.X, Position.Y, Text);
    46379end;
    47380
     381procedure TCanvasText.Zoom(Factor: Double);
     382begin
     383  Position := Point(Trunc(Position.X * Factor), Trunc(Position.Y * Factor));
     384  Font.Size := Trunc(Font.Size * Factor);
     385end;
     386
     387procedure TCanvasText.Move(Delta: TPoint);
     388begin
     389  Position := AddPoint(Position, Delta);
     390end;
     391
     392constructor TCanvasText.Create;
     393begin
     394  Font := TFont.Create;
     395  Brush := TBrush.Create;
     396end;
     397
     398destructor TCanvasText.Destroy;
     399begin
     400  Brush.Free;
     401  Font.Free;
     402  inherited Destroy;
     403end;
     404
    48405{ TCanvasObject }
    49406
     
    53410end;
    54411
     412procedure TCanvasObject.Zoom(Factor: Double);
     413begin
     414
     415end;
     416
     417procedure TCanvasObject.Move(Delta: TPoint);
     418begin
     419end;
     420
    55421{ TMetaCanvas }
     422
     423procedure TMetaCanvas.SetHeight(AValue: Integer);
     424begin
     425  FSize.Y := AValue;
     426end;
     427
     428function TMetaCanvas.GetHeight: Integer;
     429begin
     430  Result := FSize.Y;
     431end;
     432
     433procedure TMetaCanvas.SetWidth(AValue: Integer);
     434begin
     435  FSize.X := AValue;
     436end;
     437
     438function TMetaCanvas.GetWidth: Integer;
     439begin
     440  Result := FSize.X;
     441end;
     442
     443procedure TMetaCanvas.DoLine(x1, y1, x2, y2: integer);
     444var
     445  NewObj: TCanvasLine;
     446begin
     447  NewObj := TCanvasLine.Create;
     448  NewObj.Pen.Assign(Pen);
     449  NewObj.P1 := Point(X1, Y1);
     450  NewObj.P2 := Point(X2, Y2);
     451  Objects.Add(NewObj);
     452end;
     453
     454procedure TMetaCanvas.DoTextOut(X, Y: Integer; Text: string);
     455var
     456  NewObj: TCanvasText;
     457begin
     458  NewObj := TCanvasText.Create;
     459  NewObj.Font.Assign(Font);
     460  NewObj.Brush.Assign(Brush);
     461  NewObj.Position := Point(X, Y);
     462  NewObj.Text := Text;
     463  Objects.Add(NewObj);
     464end;
     465
     466procedure TMetaCanvas.TextOut(X, Y: Integer; const Text: String);
     467begin
     468  DoTextOut(X, Y, Text);
     469end;
     470
     471procedure TMetaCanvas.DoRectangle(const Bounds: TRect);
     472var
     473  NewObj: TCanvasRectangle;
     474begin
     475  NewObj := TCanvasRectangle.Create;
     476  NewObj.Pen.Assign(Pen);
     477  NewObj.BoundingRect := Bounds;
     478  Objects.Add(NewObj);
     479end;
     480
     481procedure TMetaCanvas.DoRectangleFill(const Bounds: TRect);
     482var
     483  NewObj: TCanvasRectangle;
     484begin
     485  NewObj := TCanvasRectangle.Create;
     486  NewObj.Brush.Assign(Brush);
     487  NewObj.Pen.Assign(Pen);
     488  NewObj.BoundingRect := Bounds;
     489  Objects.Add(NewObj);
     490end;
     491
     492procedure TMetaCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: boolean
     493  );
     494var
     495  APoints: array of TPoint;
     496  I: Integer;
     497begin
     498  SetLength(APoints, NumPts);
     499  for I := 0 to High(APoints) do
     500    APoints[I] := Points[I];
     501  DoPolygon(APoints);
     502end;
     503
     504procedure TMetaCanvas.DoPolygon(const Points: array of TPoint);
     505var
     506  NewObj: TCanvasPolygon;
     507  I: Integer;
     508begin
     509  NewObj := TCanvasPolygon.Create;
     510  NewObj.Brush.Assign(Brush);
     511  NewObj.Pen.Assign(Pen);
     512  SetLength(NewObj.Points, Length(Points));
     513  for I := 0 to High(Points) do
     514    NewObj.Points[I] := Points[I];
     515  Objects.Add(NewObj);
     516end;
     517
     518procedure TMetaCanvas.CreateHandle;
     519begin
     520end;
     521
     522procedure TMetaCanvas.Ellipse(x1, y1, x2, y2: Integer);
     523begin
     524  DoEllipse(Rect(X1, Y1, X2, Y2));
     525end;
     526
     527procedure TMetaCanvas.DoEllipse(const Bounds: TRect);
     528var
     529  NewObj: TCanvasEllipse;
     530begin
     531  NewObj := TCanvasEllipse.Create;
     532  NewObj.Brush.Assign(Brush);
     533  NewObj.Pen.Assign(Pen);
     534  NewObj.BoundingRect := Bounds;
     535  Objects.Add(NewObj);
     536end;
     537
     538procedure TMetaCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
     539var
     540  NewObj: TCanvasStretchDraw;
     541begin
     542  NewObj := TCanvasStretchDraw.Create;
     543  NewObj.SrcGraphic := SrcGraphic;
     544  NewObj.DestRect := DestRect;
     545  Objects.Add(NewObj);
     546end;
     547
     548function TMetaCanvas.TextExtent(const Text: string): TSize;
     549begin
     550  Result := Size(0, 0);
     551end;
     552
     553procedure TMetaCanvas.DoMoveTo(X, Y: Integer);
     554begin
     555  FPenPos := Point(X, Y);
     556end;
     557
     558procedure TMetaCanvas.DoLineTo(X, Y: Integer);
     559begin
     560  DoLine(FPenPos.X, FPenPos.Y, X, Y);
     561  DoMoveTo(X, Y);
     562end;
     563
     564procedure TMetaCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,
     565  StartY, EndX, EndY: Integer);
     566var
     567  NewObj: TCanvasPie;
     568begin
     569  NewObj := TCanvasPie.Create;
     570  NewObj.Brush.Assign(Brush);
     571  NewObj.Pen.Assign(Pen);
     572  NewObj.BoundingRect := Rect(EllipseX1, EllipseY1, EllipseX2, EllipseY2);
     573  NewObj.StartPoint := Point(StartX, StartY);
     574  NewObj.EndPoint := Point(EndX, EndY);
     575  Objects.Add(NewObj);
     576end;
     577
     578procedure TMetaCanvas.SetSize(Size: TPoint);
     579begin
     580  FSize := Size;
     581end;
    56582
    57583procedure TMetaCanvas.Reset;
     
    68594end;
    69595
     596procedure TMetaCanvas.Zoom(Factor: Double);
     597var
     598  I: Integer;
     599begin
     600  for I := 0 to Objects.Count - 1 do
     601    TCanvasObject(Objects[I]).Zoom(Factor);
     602end;
     603
     604procedure TMetaCanvas.Move(Delta: TPoint);
     605var
     606  I: Integer;
     607begin
     608  for I := 0 to Objects.Count - 1 do
     609    TCanvasObject(Objects[I]).Move(Delta);
     610end;
     611
    70612constructor TMetaCanvas.Create;
    71613begin
     614  inherited;
     615  FPenPos := Point(0, 0);
    72616  Objects := TObjectList.Create;
    73617end;
Note: See TracChangeset for help on using the changeset viewer.