prndbgeh.pas

来自「EHlib CN For Delphi2009」· PAS 代码 · 共 1,912 行 · 第 1/5 页

{*******************************************************}
{                                                       }
{                      EhLib v4.2                       }
{                TPrintDBGridEh component               }
{                    (Build 4.2.02)                     }
{                                                       }
{   Copyright (c) 1998-2006 by Dmitry V. Bolshakov      }
{                                                       }
{*******************************************************}

unit PrnDbgeh {$IFDEF CIL} platform{$ENDIF};

interface

{$I EhLib.Inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, DBGridEh, PrntsEh,
{$IFDEF CIL}
  EhLibVCLNET,
  System.Text,
  System.Runtime.InteropServices,
{$ELSE}
  EhLibVCL,
{$ENDIF}
  ImgList, PrViewEh, Forms, DB, GridsEh, 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);
    function IsBottomMarginStored: Boolean;
    function IsLeftMarginStored: Boolean;
    function IsRightMarginStored: Boolean;
    function IsTopMarginStored: Boolean;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property BottomMargin: Currency read FBottomMargin write SetBottomMargin stored IsBottomMarginStored;
    property LeftMargin: Currency read FLeftMargin write SetLeftMargin stored IsLeftMarginStored;
    property RightMargin: Currency read FRightMargin write SetRightMargin stored IsRightMarginStored;
    property TopMargin: Currency read FTopMargin write SetTopMargin stored IsTopMarginStored;
//    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;
    FFont: TFont;
    FLeftText: TStrings;
    FLineType: TPageColontitleLineType;
    FRightText: TStrings;
    procedure SetCenterText(const Value: TStrings);
    procedure SetFont(const Value: TFont);
    procedure SetLeftText(const Value: TStrings);
    procedure SetLineType(const Value: TPageColontitleLineType);
    procedure SetRightText(const Value: TStrings);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create;
    destructor Destroy; override;
  published
    property CenterText: TStrings read FCenterText write SetCenterText;
    property Font: TFont read FFont write SetFont;
    property LeftText: TStrings read FLeftText write SetLeftText;
    property LineType: TPageColontitleLineType read FLineType write SetLineType default pcltNon;
    property RightText: TStrings read FRightText write SetRightText;
  end;

  TPrintDBGridEh = class(TComponent)
  private
    FAfterGridText: TStrings;
    FBeforeGridText: TStrings;
    FColCellParamsEh: TColCellParamsEh;
    FDBGridEh: TDBGridEh;
    FOnAfterPrint: TNotifyEvent;
    FOnBeforePrint: TNotifyEvent;
    FOnPrinterSetupDialog: TNotifyEvent;
    FOptions: TPrintDBGridEhOptions;
    FPage: TPageParams;
    FPageFooter: TPageColontitle;
    FPageHeader: TPageColontitle;
    FPrintFontName: String;
    FSubstitutesNames: TStrings;
    FSubstitutesValues: TStrings;
    FTitle: TStrings;
    FUnits: TMeasureUnits;
    FVarColCellParamsEh: TColCellParamsEh;
    FLastRowTexts: TStrings;
    function GetAfterGridText: TStrings;
    function GetBeforeGridText: TStrings;
    function GridTextReplace(RichStrings: TStrings; const SearchStr, ReplaceStr: string;
      StartPos, Length: Integer; Options: TSearchTypes; ReplaceAll: Boolean): Integer;
    procedure ReadAfterGridText(Stream: TStream);
    procedure ReadBeforeGridText(Stream: TStream);
    procedure SetAfterGridText(const Value: TStrings);
    procedure SetBeforeGridText(const Value: TStrings);
    procedure SetDBGridEh(const Value: TDBGridEh);
    procedure SetOptions(const Value: TPrintDBGridEhOptions);
    procedure SetPage(const Value: TPageParams);
    procedure SetPageFooter(const Value: TPageColontitle);
    procedure SetPageHeader(const Value: TPageColontitle);
    procedure SetPrintFontName(const Value: String);
    procedure SetTitle(const Value: TStrings);
    procedure SetUnits(const Value: TMeasureUnits);
    procedure WriteAfterGridText(Stream: TStream);
    procedure WriteBeforeGridText(Stream: TStream);
  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;
    function PrinterSetupDialog: Boolean;
    procedure Preview;
    procedure Print;
    procedure PrintTo(VPrinter: TVirtualPrinter);
    procedure SetSubstitutes(ASubstitutes: array of const);
  published
    property AfterGridText: TStrings read GetAfterGridText write SetAfterGridText stored False;
    property BeforeGridText: TStrings read GetBeforeGridText write SetBeforeGridText stored False;
    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 OnAfterPrint: TNotifyEvent read FOnAfterPrint write FOnAfterPrint;
    property OnBeforePrint: TNotifyEvent read FOnBeforePrint write FOnBeforePrint;
    property OnPrinterSetupDialog: TNotifyEvent read FOnPrinterSetupDialog write FOnPrinterSetupDialog;
  end;


