prndbgeh.pas

Delphi控件源码

{*******************************************************}
{                                                       }
{                       EhLib v1.56                     }
{                TPrintDBGridEh component               }
{                                                       }
{   Copyright (c) 1998, 2000 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}

unit PrnDbgeh;

interface

{$I EhLib.Inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, DBGridEh, PrntsEh
{$IFDEF EH_LIB_4} ,ImgList{$ENDIF}
  ,PrViewEh,Forms,DB, Grids, StdCtrls, ComCtrls;

type
  TMeasureUnits = (MM,Inches);
  TPrintDBGridEhOption = (pghFitGridToPageWidth, pghColored, pghRowAutoStretch,
                          pghFitingByColWidths, pghOptimalColWidths);
  TPrintDBGridEhOptions = set of TPrintDBGridEhOption;


  TPageParams = class(TPersistent)
  private
//    FColumns: Integer;
//    FColumnSpace: Currency;
    FBottomMargin: Currency;
    FRightMargin: Currency;
    FLeftMargin: Currency;
    FTopMargin: Currency;
    procedure SetBottomMargin(const Value: Currency);
//    procedure SetColumns(const Value: Integer);
//    procedure SetColumnSpace(const Value: Currency);
    procedure SetLeftMargin(const Value: Currency);
    procedure SetRightMargin(const Value: Currency);
    procedure SetTopMargin(const Value: Currency);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property BottomMargin:Currency read FBottomMargin write SetBottomMargin;
    property LeftMargin:Currency read FLeftMargin write SetLeftMargin;
    property RightMargin:Currency read FRightMargin write SetRightMargin;
    property TopMargin:Currency read FTopMargin write SetTopMargin;
//    property Columns:Integer read FColumns write SetColumns;
//    property ColumnSpace:Currency read FColumnSpace write SetColumnSpace;
  end;

  TPageColontitleLineType = (pcltNon,pcltSingleLine,pcltDoubleLine);

  TPageColontitle = class(TPersistent)
  private
    FCenterText: TStrings;
    FLeftText: TStrings;
    FRightText: TStrings;
    FFont: TFont;
    FLineType: TPageColontitleLineType;
    procedure SetCenterText(const Value: TStrings);
    procedure SetFont(const Value: TFont);
    procedure SetLeftText(const Value: TStrings);
    procedure SetRightText(const Value: TStrings);
    procedure SetLineType(const Value: TPageColontitleLineType);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create;
    destructor Destroy; override;
  published
    property LeftText:TStrings read FLeftText write SetLeftText;
    property CenterText:TStrings read FCenterText write SetCenterText;
    property RightText:TStrings read FRightText write SetRightText;
    property Font:TFont read FFont write SetFont;
    property LineType: TPageColontitleLineType read FLineType write SetLineType default pcltNon;
  end;

