sctctrl.pas

suite component ace report

unit SctCtrl;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses
  {$IFDEF WIN32}  windows,
  {$ELSE}   wintypes, winprocs,
  {$ENDIF}
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls,sctvar, sctdata,
  sctrtf, sctutil, aceout, aceutil, acememou, aceimg;

{$define SCT_NO_OLDEVENT}

type
  TSctLabel = class;
  TSctTextLabel = class;
  TSctvarlabel = class;

{ TSctRotateFont }
  TSctRotateFont = 0..360;

{ TSctDirection }
  TSctDirection = (bdVertical, bdHorizontal);

{ TSctCheckStyle }
  TSctCheckStyle = (csCross, csCheck);

{ TSctClipTypes }
  TSctClipTypes = (ctDefault, ctClip, ctNoClip);

{ TsctVerticalAlign }
  TSctVerticalAlign = (laTop, laMiddle, laBottom, laCenterVert);

{ TsctHorizontalAlign }
  TSctHorizontalAlign = (laLeft, laCenter, laRight);

{ TSctBorderType }
  TSctBorderType = (btNone, btSingle, btUnderLine);

{ TSctShapeType }
  TSctShapeType = (sstCircle, sstEllipse, sstRectangle, sstRoundRect,
                   sstRoundSquare, sstSquare);

{ TSctLabelPrintWhenEvent }
{$ifdef SCT_OLDEVENT}
 TSctLabelPrintWhenEvent = function (lb: TSctLabel): Boolean of object;
{$else}
 TSctLabelPrintWhenEvent = procedure (lb: TSctLabel; var Result: Boolean) of object;
{$endif}

{ TSctLabelPrintEvent }
 TSctLabelPrintEvent = procedure (lb: TSctLabel) of object;

{ TSctOnDrawEvent }
  TSctOnDrawEvent = procedure (lb: TSctLabel; AceCanvas: TObject; Rect: TRect) of object;


{ TSctLabel }
  TSctLabel = class(TGraphicControl)
  private
    FPage: TWinControl;
    FClipType: TSctCliptypes;
    FVerticalAlign: TSctVerticalAlign;
    FHorizontalAlign: TSctHorizontalAlign;
    FEndPrint,FFirstTime: Boolean;
    FWrapText: Boolean;
    FStretch: Boolean;
    FBorderType: TSctBorderType;
    FBrush, FBrushSet: TBrush;
    FPen, FPenSet, FBorderPen: TPen;
    FPixelsPerInch: Integer;
    FLabelPrintWhen: TSctLabelPrintWhenEvent;
    FOnBeforePrint, FOnAfterPrint: TSctLabelPrintEvent;
    FRow: Integer;
    FRtfPrint: Boolean;
    FRotateFont: TSctRotateFont;
    FShade: TAceShadePercent;
    FPainting: Boolean;
    FBorderMargin: Integer;

    FAutoSize: Boolean;
    procedure AdjustBounds;
    function GetTransparent: Boolean;
    procedure SetAutoSize(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure MouseMovement(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  protected
    procedure SetParent(AParent: TWinControl); override;
    function getpage: TWinControl;
    function GetClipRect: Boolean;
    function GetAlignFlags: word;
    function GetXPos: Integer;
    function GetYPos: Integer;
    function GetDataNow: String; virtual;
    procedure Paint; override;
    procedure SetVerticalAlign( va: TSctVerticalAlign);
    procedure SetHorizontalAlign( ha: TSctHorizontalAlign);
    function GetDisplayText: string; virtual;
    procedure SetBorderType( BType: TSctBorderType); virtual;
    procedure SetWrapText( W: Boolean); virtual;
    procedure SetStretch( S: Boolean); virtual;
    function GetPPI: Integer;
    function GetPrintOk: Boolean;
    procedure Loaded; override;
    procedure SetRotateFont(Rotate: TSctRotateFont); virtual;
    procedure SetShade(ShadePercent: TAceShadePercent); virtual;
    procedure SetBorderMargin(bm: Integer);

    property BrushSet: TBrush read FBrushSet write FBrushSet;
    property PenSet: TPen read FPenSet write FPenSet;
    property Painting: Boolean read FPainting write FPainting;


    procedure ReadAutoSize(Reader: TReader);
    procedure WriteAutoSize( Writer: TWriter);
  public
    property Transparent: Boolean read GetTransparent write SetTransparent default True;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property Canvas;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LabelChanged(Sender: TObject); virtual;
    procedure print(oPage: TComponent; space: Integer); virtual;
    property Page: TWinControl read GetPage write FPage;
    property ClipRect: Boolean read GetClipRect;
    property AlignFlags: word read GetAlignFlags;
    property XPos: Integer read GetXPos;
    property YPos: Integer read GetYPos;
    property DataNow: String read GetDataNow;
    property ClipType: TSctClipTypes read FClipType write FClipType default ctDefault;
    property AlignVertical: TSctVerticalAlign read FVerticalAlign write SetVerticalAlign default laBottom;
    property AlignHorizontal: TSctHorizontalAlign read FHorizontalAlign write SetHorizontalAlign default laLeft;
    property DisplayText: String read GetDisplayText;

    property EndPrint: Boolean read FEndPrint write FEndPrint;
    property FirstTime: Boolean read FFirstTime write FFirstTime;
    procedure StartPrint; virtual;
    function PrintHeight( oPage: TComponent; Space, Taking: Integer): Integer; virtual;
    property BorderType: TSctBorderType read FBorderType write SetBorderType default btNone;
    property Brush: TBrush read FBrush write SetBrush;
    property Pen: TPen read FPen write SetPen;
    property BorderPen: TPen read FBorderPen write FBorderPen;

    property WrapText: Boolean read FWrapText write SetWrapText default False;
    property Stretch: Boolean read FStretch write SetStretch default False;

    property PixelsPerInch: Integer read getppi write FPixelsPerInch;

    function SpendHeight(oPage: TComponent; Space: Integer): Integer; virtual;
    property PrintOk: Boolean read GetPrintOk;

    procedure BeforePrint;
    procedure AfterPrint;

    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); virtual;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); virtual;

    function GetXSpot(x: Integer): Integer;
    function GetYSpot(y: Integer): Integer;
    procedure InitPrint(AceCanvas: TAceCanvas; Rect: TRect);
    procedure PrintBorder(AceCanvas: TAceCanvas; Rect: TRect);
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); virtual;

    property RotateFont: TSctRotateFont read FRotateFont write SetRotateFont default 0;
    property Shade: TAceShadePercent read FShade write SetShade default spNone;

    property BorderMargin: Integer read FBorderMargin write SetBorderMargin default 2;
    property Caption;
    property Color;
  published
 {    property Visible;} { no need for this to be published }
    property LabelPrintWhen: TSctLabelPrintWhenEvent read FLabelPrintWhen write FLabelPrintWhen;
    property OnBeforePrint: TSctLabelPrintEvent read FOnBeforePrint write FOnBeforePrint;
    property OnAfterPrint: TSctLabelPrintEvent  read FOnAfterPrint write FOnAfterPrint;
    property Row: Integer read FRow write FRow default 0;
    property RtfPrint: Boolean read FRtfPrint write FRtfPrint default True;
  end;


