lazarus-ccr/components/tvplanit/source/vpcanvasutils.pas

{*********************************************************} 
{*               VPCANVASUTILS.PAS 1.03                  *}
{*********************************************************}

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Visual PlanIt                              *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002        *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

{
  The drawing of Visual PlanIt controls supports rendering of the controls
  to arbitrary rectangles in a Canvas. In addition, the controls can be
  rendered rotated in 90 degree increments.

  Instead of rendering the VisualPlanIt control and then rotating it and
  translating it, the control is drawn taking account the translation and
  rotation.  This unit contains a helper class, TVpExCanvas that is used as
  a go-between for the component and the TCanvas that it needs to render
  itself to.

  The component will use members of the TVpExCanvas class to draw to the
  TCanvas.  This class will take the rotation and viewport (the rectangle
  in which the component should be rendered) into account and then draw
  the correct shape (line, text or whatever) to the canvas.

  There are three parameters of the TVpExCanvas class that must be
  initialized.  These are Angle, ViewPort and Canvas.  Angle specifies the
  rotation angle to use when drawing to the Canvas.  ViewPort specifies the
  rectangle in which all the drawing should take place.  Canvas is the
  TCanvas class to draw on.

  For the most part, methods in TVpExCanvas are analagous to methods in
  TCanvas.  There are some additional convenience methods to make dealing
  with the rotated canvas easier.

  In addition to the methods of the TVpExCanvas class, static methods are
  provided to access the TVpExCanvas functionality without having create
  and instance of the class.  This will use a built global TVpExCanvas that
  is created in the initialization section of this unit and destroyed in
  its finalization.

  -----------------------------------------------------------------------------

  VpCanvasUtils also contains an additional helper class, TVpLineWrapper.
  This class is used to wrap text within rectangles and irregularily shaped
  regions on a canvas.  This is used primarily by the TVpDayView component
  to draw multiline events (If icons are used in the TVpDayView, this is
  the class that wraps the text around the icons).

  The TVpLineWrapper class supports the rotation and viewport capablilities
  provided by the TVpExCanvas class.
  
  Like TVpExCanvas, static methods are provided to access the TVpLineWrapper
  functionality without having to explicitly create and destroy an instance
  of the class. 

}

{$I vp.inc}

unit VpCanvasUtils;

interface

uses
  {$IFDEF LCL}
  LCLProc, LCLType, LCLIntf, FileUtil,
  {$ELSE}
  Windows, //Messages,
  {$ENDIF}
  Classes, SysUtils, Graphics, Controls,
  VpException, VpSR, VpBase;

type
  TVpPaletteArray = array[0..255] of TPALETTEENTRY;

  { !!.01 Begin changes !!.01 }

  TVpExCanvas = class(TObject)
    private                                                              
      FAngle: TVpRotationAngle;
      FCanvas: TCanvas;
      FViewPort: TRect;

    protected                                                            
      procedure DrawRotatedText(x, y: Integer; Text: string; Rotate: Boolean);
      procedure Swap(var a, b: Integer);

    public                                                               
      constructor Create;                                                

      function NormalizeRectangle(const ARect: TRect): TRect;
      function RotatePoint(const APoint: TPoint): TPoint;
      function RotateRectangle(const ARect: TRect): TRect;
      function ViewportWidth: Integer;
      function ViewportHeight: Integer;
      function ViewportLeft: Integer;
      function ViewportRight: Integer;
      function ViewportTop: Integer;
      function ViewportBottom: Integer;
      procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
      procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
        const Source: TRect; AColor: TColor);
      procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
      procedure ClipRect(ARect: TRect);
      procedure CopyRect(Dest: TRect; Canvas: TCanvas; const Source: TRect);
      procedure Draw(X, Y: Integer; Graphic: TGraphic);
      procedure DrawFocusRect(const ARect: TRect);
      procedure Ellipse(X1, Y1, X2, Y2: Integer); overload;
      procedure Ellipse(const ARect: TRect); overload;
      procedure FillRect(const ARect: TRect);
      procedure FloodFill(X, Y: Integer; AColor: TColor; FillStyle: TFillStyle);
      procedure FrameRect(const ARect: TRect);
      procedure LineTo(X, Y: Integer);
      procedure MoveTo(X, Y: Integer);
      procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
      procedure PolyBezier(const Points: array of TPoint);
      procedure PolyBezierTo(const Points: array of TPoint);
      procedure Polygon(Points: array of TPoint);
      procedure Polyline(Points: array of TPoint);
      procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
      procedure Rectangle(const ARect: TRect); overload;
      procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
      procedure StretchDraw(const ARect: TRect; Graphic: TGraphic);
      procedure TextOut(X, Y: Integer; const Text: string);
      procedure TextRect(ARect: TRect; X, Y: Integer; const Text: string);
      function  GetPixel(const x, y: Integer): TColor;
      procedure SetPixel(x, y: Integer; AColor: TColor);
      procedure CenteredTextOut(ARect: TRect; const AText: string);
      procedure TextOutAtPoint(X, Y: Integer; const AText: string);
      function RGBToTColor(Red, Green, Blue: Byte): TColor;
      procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte);
      procedure CachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray);
      {
      function GetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
        x, y: Integer): TColor;
      procedure SetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
        x, y: Integer; AColor: TColor);
      }
      property Viewport: TRect read FViewport write FViewport;

    published
      property Angle : TVpRotationAngle read FAngle write FAngle default ra0;
      property Canvas : TCanvas read FCanvas write FCanvas;
  end;

  TVpOnFindWordBreak = procedure (Sender: TObject; AString: string;
    APosition: Integer; var IsBreak: Boolean) of object;

  TVpLineWrapper = class(TObject)
    private                                                              
      FAngle: TVpRotationAngle;
      FMinChars: Integer;
      FTextMargin: Integer;
      FOnFindWordBreak: TVpOnFindWordBreak;
      FViewPort: TRect;

    protected
      function FindEndingPos(ARegion: HRGN; LineSize, HPos, YPos: Integer): TPoint;
      function FindNextStartingPoint(ARegion: HRGN; LineSize: Integer;
        var HPos, YPos: Integer): Boolean;
      function FindWordBreaks(AString: string; CharPos: Integer): Integer;
      function FitStringInRect(ACanvas: TCanvas; RectWidth, AvgCharSize: Integer;
        var AString: string; var CharsOut: Integer): string;
      function GetAverageCharSize(ACanvas: TCanvas): Integer;
      function GetNextRectangle(ARegion: HRGN; LineSize, AvgCharSize: Integer;
        var HPos: Integer; var LinePos: Integer): TRect;
      function IsWordBreak(AString: string; CharPos: Integer): Boolean;
      function NextChar(AString: string; CharPos: Integer): Char;
      function PrevChar(AString: string; CharPos: Integer): Char;
      function ThisChar(AString: string; CharPos: Integer): Char;

    public                                                               
      constructor Create;                                                
      function RenderTextToCanvas(ACanvas: TCanvas; ARect: TRect;
        AString: string): Integer;
      function RenderTextToCanvasRegion(ACanvas: TCanvas; ARegion: HRGN;
        AString: string): Integer;

      property MinChars: Integer read FMinChars write FMinChars default 5;
      property TextMargin: Integer read FTextMargin write FTextMargin default 3;
      property Viewport: TRect read FViewport write FViewport;

    published
      property Angle: TVpRotationAngle read FAngle write FAngle default ra0;
      property OnFindWordBreak: TVpOnFindWordBreak read FOnFindWordBreak write FOnFindWordBreak;
  end;

