gmcanvas.pas

GmPrintSuite 2.96.7] a

{******************************************************************************}
{                                                                              }
{                              GmCanvas.pas                                    }
{                                                                              }
{           Copyright (c) 2003 Graham Murt  - www.MurtSoft.co.uk               }
{                                                                              }
{   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
{                                                                              }
{                           [e-mail]                              }
{                                                                              }
{******************************************************************************}

unit GmCanvas;

interface

uses Windows, Classes, Graphics, GmTypes, GmClasses, GmResource;

{$I GMPS.INC}

type
  TGmCanvas = class;

  TGmCustomGridPrint    = class(TGmComponent);
  TGmCustomLabelPrinter = class(TGmComponent);

  TGmCanvasWinControl   = class(TGmScrollingWinControl)
  private
    FCanvas: TGmCanvas;
  protected
    property Canvas: TGmCanvas read FCanvas write FCanvas;
  end;

  // *** TGmCanvasSavedValues ***

  TGmCanvasSavedValues = class(TPersistent)
  private
    FCoordsRelativeTo: TGmCoordsRelative;
    FBrush: TBrush;
    FFont: TFont;
    FPen: TPen;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  // *** TGmCanvas ***

  TGmCanvas = class(TPersistent)
  private
    FAllowDrag: Boolean;
    FBrush: TBrush;
    FCoordsRelativeTo: TGmCoordsRelative;
    FCopyMode: TCopyMode;
    FDefaultAlignment: TAlignment;
    FDefaultVertAlignment: TGmVertAlignment;
    FFont: TFont;
    FFontAngle: Extended;
    FPen: TPen;
    FGmBrush: TGmBrush;
    FGmFont: TGmFont;
    FGmPen: TGmPen;
    FDefaultMeasurement: TGmMeasurement;
    FLastObject: TGmBaseObject;
    FPageList: TGmObjectList;
    FPenPos: TGmPoint;
    FPropertyStream: TStream;
    FResourceTable: TGmResourceTable;
    FExtentValue: TGmValueSize;
    FSavedValues: TGmCanvasSavedValues;
    FTextBoxPadding: TGmValue;
    FWordWrap: Boolean;
    function AddObjectToPage(AObject: TGmBaseObject): TGmBaseObject;
    function AsGmBrush: TGmBrush;
    function AsGmFont: TGmFont;
    function AsGmPen: TGmPen;
    function GetCompareImages: Boolean;
    function GetPenPos(Measurement: TGmMeasurement): TGmPoint;
    procedure SetBrush(Value: TBrush);
    procedure SetCompareImages(Value: Boolean);
    procedure SetFont(Value: TFont);
    procedure SetPen(Value: TPen);
    procedure SetTextBoxPadding(Value: TGmValue);
    function TextBoxHeightExt(AWidth, Padding: Extended; AText: string; Measurement: TGmMeasurement): Extended;
    procedure TextOutExt(X, Y, Angle: Extended; AClipRect: PGmRect; AText: string; Measurement: TGmMeasurement);
  public
    constructor Create(APageList: TGmObjectList);
    destructor Destroy; override;

    // functions...
    function GraphicExtent(AGraphic: TGraphic): TGmValueSize;
    function GraphicHeight(AGraphic: TGraphic): TGmValue;
    function GraphicWidth(AGraphic: TGraphic): TGmValue;

    function TextExtent(AText: string): TGmValueSize;
    function TextHeight(AText: string): TGmValue;
    function TextWidth(AText: string): TGmValue;
    function TextBoxHeight(AWidth: Extended; AText: string; Measurement: TGmMeasurement): Extended;

    // line methods...
    procedure Line(x, y, x2, y2: Extended; Measurement: TGmMeasurement);  {$IFDEF D4+} overload; {$ENDIF}
    procedure LineTo(x, y: Extended; Measurement: TGmMeasurement);        {$IFDEF D4+} overload; {$ENDIF}
    procedure MoveTo(x, y: Extended; Measurement: TGmMeasurement);        {$IFDEF D4+} overload; {$ENDIF}
    {$IFDEF D4+}
    procedure Line(x, y, x2, y2: Extended); overload;
    procedure LineTo(x, y: Extended); overload;
    procedure MoveTo(x, y: Extended); overload;
    {$ENDIF}

    // shape methods...
    procedure Ellipse(x, y, x2, y2: Extended; Measurement: TGmMeasurement);           {$IFDEF D4+} overload; {$ENDIF}
    procedure Rectangle(x, y, x2, y2: Extended; Measurement: TGmMeasurement);         {$IFDEF D4+} overload; {$ENDIF}
    procedure RoundRect(x, y, x2, y2, x3, y3: Extended; Measurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
    {$IFDEF D4+}
    procedure Ellipse(x, y, x2, y2: Extended); overload;
    procedure Rectangle(x, y, x2, y2: Extended); overload;
    procedure RoundRect(x, y, x2, y2, x3, y3: Extended); overload;
    {$ENDIF}

    // simple text methods...
    procedure FloatOut(x, y, Value: Extended; Format: string; Measurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
    procedure RotateOut(x, y, Angle: Extended; AText: string; Measurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
    procedure TextClipped(x, y: Extended; AText: string; AWidth: Extended; Alignment: TAlignment; Measurement: TGmMeasurement);
    procedure TextOut(x, y: Extended; AText: string; Measurement: TGmMeasurement);          {$IFDEF D4+} overload; {$ENDIF}
    procedure TextOutCenter(x, y: Extended; AText: string; Measurement: TGmMeasurement);    {$IFDEF D4+} overload; {$ENDIF}
    procedure TextOutRight(x, y: Extended; AText: string; Measurement: TGmMeasurement);     {$IFDEF D4+} overload; {$ENDIF}
    procedure TextRect(ARect: TGmRect; x, y: Extended; AText: string; Measurement: TGmMeasurement);
    {$IFDEF D4+}
    procedure FloatOut(x, y, Value: Extended; Format: string); overload;
    procedure RotateOut(x, y, Angle: Extended; AText: string); overload;
    procedure TextOut(x, y: Extended; AText: string); overload;
    //procedure TextOut(x, y: Extended; AClipRect: TGmRect; AText: string; Measurement: TGmMeasurement); overload;
    procedure TextOutCenter(x, y: Extended; AText: string); overload;
    procedure TextOutRight(x, y: Extended; AText: string); overload;
    {$ENDIF}

    // textbox methods...
    procedure TextBox(x, y, x2, y2: Extended; AText: string; Measurement: TGmMeasurement);  {$IFDEF D4+} overload; {$ENDIF}
    procedure TextBoxExt(x, y, x2, y2, Padding: Extended; AText: string;  Alignment: TAlignment;
      VertAlignment: TGmVertAlignment; Measurement: TGmMeasurement);
    {$IFDEF D4+}
    procedure TextBox(x, y, x2, y2: Extended; AText: string; Alignment: TAlignment; VertAlignment: TGmVertAlignment;
      Measurement: TGmMeasurement); overload;
    {$ENDIF}

    // complex shape methods...
    procedure Arc(x, y, x2, y2, x3, y3, x4, y4: Extended; Measurement: TGmMeasurement);   {$IFDEF D4+} overload; {$ENDIF}
    procedure Chord(x, y, x2, y2, x3, y3, x4, y4: Extended; Measurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
    procedure Pie(x, y, x2, y2, x3, y3, x4, y4: Extended; Measurement: TGmMeasurement);   {$IFDEF D4+} overload; {$ENDIF}
    {$IFDEF D4+}
    procedure Arc(x, y, x2, y2, x3, y3, x4, y4: Extended); overload;
    procedure Chord(x, y, x2, y2, x3, y3, x4, y4: Extended); overload;
    procedure Pie(x, y, x2, y2, x3, y3, x4, y4: Extended); overload;
    {$ENDIF}

    // graphics methods...
    procedure Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended; Measurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
    procedure StretchDraw(x, y, x2, y2: Extended; AGraphic: TGraphic; Measurement: TGmMeasurement);   {$IFDEF D4+} overload; {$ENDIF}
    {$IFDEF D4+}
    procedure Draw(x, y: Extended; AGraphic: TGraphic; const Scale: Extended = 1); overload;
    procedure StretchDraw(x, y, x2, y2: Extended; AGraphic: TGraphic); overload;
    {$ENDIF}

    // polygon/line methods...
    procedure Polygon(Points: array of TGmPoint; Measurement: TGmMeasurement);
    procedure Polyline(Points: array of TGmPoint; Measurement: TGmMeasurement);
    procedure PolyBezier(Points: array of TGmPoint; Measurement: TGmMeasurement);
    procedure PolylineTo(Points: array of TGmPoint; Measurement: TGmMeasurement);
    procedure PolyBezierTo(Points: array of TGmPoint; Measurement: TGmMeasurement);

    // path methods...
    procedure BeginPath;
    procedure EndPath;
    procedure FillPath;
    procedure StrokePath;
    procedure StrokeAndFillPath;
    procedure CloseFigure;

    // clipping methods...
    procedure SetClipEllipse(x, y, x2, y2: Extended; Measurement: TGmMeasurement);           {$IFDEF D4+} overload; {$ENDIF}
    procedure SetClipRect(x, y, x2, y2: Extended; Measurement: TGmMeasurement);              {$IFDEF D4+} overload; {$ENDIF}
    procedure SetClipRoundRect(x, y, x2, y2, x3, y3: Extended; Measurement: TGmMeasurement); {$IFDEF D4+} overload; {$ENDIF}
    procedure RemoveClipRgn;
    {$IFDEF D4+}
    procedure SetClipEllipse(x, y, x2, y2: Extended); overload;
    procedure SetClipRect(x, y, x2, y2: Extended); overload;
    procedure SetClipRoundRect(x, y, x2, y2, x3, y3: Extended); overload;
    {$ENDIF}

    // brush, font & pen methods...
    procedure SetBrushValues(AColor: TColor; AStyle: TBrushStyle);
    procedure SetFontHeight(AHeight: Extended; Measurement: TGmMeasurement);
    procedure SetFontValues(AName: string; ASize: integer; AColor: TColor; AStyle: TFontStyles);
    procedure SetPenValues(AWidth: integer; AColor: TColor; AStyle: TPenStyle);

    procedure LoadCanvasProperties;
    procedure SaveCanvasProperties;
    // properties...
    property AllowDrag: Boolean read FAllowDrag write FAllowDrag default True;
    property Brush: TBrush read FBrush write SetBrush;
    property CopyMode: TCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
    property DefaultAlignment: TAlignment read FDefaultAlignment write FDefaultAlignment default taLeftJustify;
    property DefaultVertAlignment: TGmVertAlignment read FDefaultVertAlignment write FDefaultVertAlignment default gmTop;
    property Font: TFont read FFont write SetFont;
    property LastObject: TGmBaseObject read FLastObject;
    property Pen: TPen read FPen write SetPen;
    property PenPos[Measurement: TGmMeasurement]: TGmPoint read GetPenPos;
    property TextBoxPadding: TGmValue read FTextBoxPadding write SetTextBoxPadding;
    property WordWrap: Boolean read FWordWrap write FWordWrap default True;
  published
    property CompareGraphics: Boolean read GetCompareImages write SetCompareImages;
    property CoordsRelativeTo: TGmCoordsRelative read FCoordsRelativeTo write FCoordsRelativeTo default gmFromPage;
    property DefaultMeasurement: TGmMeasurement read FDefaultMeasurement write FDefaultMeasurement default gmMillimeters;
  end;

implementation

uses GmObjects, GmConst, GmFuncs, GmPageList, SysUtils;

//------------------------------------------------------------------------------

constructor TGmCanvasSavedValues.Create;
begin
  inherited Create;
  FBrush := TBrush.Create;
  FFont := TFont.Create;
  FPen := TPen.Create;
end;

destructor TGmCanvasSavedValues.Destroy;
begin
  FBrush.Free;
  FFont.Free;
  FPen.Free;
  inherited Destroy;
end;

//------------------------------------------------------------------------------

constructor TGmCanvas.Create(APageList: TGmObjectList);
begin
  inherited Create;
  FResourceTable := TGmPageList(APageList).ResourceTable;
  FBrush := TBrush.Create;
  FFont := TFont.Create;
  FPen := TPen.Create;
  FGmBrush := TGmBrush.Create;
  FGmFont := TGmFont.Create;
  FGmPen := TGmPen.Create;
  FExtentValue := TGmValueSize.Create;
  FPropertyStream := TMemoryStream.Create;
  FTextBoxPadding := TGmValue.Create;
  FSavedValues := TGmCanvasSavedValues.Create;
  FPageList := APageList;
  FAllowDrag := True;
  FFontAngle := 0;
  FBrush.Style := bsClear;
  FFont.Name := DEFAULT_FONT;
  FFont.Size := DEFAULT_FONT_SIZE;
  FCoordsRelativeTo := gmFromPage;
  FCopyMode := cmSrcCopy;
  FDefaultMeasurement := gmMillimeters;
  FWordWrap := True;
  FTextBoxPadding.AsMillimeters := 1;
  FDefaultAlignment := taLeftJustify;
  FDefaultVertAlignment := gmTop;
end;

destructor TGmCanvas.Destroy;
begin
  FGmBrush.Free;
  FBrush.Free;
  FGmFont.Free;
  FFont.Free;
  FPen.Free;
  FGmPen.Free;
  FExtentValue.Free;
  FPropertyStream.Free;
  FTextBoxPadding.Free;
  FSavedValues.Free;
  inherited Destroy;
end;

function TGmCanvas.GraphicExtent(AGraphic: TGraphic): TGmValueSize;
var
  AExtent: TGmValueSize;
begin
  AExtent := TGmValueSize.Create;
  try
    AExtent.Height.AsInches := GraphicHeight(AGraphic).AsInches;
    AExtent.Width.AsInches  := GraphicWidth(AGraphic).AsInches;
    FExtentValue.Assign(AExtent);
    Result := FExtentValue;
  finally
    AExtent.Free;
  end;
end;

function TGmCanvas.GraphicHeight(AGraphic: TGraphic): TGmValue;
begin
  Result := FExtentValue.Height;
  Result.AsInches := AGraphic.Height / 96;
end;

function TGmCanvas.GraphicWidth(AGraphic: TGraphic): TGmValue;
begin
  Result := FExtentValue.Width;
  Result.AsInches := AGraphic.Width / 96;
end;

function TGmCanvas.TextExtent(AText: string): TGmValueSize;
var
  InchSize: TGmSize;
begin
  Result := FExtentValue;
  InchSize := GmFuncs.TextExtent(AText, FFont);
  Result.Height.AsInches := InchSize.Height;
  Result.Width.AsInches := InchSize.Width;
end;

function TGmCanvas.TextHeight(AText: string): TGmValue;
begin
  Result := FExtentValue.Height;
  Result.AsInches := GmFuncs.TextExtent(AText, FFont).Height;
end;

function TGmCanvas.TextWidth(AText: string): TGmValue;
begin
  Result := FExtentValue.Width;
  Result.AsInches := GmFuncs.TextExtent(AText, FFont).Width;
end;

function TGmCanvas.TextBoxHeight(AWidth: Extended; AText: string; Measurement: TGmMeasurement): Extended;
var
  inchWidth: Extended;
begin
  inchWidth := ConvertValue(AWidth, Measurement, gmInches);
  Result := TextBoxHeightExt(inchWidth, FTextBoxPadding.AsGmValue[gmInches], AText, gmInches);
  Result := ConvertValue(Result, gmInches, Measurement);
end;