{ TSctWrapHeightPercent }
  TSctWrapHeightPercent = 25..300;

{ TSctTVLabel }
  TSctTVLabel = class(TSctLabel)
  private
    FVariable: TSctvar;
    FDataRow: Integer;
    FWrapHeightPercent: TSctWrapHeightPercent;
    FAceMemo: TAceMemo;
    FJustifyMemo: Boolean;
    FDataFormat: TSctFormat;
    FSuppressRepeats: Boolean;
    FLines: TStrings;
    FSuppressBlankLines: Boolean;
    FSuppressWhiteSpace: Boolean;
    procedure SetLines(Value: TStrings);
  protected
    function GetDisplayText: string; override;
    procedure Paint; override;
    procedure SetWrapHeightPercent(whp: TSctWrapHeightPercent);
    procedure SetJustifyMemo(Value: Boolean);
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: Tcomponent); override;
    destructor Destroy; override;
    procedure SetVariable(variable: TSctvar);
    function GetDataNow: String; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    procedure Print(oPage: TComponent; Space: Integer); override;
    procedure StartPrint; override;
    function PrintHeight( oPage: TComponent; Space, Taking: Integer): Integer; override;
    property DataRow: Integer read FDataRow write FDataRow;
    function PrintMemo( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer): Integer;
    function SpendHeight(oPage: TComponent; Space: Integer): Integer; override;
    function SpendMemo( oPage: TComponent; Space: Integer): Integer;
    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); override;
    procedure UpdateMemo; virtual;
    property AceMemo: TAceMemo read FAceMemo write FAceMemo;
    function IsMemo: Boolean;


    property Variable: TSctvar read FVariable write setvariable;
    property DataFormat: TSctFormat read FDataFormat write FDataFormat;


    property SuppressRepeats: Boolean read FSuppressRepeats write FSuppressRepeats default False;

  published
    property Align;
    property Color;
    property Font;
    property ParentColor;
    property ParentFont;
    property Transparent;

    property ClipType;
    property AlignVertical;
    property AlignHorizontal;
    property BorderType;
    property RotateFont;
    property Shade;
    property BorderMargin;

    property WrapText;
    property Stretch;
    property WrapHeightPercent: TSctWrapHeightPercent
                          read FWrapHeightPercent
                          write SetWrapHeightPercent default 100;

    property JustifyMemo: Boolean read FJustifyMemo write SetJustifyMemo default False;
    property Lines: TStrings read FLines write SetLines;
    property SuppressBlankLines: Boolean read FSuppressBlankLines
                                         write FSuppressBlankLines default False;
    property SuppressWhiteSpace: Boolean read FSuppressWhiteSpace
                                         write FSuppressWhiteSpace default False;
  end;