function TPSNormalizeRectangle(const ARect: TRect): TRect;

function TPSRotatePoint(const Angle: TVpRotationAngle;
  const ViewPort: TRect; const APoint: TPoint): TPoint;

function TPSRotateRectangle(const Angle: TVpRotationAngle;
  const ViewPort: TRect; const ARect: TRect): TRect;

function TPSViewportWidth(const Angle: TVpRotationAngle; const ViewPort: TRect): Integer;
function TPSViewportHeight(const Angle: TVpRotationAngle; const ViewPort: TRect): Integer;
function TPSViewportLeft(const Angle: TVpRotationAngle; const ViewPort: TRect): Integer;
function TPSViewportRight(const Angle: TVpRotationAngle; const ViewPort: TRect): Integer;
function TPSViewportTop(const Angle: TVpRotationAngle; const ViewPort: TRect): Integer;
function TPSViewportBottom(const Angle: TVpRotationAngle; const ViewPort: TRect): Integer;

procedure TPSArc(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);

procedure TPSBrushCopy(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, Dest: TRect; Bitmap: TBitmap; const Source: TRect; AColor: TColor);

procedure TPSChord(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);

procedure TPSCopyRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, Dest: TRect; Canvas: TCanvas; const Source: TRect);

procedure TPSDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; Graphic: TGraphic);

procedure TPSDrawFocusRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);

procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2: Integer); overload;

procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect); overload;

procedure TPSFillRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);

procedure TPSFloodFill(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; AColor: TColor; FillStyle: TFillStyle);

procedure TPSFrameRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);

procedure TPSLineTo(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer);

procedure TPSMoveTo(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer);

procedure TPSPie(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);

procedure TPSPolyBezier(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const Points: array of TPoint);

procedure TPSPolyBezierTo(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const Points: array of TPoint);

procedure TPSPolygon(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; Points: array of TPoint);

procedure TPSPolyline(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; Points: array of TPoint);

procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2: Integer); overload;

procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect); overload;

procedure TPSRoundRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3: Integer);

procedure TPSStretchDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect; Graphic: TGraphic);

procedure TPSTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; const Text: string);

procedure TPSTextRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect; X, Y: Integer; const Text: string);

function  TPSGetPixel(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const x, y: Integer): TColor;

procedure TPSSetPixel(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; x, y: Integer; AColor: TColor);

procedure TPSCenteredTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect; const Text: string);

procedure TPSTextOutAtPoint(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; const Text: string);

function RGBToTColor(Red, Green, Blue: Byte): TColor;

procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte);

procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray);

{
function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
  x, y: Integer): TColor;

procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
  x, y: Integer; AColor: TColor);
}
function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const Viewport: TRect; ARect: TRect; AString: string): Integer;

function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const Viewport: TRect; ARegion: HRGN; AString: string): Integer;

{$IFDEF FPC}
procedure RotateBitmap(ABitmap: TBitmap; Angle: TVpRotationAngle);
{$ENDIF}


implementation

uses
 {$IFDEF FPC}
  IntfGraphics,
 {$ENDIF}
  VpMisc;

var
  VpRotatedCanvas: TVpExCanvas;
  VpTextRenderer: TVpLineWrapper;


{ Function based TVpExCanvas access }

procedure SetTVpExCanvasAV(const Angle: TVpRotationAngle; const Viewport: TRect);
begin
  VpRotatedCanvas.Angle := Angle;
  VpRotatedCanvas.Viewport := Viewport;
end;

procedure SetTVpExCanvasAVC(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect);
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  VpRotatedCanvas.Canvas := ACanvas;
end;

function TPSNormalizeRectangle(const ARect: TRect): TRect;
begin
  Result := VpRotatedCanvas.NormalizeRectangle(ARect);
end;

function TPSRotatePoint(const Angle: TVpRotationAngle; const ViewPort: TRect;
  const APoint: TPoint): TPoint;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.RotatePoint(APoint);
end;

function TPSRotateRectangle(const Angle: TVpRotationAngle;
  const ViewPort: TRect; const ARect: TRect): TRect;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.RotateRectangle(ARect);
end;

function TPSViewportWidth(const Angle: TVpRotationAngle;
  const ViewPort: TRect): Integer;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.ViewportWidth;
end;

function TPSViewportHeight(const Angle: TVpRotationAngle;
  const ViewPort: TRect): Integer;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.ViewportHeight;
end;

function TPSViewportLeft(const Angle: TVpRotationAngle;
  const ViewPort: TRect): Integer;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.ViewportLeft;
end;

function TPSViewportRight(const Angle: TVpRotationAngle;
  const ViewPort: TRect): Integer;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.ViewportRight;
end;

function TPSViewportTop(const Angle: TVpRotationAngle;
  const ViewPort: TRect): Integer;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.ViewportTop;
end;

function TPSViewportBottom(const Angle: TVpRotationAngle;
  const ViewPort: TRect): Integer;
begin
  SetTVpExCanvasAV(Angle, ViewPort);
  Result := VpRotatedCanvas.ViewportBottom;
end;

procedure TPSArc(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TPSBrushCopy(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const Dest: TRect; Bitmap: TBitmap; const Source: TRect;
  AColor: TColor);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.BrushCopy(Dest, Bitmap, Source, AColor);
end;

procedure TPSChord(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort : TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TPSCopyRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, Dest: TRect; Canvas: TCanvas; const Source: TRect);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.CopyRect(Dest, Canvas, Source);
end;

procedure TPSDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; Graphic: TGraphic);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Draw(X, Y, Graphic);
end;

procedure TPSDrawFocusRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.DrawFocusRect(ARect);
end;

procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect;  X1, Y1, X2, Y2: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Ellipse(X1, Y1, X2, Y2);
end;

procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Ellipse(ARect);
end;

procedure TPSFillRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.FillRect(ARect);
end;

procedure TPSFloodFill(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; AColor: TColor; FillStyle: TFillStyle);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.FloodFill(X, Y, AColor, FillStyle);
end;

procedure TPSFrameRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.FrameRect(ARect);
end;

