prndbgeh.pas

Dbgrid 增强(附源码):支持多表头,多固定列,按表头排序,支持合计列,并支持直接打印

{*******************************************************}
{                                                       }
{                       EhLib v1.52                     }
{                TPrintDBGridEh component               }
{                                                       }
{   Copyright (c) 1998, 1999 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;

type
  TMeasureUnits = (MM,Inches);
  TPrintDBGridEhOption = (pghFitGridToPageWidth, pghColored, pghRowAutoStretch);
  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;
    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);
  protected
    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);
  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 Units:TMeasureUnits read FUnits write SetUnits;
    property OnPrinterSetupDialog: TNotifyEvent read FOnPrinterSetupDialog write FOnPrinterSetupDialog;
  end;


implementation

uses PrnDGDlg;

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;


{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;
var opt:Integer;
   tm: TTEXTMETRIC;
begin
 Result := 0;
 if CalcRect = False then begin
//   Dec(ARect.Top,(tm.tmExternalLeading + tm.tmInternalLeading) div 2); //Dec(ARect.Bottom,tm.tmExternalLeading);
   DBGridEh.WriteTextEh(ACanvas,ARect,FillRect,DX,DY,Text,Alignment,Layout,MultyL,EndEllipsis,LeftMarg,RightMarg)
 end else begin
    GetTextMetrics(ACanvas.Handle, tm);
    Inc(ARect.Left,DX);  Inc(ARect.Top,DY);
    Dec(ARect.Right,DX);  Dec(ARect.Bottom,DY);
    opt := DT_LEFT or DT_EXPANDTABS or DT_NOPREFIX or DT_CALCRECT;
    if MultyL then opt := opt or DT_WORDBREAK;
    Result := DrawTextEx(ACanvas.Handle, PChar(Text), Length(Text), ARect, opt, nil);
    Inc(Result,tm.tmExternalLeading);
    Inc(Result,DY*2);
 end;
end;

{$IFNDEF VER120} {Borland Delphi 3.0 }
type TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
{$ENDIF}

function StringReplaceMacros(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags; MacroChar: Char): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    if (Offset = 1) or (SearchStr[Offset-1] <> MacroChar) then
      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern
    else
      Result := Result + Copy(NewStr, 1, Offset - 1) + OldPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

function GetStingListText(sl:TStrings):String;
begin
  Result := Copy(sl.Text,1,Length(sl.Text)-2);
end;

{ TPrintDBGridEh }

constructor TPrintDBGridEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPage := TPageParams.Create;
  FPageFooter := TPageColontitle.Create;
  FPagEheader := TPageColontitle.Create;
  FTitle := TStringList.Create;
end;

destructor TPrintDBGridEh.Destroy;
begin
  Page.Free;
  PageFooter.Free;
  PagEheader.Free;
  FTitle.Free;
  inherited Destroy;
end;

{procedure TPrintDBGridEh.Print;
var ARepGrid:TReportGrid;
begin
    ARepGrid := TReportGrid.Create(Application);
  try
    ARepGrid.Visible := False;
    ARepGrid.Parent := Application.MainForm;

    ARepGrid.DefaultDrawing := False;
    ARepGrid.Align := alClient;
    if (PrintFontName <> '') then
      ARepGrid.Font.Name := PrintFontName;
    ARepGrid.AutoStretch := AutoStretch;
    ARepGrid.UseMultiTitle := DBGridEh.UseMultiTitle;
    ARepGrid.Title := Title;
    ARepGrid.CreateColumnsFromDBGridEh(DBGridEh);
    ARepGrid.Groups[0].AutoStretch := AutoStretch;
    ARepGrid.TopLeftPrintText := LeftTopText;
    ARepGrid.TopRightPrintText := RightTopText;
    ARepGrid.FillData;
    ARepGrid.FitWidthToPage :=  FitGridToPageWidth in Options;
    ARepGrid.Print;
  finally
    ARepGrid.Free;
  end;
end;}

procedure TPrintDBGridEh.Preview;
begin
  if Assigned(OnPrinterSetupDialog) then
    PrinterPreview.OnPrinterSetupDialog := OnPrinterSetupDialog
  else
    PrinterPreview.OnPrinterSetupDialog := PrinterSetupDialogPreview;
  PrinterPreview.PrinterSetupOwner := Self;
  PrintTo(PrinterPreview);
end;

procedure TPrintDBGridEh.PrintTo(VPrinter:TVirtualPrinter);
type
 TPolyBookmark = record
   bm:TBookmarkStr;
   InDS:Boolean;
   EOF:Boolean;