  TPrintDBGridEh = class(TComponent)
  private
    FDBGridEh: TDBGridEh;
    FUnits: TMeasureUnits;
    FTitle: TStrings;
    FPrintFontName: String;
    FOptions: TPrintDBGridEhOptions;
    FPage: TPageParams;
    FPageFooter: TPageColontitle;
    FPageHeader: TPageColontitle;
    FOnPrinterSetupDialog: TNotifyEvent;
    FBeforeGridText: TStrings;
    FAfterGridText: TStrings;
    FSubstitutesNames: TStrings;
    FSubstitutesValues: TStrings;
    procedure ReadBeforeGridText(Stream: TStream);
    procedure ReadAfterGridText(Stream: TStream);
    procedure SetDBGridEh(const Value: TDBGridEh);
    procedure SetUnits(const Value: TMeasureUnits);
    procedure SetTitle(const Value: TStrings);
    procedure SetPrintFontName(const Value: String);
    procedure SetOptions(const Value: TPrintDBGridEhOptions);
    procedure SetPage(const Value: TPageParams);
    procedure SetPageFooter(const Value: TPageColontitle);
    procedure SetPageHeader(const Value: TPageColontitle);
    procedure SetBeforeGridText(const Value: TStrings);
    procedure WriteBeforeGridText(Stream: TStream);
    procedure WriteAfterGridText(Stream: TStream);
    procedure SetAfterGridText(const Value: TStrings);
    function  GetAfterGridText: TStrings;
    function  GetBeforeGridText: TStrings;
    function  GridTextReplace(RichStrings:TStrings; const SearchStr, ReplaceStr: string;
      StartPos, Length: Integer; Options: TSearchTypes; ReplaceAll: Boolean): Integer;
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PrinterSetupDialogPreview(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Preview;
    procedure Print;
    function  PrinterSetupDialog:Boolean;
    procedure PrintTo(VPrinter:TVirtualPrinter);
    procedure SetSubstitutes(ASubstitutes:array of const);
  published
    property DBGridEh:TDBGridEh read FDBGridEh write SetDBGridEh;
    property Options:TPrintDBGridEhOptions read FOptions write SetOptions;
    property Page:TPageParams read FPage write SetPage;
    property PageFooter:TPageColontitle read FPageFooter write SetPageFooter;
    property PageHeader:TPageColontitle read FPageHeader write SetPageHeader;
    property PrintFontName:String read FPrintFontName write SetPrintFontName;
    property Title:TStrings read FTitle write SetTitle;
    property BeforeGridText:TStrings read GetBeforeGridText write SetBeforeGridText stored False;
    property AfterGridText:TStrings read GetAfterGridText write SetAfterGridText stored False;
    property Units:TMeasureUnits read FUnits write SetUnits;
    property OnPrinterSetupDialog: TNotifyEvent read FOnPrinterSetupDialog write FOnPrinterSetupDialog;
  end;


implementation

uses PrnDGDlg, RichEdit, ComStrs;

var
  FCheckBoxWidth, FCheckBoxHeight: Integer;

procedure GetCheckSize;
begin
  with TBitmap.Create do
    try
      Handle := LoadBitmap(0, PChar(32759));
      FCheckBoxWidth := Width div 4;
      FCheckBoxHeight := Height div 3;
    finally
      Free;
    end;
end;

function iif(Condition:Boolean;V1,V2:Integer):Integer;
begin
  if (Condition) then Result := V1 else Result := V2;
end;

function GetTextWidth(Canvas:TCanvas; Text:String):Integer;
var ARect:TRect;
    uFormat:Integer;
begin
  uFormat := DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_EXPANDTABS;
  ARect := Rect(0,0,1,0);
  DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect, uFormat);
  Result := ARect.Right - ARect.Left;
end;

{new WriteTextEh}{}
function WriteTextEh(ACanvas: TCanvas; ARect: TRect; FillRect:Boolean; DX, DY: Integer;
  const Text: string; Alignment: TAlignment; Layout: TTextLayout; MultyL:Boolean;
  EndEllipsis:Boolean; LeftMarg,RightMarg:Integer; CalcRect:Boolean):Integer;
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_EXPANDTABS or DT_NOPREFIX,
      DT_RIGHT or DT_EXPANDTABS or DT_NOPREFIX,
      DT_CENTER or DT_EXPANDTABS or DT_NOPREFIX );
var opt:Integer;
   tm: TTEXTMETRIC;
   rect1: TRect;
   txth, DrawFlag: Integer;
   lpDTP :  TDrawTextParams;
begin
 Result := 0;
 if CalcRect = False then begin
   if (FillRect = True) then ACanvas.FillRect(ARect);

   DrawFlag := 0;
   if (MultyL = True) then DrawFlag := DrawFlag or DT_WORDBREAK;
   if (EndEllipsis = True) then DrawFlag := DrawFlag or DT_END_ELLIPSIS;
   DrawFlag := DrawFlag or AlignFlags[Alignment];

    {}
   rect1.Left := 0; rect1.Top := 0; rect1.Right := 0; rect1.Bottom := 0;
   rect1 := ARect;  {}

   lpDTP.cbSize := SizeOf(lpDTP);
   lpDTP.uiLengthDrawn := Length(Text);
   lpDTP.iLeftMargin := LeftMarg;
   lpDTP.iRightMargin := RightMarg;

   InflateRect(rect1, -DX, -DY);

   if (Layout <> tlTop) {and (MultyL = True)} then
     txth := DrawTextEx(ACanvas.Handle,PChar(Text), Length(Text),    {}
        rect1, DrawFlag or DT_CALCRECT,@lpDTP) // 项塍麒螯 赈噤疣