procedure TPSLineTo(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.LineTo(X, Y);
end;

procedure TPSMoveTo(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.MoveTo(X, Y);
end;

procedure TPSPie(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TPSPolyBezier(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const Points: array of TPoint);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.PolyBezier(Points);
end;

procedure TPSPolyBezierTo(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const Points: array of TPoint);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.PolyBezierTo(Points);
end;

procedure TPSPolygon(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; Points: array of TPoint);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Polygon(Points);
end;

procedure TPSPolyline(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; Points: array of TPoint);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Polyline(Points);
end;

procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Rectangle(X1, Y1, X2, Y2);
end;

procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect); overload;
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.Rectangle(ARect);
end;

procedure TPSRoundRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3);
end;

procedure TPSStretchDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect; Graphic: TGraphic);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.StretchDraw(ARect, Graphic);
end;

procedure TPSTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; const Text: string);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.TextOut(X, Y, Text);
end;

procedure TPSTextRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect; X, Y: Integer; const Text: string);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.TextRect(ARect, X, Y, Text);
end;

function TPSGetPixel(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; const x, y: Integer): TColor;
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  Result := VpRotatedCanvas.GetPixel(x, y);
end;

procedure TPSSetPixel(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; x, y : Integer; AColor: TColor);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.SetPixel(x, y, AColor);
end;

procedure TPSCenteredTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort, ARect: TRect; const Text: string);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.CenteredTextOut(ARect, Text);
end;

procedure TPSTextOutAtPoint(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const ViewPort: TRect; X, Y: Integer; const Text: string);
begin
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  VpRotatedCanvas.TextOutAtPoint(X, Y, Text);
end;

function RGBToTColor(Red, Green, Blue: Byte) : TColor;
begin
  Result := VpRotatedCanvas.RGBToTColor(Red, Green, Blue);
end;

procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte);
begin
  VpRotatedCanvas.TColorToRGB(Color, Red, Green, Blue);
end;

procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray);
begin
  VpRotatedCanvas.CachePalette(ABitmap, PaletteEntries);
end;
{
function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
  x, y: Integer): TColor;
begin
  Result := VpRotatedCanvas.GetBmpPixel(ABitmap, PaletteCache, x, y);
end;

procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
  x, y: Integer; AColor: TColor);
begin
  VpRotatedCanvas.SetBmpPixel(ABitmap, PaletteCache, x, y, AColor);
end;
}
function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const Viewport: TRect; ARect: TRect; AString: string): Integer;
begin
  VpTextRenderer.Angle := Angle;
  VpTextRenderer.Viewport := Viewport;
  Result := VpTextRenderer.RenderTextToCanvas(ACanvas, ARect, AString);
end;

function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle;
  const Viewport: TRect; ARegion: HRGN; AString: string): Integer;
begin
  VpTextRenderer.Angle := Angle;
  VpTextRenderer.Viewport := Viewport;
  Result := VpTextRenderer.RenderTextToCanvasRegion(ACanvas, ARegion, AString);
end;


{ TVpExCanvas *************************************************************** }

constructor TVpExCanvas.Create;
begin
  inherited Create;

  FAngle := ra0;
  FViewPort := Rect(0, 0, 0, 0);
  FCanvas := nil;
end;

procedure TVpExCanvas.Swap(var a, b: Integer);
var
  t: Integer;
begin
  t := a;
  a := b;
  b := t;
end;

function TVpExCanvas.NormalizeRectangle(const ARect: TRect): TRect;
begin
  Result := ARect;
  if Result.Left > Result.Right then
    Swap(Result.Left, Result.Right);

  if Result.Top > Result.Bottom then
    Swap(Result.Top, Result.Bottom);
end;

function TVpExCanvas.RotatePoint(const APoint: TPoint): TPoint;
begin
  Result := APoint;
  case Angle of
    ra0   : Result := Point(APoint.X, APoint.Y);
    ra90  : Result := Point(ViewPort.Left + ViewPort.Right - APoint.Y, APoint.X);
    ra180 : Result := Point(ViewPort.Left + ViewPort.Right - APoint.X, ViewPort.Top + ViewPort.Bottom - APoint.Y);
    ra270 : Result := Point(APoint.Y, ViewPort.Top + ViewPort.Bottom - APoint.X);
  end;
end;

function TVpExCanvas.RotateRectangle(const ARect: TRect): TRect;
begin
  case Angle of
    ra0   : Result := Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
    ra90  : Result := Rect(
              Viewport.Left + Viewport.Right - ARect.Top,
              ARect.Left,
              Viewport.Left + Viewport.Right - ARect.Bottom,
              ARect.Right
            );
    ra180 : Result := Rect(
              ViewPort.Left + ViewPort.Right - ARect.Left,
              ViewPort.Top + ViewPort.Bottom - ARect.Top,
              ViewPort.Left + ViewPort.Right - ARect.Right,
              ViewPort.Top + ViewPort.Bottom - ARect.Bottom
            );
    ra270 : Result := Rect(
              ARect.Top,
              ViewPort.Top + ViewPort.Bottom - ARect.Left,
              ARect.Bottom,
              ViewPort.Top + ViewPort.Bottom - ARect.Right
            );
  end;
  Result := TPSNormalizeRectangle(Result);
end;

procedure TVpExCanvas.DrawRotatedText(x, y: Integer; Text: string;
  Rotate: Boolean);
