?? prndbgeh.pas
字號:
{*******************************************************}
{ }
{ 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) // 項塍麒螯 賑噤疣
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -