gmobjects.pas

GmPrintSuite 2.96.7] a

{******************************************************************************}
{                                                                              }
{                               GmObjects.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 GmObjects;

interface

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

const

  // *** GmObject ID constants ***

  GM_TEXT_OBJECT_ID           = 0;
  GM_LINE_OBJECT_ID           = 1;
  GM_RECTANGLE_OBJECT_ID      = 2;
  GM_ELLIPSE_OBJECT_ID        = 3;
  GM_ROUNDRECT_OBJECT_ID      = 4;
  GM_ARC_ID                   = 5;
  GM_CHORD_ID                 = 6;
  GM_PIE_ID                   = 7;
  GM_PATH_OBJECT_ID           = 8;
  GM_REMOVE_CLIP_OBJECT_ID    = 9;
  GM_CLIPRECT_OBJECT_ID       = 10;
  GM_CLIPROUNDRECT_OBJECT_ID  = 11;
  GM_CLIPELLIPSE_OBJECT_ID    = 12;
  GM_GRAPHIC_OBJECT_ID        = 13;
  GM_TEXTBOX_OBJECT_ID        = 14;
  GM_POLYGON_OBJECT_ID        = 15;
  GM_POLYLINE_OBJECT_ID       = 16;
  GM_POLYBEZIER_OBJECT_ID     = 17;
  GM_POLYLINETO_OBJECT_ID     = 18;
  GM_POLYBEZIERTO_OBJECT_ID   = 19;

type
  //----------------------------------------------------------------------------

  // *** TGmOutlineShape ***

  TGmOutlineShape = class(TGmVisibleObject)
  private
    FPen: TGmPen;
    FSavePen: TGmPen;
    function GetPen: TGmPen;
    procedure PenChanged(Sender: TObject);
    procedure SetPen(Value: TGmPen);
  protected
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
    property Pen: TGmPen read GetPen write SetPen;
  public
    destructor Destroy; override;
  end;

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

  // *** TGmSolidShape ***

  TGmSolidShape = class(TGmOutlineShape)
  private
    FBrush: TGmBrush;
    FSaveBrush: TGmBrush;
    function GetBrush: TGmBrush;
    procedure BrushChanged(Sender: TObject);
    procedure SetBrush(Value: TGmBrush);
  protected
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
    property Brush: TGmBrush read GetBrush write SetBrush;
  public
    destructor Destroy; override;
  end;

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

  // *** TGmBaseSolidShape ***

  TGmBaseSolidShape = class(TGmSolidShape)
  private
    FCoords: TGmRect;
    function GetCoords(Measurement: TGmMeasurement): TGmRect;
    function GetX(Measurement: TGmMeasurement): Extended;
    function GetY(Measurement: TGmMeasurement): Extended;
    function GetX2(Measurement: TGmMeasurement): Extended;
    function GetY2(Measurement: TGmMeasurement): Extended;
    procedure SetCoords(Measurement: TGmMeasurement; Value: TGmRect);
    procedure SetX(Measurement: TGmMeasurement; Value: Extended);
    procedure SetY(Measurement: TGmMeasurement; Value: Extended);
    procedure SetX2(Measurement: TGmMeasurement; Value: Extended);
    procedure SetY2(Measurement: TGmMeasurement; Value: Extended);
  protected
    function CoordsAsPixels(PpiX, PpiY: integer): TRect;
    property Coords[Measurement: TGmMeasurement]: TGmRect read GetCoords write SetCoords;
    property X[Measurement: TGmMeasurement]: Extended read GetX write SetX;
    property Y[Measurement: TGmMeasurement]: Extended read GetY write SetY;
    property X2[Measurement: TGmMeasurement]: Extended read GetX2 write SetX2;
    property Y2[Measurement: TGmMeasurement]: Extended read GetY2 write SetY2;
  public
    procedure OffsetObject(x, y: Extended; Measurement: TGmMeasurement); override;
  end;

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

  // *** TGmSimpleSolidShape ***

  TGmSimpleSolidShape = class(TGmBaseSolidShape)
  protected
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
    property Coords;
  public
    property X;
    property Y;
    property X2;
    property Y2;
  end;

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

  // *** TGmBaseTextObject ***

  TGmBaseTextObject = class(TGmBaseSolidShape)
  private
    FCaption: string;
    FClipRect: TGmRect;
    FFont: TGmFont;
    FSaveFont: TGmFont;
    function GetClipRect(Measurement: TGmMeasurement): TGmRect;
    function GetFont: TGmFont;
    procedure FontChanged(Sender: TObject);
    procedure SetCaption(Value: string);
    procedure SetClipRect(Measurement: TGmMeasurement; Value: TGmRect);
    procedure SetFont(Value: TGmFont);
  protected
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    destructor Destroy; override;
    property Caption: string read FCaption write SetCaption;
    property ClipRect[Measurement: TGmMeasurement]: TGmRect read GetClipRect write SetClipRect;
    property Brush;
    property Font: TGmFont read GetFont write SetFont;
    property Pen;
    property X;
    property Y;
  end;

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

  // *** TGmTextObject ***

  TGmTextObject = class(TGmBaseTextObject)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  public
    function BoundingRect(Data: TGmObjectDrawData): TGmRectPoints; override;
    procedure OffsetObject(x, y: Extended; Measurement: TGmMeasurement); override;
  end;

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

  // *** TGmLineObject ***

  TGmLineObject = class(TGmSimpleSolidShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  public
    function BoundingRect(Data: TGmObjectDrawData): TGmRectPoints; override;
    property Coords;
    property Pen;
  end;

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

  // *** TGmGraphicObject ***

  TGmGraphicObject = class(TGmSimpleSolidShape)
  private
    FCopyMode: TCopyMode;
    FGraphic: TGraphic;
    FPrintPixelFormat: TPixelFormat;
    procedure SetGraphic(AGraphic: TGraphic);
  protected
    function GetObjectID: integer; override;
     procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
     procedure LoadFromValueList(Values: TGmValueList); override;
     procedure SaveToValueList(Values: TGmValueList); override;
  public
    constructor Create(AResourceTable: TGmResourceTable); override;
    property Coords;
    property CopyMode: TCopyMode read FCopyMode write FCopyMode;
    property Graphic: TGraphic read FGraphic write SetGraphic;
    property PrintPixelFormat: TPixelFormat read FPrintPixelFormat write FPrintPixelFormat default pf8bit;
  end;

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

  // *** TGmTextBoxObject ***

  TGmTextBoxObject = class(TGmBaseTextObject)
  private
    FAlignment: TAlignment;
    FClipText: Boolean;
    FPadding: Extended;
    FTextHeight: Extended;
    FVertAlignment: TGmVertAlignment;
    FWordBreak: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetClipText(Value: Boolean);
    procedure SetPadding(Value: Extended);
    procedure SetWordBreak(Value: Boolean);
    procedure SetVertAlignment(Value: TGmVertAlignment);
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    constructor Create(AResourceTable: TGmResourceTable); override;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property ClipText: Boolean read FClipText write SetClipText default True;
    property Coords;
    property Padding: Extended read FPadding write SetPadding;
    property TextHeight: Extended read FTextHeight write FTextHeight;
    property VertAlignment: TGmVertAlignment read FVertAlignment write SetVertAlignment default gmTop;
    property WordBreak: Boolean read FWordBreak write SetWordBreak default True;
    property X2;
    property Y2;
  end;

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

  // *** TGmRectangleShape ***

  TGmRectangleShape = class(TGmSimpleSolidShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  public
    property Brush;
    property Coords;
    property Pen;
  end;

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

  // *** TGmEllipseShape ***

  TGmEllipseShape = class(TGmSimpleSolidShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  public
    property Brush;
    property Coords;
    property Pen;
  end;

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

  // *** TGmSemiComplexShape ***

  TGmSemiComplexShape = class(TGmSimpleSolidShape)
  private
    FX3: Extended;
    FY3: Extended;
    function GetX3(Measurement: TGmMeasurement): Extended;
    function GetY3(Measurement: TGmMeasurement): Extended;
    procedure SetX3(Measurement: TGmMeasurement; const Value: Extended);
    procedure SetY3(Measurement: TGmMeasurement; const Value: Extended);
  protected
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    procedure OffsetObject(x, y: Extended; Measurement: TGmMeasurement); override;
    property Brush;
    property Coords;
    property Pen;
    property X3[Measurement: TGmMeasurement]: Extended read GetX3 write SetX3;
    property Y3[Measurement: TGmMeasurement]: Extended read GetY3 write SetY3;
  end;

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

  // *** TGmRoundRectShape ***

  TGmRoundRectShape = class(TGmSemiComplexShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmComplexShape ***

  TGmComplexShape = class(TGmSemiComplexShape)
  private
    FX4: Extended;
    FY4: Extended;
    function GetCoords(index: TGmMeasurement): TGmComplexCoords;
    function GetX4(index: TGmMeasurement): Extended;
    function GetY4(index: TGmMeasurement): Extended;
    procedure SetCoords(index: TGmMeasurement; Value: TGmComplexCoords);
    procedure SetX4(index: TGmMeasurement; const Value: Extended);
    procedure SetY4(index: TGmMeasurement; const Value: Extended);
  protected
   procedure LoadFromValueList(Values: TGmValueList); override;
   procedure SaveToValueList(Values: TGmValueList); override;
    property Coords[Measurement: TGmMeasurement]: TGmComplexCoords read GetCoords write SetCoords;
  public
    procedure OffsetObject(x, y: Extended; Measurement: TGmMeasurement); override;
    property X4[Measurement: TGmMeasurement]: Extended read GetX4 write SetX4;
    property Y4[Measurement: TGmMeasurement]: Extended read GetY4 write SetY4;
  end;

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

  // *** TGmArcShape ***

  TGmArcShape = class(TGmComplexShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmChordShape ***

  TGmChordShape = class(TGmComplexShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmPieShape ***

  TGmPieShape = class(TGmComplexShape)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmPolyBaseObject ***

  TGmPolyBaseObject = class(TGmSolidShape)
  private
    FPoints: TGmPolyPoints;
    function GetPoints(Measurement: TGmMeasurement): TGmPolyPoints;
    procedure SetPoints(Measurement: TGmMeasurement; Value: TGmPolyPoints);
  protected
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    procedure OffsetObject(x, y: Extended; Measurement: TGmMeasurement); override;
    property Brush;
    property Pen;
    property Points[Measurement: TGmMeasurement]: TGmPolyPoints read GetPoints write SetPoints;
  end;

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

  // *** TGmPolygonObject ***

  TGmPolygonObject = class(TGmPolyBaseObject)
  protected
    function GetObjectID: integer; override;
  end;

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

  // *** TGmPolylineObject ***

  TGmPolylineObject = class(TGmPolyBaseObject)
  protected
    function GetObjectID: integer; override;
  end;

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

  // *** TGmPolyBezierObject ***

  TGmPolyBezierObject = class(TGmPolyBaseObject)
  protected
    function GetObjectID: integer; override;
  end;

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

  // *** TGmPolylineToObject ***

  TGmPolylineToObject = class(TGmPolyBaseObject)
  protected
    function GetObjectID: integer; override;
  end;

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

  // *** TGmPolyBezierToObject ***

  TGmPolyBezierToObject = class(TGmPolyBaseObject)
  protected
    function GetObjectID: integer; override;
  end;

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