var
  LF: TLogFont;
  OldFont: TFont;
  RealPoint: TPoint;
  OldBrushStyle: TBrushStyle;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FillChar(LF{%H-}, SizeOf(LF), #0);
  LF.lfHeight := FCanvas.Font.Height;
  LF.lfWidth :=  0;
  case Angle of
    ra0   : LF.lfEscapement:= 0;
    ra90  : LF.lfEscapement:= 2700;
    ra180 : LF.lfEscapement:= 1800;
    ra270 : LF.lfEscapement:= 900;
  end;
  LF.lfOrientation := 0;
  if fsBold in FCanvas.Font.Style then
    LF.lfWeight := FW_BOLD
  else
    LF.lfWeight := FW_NORMAL;
  LF.lfItalic := Byte(fsItalic in FCanvas.Font.Style);
  LF.lfUnderline := Byte(fsUnderline in FCanvas.Font.Style);
  LF.lfStrikeOut := Byte(fsStrikeOut in FCanvas.Font.Style);
  LF.lfCharSet := DEFAULT_CHARSET;
  LF.lfQuality := DEFAULT_QUALITY;
  if Length(FCanvas.Font.Name) <= 31 then                                
    StrCopy(LF.lfFaceName, PChar(FCanvas.Font.Name));                    
  {everything else as default}
  LF.lfOutPrecision := OUT_DEFAULT_PRECIS;
  LF.lfClipPrecision := CLIP_DEFAULT_PRECIS;
  case FCanvas.Font.Pitch of
    fpVariable : LF.lfPitchAndFamily := VARIABLE_PITCH or FF_DONTCARE;
    fpFixed    : LF.lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;
    else         LF.lfPitchAndFamily := DEFAULT_PITCH;
  end;

  // Store currently used font
  OldFont := TFont.Create;
  try
    OldFont.Assign(FCanvas.Font);

    // Create new font to use.
    FCanvas.Font.Handle := CreateFontIndirect(LF);

    // Output the text
    if Rotate then
      RealPoint := TPSRotatePoint(Angle, ViewPort, Point(x, y))
    else
      RealPoint := Point(x, y);
    OldBrushStyle := FCanvas.Brush.Style;       
    try
      FCanvas.Brush.Style := bsClear;
      FCanvas.TextOut(RealPoint.X, RealPoint.Y, Text);
    finally
      FCanvas.Brush.Style := OldBrushStyle;
    end;
  finally
    // Restore previously used font.
    FCanvas.Font.Assign(OldFont);
    OldFont.Free;
  end;
end;

function TVpExCanvas.ViewportWidth: Integer;
var
  FixRect: TRect;
begin
  FixRect := TPSNormalizeRectangle(ViewPort);
  case Angle of
    ra0,  ra180 : Result := FixRect.Right - FixRect.Left;
    ra90, ra270 : Result := FixRect.Bottom - FixRect.Top;
  else
    Result := FixRect.Right - FixRect.Left;
  end;
end;

function TVpExCanvas.ViewportHeight: Integer;
var
  FixRect: TRect;
begin
  FixRect := TPSNormalizeRectangle(ViewPort);
  case Angle of
    ra0,  ra180 : Result := FixRect.Bottom - FixRect.Top;
    ra90, ra270 : Result := FixRect.Right - FixRect.Left;
  else
    Result := FixRect.Bottom - FixRect.Top;
  end;
end;

function TVpExCanvas.ViewportLeft: Integer;
var
  FixRect: TRect;
begin
  FixRect := TPSNormalizeRectangle(ViewPort);
  case Angle of
    ra0,  ra180 : Result := FixRect.Left;
    ra90, ra270 : Result := FixRect.Top;
  else
    Result := FixRect.Left;
  end;
end;

function TVpExCanvas.ViewportRight: Integer;
var
  FixRect: TRect;
begin
  FixRect := TPSNormalizeRectangle(ViewPort);
  case Angle of
    ra0,  ra180 : Result := FixRect.Right;
    ra90, ra270 : Result := FixRect.Bottom;
  else
    Result := FixRect.Right;
  end;
end;

function TVpExCanvas.ViewportTop: Integer;
var
  FixRect: TRect;
begin
  FixRect := TPSNormalizeRectangle(ViewPort);
  case Angle of
    ra0,  ra180 : Result := FixRect.Top;
    ra90, ra270 : Result := FixRect.Left;
  else
    Result := FixRect.Top;
  end;
end;

function TVpExCanvas.ViewportBottom: Integer;
var
  FixRect: TRect;
begin
  FixRect := TPSNormalizeRectangle(ViewPort);
  case Angle of
    ra0,  ra180 : Result := FixRect.Bottom;
    ra90, ra270 : Result := FixRect.Right;
  else
    Result := FixRect.Bottom;
  end;
end;

procedure TVpExCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var
  P1 : TPoint;
  P2 : TPoint;
  P3 : TPoint;
  P4 : TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1));
  P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2));
  P3 := TPSRotatePoint(Angle, ViewPort, Point(X3, Y3));
  P4 := TPSRotatePoint(Angle, ViewPort, Point(X4, Y4));

  FCanvas.Arc(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y);
end;

procedure TVpExCanvas.BrushCopy(const Dest: TRect; Bitmap: TBitmap;
  const Source: TRect; AColor: TColor);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.BrushCopy(TPSRotateRectangle(Angle, ViewPort, Dest), Bitmap, Source, AColor);

//TODO:  FCanvas.BrushCopy(TPSRotateRectangle(Angle, ViewPort, Dest),
//                     Bitmap, Source, AColor);
end;

procedure TVpExCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var
  P1: TPoint;
  P2: TPoint;
  P3: TPoint;
  P4: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1));
  P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2));
  P3 := TPSRotatePoint(Angle, ViewPort, Point(X3, Y3));
  P4 := TPSRotatePoint(Angle, ViewPort, Point(X4, Y4));

  FCanvas.Chord(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y);
end;

procedure TVpExCanvas.ClipRect(ARect: TRect);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.ClipRect := TPSRotateRectangle(Angle, ViewPort, ARect);
end;

procedure TVpExCanvas.CopyRect(Dest: TRect; Canvas: TCanvas; const Source: TRect);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.CopyRect(TPSRotateRectangle(Angle, ViewPort, Dest), Canvas, Source);
end;

procedure TVpExCanvas.Draw(X, Y: Integer; Graphic: TGraphic);
var
  RealPoint: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  RealPoint := TPSRotatePoint(Angle, ViewPort, Point(X, Y));
  FCanvas.Draw(RealPoint.X, RealPoint.Y, Graphic);  // wp: I think the graphic itself is not rotated here!
end;

procedure TVpExCanvas.DrawFocusRect(const ARect: TRect);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.DrawFocusRect(TPSRotateRectangle(Angle, ViewPort, ARect));
end;

procedure TVpExCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
var
  P1: TPoint;
  P2: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1));
  P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2));

  FCanvas.Ellipse(P1.X, P1.Y, P2.X, P2.Y);
end;

procedure TVpExCanvas.Ellipse(const ARect: TRect);
{$IFNDEF VERSION5}
var
  R: TRect;
{$ENDIF}
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  {$IFDEF VERSION5}
  FCanvas.Ellipse(TPSRotateRectangle(Angle, ViewPort, ARect));
  {$ELSE}
  R := TPSRotateRectangle(Angle, ViewPort, ARect);
  FCanvas.Ellipse(R.Left, R.Top, R.Right, R.Bottom);
  {$ENDIF}
end;

procedure TVpExCanvas.FillRect(const ARect: TRect);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.FillRect(TPSRotateRectangle(Angle, ViewPort, ARect));
end;

procedure TVpExCanvas.FloodFill(X, Y: Integer; AColor: TColor;
  FillStyle: TFillStyle);
var
  RealPoint: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  RealPoint := TPSRotatePoint(Angle, ViewPort, Point(X, Y));
  FCanvas.FloodFill(RealPoint.X, RealPoint.Y, AColor, FillStyle);
end;

procedure TVpExCanvas.FrameRect(const ARect: TRect);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.FrameRect(TPSRotateRectangle(Angle, ViewPort, ARect));
end;

procedure TVpExCanvas.LineTo(X, Y: Integer);
var
  P: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P := TPSRotatePoint(Angle, ViewPort, Point(X, Y));
  FCanvas.LineTo(P.X, P.Y);
end;

