diff --git a/components/tvplanit/source/vpcanvasutils.pas b/components/tvplanit/source/vpcanvasutils.pas index f7f47b319..3e5110027 100644 --- a/components/tvplanit/source/vpcanvasutils.pas +++ b/components/tvplanit/source/vpcanvasutils.pas @@ -83,7 +83,7 @@ interface uses {$IFDEF LCL} - LMessages,LCLProc,LCLType,LCLIntf,FileUtil, + LMessages, LCLProc, LCLType, LCLIntf, FileUtil, {$ELSE} Windows, //Messages, {$ENDIF} @@ -91,924 +91,664 @@ uses VpException, VpSR, VpBase; type - TVpPaletteArray = array [0..255] of TPALETTEENTRY; + TVpPaletteArray = array[0..255] of TPALETTEENTRY; { !!.01 Begin changes !!.01 } - TVpExCanvas = class (TObject) + TVpExCanvas = class(TObject) private - FAngle : TVpRotationAngle; - FCanvas : TCanvas; - FViewPort : TRect; + FAngle: TVpRotationAngle; + FCanvas: TCanvas; + FViewPort: TRect; protected - procedure DrawRotatedText (x, y : Integer; - Text : string; - Rotate : Boolean); - procedure Swap (var a, b : Integer); + 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 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 : Integer; - const y : Integer) : TColor; - procedure SetPixel (x : Integer; - y : Integer; - AColor : TColor); - procedure CenteredTextOut ( ARect : TRect; - const Text : string); - procedure TextOutAtPoint ( X, Y : Integer; - const Text : string); - function RGBToTColor (Red, Green, Blue : Byte) : TColor; - procedure TColorToRGB ( Color : TColor; - var Red : Byte; - var Green : Byte; - var Blue : Byte); - procedure CachePalette ( ABitmap : TBitmap; - var PaletteEntries : TVpPaletteArray); - function GetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer) : TColor; - procedure SetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer; - AColor : TColor); - - property Viewport : TRect read FViewport write FViewport; + 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 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 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; + TVpOnFindWordBreak = procedure (Sender: TObject; AString: string; + APosition: Integer; var IsBreak: Boolean) of object; - TVpLineWrapper = class (TObject) + TVpLineWrapper = class(TObject) private - FAngle : TVpRotationAngle; - FMinChars : Integer; - FTextMargin : Integer; - FOnFindWordBreak : TVpOnFindWordBreak; - FViewPort : TRect; + FAngle: TVpRotationAngle; + FMinChars: Integer; + FTextMargin: Integer; + FOnFindWordBreak: TVpOnFindWordBreak; + FViewPort: TRect; protected - function FindEndingPos (ARegion : HRGN; - LineSize : Integer; - HPos : Integer; - YPos : Integer) : TPoint; - function FindNextStartingPoint ( ARegion : HRGN; - LineSize : Integer; - var HPos : Integer; - var YPos : Integer) : Boolean; - function FindWordBreaks (AString : string; - CharPos : Integer) : Integer; - function FitStringInRect ( ACanvas : TCanvas; - RectWidth : Integer; - AvgCharSize : Integer; - var AString : string; - var CharsOut : Integer) : string; - function GetAverageCharSize (ACanvas : TCanvas) : Integer; - function GetNextRectangle ( ARegion : HRGN; - LineSize : Integer; - 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; + 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; - 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; + 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; + property Angle: TVpRotationAngle read FAngle write FAngle default ra0; + property OnFindWordBreak: TVpOnFindWordBreak read FOnFindWordBreak write FOnFindWordBreak; end; -function TPSNormalizeRectangle (const ARect : TRect) : TRect; +function TPSNormalizeRectangle(const ARect: TRect): TRect; -function TPSRotatePoint (const Angle : TVpRotationAngle; - const ViewPort : TRect; - const APoint : TPoint) : TPoint; +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 TPSRotateRectangle(const Angle: TVpRotationAngle; + const ViewPort: TRect; const ARect: TRect): TRect; -function TPSViewportWidth (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +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; -function TPSViewportHeight (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); -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 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 TPSArc ( 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 TPSBrushCopy ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const Dest : TRect; - Bitmap : TBitmap; - const Source : TRect; - AColor : TColor); +procedure TPSDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer; Graphic: TGraphic); -procedure TPSChord ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +procedure TPSDrawFocusRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); -procedure TPSCopyRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - Dest : TRect; - Canvas : TCanvas; - const Source : TRect); +procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X1, Y1, X2, Y2: Integer); overload; -procedure TPSDraw ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer; - Graphic : TGraphic); +procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); overload; -procedure TPSDrawFocusRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); +procedure TPSFillRect(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 TPSFloodFill(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer; AColor: TColor; FillStyle: TFillStyle); -procedure TPSEllipse ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); overload; +procedure TPSFrameRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); -procedure TPSFillRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); +procedure TPSLineTo(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer); -procedure TPSFloodFill ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer; - AColor : TColor; - FillStyle : TFillStyle); +procedure TPSMoveTo(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer); -procedure TPSFrameRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); +procedure TPSPie(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); -procedure TPSLineTo ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer); +procedure TPSPolyBezier(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; const Points: array of TPoint); -procedure TPSMoveTo ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer); +procedure TPSPolyBezierTo(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; const Points: array of TPoint); -procedure TPSPie ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +procedure TPSPolygon(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; Points: array of TPoint); -procedure TPSPolyBezier ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const Points : array of TPoint); +procedure TPSPolyline(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; Points: array of TPoint); -procedure TPSPolyBezierTo ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const Points : array of TPoint); +procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X1, Y1, X2, Y2: Integer); overload; -procedure TPSPolygon ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - Points : array of TPoint); +procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); overload; -procedure TPSPolyline ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - Points : array of TPoint); +procedure TPSRoundRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X1, Y1, X2, Y2, X3, Y3: Integer); -procedure TPSRectangle ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X1, Y1, X2, Y2 : Integer); overload; +procedure TPSStretchDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect; Graphic: TGraphic); -procedure TPSRectangle ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); overload; +procedure TPSTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer; const Text: string); -procedure TPSRoundRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X1, Y1, X2, Y2, X3, Y3 : Integer); +procedure TPSTextRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect; X, Y: Integer; const Text: string); -procedure TPSStretchDraw ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect; - Graphic : TGraphic); +function TPSGetPixel(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; const x, y: Integer): TColor; -procedure TPSTextOut ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer; - const Text : string); +procedure TPSSetPixel(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; x, y: Integer; AColor: TColor); -procedure TPSTextRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - ARect : TRect; - X, Y : Integer; - const Text : string); +procedure TPSCenteredTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect; const Text: string); -function TPSGetPixel ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const x : Integer; - const y : Integer) : TColor; +procedure TPSTextOutAtPoint(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer; const Text: string); -procedure TPSSetPixel ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - x : Integer; - y : Integer; - AColor : TColor); +function RGBToTColor(Red, Green, Blue: Byte): TColor; -procedure TPSCenteredTextOut ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - ARect : TRect; - const Text : string); +procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte); -procedure TPSTextOutAtPoint ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer; - const Text : string); +procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray); -function RGBToTColor (Red, Green, Blue : Byte) : TColor; +function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; + x, y: Integer): TColor; -procedure TColorToRGB ( Color : TColor; - var Red : Byte; - var Green : Byte; - var Blue : Byte); +procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; + x, y: Integer; AColor: TColor); -procedure TPSCachePalette (ABitmap : TBitmap; - var PaletteEntries : TVpPaletteArray); +function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const Viewport: TRect; ARect: TRect; AString: string): Integer; -function TPSGetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer) : TColor; +function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const Viewport: TRect; ARegion: HRGN; AString: string): Integer; -procedure TPSSetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - 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; implementation +uses + VpMisc; + var - VpRotatedCanvas : TVpExCanvas; - VpTextRenderer : TVpLineWrapper; + VpRotatedCanvas: TVpExCanvas; + VpTextRenderer: TVpLineWrapper; -{ Function based TVpExCanvas Access ***************************************** } -procedure SetTVpExCanvasAV (const Angle : TVpRotationAngle; - const Viewport : TRect); +{ 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); +procedure SetTVpExCanvasAVC(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect); begin - SetTVpExCanvasAV (Angle, ViewPort); + SetTVpExCanvasAV(Angle, ViewPort); VpRotatedCanvas.Canvas := ACanvas; end; -function TPSNormalizeRectangle (const ARect : TRect) : TRect; +function TPSNormalizeRectangle(const ARect: TRect): TRect; begin - Result := VpRotatedCanvas.NormalizeRectangle (ARect); + Result := VpRotatedCanvas.NormalizeRectangle(ARect); end; -function TPSRotatePoint (const Angle : TVpRotationAngle; - const ViewPort : TRect; - const APoint : TPoint) : TPoint; +function TPSRotatePoint(const Angle: TVpRotationAngle; const ViewPort: TRect; + const APoint: TPoint): TPoint; begin - SetTVpExCanvasAV (Angle, ViewPort); - Result := VpRotatedCanvas.RotatePoint (APoint); + SetTVpExCanvasAV(Angle, ViewPort); + Result := VpRotatedCanvas.RotatePoint(APoint); end; -function TPSRotateRectangle (const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect) : TRect; +function TPSRotateRectangle(const Angle: TVpRotationAngle; + const ViewPort: TRect; const ARect: TRect): TRect; begin - SetTVpExCanvasAV (Angle, ViewPort); - Result := VpRotatedCanvas.RotateRectangle (ARect); + SetTVpExCanvasAV(Angle, ViewPort); + Result := VpRotatedCanvas.RotateRectangle(ARect); end; -function TPSViewportWidth (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +function TPSViewportWidth(const Angle: TVpRotationAngle; + const ViewPort: TRect): Integer; begin - SetTVpExCanvasAV (Angle, ViewPort); + SetTVpExCanvasAV(Angle, ViewPort); Result := VpRotatedCanvas.ViewportWidth; end; -function TPSViewportHeight (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +function TPSViewportHeight(const Angle: TVpRotationAngle; + const ViewPort: TRect): Integer; begin - SetTVpExCanvasAV (Angle, ViewPort); + SetTVpExCanvasAV(Angle, ViewPort); Result := VpRotatedCanvas.ViewportHeight; end; -function TPSViewportLeft (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +function TPSViewportLeft(const Angle: TVpRotationAngle; + const ViewPort: TRect): Integer; begin - SetTVpExCanvasAV (Angle, ViewPort); + SetTVpExCanvasAV(Angle, ViewPort); Result := VpRotatedCanvas.ViewportLeft; end; -function TPSViewportRight (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +function TPSViewportRight(const Angle: TVpRotationAngle; + const ViewPort: TRect): Integer; begin - SetTVpExCanvasAV (Angle, ViewPort); + SetTVpExCanvasAV(Angle, ViewPort); Result := VpRotatedCanvas.ViewportRight; end; -function TPSViewportTop (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +function TPSViewportTop(const Angle: TVpRotationAngle; + const ViewPort: TRect): Integer; begin - SetTVpExCanvasAV (Angle, ViewPort); + SetTVpExCanvasAV(Angle, ViewPort); Result := VpRotatedCanvas.ViewportTop; end; -function TPSViewportBottom (const Angle : TVpRotationAngle; - const ViewPort : TRect) : Integer; +function TPSViewportBottom(const Angle: TVpRotationAngle; + const ViewPort: TRect): Integer; begin - SetTVpExCanvasAV (Angle, ViewPort); + 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); +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); + 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); +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); + 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); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4); end; -procedure TPSCopyRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - Dest : TRect; - Canvas : TCanvas; - const Source : TRect); +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); + 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); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Draw(X, Y, Graphic); end; -procedure TPSDrawFocusRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); +procedure TPSDrawFocusRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.DrawFocusRect (ARect); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.DrawFocusRect(ARect); end; -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: TRect; X1, Y1, X2, Y2: Integer); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.Ellipse (X1, Y1, X2, Y2); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Ellipse(X1, Y1, X2, Y2); end; -procedure TPSEllipse ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); overload; +procedure TPSEllipse(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.Ellipse (ARect); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Ellipse(ARect); end; -procedure TPSFillRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); +procedure TPSFillRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.FillRect (ARect); + 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); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.FloodFill(X, Y, AColor, FillStyle); end; -procedure TPSFrameRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); +procedure TPSFrameRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.FrameRect (ARect); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.FrameRect(ARect); end; -procedure TPSLineTo ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer); +procedure TPSLineTo(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.LineTo (X, Y); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.LineTo(X, Y); end; -procedure TPSMoveTo ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - X, Y : Integer); +procedure TPSMoveTo(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; X, Y: Integer); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.MoveTo (X, Y); + 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); +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); + 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); +procedure TPSPolyBezier(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; const Points: array of TPoint); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.PolyBezier (Points); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.PolyBezier(Points); end; -procedure TPSPolyBezierTo ( 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); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.PolyBezierTo (Points); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.PolyBezierTo(Points); end; -procedure TPSPolygon ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - Points : array of TPoint); +procedure TPSPolygon(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort: TRect; Points: array of TPoint); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.Polygon (Points); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Polygon(Points); end; -procedure TPSPolyline ( 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); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.Polyline (Points); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Polyline(Points); end; -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: TRect; X1, Y1, X2, Y2: Integer); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.Rectangle (X1, Y1, X2, Y2); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.Rectangle(X1, Y1, X2, Y2); end; -procedure TPSRectangle ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect); overload; +procedure TPSRectangle(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect); overload; begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.Rectangle (ARect); + 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); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3); end; -procedure TPSStretchDraw ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const ARect : TRect; - Graphic : TGraphic); +procedure TPSStretchDraw(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect; Graphic: TGraphic); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.StretchDraw (ARect, Graphic); + 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); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.TextOut(X, Y, Text); end; -procedure TPSTextRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - ARect : TRect; - X, Y : Integer; - const Text : string); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.TextRect(ARect, X, Y, Text); end; -function TPSGetPixel ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - const x : Integer; - const y : Integer) : TColor; +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + Result := VpRotatedCanvas.GetPixel(x, y); end; -procedure TPSSetPixel ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - x : Integer; - y : Integer; - AColor : TColor); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.SetPixel(x, y, AColor); end; -procedure TPSCenteredTextOut ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const ViewPort : TRect; - ARect : TRect; - const Text : string); +procedure TPSCenteredTextOut(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const ViewPort, ARect: TRect; const Text: string); begin - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - VpRotatedCanvas.CenteredTextOut (ARect, Text); + 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); +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); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + VpRotatedCanvas.TextOutAtPoint(X, Y, Text); end; -function RGBToTColor (Red, Green, Blue : Byte) : TColor; +function RGBToTColor(Red, Green, Blue: Byte) : TColor; begin - Result := VpRotatedCanvas.RGBToTColor (Red, Green, Blue); + Result := VpRotatedCanvas.RGBToTColor(Red, Green, Blue); end; -procedure TColorToRGB ( Color : TColor; - var Red : Byte; - var Green : Byte; - var Blue : Byte); +procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte); begin - VpRotatedCanvas.TColorToRGB (Color, Red, Green, Blue); + VpRotatedCanvas.TColorToRGB(Color, Red, Green, Blue); end; -procedure TPSCachePalette ( ABitmap : TBitmap; - var PaletteEntries : TVpPaletteArray); +procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray); begin - VpRotatedCanvas.CachePalette (ABitmap, PaletteEntries); + VpRotatedCanvas.CachePalette(ABitmap, PaletteEntries); end; -function TPSGetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer) : TColor; +function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; + x, y: Integer): TColor; begin - Result := VpRotatedCanvas.GetBmpPixel (ABitmap, PaletteCache, x, y); + Result := VpRotatedCanvas.GetBmpPixel(ABitmap, PaletteCache, x, y); end; -procedure TPSSetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer; - AColor : TColor); +procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; + x, y: Integer; AColor: TColor); begin - VpRotatedCanvas.SetBmpPixel (ABitmap, PaletteCache, x, y, AColor); + VpRotatedCanvas.SetBmpPixel(ABitmap, PaletteCache, x, y, AColor); end; -function RenderTextToRect ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const Viewport : TRect; - ARect : TRect; - AString : string) : Integer; +function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const Viewport: TRect; ARect: TRect; AString: string): Integer; begin - VpTextRenderer.Angle := Angle; + VpTextRenderer.Angle := Angle; VpTextRenderer.Viewport := Viewport; - Result := VpTextRenderer.RenderTextToCanvas (ACanvas, ARect, AString); + Result := VpTextRenderer.RenderTextToCanvas(ACanvas, ARect, AString); end; -function RenderTextToRegion ( ACanvas : TCanvas; - const Angle : TVpRotationAngle; - const Viewport : TRect; - ARegion : HRGN; - AString : string) : Integer; +function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle; + const Viewport: TRect; ARegion: HRGN; AString: string): Integer; begin - VpTextRenderer.Angle := Angle; + VpTextRenderer.Angle := Angle; VpTextRenderer.Viewport := Viewport; - Result := VpTextRenderer.RenderTextToCanvasRegion (ACanvas, ARegion, - AString); + Result := VpTextRenderer.RenderTextToCanvasRegion(ACanvas, ARegion, AString); end; + { TVpExCanvas *************************************************************** } constructor TVpExCanvas.Create; begin inherited Create; - FAngle := ra0; - FViewPort := Rect (0, 0, 0, 0); - FCanvas := nil; + FAngle := ra0; + FViewPort := Rect(0, 0, 0, 0); + FCanvas := nil; end; -procedure TVpExCanvas.Swap (var a, b : Integer); +procedure TVpExCanvas.Swap(var a, b: Integer); var - t : Integer; - + t: Integer; begin t := a; a := b; b := t; end; -function TVpExCanvas.NormalizeRectangle (const ARect : TRect) : TRect; +function TVpExCanvas.NormalizeRectangle(const ARect: TRect): TRect; begin Result := ARect; if Result.Left > Result.Right then - Swap (Result.Left, Result.Right); + Swap(Result.Left, Result.Right); - if Result .Top > Result.Bottom then - Swap (Result.Top, Result.Bottom); + if Result.Top > Result.Bottom then + Swap(Result.Top, Result.Bottom); end; -function TVpExCanvas.RotatePoint (const APoint : TPoint) : TPoint; +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); + 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; +function TVpExCanvas.RotateRectangle(const ARect: TRect): TRect; begin - Result := ARect; - case Angle of - ra0 : - Result := TPSNormalizeRectangle (Rect (ARect.Left, - ARect.Top, - ARect.Right, - ARect.Bottom)); - - ra90 : - Result := TPSNormalizeRectangle (Rect (ViewPort.Left + ViewPort.Right - ARect.Top, - ARect.Left, - ViewPort.Left + ViewPort.Right - ARect.Bottom, - ARect.Right)); - - ra180 : - Result := TPSNormalizeRectangle (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 := TPSNormalizeRectangle (Rect (ARect.Top, - ViewPort.Top + ViewPort.Bottom - ARect.Left, - ARect.Bottom, - ViewPort.Top + ViewPort.Bottom - ARect.Right)); + 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); - +procedure TVpExCanvas.DrawRotatedText(x, y: Integer; Text: string; + Rotate: Boolean); var - LF : TLogFont; - OldFont : TFont; - RealPoint : TPoint; - OldBrushStyle : TBrushStyle; - + LF: TLogFont; + OldFont: TFont; + RealPoint: TPoint; + OldBrushStyle: TBrushStyle; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - FillChar (LF, SizeOf (LF), #0); - - LF.lfHeight := FCanvas.Font.Height; - LF.lfWidth := 0; + FillChar(LF, 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; + LF.lfOrientation := 0; if fsBold in FCanvas.Font.Style then - LF.lfWeight := FW_BOLD + 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; + 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; + 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; @@ -1016,20 +756,20 @@ begin LF.lfPitchAndFamily := DEFAULT_PITCH; end; -// Create new font to use + // Create new font to use OldFont := FCanvas.Font; try - FCanvas.Font.Handle:= CreateFontIndirect (LF); + FCanvas.Font.Handle:= CreateFontIndirect(LF); -// Output the text + // Output the text if Rotate then - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (x, y)) + RealPoint := TPSRotatePoint(Angle, ViewPort, Point(x, y)) else - RealPoint := Point (x, y); + RealPoint := Point(x, y); OldBrushStyle := FCanvas.Brush.Style; try FCanvas.Brush.Style := bsClear; - FCanvas.TextOut (RealPoint.X, RealPoint.Y, Text); + FCanvas.TextOut(RealPoint.X, RealPoint.Y, Text); finally FCanvas.Brush.Style := OldBrushStyle; end; @@ -1038,12 +778,11 @@ begin end; end; -function TVpExCanvas.ViewportWidth : Integer; +function TVpExCanvas.ViewportWidth: Integer; var - FixRect : TRect; - + FixRect: TRect; begin - FixRect := TPSNormalizeRectangle (ViewPort); + FixRect := TPSNormalizeRectangle(ViewPort); case Angle of ra0, ra180 : Result := FixRect.Right - FixRect.Left; ra90, ra270 : Result := FixRect.Bottom - FixRect.Top; @@ -1052,12 +791,11 @@ begin end; end; -function TVpExCanvas.ViewportHeight : Integer; +function TVpExCanvas.ViewportHeight: Integer; var - FixRect : TRect; - + FixRect: TRect; begin - FixRect := TPSNormalizeRectangle (ViewPort); + FixRect := TPSNormalizeRectangle(ViewPort); case Angle of ra0, ra180 : Result := FixRect.Bottom - FixRect.Top; ra90, ra270 : Result := FixRect.Right - FixRect.Left; @@ -1066,12 +804,11 @@ begin end; end; -function TVpExCanvas.ViewportLeft : Integer; +function TVpExCanvas.ViewportLeft: Integer; var - FixRect : TRect; - + FixRect: TRect; begin - FixRect := TPSNormalizeRectangle (ViewPort); + FixRect := TPSNormalizeRectangle(ViewPort); case Angle of ra0, ra180 : Result := FixRect.Left; ra90, ra270 : Result := FixRect.Top; @@ -1080,12 +817,11 @@ begin end; end; -function TVpExCanvas.ViewportRight : Integer; +function TVpExCanvas.ViewportRight: Integer; var - FixRect : TRect; - + FixRect: TRect; begin - FixRect := TPSNormalizeRectangle (ViewPort); + FixRect := TPSNormalizeRectangle(ViewPort); case Angle of ra0, ra180 : Result := FixRect.Right; ra90, ra270 : Result := FixRect.Bottom; @@ -1094,12 +830,11 @@ begin end; end; -function TVpExCanvas.ViewportTop : Integer; +function TVpExCanvas.ViewportTop: Integer; var - FixRect : TRect; - + FixRect: TRect; begin - FixRect := TPSNormalizeRectangle (ViewPort); + FixRect := TPSNormalizeRectangle(ViewPort); case Angle of ra0, ra180 : Result := FixRect.Top; ra90, ra270 : Result := FixRect.Left; @@ -1108,12 +843,11 @@ begin end; end; -function TVpExCanvas.ViewportBottom : Integer; +function TVpExCanvas.ViewportBottom: Integer; var - FixRect : TRect; - + FixRect: TRect; begin - FixRect := TPSNormalizeRectangle (ViewPort); + FixRect := TPSNormalizeRectangle(ViewPort); case Angle of ra0, ra180 : Result := FixRect.Bottom; ra90, ra270 : Result := FixRect.Right; @@ -1122,396 +856,356 @@ begin end; end; -procedure TVpExCanvas.Arc (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +procedure TVpExCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); var - Point1 : TPoint; - Point2 : TPoint; - Point3 : TPoint; - Point4 : TPoint; - + P1 : TPoint; + P2 : TPoint; + P3 : TPoint; + P4 : TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); - Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); - Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); - Point4 := TPSRotatePoint (Angle, ViewPort, Point (X4, Y4)); + 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 (Point1.X, Point1.Y, Point2.X, Point2.Y, Point3.X, Point3.Y, - Point4.X, Point4.Y); + 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); +procedure TVpExCanvas.BrushCopy(const Dest: TRect; Bitmap: TBitmap; + const Source: TRect; AColor: TColor); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); -//TODO: FCanvas.BrushCopy (TPSRotateRectangle (Angle, ViewPort, Dest), +//TODO: FCanvas.BrushCopy(TPSRotateRectangle(Angle, ViewPort, Dest), // Bitmap, Source, AColor); end; -procedure TVpExCanvas.Chord (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +procedure TVpExCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); var - Point1 : TPoint; - Point2 : TPoint; - Point3 : TPoint; - Point4 : TPoint; - + P1: TPoint; + P2: TPoint; + P3: TPoint; + P4: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); - Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); - Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); - Point4 := TPSRotatePoint (Angle, ViewPort, Point (X4, Y4)); + 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 (Point1.X, Point1.Y, Point2.X, Point2.Y, Point3.X, Point3.Y, - Point4.X, Point4.Y); + FCanvas.Chord(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y); end; -procedure TVpExCanvas.CopyRect ( Dest : TRect; - Canvas : TCanvas; - const Source : TRect); +procedure TVpExCanvas.CopyRect(Dest: TRect; Canvas: TCanvas; const Source: TRect); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - FCanvas.CopyRect (TPSRotateRectangle (Angle, ViewPort, Dest), - Canvas, Source); + FCanvas.CopyRect(TPSRotateRectangle(Angle, ViewPort, Dest), Canvas, Source); end; -procedure TVpExCanvas.Draw (X, Y : Integer; - Graphic : TGraphic); +procedure TVpExCanvas.Draw(X, Y: Integer; Graphic: TGraphic); var - RealPoint : TPoint; - + RealPoint: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); - FCanvas.Draw (RealPoint.X, RealPoint.Y, Graphic); + 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); +procedure TVpExCanvas.DrawFocusRect(const ARect: TRect); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - FCanvas.DrawFocusRect (TPSRotateRectangle (Angle, ViewPort, ARect)); + FCanvas.DrawFocusRect(TPSRotateRectangle(Angle, ViewPort, ARect)); end; -procedure TVpExCanvas.Ellipse (X1, Y1, X2, Y2 : Integer); +procedure TVpExCanvas.Ellipse(X1, Y1, X2, Y2: Integer); var - Point1 : TPoint; - Point2 : TPoint; - + P1: TPoint; + P2: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); - Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1)); + P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2)); - FCanvas.Ellipse (Point1.X, Point1.Y, Point2.X, Point2.Y); + FCanvas.Ellipse(P1.X, P1.Y, P2.X, P2.Y); end; -procedure TVpExCanvas.Ellipse (const ARect : TRect); +procedure TVpExCanvas.Ellipse(const ARect: TRect); {$IFNDEF VERSION5} var R: TRect; {$ENDIF} begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); {$IFDEF VERSION5} - FCanvas.Ellipse (TPSRotateRectangle (Angle, ViewPort, ARect)); + FCanvas.Ellipse(TPSRotateRectangle(Angle, ViewPort, ARect)); {$ELSE} - R := TPSRotateRectangle (Angle, ViewPort, ARect); - FCanvas.Ellipse (R.Left, R.Top, R.Right, R.Bottom); + R := TPSRotateRectangle(Angle, ViewPort, ARect); + FCanvas.Ellipse(R.Left, R.Top, R.Right, R.Bottom); {$ENDIF} end; -procedure TVpExCanvas.FillRect (const ARect : TRect); +procedure TVpExCanvas.FillRect(const ARect: TRect); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - FCanvas.FillRect (TPSRotateRectangle (Angle, ViewPort, ARect)); + FCanvas.FillRect(TPSRotateRectangle(Angle, ViewPort, ARect)); end; -procedure TVpExCanvas.FloodFill (X, Y : Integer; - AColor : TColor; - FillStyle : TFillStyle); +procedure TVpExCanvas.FloodFill(X, Y: Integer; AColor: TColor; + FillStyle: TFillStyle); var - RealPoint : TPoint; - + RealPoint: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); - FCanvas.FloodFill (RealPoint.X, RealPoint.Y, AColor, FillStyle); + RealPoint := TPSRotatePoint(Angle, ViewPort, Point(X, Y)); + FCanvas.FloodFill(RealPoint.X, RealPoint.Y, AColor, FillStyle); end; -procedure TVpExCanvas.FrameRect (const ARect : TRect); +procedure TVpExCanvas.FrameRect(const ARect: TRect); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - FCanvas.FrameRect (TPSRotateRectangle (Angle, ViewPort, ARect)); + FCanvas.FrameRect(TPSRotateRectangle(Angle, ViewPort, ARect)); end; -procedure TVpExCanvas.LineTo (X, Y : Integer); +procedure TVpExCanvas.LineTo(X, Y: Integer); var - RealPoint : TPoint; - + P: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); - FCanvas.LineTo (RealPoint.X, RealPoint.Y); + P := TPSRotatePoint(Angle, ViewPort, Point(X, Y)); + FCanvas.LineTo(P.X, P.Y); end; -procedure TVpExCanvas.MoveTo (X, Y : Integer); +procedure TVpExCanvas.MoveTo(X, Y: Integer); var - RealPoint : TPoint; - + P: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); - FCanvas.MoveTo (RealPoint.X, RealPoint.Y); + 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); +procedure TVpExCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); var - Point1 : TPoint; - Point2 : TPoint; - Point3 : TPoint; - Point4 : TPoint; - + P1: TPoint; + P2: TPoint; + P3: TPoint; + P4: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); - Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); - Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); - Point4 := TPSRotatePoint (Angle, ViewPort, Point (X4, Y4)); + 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 (Point1.X, Point1.Y, Point2.X, Point2.Y, Point3.X, Point3.Y, - Point4.X, Point4.Y); + 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); +procedure TVpExCanvas.PolyBezier(const Points: array of TPoint); var - i : Integer; - PointArray : array of TPoint; - + i: Integer; + P: array of TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - SetLength (PointArray, Length (Points)); + SetLength(P, Length(Points)); + for i := 0 to Length(Points) - 1 do + P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]); - for i := 0 to Length (Points) - 1 do - PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); - - FCanvas.PolyBezier (PointArray); + FCanvas.PolyBezier(P); end; -procedure TVpExCanvas.PolyBezierTo (const Points : array of TPoint); +procedure TVpExCanvas.PolyBezierTo(const Points: array of TPoint); var - i : Integer; - PointArray : array of TPoint; - + i: Integer; + P: array of TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - SetLength (PointArray, Length (Points)); + SetLength(P, Length(Points)); + for i := 0 to Length(Points) - 1 do + P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]); - for i := 0 to Length (Points) - 1 do - PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); - -//TODO: FCanvas.PolyBezierTo (PointArray); +//TODO: FCanvas.PolyBezierTo(P); end; -procedure TVpExCanvas.Polygon (Points : array of TPoint); +procedure TVpExCanvas.Polygon(Points: array of TPoint); var - i : Integer; - PointArray : array of TPoint; - + i: Integer; + P: array of TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - SetLength (PointArray, Length (Points)); + SetLength(P, Length(Points)); + for i := 0 to Length(Points) - 1 do + P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]); - for i := 0 to Length (Points) - 1 do - PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); - - FCanvas.Polygon (PointArray); + FCanvas.Polygon(P); end; -procedure TVpExCanvas.Polyline (Points : array of TPoint); +procedure TVpExCanvas.Polyline(Points: array of TPoint); var - i : Integer; - PointArray : array of TPoint; - + i: Integer; + P: array of TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - SetLength (PointArray, Length (Points)); + SetLength(P, Length(Points)); + for i := 0 to Length(Points) - 1 do + P[i] := TPSRotatePoint(Angle, ViewPort, Points[i]); - for i := 0 to Length (Points) - 1 do - PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); - - FCanvas.Polyline (PointArray); + FCanvas.Polyline(P); end; -procedure TVpExCanvas.Rectangle (X1, Y1, X2, Y2 : Integer); +procedure TVpExCanvas.Rectangle(X1, Y1, X2, Y2: Integer); var - Point1 : TPoint; - Point2 : TPoint; + P1: TPoint; + P2: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); - Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1)); + P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2)); - FCanvas.Rectangle (Point1.X, Point1.Y, Point2.X, Point2.Y); + FCanvas.Rectangle(P1.X, P1.Y, P2.X, P2.Y); end; -procedure TVpExCanvas.Rectangle (const ARect : TRect); +procedure TVpExCanvas.Rectangle(const ARect: TRect); {$IFNDEF VERSION5} var R: TRect; {$ENDIF} begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); {$IFDEF VERSION5} - FCanvas.Rectangle (TPSRotateRectangle (Angle, ViewPort, ARect)); + FCanvas.Rectangle(TPSRotateRectangle(Angle, ViewPort, ARect)); {$ELSE} - R := TPSRotateRectangle (Angle, ViewPort, ARect); - FCanvas.Rectangle (R.Left, R.Top, R.Right, R.Bottom); + 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); +procedure TVpExCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); var - Point1 : TPoint; - Point2 : TPoint; - Point3 : TPoint; - + P1: TPoint; + P2: TPoint; + P3: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); - Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); - Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); + P1 := TPSRotatePoint(Angle, ViewPort, Point(X1, Y1)); + P2 := TPSRotatePoint(Angle, ViewPort, Point(X2, Y2)); + P3 := TPSRotatePoint(Angle, ViewPort, Point(X3, Y3)); - FCanvas.RoundRect (Point1.X, Point1.Y, Point2.X, Point2.Y, - Point3.X, Point3.Y); + FCanvas.RoundRect(P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y); end; -procedure TVpExCanvas.StretchDraw (const ARect : TRect; - Graphic : TGraphic); +procedure TVpExCanvas.StretchDraw(const ARect: TRect; Graphic: TGraphic); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - FCanvas.StretchDraw (TPSRotateRectangle (Angle, ViewPort, ARect), Graphic); + FCanvas.StretchDraw(TPSRotateRectangle(Angle, ViewPort, ARect), Graphic); end; -procedure TVpExCanvas.TextOut ( X, Y : Integer; - const Text : string); +procedure TVpExCanvas.TextOut(X, Y: Integer; const Text: string); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - DrawRotatedText (X, Y, Text, True); + DrawRotatedText(X, Y, Text, True); end; -procedure TVpExCanvas.TextRect ( ARect : TRect; - X, Y : Integer; - const Text : string); +procedure TVpExCanvas.TextRect(ARect: TRect; X, Y: Integer; const Text: string); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); end; -function TVpExCanvas.GetPixel (const x : Integer; - const y : Integer) : TColor; +function TVpExCanvas.GetPixel(const x, y: Integer): TColor; var - RealPoint : TPoint; - + P: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (x, y)); - Result := FCanvas.Pixels [RealPoint.X, RealPoint.Y]; + P := TPSRotatePoint(Angle, ViewPort, Point(x, y)); + Result := FCanvas.Pixels[P.X, P.Y]; end; -procedure TVpExCanvas.SetPixel (x : Integer; - y : Integer; - AColor : TColor); +procedure TVpExCanvas.SetPixel(x, y: Integer; AColor: TColor); var - RealPoint : TPoint; - + P: TPoint; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - RealPoint := TPSRotatePoint (Angle, ViewPort, Point (x, y)); - FCanvas.Pixels [RealPoint.X, RealPoint.Y] := AColor; + P := TPSRotatePoint(Angle, ViewPort, Point(x, y)); + FCanvas.Pixels[P.X, P.Y] := AColor; end; -procedure TVpExCanvas.CenteredTextOut ( ARect : TRect; - const Text : string); +procedure TVpExCanvas.CenteredTextOut(ARect: TRect; const AText: string); var - TW : Integer; - + TW: Integer; begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - TW := FCanvas.TextWidth (Text); + TW := FCanvas.TextWidth(AText); if TW < ARect.Right - ARect.Left then - ARect.Left := ARect.Left + ((ARect.Right - ARect.Left - TW) div 2); +// ARect.Left := ARect.Left +((ARect.Right - ARect.Left - TW) div 2); + ARect.Left := (ARect.Left + ARect.Right - TW) div 2; - TPSTextOut (FCanvas, Angle, ViewPort, ARect.Left, ARect.Top, Text); + TPSTextOut(FCanvas, Angle, ViewPort, ARect.Left, ARect.Top, AText); end; -procedure TVpExCanvas.TextOutAtPoint ( X, Y : Integer; - const Text : string); +procedure TVpExCanvas.TextOutAtPoint(X, Y: Integer; const AText: string); begin - if not Assigned (FCanvas) then - raise EVpCanvasError.Create (RSNoCanvas); + if not Assigned(FCanvas) then + raise EVpCanvasError.Create(RSNoCanvas); - DrawRotatedText (X, Y, Text, False); + DrawRotatedText(X, Y, AText, False); end; -function TVpExCanvas.RGBToTColor (Red, Green, Blue : Byte) : TColor; +function TVpExCanvas.RGBToTColor(Red, Green, Blue: Byte): TColor; var - RedPart, GreenPart, BluePart : Integer; - + RedPart, GreenPart, BluePart: Integer; begin RedPart := Red; GreenPart := Green shl 8; @@ -1519,156 +1213,135 @@ begin Result := $02000000 or RedPart or GreenPart or BluePart; end; -procedure TVpExCanvas.TColorToRGB ( Color : TColor; - var Red : Byte; - var Green : Byte; - var Blue : Byte); +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); +procedure TVpExCanvas.CachePalette(ABitmap: TBitmap; + var PaletteEntries: TVpPaletteArray); var - PaletteSize : Integer; - + 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; + 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); + GetPaletteEntries(ABitmap.Palette, 0, PaletteSize, PaletteEntries); end; -function TVpExCanvas.GetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer) : TColor; // 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; - + 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); + raise EVpCanvasError.Create(RSOutOfRange); case ABitmap.PixelFormat of pfDevice : begin - raise EVpCanvasError.Create (RSNotSupported); + 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); + 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); + 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); + 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]); + 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); + Result := RGBToTColor(Red, Green, Blue); end; pf16bit : begin ByteArray := ABitmap.ScanLine[y]; - WorkWord := Byte (ByteArray[x * 2]) + - 256 * Byte (ByteArray[(x * 2) + 1]); + 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); + 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])); + 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])); + Result := RGBToTColor(Byte(ByteArray[x * 4 + 2]), + Byte(ByteArray[x * 4 + 1]), + Byte(ByteArray[x * 4])); end; pfCustom : begin - raise EVpCanvasError.Create (RSNotSupported); + raise EVpCanvasError.Create(RSNotSupported); end; else - raise EVpCanvasError.Create (RSNotSupported); + raise EVpCanvasError.Create(RSNotSupported); end; } end; - -procedure TVpExCanvas.SetBmpPixel (ABitmap : TBitmap; - PaletteCache : TVpPaletteArray; - x : Integer; - y : Integer; - AColor : TColor); // Fast scanline based pixel access -var - BytePos : Integer; - WorkByte : Byte; - WorkWord : Word; - ByteArray : PChar; - PaletteIndex : Byte; - Red : Byte; - Green : Byte; - Blue : Byte; +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: { @@ -1678,135 +1351,128 @@ begin case ABitmap.PixelFormat of pfDevice : begin - raise EVpCanvasError.Create (RSNotSupported); + raise EVpCanvasError.Create(RSNotSupported); end; pf1bit : begin ByteArray := ABitmap.ScanLine[y]; BytePos := x div 8; - WorkByte := Byte (ByteArray[BytePos]); + WorkByte := Byte(ByteArray[BytePos]); WorkByte := WorkByte and (not ($01 shl (7 - (x mod 8)))); - PaletteIndex := GetNearestPaletteIndex (ABitmap.Palette, AColor) and $01; + PaletteIndex := GetNearestPaletteIndex(ABitmap.Palette, AColor) and $01; WorkByte := WorkByte or (PaletteIndex shl (7 - (x mod 8))); - ByteArray[BytePos] := Char (WorkByte); + ByteArray[BytePos] := Char(WorkByte); end; pf4bit : begin ByteArray := ABitmap.ScanLine[y]; BytePos := x div 2; - WorkByte := Byte (ByteArray[BytePos]); + WorkByte := Byte(ByteArray[BytePos]); WorkByte := WorkByte and (not ($0f shl (((x + 1) mod 2) * 4))); - PaletteIndex := GetNearestPaletteIndex (ABitmap.Palette, AColor) and $0f; + PaletteIndex := GetNearestPaletteIndex(ABitmap.Palette, AColor) and $0f; WorkByte := WorkByte or (PaletteIndex shl (((x + 1) mod 2) * 4)); - ByteArray[BytePos] := Char (WorkByte); + ByteArray[BytePos] := Char(WorkByte); end; pf8bit : begin ByteArray := ABitmap.ScanLine[y]; - PaletteIndex := GetNearestPaletteIndex (ABitmap.Palette, AColor); - ByteArray[x] := Char (PaletteIndex); + PaletteIndex := GetNearestPaletteIndex(ABitmap.Palette, AColor); + ByteArray[x] := Char(PaletteIndex); end; pf15bit : begin - TColorToRGB (AColor, Red, Green, Blue); + 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);; + 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); + 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);; + 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); + 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); + 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); + 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); + ByteArray[(x * 4) + 2] := Char(Red); + ByteArray[(x * 4) + 1] := Char(Green); + ByteArray[x * 4] := Char(Blue); end; pfCustom : begin - raise EVpCanvasError.Create (RSNotSupported); + 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); + FMinChars := 5; + FAngle := ra0; + FViewPort := Rect(0, 0, 0, 0); end; -function TVpLineWrapper.FindEndingPos (ARegion : HRGN; - LineSize : Integer; - HPos : Integer; - YPos : Integer) : TPoint; +function TVpLineWrapper.FindEndingPos(ARegion: HRGN; + LineSize, HPos, YPos: Integer): TPoint; var - WorkRect : TRect; - + WorkRect: TRect; begin - GetRgnBox (ARegion, @WorkRect); - + 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); + 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 : Integer; - var YPos : Integer) : Boolean; - +function TVpLineWrapper.FindNextStartingPoint(ARegion: HRGN; LineSize: Integer; + var HPos, YPos: Integer): Boolean; var - WorkRect : TRect; - Done : Boolean; - + WorkRect: TRect; + Done: Boolean; begin Result := False; - Done := False; - GetRgnBox (ARegion, @WorkRect); + Done := False; + GetRgnBox(ARegion, @WorkRect); while not Done do begin if HPos > WorkRect.Right then begin HPos := WorkRect.Left; - Inc (YPos, LineSize); + 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 (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); + Inc(YPos, LineSize); if YPos > WorkRect.Bottom then Break; end; @@ -1817,171 +1483,139 @@ begin end; end; -function TVpLineWrapper.FindWordBreaks (AString : string; - CharPos : Integer) : Integer; +function TVpLineWrapper.FindWordBreaks(AString: string; + CharPos: Integer): Integer; var - Done : Boolean; - WorkPos : Integer; - + Done: Boolean; + WorkPos: Integer; begin - Done := False; + Done := False; WorkPos := CharPos; - while not Done do begin - if IsWordBreak (AString, WorkPos) then + if IsWordBreak(AString, WorkPos) then Done := True else - Dec (WorkPos); - + 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; - +function TVpLineWrapper.FitStringInRect(ACanvas: TCanvas; RectWidth: Integer; + AvgCharSize: Integer; var AString: string; var CharsOut: Integer): string; var - CharsToRender : Integer; - L : Integer; - R : Integer; - M : Integer; - + 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); + 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); + while (ACanvas.TextWidth(Result) > RectWidth) and + (CharsToRender > 0) do + begin + Dec(CharsToRender); + Result := Copy(AString, 1, CharsToRender); end; - if CharsToRender >= Length (AString) then begin + if CharsToRender >= Length(AString) then begin CharsOut := CharsToRender; - AString := Trim (Copy (AString, - CharsToRender + 1, - Length (AString) - 1)); - Exit; - end; + AString := Trim(Copy(AString, CharsToRender + 1, Length(AString) - 1)); + Exit; + end; - CharsToRender := FindWordBreaks (AString, CharsToRender); - Result := Copy (AString, 1, CharsToRender); + CharsToRender := FindWordBreaks(AString, CharsToRender); + Result := Copy(AString, 1, CharsToRender); end; if CharsToRender > 0 then begin - AString := Copy (AString, - CharsToRender + 1, - Length (AString) - CharsToRender + 1); + AString := Copy(AString, CharsToRender + 1, Length(AString) - CharsToRender + 1); end else begin - Result := Copy (AString, 1, 1); - AString := Copy (AString, - 2, - Length (AString) - 1); + 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); + 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) + 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)); + 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); + CharsToRender := FindWordBreaks(AString, M); + Result := Copy(AString, 1, CharsToRender); + AString := Copy(AString, CharsToRender + 1, Length(AString) - 1); end; CharsOut := CharsToRender; - Result := Trim (Result); + Result := Trim(Result); end; -function TVpLineWrapper.GetAverageCharSize ( - ACanvas : TCanvas) : Integer; - +function TVpLineWrapper.GetAverageCharSize(ACanvas: TCanvas): Integer; var - Metrics : TTextMetric; - SavedFontHandle : THandle; - DC : HDC; - + Metrics: TTextMetric; + SavedFontHandle: THandle; + DC: HDC; begin - DC := GetDC (0); - SavedFontHandle := SelectObject (DC, ACanvas.Font.Handle); + DC := GetDC(0); + SavedFontHandle := SelectObject(DC, ACanvas.Font.Handle); try - GetTextMetrics (DC, Metrics); + GetTextMetrics(DC, Metrics); Result := Metrics.tmAveCharWidth; finally - SelectObject (DC, SavedFontHandle); - ReleaseDC (0, DC); + SelectObject(DC, SavedFontHandle); + ReleaseDC(0, DC); end; end; -function TVpLineWrapper.GetNextRectangle ( - ARegion : HRGN; - LineSize : Integer; - AvgCharSize : Integer; - var HPos : Integer; - var LinePos : Integer) : TRect; - +function TVpLineWrapper.GetNextRectangle(ARegion: HRGN; + LineSize, AvgCharSize: Integer; var HPos, LinePos: Integer): TRect; var - EndPoint : TPoint; - Done : Boolean; - + EndPoint: TPoint; + Done: Boolean; begin - Result := Rect (0, 0, 0, 0); - Done := False; + 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 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); + Result := Rect(HPos, LinePos, EndPoint.x, EndPoint.y); Break; end else - Inc (HPos); + Inc(HPos); end else Break; end; -function TVpLineWrapper.IsWordBreak (AString : string; - CharPos : Integer) : Boolean; +function TVpLineWrapper.IsWordBreak(AString: string; CharPos: Integer): Boolean; var - NC : Char; - PC : Char; - C : Char; - + NC, PC, C: Char; begin - C := ThisChar (AString, CharPos); - NC := NextChar (AString, CharPos); - PC := PrevChar (AString, CharPos); + C := ThisChar(AString, CharPos); + NC := NextChar(AString, CharPos); + PC := PrevChar(AString, CharPos); Result := False; if C = '.' then begin @@ -1994,60 +1628,55 @@ begin (NC in ['0'..'9', 'A'..'Z', 'a'..'z']) then Result := True; end; - if Assigned (FOnFindWordBreak) then - FOnFindWordBreak (Self, AString, CharPos, Result); + if Assigned(FOnFindWordBreak) then + FOnFindWordBreak(Self, AString, CharPos, Result); end; -function TVpLineWrapper.NextChar (AString : string; - CharPos : Integer) : Char; +function TVpLineWrapper.NextChar(AString: string; CharPos: Integer): Char; begin - if (CharPos >= 1) and (CharPos < Length (AString)) then + if (CharPos >= 1) and (CharPos < Length(AString)) then Result := AString[CharPos + 1] else Result := #0; end; -function TVpLineWrapper.PrevChar (AString : string; - CharPos : Integer) : Char; +function TVpLineWrapper.PrevChar(AString: string; CharPos: Integer): Char; begin - if (CharPos > 1) and (CharPos <= Length (AString)) then + 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; - +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; - + LineHeight: Integer; + RectWidth: Integer; + RectHeight: Integer; + LinePos: Integer; + AvgCharSize: Integer; + Done: Boolean; + CharsWritten: Integer; begin { Initialize stuff } - Result := 0; + Result := 0; CharsWritten := 0; - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); - LineHeight := ACanvas.TextHeight ('yY0'); + LineHeight := ACanvas.TextHeight('yY0'); if Angle = ra0 then - RectWidth := ARect.Right - ARect.Left - 2 * FTextMargin + RectWidth := ARect.Right - ARect.Left - 2 * FTextMargin else - RectWidth := VpRotatedCanvas.ViewportWidth; + 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; + LinePos := ARect.Top + FTextMargin; + AvgCharSize := GetAverageCharSize(ACanvas); + Done := False; if LineHeight > RectHeight then Exit; @@ -2059,50 +1688,43 @@ begin if AString = '' then Break; - VpRotatedCanvas.TextOut (ARect.Left + FTextMargin, - LinePos, - FitStringInRect (ACanvas, - RectWidth, - AvgCharSize, - AString, - CharsWritten)); + 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; +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; - + LineHeight: Integer; + RectHeight: Integer; + LinePos: Integer; + AvgCharSize: Integer; + Done: Boolean; + HPos: Integer; + RegionRect: TRect; + WorkRect: TRect; + CharsWritten: Integer; begin - Result := 0; + Result := 0; CharsWritten := 0; - SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); - GetRgnBox (ARegion, @RegionRect); + SetTVpExCanvasAVC(ACanvas, Angle, ViewPort); + GetRgnBox(ARegion, @RegionRect); - LineHeight := ACanvas.TextHeight ('yY0'); + 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; + LinePos := RegionRect.Top + FTextMargin; + HPos := RegionRect.Left + FTextMargin; + AvgCharSize := GetAverageCharSize(ACanvas); + Done := False; if LineHeight > RectHeight then Exit; @@ -2114,23 +1736,13 @@ begin 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 + WorkRect := GetNextRectangle(ARegion, LineHeight, AvgCharSize, HPos, linepos); + if (WorkRect.Top = 0) and (WorkRect.left = 0) and (WorkRect.Bottom = 0) and (WorkRect.Right = 0) then Workrect := Regionrect; if WorkRect.Right - WorkRect.Left > 0 then begin - VpRotatedCanvas.TextOut (WorkRect.Left + FTextMargin, - WorkRect.Top, - FitStringInRect (ACanvas, - WorkRect.Right - - WorkRect.Left - - FTextMargin, - AvgCharSize, - AString, - CharsWritten)); + VpRotatedCanvas.TextOut(WorkRect.Left + FTextMargin, WorkRect.Top, + FitStringInRect(ACanvas, WidthOf(WorkRect) - FTextMargin, AvgCharSize, AString, CharsWritten) + ); Result := Result + CharsWritten; end else Break; @@ -2138,22 +1750,20 @@ begin end; end; -function TVpLineWrapper.ThisChar (AString : string; - CharPos : Integer) : Char; +function TVpLineWrapper.ThisChar(AString: string; CharPos: Integer): Char; begin - if (CharPos >= 1) and (CharPos <= Length (AString)) then + if (CharPos >= 1) and (CharPos <= Length(AString)) then Result := AString[CharPos] else Result := #0; end; -initialization +initialization VpRotatedCanvas := TVpExCanvas.Create; - VpTextRenderer := TVpLineWrapper.Create; + VpTextRenderer := TVpLineWrapper.Create; finalization - VpRotatedCanvas.Free; VpTextRenderer.Free; diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index 6d45d9267..faf9ad924 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/components/tvplanit/source/vpdayviewpainter.pas @@ -91,7 +91,7 @@ type procedure DrawEvent(AEvent: TVpEvent; AEventRec: TVpDvEventRec; ARenderDate: TDateTime; Col: Integer); procedure DrawEvents(ARenderDate: TDateTime; Col: Integer); - procedure DrawEventString(const AText: String; const AEventRect, AIconRect: TRect; + procedure DrawEventText(const AText: String; const AEventRect, AIconRect: TRect; ALevel: Integer; AEventIsEditing: Boolean); procedure DrawIcons(AIconRect: TRect); procedure DrawNavBtns; @@ -879,7 +879,7 @@ begin EventString := BuildEventString(AEvent, EventRect, IconRect); { draw the event string } - DrawEventString(EventString, EventRect, IconRect, AEventRec.Level, EventIsEditing); + DrawEventText(EventString, EventRect, IconRect, AEventRec.Level, EventIsEditing); { paint the borders around the event text area } TPSPolyline(RenderCanvas, Angle, RenderIn, [ @@ -1055,7 +1055,7 @@ begin DrawIcon(dvBmpRecurring, RecurringW, RecurringH, false); end; -procedure TVpDayViewPainter.DrawEventString(const AText: String; +procedure TVpDayViewPainter.DrawEventText(const AText: String; const AEventRect, AIconRect: TRect; ALevel: Integer; AEventIsEditing: Boolean); var WorkRegion1: HRGN;