gmclasses.pas

GmPrintSuite 2.96.7] a

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

interface

uses Windows, Classes, GmTypes, Graphics, ExtCtrls, Forms, Controls,
  GmResource, GmStream, StdCtrls, Messages;

{$I GMPS.INC}

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

  TGmValue = class;

  // *** TGmComponent ***

  TGmNewPageEvent = procedure (Sender: TObject; var ATopMargin, ABottomMargin: TGmValue) of object;

  TGmComponent = class(TGmCustomComponent)
  private
    function GetAbout: string;
    function GetVersion: Extended;
    procedure SetAbout(const Value: string);
  public
    property Version: Extended read GetVersion;
  published
    property About: string read GetAbout write SetAbout;
  end;

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

  // *** TGmScrollingWinControl ***

  TGmScrollingWinControl = class(TGmCustomPageControl)
  private
    FBorderStyle: TBorderStyle;
    function GetAbout: string;
    function GetVersion: Extended;
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetAbout(const Value: string);
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Version: Extended read GetVersion;
  published
    property About: string read GetAbout write SetAbout;
    {$IFDEF D4+}
    property Anchors;
    property Constraints;
    property DoubleBuffered default True;
    {$ENDIF}
    property Align;
    property AutoScroll;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Color default $C0C0C0;
    property Ctl3D;
    property Enabled;
    property Hint;
    property ParentColor default False;
    property ShowHint;
    property TabOrder;
    property Tag;
    property Visible;
  end;

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

  // *** TGmPanel ***

  TGmWinControl = class(TGmCustomWinControl)
  private
    FBorderStyle: TBorderStyle;
    function GetAbout: string;
    function GetVersion: Extended;
    procedure SetAbout(const Value: string);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Version: Extended read GetVersion;
  published
    property About: string read GetAbout write SetAbout;
    {$IFDEF D4+}
    property Anchors;
    property Constraints;
    {$ENDIF}
    property Align;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
    property Color default $C0C0C0;
    property Ctl3D;
    property Hint;
    property ParentColor default False;
    property ShowHint;
    property TabOrder;
    property Visible;
  end;

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

  TGmComboBox = class(TGmCustomComboBox)
  private
    function GetAbout: string;
    function GetVersion: Extended;
    procedure SetAbout(const Value: string);
  public
    property Version: Extended read GetVersion;
  published
    property About: string read GetAbout write SetAbout;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property Anchors;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    // events...
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    {$IFDEF D7+}
    property OnSelect;
    {$ENDIF}
    property OnStartDock;
    property OnStartDrag;
    property Items;
  end;
  //----------------------------------------------------------------------------

  // forward declarations...

  //TGmHeaderFooter = class;
  TGmMargins = class;
  TGmMarginValues = class;

  TGmPageDragDropEvent     = procedure(Sender, Source: TObject;  X, Y: TGmValue) of object;
  TGmPageDragOverEvent     = procedure(Sender, Source: TObject; X, Y: TGmValue; State: TDragState; var Accept: Boolean) of object;
  TGmPageMouseEvent        = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue) of object;
  TGmPageMouseMoveEvent    = procedure(Sender: TObject; Shift: TShiftState; X, Y: TGmValue) of object;

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

  // *** TGmValue ***

  TGmValue = class(TPersistent)
  private
    FInches: Extended;
    // events...
    FOnChange: TNotifyEvent;
    function GetAsCentimeters: Extended;
    function GetAsGmUnits: integer;
    function GetAsMillimeters: Extended;
    function GetAsPixels(Ppi: integer): integer;
    function GetAsTwips: integer;
    function GetGmValue(Measurement: TGmMeasurement): Extended;
    procedure Changed;
    procedure SetAsCentimeters(Value: Extended);
    procedure SetAsGmUnits(Value: integer);
    procedure SetAsInches(Value: Extended);
    procedure SetAsMillimeters(Value: Extended);
    procedure SetAsPixels(Ppi: integer; Value: integer);
    procedure SetAsTwips(Value: integer);
    procedure SetGmValue(Measurement: TGmMeasurement; Value: Extended);
  public
    constructor Create(const AChangeEvent: TNotifyEvent = nil);
    constructor CreateValue(Value: Extended; Measurement: TGmMeasurement);
    procedure Assign(Source: TPersistent); override;
    property AsCentimeters: Extended read GetAsCentimeters write SetAsCentimeters;
    property AsGmValue[Measurement: TGmMeasurement]: Extended read GetGmValue write SetGmValue;
    property AsGmUnits: integer read GetAsGmUnits write SetAsGmUnits;
    property AsInches: Extended read FInches write SetAsInches;
    property AsMillimeters: Extended read GetAsMillimeters write SetAsMillimeters;
    property AsPixels[Ppi: integer]: integer read GetAsPixels write SetAsPixels;
    property AsTwips: integer read GetAsTwips write SetAsTwips;
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TGmCustomValueSize = class(TPersistent)
  protected
    FHeight: TGmValue;
    FWidth: TGmValue;
    // events...
    FOnChange: TNotifyEvent;
    procedure ValueChanged(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TGmValueSize = class(TGmCustomValueSize)
  public
    property Height: TGmValue read FHeight;
    property Width: TGmValue read FWidth;
  end;

  TGmValuePoint = class(TGmCustomValueSize)
  public
    property X: TGmValue read FHeight;
    property Y: TGmValue read FWidth;
  end;

  TGmValueRect = class(TPersistent)
  private
    FTopLeft: TGmValuePoint;
    FBottomRight: TGmValuePoint;
    function GetAsInchRect: TGmRect;
    function GetValue(index: integer): TGmValue;
    procedure SetAsInchRect(Value: TGmRect);
    procedure SetValue(index: integer; Value: TGmValue);
  public
    constructor Create;
    destructor Destroy; override;
    property AsInchRect: TGmRect read GetAsInchRect write SetAsInchRect;
    property Left: TGmValue index 1 read GetValue write SetValue;
    property Top: TGmValue index 2 read GetValue write SetValue;
    property Right: TGmValue index 3 read GetValue write SetValue;
    property Bottom: TGmValue index 4 read GetValue write SetValue;
  end;

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

  // *** TGmBaseObject ***

  TGmBaseObject = class(TPersistent)
  private
    FObjectID: integer;
    FPrintThisObject: Boolean;
    FResourceTable: TGmResourceTable;
    FTag: integer;
    FUpdating: Boolean;
    // events...
    FOnChange: TNotifyEvent;
  protected
    function GetObjectID: integer; virtual; abstract;
    procedure AssignTo(Source: TPersistent); override;
    procedure Changed; virtual;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); virtual;
    procedure LoadFromValueList(Values: TGmValueList); virtual;
    procedure SaveToValueList(Values: TGmValueList); virtual;
  public
    constructor Create(AResourceTable: TGmResourceTable); virtual;
    //procedure Assign(Source: TPersistent); override;
    procedure Draw(ACanvas: TCanvas; var Data: TGmObjectDrawData);
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure OffsetObject(x, y: Extended; Measurement: TGmMeasurement); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    property ObjectID: integer read FObjectID;
    property PrintThisObject: Boolean read FPrintThisObject write FPrintThisObject default True;
    property ResourceTable: TGmResourceTable read FResourceTable;
    property Tag: integer read FTag write FTag default -1;
    property Updating: Boolean read FUpdating write FUpdating default False;
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;


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

  // *** TGmVisibleObject ***

  TGmChangeObjectLevel = procedure(Sender: TObject; LevelChange: TGmArrangeObject) of object;

  TGmVisibleObject = class(TGmBaseObject)
  private
    FLevelChange: TGmChangeObjectLevel;
    FAllowDrag: Boolean;
  protected
    procedure AssignTo(Source: TPersistent); override;
  public
    constructor Create(AResourceTable: TGmResourceTable); override;
    function BoundingRect(Data: TGmObjectDrawData): TGmRectPoints; virtual;
    procedure Arrange(ChangeLevel: TGmArrangeObject);
    property AllowDrag: Boolean read FAllowDrag write FAllowDrag default True;
    // events...
    property OnLevelChange: TGmChangeObjectLevel read FLevelChange write FLevelChange;
  end;


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

  // *** TGmBaseObjectList ***

  TGmBaseObjectList = class(TGmObjectList)
  private
    FOnChanged: TNotifyEvent;
    function GetObject(index: integer): TGmBaseObject;
    procedure SetObject(index: integer; AObject: TGmBaseObject);
    procedure Changed(Sender: TObject);
  public
    constructor Create;
    procedure AddObject(AObject: TGmBaseObject);
    procedure InsertObject(Index: integer; AObject: TGmBaseObject);
    property GmObject[index: integer]: TGmBaseObject read GetObject write SetObject;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;


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

  // *** TGmPageRtfInfo ***

  TGmPageRtfInfo = class(TObject)
  private
    FOffset: TPoint;
    FMargins: TGmValueRect;
    FRichEdit: TCustomMemo;
    FResourceTable: TObject;
    FWrapText: Boolean;
    // events...
    FOnChange: TNotifyEvent;
    procedure Changed;
    procedure SetMargins(Value: TGmValueRect);
    procedure SetOffset(Value: TPoint);
    procedure SetRichEdit(ARichEdit: TCustomMemo);
  public
    constructor Create(AResourceTable: TObject);
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromValueList(Values: TGmValueList);
    procedure SaveToValueList(Values: TGmValueList);
    property Margins: TGmValueRect read FMargins write SetMargins;
    property Offset: TPoint read FOffset write SetOffset;
    property ResourceTable: TObject read FResourceTable write FResourceTable;
    property RichEdit: TCustomMemo read FRichEdit write SetRichEdit;
    property WrapText: Boolean read FWrapText write FWrapText;
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

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

  // *** TGmMargins ***

  TGmMargins = class(TPersistent)
  private
    FClipMargins: Boolean;
    FLeft: TGmValue;
    FTop: TGmValue;
    FRight: TGmValue;
    FBottom: TGmValue;
    FPen: TPen;
    FDrawPpi: integer;
    FPrinter: TObject;
    FPrinterMarginPen: TPen;
    FShowPrinterMargins: Boolean;
    FUpdating: Boolean;
    FUsePrinterMargins: Boolean;
    FValues: TGmMarginValues;
    FVisible: Boolean;
    // events...
    FOnChange: TNotifyEvent;
    function GetAsInches: TGmRect;
    function GetPrinterMargins(Measurement: TGmMeasurement; AOrientation: TGmOrientation): TGmRect;
    procedure Changed(Sender: TObject);
    procedure Clip(APageSize: TGmSize; AOrientation: TGmOrientation; ACanvas: TCanvas; Ppi: integer);
    procedure Draw(APageSize: TGmSize; AOrientation: TGmOrientation; ACanvas: TCanvas; Ppi: integer);
    procedure SetAsInches(ARect: TGmRect);
    procedure SetClipMargins(Value: Boolean);
    procedure SetPen(Value: TPen);
    procedure SetPrinterMarginPen(Value: TPen);
    procedure SetShowPrinterMargins(Value: Boolean);
    procedure SetUsePrinterMargins(Value: Boolean);
    procedure SetVisible(Value: Boolean);
  public
    constructor Create(GmPrinter: TObject);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    property AsInches: TGmRect read GetAsInches write SetAsInches;
    property Left: TGmValue read FLeft;
    property Top: TGmValue read FTop;
    property Right: TGmValue read FRight;
    property Bottom: TGmValue read FBottom;
    property PrinterMargins[Measurement: TGmMeasurement; Orientation: TGmOrientation]: TGmRect read GetPrinterMargins;
    property UsePrinterMargins: Boolean read FUsePrinterMargins write SetUsePrinterMargins;
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property ClipMargins: Boolean read FClipMargins write SetClipMargins default False;
    property Pen: TPen read FPen write SetPen;
    property PrinterMarginPen: TPen read FPrinterMarginPen write SetPrinterMarginPen;
    property ShowPrinterMargins: Boolean read FShowPrinterMargins write SetShowPrinterMargins default False;
    property Values: TGmMarginValues read FValues write FValues;
    property Visible: Boolean read FVisible write SetVisible default False;
  end;

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

  // *** TGmMarginValues ***

  TGmMarginValues = class(TPersistent)
  private
    FMargins: TGmMargins;
    FMeasurement: TGmMeasurement;
    function GetValue(index: integer): Single;
    procedure SetMeasurement(Value: TGmMeasurement);
    procedure SetValue(index: integer; Value: Single);
  public
    constructor Create(AMargins: TGmMargins);
  published
    property Left: Single   index 0 read GetValue write SetValue;
    property Top: Single    index 1 read GetValue write SetValue;
    property Right: Single  index 2 read GetValue write SetValue;
    property Bottom: Single index 3 read GetValue write SetValue;
    property ValueMeasurement: TGmMeasurement read FMeasurement write SetMeasurement default gmInches;
  end;

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

  // *** TGmShadow ***

  TGmShadow = class(TPersistent)
  private
    FColor: TColor;
    FWidth: integer;
    FVisible: Boolean;
    // events...
    FOnChange: TNotifyEvent;
    procedure Changed;
    procedure Draw(ACanvas: TCanvas; APageRect: TRect);
    procedure SetColor(Value: TColor);
    procedure SetVisible(Value: Boolean);
    procedure SetWidth(Value: integer);
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property Color: TColor read FColor write SetColor default clBlack;
    property Visible: Boolean read FVisible write SetVisible default True;
    property Width: integer read FWidth write SetWidth default 3;
  end;

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

  // *** TGmPageGrid ***

  TGmPageGrid = class(TPersistent)
  private
    FGridPen: TPen;
    FGridStyle: TGmGridStyle;
    FGridInterval: TGmValue;
    FOnChange: TNotifyEvent;
    procedure Changed(Sender: TObject);
    procedure DrawToCanvas(Canvas: TCanvas; APageSize: TGmSize; Ppi: integer);
    procedure SetGridStyle(const Value: TGmGridStyle);
    procedure SetGridPen(Value: TPen);
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create;
    destructor Destroy; override;
    property Interval: TGmValue read FGridInterval;
  published
    property GridStyle: TGmGridStyle read FGridStyle write SetGridStyle default gmNoGrid;
    property GridPen: TPen read FGridPen write SetGridPen;
  end;