procedure TVpExCanvas.MoveTo(X, Y: Integer);
var
  P: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P := TPSRotatePoint(Angle, ViewPort, Point(X, Y));
  FCanvas.MoveTo(P.X, P.Y);
end;

procedure TVpExCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var
  P1: TPoint;
  P2: TPoint;
  P3: TPoint;
  P4: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1));
  P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2));
  P3 := TPSRotatePoint(Angle, ViewPort, Point(X3, Y3));
  P4 := TPSRotatePoint(Angle, ViewPort, Point(X4, Y4));

  FCanvas.Pie(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y);
end;

procedure TVpExCanvas.PolyBezier(const Points: array of TPoint);
var
  i: Integer;
  P: array of TPoint = nil;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  SetLength(P, Length(Points));
  for i := 0 to Length(Points) - 1 do
    P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]);

  FCanvas.PolyBezier(P);
end;

procedure TVpExCanvas.PolyBezierTo(const Points: array of TPoint);
var
  i: Integer;
  P: array of TPoint = nil;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  SetLength(P, Length(Points));
  for i := 0 to Length(Points) - 1 do
    P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]);

//TODO:  FCanvas.PolyBezierTo(P);
end;

procedure TVpExCanvas.Polygon(Points: array of TPoint);
var
  i: Integer;
  P: array of TPoint = nil;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  SetLength(P, Length(Points));
  for i := 0 to Length(Points) - 1 do
    P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]);

  FCanvas.Polygon(P);
end;

procedure TVpExCanvas.Polyline(Points: array of TPoint);
var
  i: Integer;
  P: array of TPoint = nil;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  SetLength(P, Length(Points));
  for i := 0 to Length(Points) - 1 do
    P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]);

  FCanvas.Polyline(P);
end;

procedure TVpExCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
var
  P1: TPoint;
  P2: TPoint;

begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1));
  P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2));

  FCanvas.Rectangle(P1.X, P1.Y, P2.X, P2.Y);
end;

procedure TVpExCanvas.Rectangle(const ARect: TRect);
{$IFNDEF VERSION5}
var
  R: TRect;
{$ENDIF}
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  {$IFDEF VERSION5}
  FCanvas.Rectangle(TPSRotateRectangle(Angle, ViewPort, ARect));
  {$ELSE}
  R := TPSRotateRectangle(Angle, ViewPort, ARect);
  FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  {$ENDIF}
end;

procedure TVpExCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
var
  P1: TPoint;
  P2: TPoint;
  P3: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1));
  P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2));
  P3 := TPSRotatePoint(Angle, ViewPort, Point(X3, Y3));

  FCanvas.RoundRect(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y);
end;

procedure TVpExCanvas.StretchDraw(const ARect: TRect; Graphic: TGraphic);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  FCanvas.StretchDraw(TPSRotateRectangle(Angle, ViewPort, ARect), Graphic);
end;

procedure TVpExCanvas.TextOut(X, Y: Integer; const Text: string);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  DrawRotatedText(X, Y, Text, True);
end;

procedure TVpExCanvas.TextRect(ARect: TRect; X, Y: Integer; const Text: string);
begin
  Unused(ARect, X, Y);
  Unused(Text);
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);
end;

function  TVpExCanvas.GetPixel(const x, y: Integer): TColor;
var
  P: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P := TPSRotatePoint(Angle, ViewPort, Point(x, y));
  Result := FCanvas.Pixels[P.X, P.Y];
end;

procedure TVpExCanvas.SetPixel(x, y: Integer; AColor: TColor);
var
  P: TPoint;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  P := TPSRotatePoint(Angle, ViewPort, Point(x, y));
  FCanvas.Pixels[P.X, P.Y] := AColor;
end;

procedure TVpExCanvas.CenteredTextOut(ARect: TRect; const AText: string);
var
  TW: Integer;
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  TW := FCanvas.TextWidth(AText);
  if TW < ARect.Right - ARect.Left then
    ARect.Left := (ARect.Left + ARect.Right - TW) div 2;

  TPSTextOut(FCanvas, Angle, ViewPort, ARect.Left, ARect.Top, AText);
end;

procedure TVpExCanvas.TextOutAtPoint(X, Y: Integer; const AText: string);
begin
  if not Assigned(FCanvas) then
    raise EVpCanvasError.Create(RSNoCanvas);

  DrawRotatedText(X, Y, AText, False);
end;

function TVpExCanvas.RGBToTColor(Red, Green, Blue: Byte): TColor;
var
  RedPart, GreenPart, BluePart: Integer;
begin
  RedPart := Red;
  GreenPart := Green shl 8;
  BluePart := Blue shl 16;
  Result := $02000000 or RedPart or GreenPart or BluePart;
end;

procedure TVpExCanvas.TColorToRGB(Color: TColor; var Red, Green, Blue: Byte);
begin
  Red := Color and $0000ff;
  Green := (Color and $00ff00) shr 8;
  Blue := (Color and $ff0000) shr 16;
end;

procedure TVpExCanvas.CachePalette(ABitmap: TBitmap;
  var PaletteEntries: TVpPaletteArray);
var
  PaletteSize: Integer;
begin
  case ABitmap.PixelFormat of
    pfDevice : PaletteSize := 0;
    pf1bit   : PaletteSize := 2;
    pf4bit   : PaletteSize := 16;
    pf8bit   : PaletteSize := 256;
    pf15bit  : PaletteSize := 0;
    pf16bit  : PaletteSize := 0;
    pf24bit  : PaletteSize := 0;
    pf32bit  : PaletteSize := 0;
    pfCustom : PaletteSize := 0;
    else       PaletteSize := 0;
  end;

  if PaletteSize > 0  then
    GetPaletteEntries(ABitmap.Palette, 0, PaletteSize, PaletteEntries);
end;