implementation

uses PrnDGDlg, RichEdit, ComStrs, EhLibConsts, ToolCtrlsEh
  {$IFDEF EH_LIB_6} ,Variants ,Types {$ENDIF};

var
  FCheckBoxWidth, FCheckBoxHeight: Integer;

procedure GetCheckSize;
begin
  with TBitmap.Create do
  try
{$IFDEF CIL}
    Handle := LoadBitmap(0, OBM_CHECKBOXES);
{$ELSE}
    Handle := LoadBitmap(0, PChar(32759));
{$ENDIF}
    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);
  DrawTextEh(Canvas.Handle, 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;
  ARightToLeftAlignment, ARightToLeftReading: 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);
  RTL: array[Boolean] of Integer = (0, DT_RTLREADING);
var opt: Integer;
  tm: TTEXTMETRIC;
  rect1: TRect;
  txth, DrawFlag: Integer;
  lpDTP: TDrawTextParams;
begin
  Result := 0;
  if ARightToLeftAlignment then
  begin
    ChangeBiDiModeAlignment(Alignment);
    opt := LeftMarg;
    LeftMarg := RightMarg;
    RightMarg := opt;
  end;
  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] or RTL[ARightToLeftReading];

    {}
    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 := WindowsDrawTextEx(ACanvas.Handle, Text, Length(Text), {}
        rect1, DrawFlag or DT_CALCRECT, lpDTP) // 项塍麒螯 赈噤疣?
    else txth := 0;
    rect1 := ARect; {}
    InflateRect(rect1, -DX, -DY);

    case Layout of
      tlTop: ;
      tlBottom: rect1.top := rect1.Bottom - txth;
      tlCenter: rect1.top := rect1.top + ((rect1.Bottom - rect1.top) div 2) - (txth div 2);
    end;

    if DX > 0 then rect1.Bottom := rect1.Bottom + 1;
      WindowsDrawTextEx(ACanvas.Handle, Text, Length(Text), rect1, DrawFlag, lpDTP); {}
  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 or RTL[ARightToLeftReading];
    if MultyL
      then opt := opt or DT_WORDBREAK;
    Result := WindowsDrawTextEx(ACanvas.Handle, Text, Length(Text), ARect, opt);
    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 := NlsUpperCase(S);
    Patt := NlsUpperCase(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;

{ TRichEditStrings, from VCL ComCtrls.pas }

const
  ReadError = $0001;
  WriteError = $0002;
  NoError = $0000;

type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

  TRichEditStrings = class(TStrings)
  private
    RichEdit: TRichEdit;
    FPlainText: Boolean;
    FConverter: TConversion;
    procedure EnableChange(const Value: Boolean);
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure SetTextStr(const Value: string); override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure AddStrings(Strings: TStrings); override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;

{$IFDEF CIL}
    procedure LoadFromFile(const FileName: string; Encoding: System.Text.Encoding); override;
    procedure LoadFromStream(Stream: TStream; Encoding: System.Text.Encoding); override;
    procedure SaveToFile(const FileName: string; Encoding: System.Text.Encoding); override;
    procedure SaveToStream(Stream: TStream; Encoding: System.Text.Encoding); override;
{$ELSE}
    procedure LoadFromFile(const FileName: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToFile(const FileName: string); override;
    procedure SaveToStream(Stream: TStream); override;
{$ENDIF}
    property PlainText: Boolean read FPlainText write FPlainText;
  end;

constructor TRichEditStrings.Create;
begin
  inherited Create;
  RichEdit := TRichEdit.Create(nil);
  RichEdit.Visible := False;
  //Application.CreateHandle;
  RichEdit.ParentWindow := GetDesktopWindow; //}Application.Handle;
end;

destructor TRichEditStrings.Destroy;
begin
  FreeAndNil(FConverter);
  FreeAndNil(RichEdit);
  inherited Destroy;
end;

procedure TRichEditStrings.AddStrings(Strings: TStrings);
var
  SelChange: TNotifyEvent;
begin
  SelChange := RichEdit.OnSelectionChange;