{ TSctvarlabel }
  TSctvarlabel = class(TSctTVLabel)
  protected
  public
  published
    property Variable;
    property DataFormat;
    property SuppressRepeats;
    property Caption;
  end;

{ TSctTextLabel }
  TSctTextLabel = class(TSctTVLabel)
  protected
    procedure WriteState(Writer: TWriter); override;
  public
  published
    property AutoSize;
    property Caption;
  end;

{ TSctCheckLabel }
  TSctCheckLabel = class(TSctLabel)
  private
    FVariable: TSctvar;
    FCheckStyle: TSctCheckStyle;
  protected
    procedure SetCheckStyle(style: TSctCheckStyle);
    function GetDisplayText: string; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetVariable(Variable: TSctvar);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); override;
  published
    property Variable: TSctvar read FVariable write SetVariable;

    property Align;
    property Color;
    property ParentColor;
    property Transparent;

    property Pen;
    property CheckStyle: TSctCheckStyle read FCheckStyle write SetCheckStyle default csCross;
    property BorderType;
    property Shade;
  end;

{ TSctBarCodeType }
  TSctBarCodeType = (bct3of9, bct2of5);

{ TSctBarCodeLabel }
  TSctBarCodeLabel = class(TSctLabel)
  private
    FVariable: TSctvar;
    FDirection: TSctDirection;
    FNarrowWidth, FWideWidth: Integer;
    FBarCodeBrush: TBrush;
    FBarCodeType: TSctBarCodeType;
    FWidthInInches_1000: Boolean;
  protected
    procedure SetDirection(d: TSctDirection);
    procedure SetNarrowWidth(nw: Integer);
    procedure SetWideWidth(ww: Integer);
    function GetDisplayText: string; override;
    procedure SetBarCodeType(bct: TSctBarCodeType);
  public
    constructor Create(AOwner: Tcomponent); override;
    destructor Destroy; override;
    procedure SetVariable(variable: TSctvar);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;


    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); override;
  published
    property Variable: TSctvar read FVariable write SetVariable;

    property Align;
    property Color;
    property ParentColor;
    property Transparent;

    property BorderType;

    property Direction: TSctDirection read FDirection write SetDirection default bdHorizontal;
    property NarrowWidth: Integer read FNarrowWidth write SetNarrowWidth default 1;
    property WideWidth: Integer read FWideWidth write SetWideWidth default 3;
    property BarCodeBrush: TBrush read FBarCodeBrush write FBarCodeBrush;
    property AlignVertical;
    property AlignHorizontal;
    property BorderMargin;
    property BarCodeType: TSctBarCodeType read FBarCodeType write SetBarCodeType default bct3of9;
    property WidthInInches_1000: Boolean read FWidthInInches_1000 write FWidthInInches_1000 default False;
  end;

{ TSctTotalvarLabel }
  TSctTotalvarLabel = class(TSctLabel)
  private
    FTotalVariable: TSctTotalvar;
    FAutoLevel: Boolean;
    FLevel: TSctLevel;
    FTotalType: TSctTotalType;
    FDataFormat: TSctFloatFormat;
  protected
    function GetDisplayText: string; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: Tcomponent); override;
    destructor Destroy; override;
    procedure SetVariable(variable: TSctTotalvar);
    function GetDataNow: String; override;
  published
    property TotalVariable: TSctTotalvar read FTotalVariable write SetVariable;
    property Level: TSctLevel read FLevel write FLevel;
    property AutoLevel: Boolean read FAutoLevel write FAutoLevel default True;
    property TotalType: TSctTotalType read FTotalType write FTotalType default ttSum;
    property DataFormat: TSctFloatFormat read FDataFormat write FDataFormat;

    property Align;
    property Color;
    property Font;
    property ParentColor;
    property ParentFont;
    property Transparent;

    property ClipType;
    property AlignVertical;
    property AlignHorizontal default laRight;
    property BorderType;

    property RotateFont;
    property Shade;

    property BorderMargin;
  end;

{ TSctLineType }
  TSctLineType = (ltHorizontal, ltVertical, ltDiagonalLeft, ltDiagonalRight);

{ TSctLine }
  TSctLine = class(TSctLabel)
  private
    FLineType: TSctLineType;
  protected
    procedure SetLineType(lt: TSctLineType);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); override;
  published
    property Pen;
    property AlignVertical;
    property AlignHorizontal;
    property LineType: TSctLineType read FLineType write SetLineType default ltHorizontal;
    property Transparent;
  end;

{ TSctShape }
  TSctShape = class(TSctLabel)
  private
    FShapeType: TSctShapeType;
    procedure SetShapeType(ST: TSctShapeType);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); override;
  published
    property Brush;
    property Pen;
    property ShapeType: TSctShapeType read FShapeType write SetShapeType default sstRectangle;
  end;

{ TSctImageLabel }
  TSctImageLabel = class(TSctLabel)
  private
    FVariable: TSctvar;
    FPicture, FData: TPicture;
    FCenter: Boolean;
    FImageStream: TMemoryStream;
    FAceBitmap: TAceBitmap;
  protected
    function GetDisplayText: string; override;