(*
// Fast scanline based pixel access
function TVpExCanvas.GetBmpPixel(ABitmap: TBitmap;
  PaletteCache: TVpPaletteArray; x, y: Integer): TColor;
var
  ByteArray: PChar;
  WorkByte: Byte;
  WorkWord: Word;
  Red: Byte;
  Blue: Byte;
  Green: Byte;
begin
//TODO:
{
  if (x < 0) or (x >= ABitmap.Width) or
     (y < 0) or (y >= ABitmap.Height) then
    raise EVpCanvasError.Create(RSOutOfRange);

  case ABitmap.PixelFormat of
    pfDevice : begin
      raise EVpCanvasError.Create(RSNotSupported);
    end;

    pf1bit   : begin
      ByteArray := ABitmap.ScanLine[y];
      WorkByte := (Byte (ByteArray[x div 8]) shr (7 - (x mod 8))) and $01;
      Result := RGBToTColor(PaletteCache[WorkByte].peRed,
                            PaletteCache[WorkByte].peGreen,
                            PaletteCache[WorkByte].peBlue);
    end;

    pf4bit   : begin
      ByteArray := ABitmap.ScanLine[y];
      WorkByte := (Byte (ByteArray[x div 2]) shr (((x + 1) mod 2) * 4)) and $0F;
      Result := RGBToTColor(PaletteCache[WorkByte].peRed,
                            PaletteCache[WorkByte].peGreen,
                            PaletteCache[WorkByte].peBlue);
    end;

    pf8bit   : begin
      ByteArray := ABitmap.ScanLine[y];
      WorkByte := Byte(ByteArray[x]);
      Result := RGBToTColor(PaletteCache[WorkByte].peRed,
                            PaletteCache[WorkByte].peGreen,
                            PaletteCache[WorkByte].peBlue);
    end;

    pf15bit  : begin
      ByteArray := ABitmap.ScanLine[y];
      WorkWord := Byte(ByteArray[x * 2]) +
                  256 * Byte(ByteArray[(x * 2) + 1]);
      Red := ((WorkWord shr 10) and $1f) shl 3;
      Green := ((WorkWord shr 5) and $1f) shl 3;
      Blue := (WorkWord and $1f) shl 3;
      Result := RGBToTColor(Red, Green, Blue);
    end;

    pf16bit  : begin
      ByteArray := ABitmap.ScanLine[y];
      WorkWord := Byte(ByteArray[x * 2]) +
                  256 * Byte(ByteArray[(x * 2) + 1]);
      Red := ((WorkWord shr 11) and $1f) shl 3;
      Green := ((WorkWord shr 5) and $3f) shl 2;
      Blue := (WorkWord and $1f) shl 3;
      Result := RGBToTColor(Red, Green, Blue);
    end;

    pf24bit  : begin
      ByteArray := ABitmap.ScanLine[y];
      Result := RGBToTColor(Byte(ByteArray[x * 3 + 2]),
                            Byte(ByteArray[x * 3 + 1]),
                            Byte(ByteArray[x * 3]));
    end;

    pf32bit  : begin
      ByteArray := ABitmap.ScanLine[y];
      Result := RGBToTColor(Byte(ByteArray[x * 4 + 2]),
                            Byte(ByteArray[x * 4 + 1]),
                            Byte(ByteArray[x * 4]));
    end;
    pfCustom : begin
      raise EVpCanvasError.Create(RSNotSupported);
    end;
    else
      raise EVpCanvasError.Create(RSNotSupported);
  end;
}
end;
// Fast scanline based pixel access

procedure TVpExCanvas.SetBmpPixel(ABitmap: TBitmap;
  PaletteCache: TVpPaletteArray; x, y: Integer; AColor: TColor);
var
  BytePos: Integer;
  WorkByte: Byte;
  WorkWord: Word;
  ByteArray: PChar;
  PaletteIndex: Byte;
  Red: Byte;
  Green: Byte;
  Blue: Byte;
begin
//TODO:
{
  if (x < 0) or (x >= ABitmap.Width) or
     (y < 0) or (y >= ABitmap.Height) then
    Exit;

  case ABitmap.PixelFormat of
    pfDevice : begin
      raise EVpCanvasError.Create(RSNotSupported);
    end;

    pf1bit   : begin
      ByteArray := ABitmap.ScanLine[y];
      BytePos := x div 8;
      WorkByte := Byte(ByteArray[BytePos]);
      WorkByte := WorkByte and (not ($01 shl (7 - (x mod 8))));
      PaletteIndex := GetNearestPaletteIndex(ABitmap.Palette, AColor) and $01;
      WorkByte := WorkByte or (PaletteIndex shl (7 - (x mod 8)));
      ByteArray[BytePos] := Char(WorkByte);
    end;

    pf4bit   : begin
      ByteArray := ABitmap.ScanLine[y];
      BytePos := x div 2;
      WorkByte := Byte(ByteArray[BytePos]);
      WorkByte := WorkByte and (not ($0f shl (((x + 1) mod 2) * 4)));
      PaletteIndex := GetNearestPaletteIndex(ABitmap.Palette, AColor) and $0f;
      WorkByte := WorkByte or (PaletteIndex shl (((x + 1) mod 2) * 4));
      ByteArray[BytePos] := Char(WorkByte);
    end;

    pf8bit   : begin
      ByteArray := ABitmap.ScanLine[y];
      PaletteIndex := GetNearestPaletteIndex(ABitmap.Palette, AColor);
      ByteArray[x] := Char(PaletteIndex);
    end;

    pf15bit  : begin
      TColorToRGB(AColor, Red, Green, Blue);
      ByteArray := ABitmap.ScanLine[y];
      WorkWord := ((Red and $f8) shl 7) or
                  ((Green and $f8) shl 3) or
                  ((Blue and $f8) shr 3);
      ByteArray[x * 2] := Char(WorkWord and $ff);
      ByteArray[(x * 2) + 1] := Char((WorkWord shr 8) and $ff);;
    end;

    pf16bit  : begin
      TColorToRGB(AColor, Red, Green, Blue);
      ByteArray := ABitmap.ScanLine[y];
      WorkWord := ((Red and $f8) shl 8) or
                  ((Green and $fc) shl 3) or
                  ((Blue and $f8) shr 3);
      ByteArray[x * 2] := Char(WorkWord and $ff);
      ByteArray[(x * 2) + 1] := Char((WorkWord shr 8) and $ff);;
    end;

    pf24bit  : begin
      TColorToRGB(AColor, Red, Green, Blue);
      ByteArray := ABitmap.ScanLine[y];
      ByteArray[(x * 3) + 2] := Char(Red);
      ByteArray[(x * 3) + 1] := Char(Green);
      ByteArray[x * 3] := Char(Blue);
    end;

    pf32bit  : begin
      TColorToRGB(AColor, Red, Green, Blue);
      ByteArray := ABitmap.ScanLine[y];
      ByteArray[(x * 4) + 2] := Char(Red);
      ByteArray[(x * 4) + 1] := Char(Green);
      ByteArray[x * 4] := Char(Blue);
    end;

    pfCustom : begin
      raise EVpCanvasError.Create(RSNotSupported);
    end;
  end;
  }
end;
*)

{ TVpLineWrapper ************************************************************ }

constructor TVpLineWrapper.Create;
begin
  inherited Create;
  FTextMargin := 3;
  FMinChars := 5;
  FAngle := ra0;
  FViewPort := Rect(0, 0, 0, 0);
end;

function TVpLineWrapper.FindEndingPos(ARegion: HRGN;
  LineSize, HPos, YPos: Integer): TPoint;
var                                                                      
  WorkRect: TRect;
begin
  GetRgnBox(ARegion, @WorkRect);
  Result.x := HPos;
  Result.y := YPos;
  while (PtInRegion(ARegion, Result.x, Result.y)) and
        (PtInRegion(ARegion, Result.x, Result.y + LineSize)) and
        (Result.x < WorkRect.Right)
  do
    Inc(Result.x);
end;

function TVpLineWrapper.FindNextStartingPoint(ARegion: HRGN; LineSize: Integer;
  var HPos, YPos: Integer): Boolean;
var                                                                      
  WorkRect: TRect;
  Done: Boolean;
begin
  Result := False;
  Done := False;
  GetRgnBox(ARegion, @WorkRect);
  while not Done do begin
    if HPos > WorkRect.Right then begin 
      HPos := WorkRect.Left;
      Inc(YPos, LineSize);
      if YPos > WorkRect.Bottom then 
        Break;
    end;
    if (not PtInRegion(ARegion, HPos, YPos)) or
       (not PtInRegion(ARegion, HPos, YPos + LineSize)) then
    begin
      Inc(HPos);
      if HPos > WorkRect.Right then begin
        HPos := WorkRect.Left;
        Inc(YPos, LineSize);
        if YPos > WorkRect.Bottom then 
          Break;                                                         
      end;
    end else begin                                                       
      Result := True;                                                    
      Break;                                                             
    end;                                                                 
  end;
end;

function TVpLineWrapper.FindWordBreaks(AString: string;
  CharPos: Integer): Integer;
var                                                                      
  Done: Boolean;
  WorkPos: Integer;
begin                                                                    
  Done := False;
  WorkPos := CharPos;                                                    
  while not Done do begin                                                
    if IsWordBreak(AString, WorkPos) then
      Done := True                                                       
    else                                                                 
      Dec(WorkPos);
    if WorkPos = 0 then                                                  
      Done := True;                                                      
  end;
  if WorkPos > 0 then                                                    
    Result := WorkPos                                                    
  else                                                                   
    Result := CharPos;                                                   
end;                                                                     

function TVpLineWrapper.FitStringInRect(ACanvas: TCanvas; RectWidth: Integer;
  AvgCharSize: Integer; var AString: string; var CharsOut: Integer): string;
var                                                                      
  CharsToRender: Integer;
  L, R, M: Integer;
begin                                                                    
  if AvgCharSize > 0 then begin                                          
    { Guess at the number of characters that can fit on a line }         
    CharsToRender := RectWidth div AvgCharSize;                          

    if CharsToRender > 0 then begin                                      
      Result := Copy(AString, 1, CharsToRender);
      while (ACanvas.TextWidth(Result) < RectWidth) and
            (CharsToRender < Length(Result)) do
      begin
        Inc(CharsToRender);
        Result := Copy(AString, 1, CharsToRender);
      end;                                                               
      while (ACanvas.TextWidth(Result) > RectWidth) and
            (CharsToRender > 0) do
      begin
        Dec(CharsToRender);
        Result := Copy(AString, 1, CharsToRender);
      end;

      if CharsToRender >= Length(AString) then begin
        CharsOut := CharsToRender;                    
        AString := Trim(Copy(AString, CharsToRender + 1, Length(AString) - 1));
        Exit;
      end;

      CharsToRender := FindWordBreaks(AString, CharsToRender);
      Result := Copy(AString, 1, CharsToRender);
    end;                                                                        

    if CharsToRender > 0 then begin                                      
      AString := Copy(AString, CharsToRender + 1, Length(AString) - CharsToRender + 1);
    end else begin                                                       
      Result := Copy(AString, 1, 1);
      AString := Copy(AString, 2, Length(AString) - 1);
    end;                                                                 
  end else begin                                                         
    { Use binary search if the average character guess fails }           
    L := 1;                                                              
    R := Length(AString);
    M := 0;                                                              
    while L <= R do begin                                                
      M := (L + R) div 2;                                                
      Result := Copy(AString, 1, M);
      if (ACanvas.TextWidth(Result) < RectWidth) then
        L := Succ(M)
      else                                                               
        R := Pred(M);
      if M >= Length(AString) then begin
        CharsOut := Length(AString);
        AString := Trim(Copy(AString, M + 1, Length(AString) - 1));
        Exit;                                                            
      end;                                                               
    end;                                                                 
    CharsToRender := FindWordBreaks(AString, M);
    Result := Copy(AString, 1, CharsToRender);
    AString := Copy(AString, CharsToRender + 1, Length(AString) - 1);
  end;
  CharsOut := CharsToRender;                    
  Result := Trim(Result);
end;

function TVpLineWrapper.GetAverageCharSize(ACanvas: TCanvas): Integer;
var
  Metrics: TTextMetric;
  {$IFDEF LCL}
  bmp: TBitmap;
  {$ELSE}
  SavedFontHandle: THandle;
  DC: HDC;
  {$ENDIF}
begin
  {$IFDEF LCL}
  // The Delphi version crashes in cocoa.
  bmp := TBitmap.Create;
  try
    bmp.SetSize(10, 10);
    bmp.Canvas.Font.Assign(ACanvas.Font);
    GetTextMetrics(bmp.Canvas.Handle, Metrics);
    Result := Metrics.tmAveCharWidth;
  finally
    bmp.Free;
  end;
  {$ELSE}
  DC := GetDC(0);
  SavedFontHandle := SelectObject(DC, ACanvas.Font.Reference.Handle);
  try                                                                    
    GetTextMetrics(DC, Metrics{%H-});
    Result := Metrics.tmAveCharWidth;                                    
  finally                                                                
    SelectObject(DC, SavedFontHandle);
    ReleaseDC(0, DC);
  end;
  {$ENDIF}
end;                                                                     

function TVpLineWrapper.GetNextRectangle(ARegion: HRGN;
  LineSize, AvgCharSize: Integer; var HPos, LinePos: Integer): TRect;
var                                                                      
  EndPoint: TPoint;
  Done: Boolean;
begin                                                                    
  Result := Rect(0, 0, 0, 0);
  Done := False;
  while not Done do                                                      
    if FindNextStartingPoint(ARegion, LineSize, HPos, LinePos) then begin
      EndPoint := FindEndingPos(ARegion, LineSize, HPos, LinePos);
      if EndPoint.x - HPos > FMinChars * AvgCharSize then begin          
        Result := Rect(HPos, LinePos, EndPoint.x, EndPoint.y);
        Break;                                                           
      end else                                                           
        Inc(HPos);
    end else                                                             
      Break;                                                             
end;                                                                     

function TVpLineWrapper.IsWordBreak(AString: string; CharPos: Integer): Boolean;
var                                                                      
  NC, PC, C: Char;
begin                                                                    
  C := ThisChar(AString, CharPos);
  NC := NextChar(AString, CharPos);
  PC := PrevChar(AString, CharPos);
  Result := False;                                                       

  if C = '.' then begin
    if not (NC in ['0'..'9']) then                                       
      Result := True;                                                    
  end else if (C in [' ', #10, #13, #9]) then                            
    Result := True                                                       
  else if C = '-' then begin                                             
    if (PC in ['0'..'9', 'A'..'Z', 'a'..'z']) and
       (NC in ['0'..'9', 'A'..'Z', 'a'..'z']) then
      Result := True;                                                    
  end;                                                                   
  if Assigned(FOnFindWordBreak) then
    FOnFindWordBreak(Self, AString, CharPos, Result);
end;                                                                     

function TVpLineWrapper.NextChar(AString: string; CharPos: Integer): Char;
begin                                                                    
  if (CharPos >= 1) and (CharPos < Length(AString)) then
    Result := AString[CharPos + 1]                                       
  else                                                                   
    Result := #0;                                                        
end;

function TVpLineWrapper.PrevChar(AString: string; CharPos: Integer): Char;
begin
  if (CharPos > 1) and (CharPos <= Length(AString)) then
    Result := AString[CharPos - 1]                                       
  else                                                                   
    Result := #0;                                                        
end;                                                                     

function TVpLineWrapper.RenderTextToCanvas(ACanvas: TCanvas; ARect: TRect;
  AString: string): Integer;
var
  LineHeight: Integer;
  RectWidth: Integer;
  RectHeight: Integer;
  LinePos: Integer;
  AvgCharSize: Integer;
  Done: Boolean;
  CharsWritten: Integer;
begin                                                                    
  { Initialize stuff }
  Result := 0;
  CharsWritten := 0;
                                                     
  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);

  LineHeight := ACanvas.TextHeight('yY0');
  if Angle = ra0 then
    RectWidth := ARect.Right - ARect.Left - 2 * FTextMargin
  else
    RectWidth := VpRotatedCanvas.ViewportWidth;
  if Angle = ra0 then
    RectHeight := ARect.Bottom - ARect.Top
  else
    RectHeight := VpRotatedCanvas.ViewportHeight;
  LinePos := ARect.Top + FTextMargin;
  AvgCharSize := GetAverageCharSize(ACanvas);
  Done := False;

  if LineHeight > RectHeight then
    Exit;

  while not Done do begin
    if LinePos + LineHeight > ARect.Bottom then
      Break;

    if AString = '' then
      Break;

    VpRotatedCanvas.TextOut(ARect.Left + FTextMargin, LinePos,
      FitStringInRect(ACanvas, RectWidth, AvgCharSize, AString, CharsWritten)
    );
    Result := Result + CharsWritten;

    LinePos := LinePos + LineHeight + FTextMargin;
  end;
end;

function TVpLineWrapper.RenderTextToCanvasRegion(ACanvas: TCanvas;
  ARegion: HRGN; AString: string): Integer;
var
  LineHeight: Integer;
  RectHeight: Integer;
  LinePos: Integer;
  AvgCharSize: Integer;
  Done: Boolean;
  HPos: Integer;
  RegionRect: TRect;
  WorkRect: TRect;
  CharsWritten: Integer;
begin
  Result := 0;
  CharsWritten := 0;

  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
  GetRgnBox(ARegion, @RegionRect);

  LineHeight := ACanvas.TextHeight('yY0');
  if Angle = ra0 then
    RectHeight := RegionRect.Bottom - RegionRect.Top
  else
    RectHeight := VpRotatedCanvas.ViewportHeight;
  LinePos := RegionRect.Top + FTextMargin;
  HPos := RegionRect.Left + FTextMargin;
  AvgCharSize := GetAverageCharSize(ACanvas);
  Done := False;

  if LineHeight > RectHeight then
    Exit;

  while not Done do begin
    if LinePos + LineHeight > RegionRect.Bottom then 
      Break;

    if AString = '' then
      Break;

    WorkRect := GetNextRectangle(ARegion, LineHeight, AvgCharSize, HPos, linepos);
    if (WorkRect.Top = 0) and (WorkRect.left = 0) and (WorkRect.Bottom = 0) and (WorkRect.Right = 0) then
      break;
//      Workrect := Regionrect;
    if WorkRect.Right - WorkRect.Left > 0 then begin
      VpRotatedCanvas.TextOut(WorkRect.Left + FTextMargin, WorkRect.Top,
        FitStringInRect(ACanvas, WidthOf(WorkRect) - FTextMargin, AvgCharSize, AString, CharsWritten)
      );
      Result := Result + CharsWritten;
    end else
      Break;
    HPos := WorkRect.Right + 1;                                          
  end;                                                                   
end;                                                                     

function TVpLineWrapper.ThisChar(AString: string; CharPos: Integer): Char;
begin                                                                    
  if (CharPos >= 1) and (CharPos <= Length(AString)) then
    Result := AString[CharPos]                                           
  else                                                                   
    Result := #0;                                                        
end;                                                                     

{$IFDEF FPC}
procedure RotateBitmap(ABitmap: TBitmap; Angle: TVpRotationAngle);
Var
  bmp: TBitmap;
  tmpIntfImg2, tmpIntfImg: TLazIntfImage;
  imgHandle, imgMaskHandle: HBitmap;
  i, j: integer;
Begin
  if Angle = ra0 then
    exit;

  tmpIntfImg2 := TLazIntfImage.Create(0, 0);
  try
    bmp := TBitmap.Create;
    try
      tmpIntfImg := TLazIntfImage.Create(0, 0);
      try
        if Angle in [ra90, ra270] then begin
          bmp.Width := ABitmap.Height;
          bmp.Height := ABitmap.Width;
          tmpIntfImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
          tmpIntfImg2.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle);
          if Angle = ra90 then
            for i:=0 to ABitmap.Width-1 do
              for j:=0 to ABitmap.Height-1 do
                tmpIntfImg.Colors[ABitmap.Height-1-j, i] := tmpIntfImg2.Colors[i, j]
          else
            for i:=0 to ABitmap.Width-1 do
              for j:=0 to ABitmap.Height-1 do
                tmpIntfImg.Colors[j, ABitmap.Width-1-i] := tmpIntfImg2.Colors[i, j];
        end else
        if Angle = ra180 then begin
          bmp.Width := ABitmap.Width;
          bmp.Height := ABitmap.Height;
          tmpIntfImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
          tmpIntfImg2.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle);
          for i:=0 to ABitmap.Width-1 do
            for j:=0 to ABitmap.Height-1 do
              tmpIntfImg.Colors[ABitmap.Width-1-i, ABitmap.Height-1-j] := tmpIntfImg2.Colors[i, j];
        end;
        tmpIntfImg.CreateBitmaps(imgHandle, imgMaskHandle, false);
        bmp.Handle := ImgHandle;
        bmp.MaskHandle := ImgMaskHandle;
      finally
        tmpIntfImg.Free;
      end;
      ABitmap.Assign(bmp);
    finally
      bmp.Free;
    end;
  finally
    tmpIntfImg2.Free;
  end;
end;
{$ENDIF}


initialization                                                           
  VpRotatedCanvas := TVpExCanvas.Create;
  VpTextRenderer := TVpLineWrapper.Create;

finalization                                                             
  VpRotatedCanvas.Free;
  VpTextRenderer.Free;                              

{ !!.01 End changes !!.01 }

end.