R.: Sim entendi errado mesmo..perdão. Faça o que eu fiz. Voce tem o fonte do tal, então, abra ele e olhe lá na parte em que ele irá imprimir os registros e você verá que ele usa algo como FDBGrid.DataSet.Field[indice].IsVisible para saber se o campo está visível - no Dataset ligado ao DBGrid!!! R.: Abri o fonte...mas na parte que imprimi não achei nada de estranho: veja abaixo: procedure TPrtGrid.PrintDialog;
begin
with TPrintDialog.Create(Self) do begin
try
Options := [poPageNums, poPrintToFile, poWarning];
MinPage := 1;
MaxPage := MaxPages;
FromPage := 1;
ToPage := MaxPages;
if Execute then begin
if PrintRange = prPageNums then begin
FFromPage := FromPage;
FEndPage := EndPage;
end;
FOrientation:=GetOrientation;
if PrintToFile then
SaveToFile
else begin
FPrintToFile := false;
Print;
end;
end;
finally
Free;
end;
end;
end;
Segue abaixo o *.pas do fonte do PrtGrid
é eu não consegui fazer funcionar....de repente você olhando o fonte do PrtGrid...você me da uma luz...
Valeu...muito Grato.
t+
fonte:
unit Prtgrid;
{ Original de Paul Rice }
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DBGrids, DB, Printers, ExtCtrls, Grids;
const
MaxPages = 1000;
MaxCols = 100;
type
TPageNumberPos = (pnNone, pnTopLeft, pnTopCenter, pnTopRight,
pnBotLeft, pnBotCenter, pnBotRight);
TPrtGrid = class(TComponent)
private
FFullPage: Boolean;
OutFileName : TFileName;
FDBGrid: TDBGrid;
FTitleFont: TFont;
FColHeaderFont: TFont;
FColScale: integer;
FLinesFont: TFont;
FTitleAlign: TAlignment;
FOrientation: TPrinterOrientation;
FPageNLabel: String;
FDateLabel: String;
FPageNPos: TPageNumberPos;
FDatePos: TPageNumberPos;
FPrintFileName: String;
FPrintFileDir: String;
FTitle: String;
FPrintMgrTitle: String;
FirstRecordY: longint;
DetailLineCharWidth: longint;
DetailLineCharHeight: longint;
RecCounter: longint;
FPrintToFile: boolean;
PrinterPageNo: longint;
FFromPage: longint;
FEndPage: longint;
NPositions: integer;
FTopMargin: integer;
FBottomMargin: integer;
FLeftMargin: integer;
FRightMargin: integer;
Positions: array[1..MaxCols]of longint;
FColLines: boolean;
FRowLines: boolean;
FBorder: boolean;
FHorizGap: integer;
FVertGap: integer;
procedure WriteAllToFile;
procedure SetTitleFont(Value: TFont);
procedure SetColHeaderFont(Value: TFont);
procedure SetLinesFont(Value: TFont);
procedure SetDBGrid(Value: TDBGrid);
function GetDBGrid: TDBGrid;
procedure SetPrintMgrTitle(const TmpStr: String);
function GetPrintMgrTitle: String;
function ColHeaderWidth(const ColHeaderStr: String): longint;
function ColHeaderHeight: longint;
procedure CalcPrinterPositions;
function SetAlign(align:TAlignment; Left, Right: longint): longint;
function SetPagePosX(PagePos: TPageNumberPos;
Left, Right: longint): longint;
function SetPagePosY(PagePos: TPageNumberPos;
Top, Bottom: longint): longint;
function PrepareAlign(Field: TField; Col: integer): longint;
procedure WriteTitleToPrinter;
procedure WriteColHdrsToPrinter(PosY: longint);
procedure WriteRecordToPrinter;
procedure PageJump;
function RealWidth: longint;
function AllPageFilled: boolean;
procedure SetPixelsPerInch;
function GetOrientation : TPrinterOrientation;
procedure InitializePrinter;
protected
procedure SetName(const Value: TComponentName); override;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Print;
procedure PrintDialog;
procedure SaveToFile;
published
property LeftMargin: integer read FLeftMargin write FLeftMargin;
property TopMargin: integer read FTopMargin write FTopMargin;
property RightMargin: integer read FRightMargin write FRightMargin;
property BottomMargin: integer read FBottomMargin
write FBottomMargin;
property ColHeaderFont: TFont read FColHeaderFont
write SetColHeaderFont;
property ColScale: integer read FColScale write FColScale; //*tj* added
property TitleFont: TFont read FTitleFont write SetTitleFont;
property LinesFont: TFont read FLinesFont write SetLinesFont;
property DBGrid: TDBGrid read GetDBGrid write SetDBGrid;
property PrintMgrTitle: String read GetPrintMgrTitle
write SetPrintMgrTitle;
property Title: String read FTitle write FTitle;
property TitleAlignment: TAlignment read FTitleAlign
write FTitleAlign;
property Orientation: TPrinterOrientation read FOrientation
write FOrientation;
property PrintToFile: boolean read FPrintToFile write FPrintToFile;
property FullPage: boolean read FFullPage write FFullPage;{RS 29.11.1996}
property PrintFileName: String read FPrintFileName
write FPrintFileName;
property PrintFileDir: String read FPrintFileDir
write FPrintFileDir;
property FromPage: longint read FFromPage write FFromPage;
property EndPage: longint read FEndPage write FEndPage;
property Border: boolean read FBorder write FBorder;
property ColLines: boolean read FColLines write FColLines;
property RowLines: boolean read FRowLines write FRowLines;
property HorizontalGap: integer read FHorizGap write FHorizGap;
property VerticalGapPct: integer read FVertGap write FVertGap;
property PageNumberPos: TPageNumberPos read FPageNPos
write FPageNPos;
property PageNumberLabel: String read FPageNLabel
write FPageNLabel;
property DatePos: TPageNumberPos read FDatePos write FDatePos;
property DateLabel: String read FDateLabel write FDateLabel;
end;
procedure Register;
implementation
var
TextMetrics: TTextMetric;
function Max(a, b: longint): longint;
begin
if a > b then Result := a else Result := b;
end;
function HeightScale(Value: longint; Pct: integer): longint;
begin
if Pct > 100 then
Pct := 100
else
if Pct < 0 then
Pct := 0;
if Pct = 0 then
Result := Value
else
Result := Value + MulDiv(Value, Pct, 100);
end;
function CenterY(PosY, TextHt, Pct: longint): longint;
begin
Result := PosY + (HeightScale(TextHt, Pct) - TextHt) div 2;
end;
constructor TPrtGrid.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FColHeaderFont := TFont.Create;
FTitleFont := TFont.Create;
FLinesFont := TFont.Create;
FDBGrid := nil;
FTitle := '';
FPrintMgrTitle := '';
RecCounter := 0;
FHorizGap := 8;
FVertGap := 40;
FTopMargin := 60;
FBottomMargin := 110;
FLeftMargin := 30;
FRightMargin := 30;
FPrintToFile := False;
FPrintFileName := 'GRID.LST';
FPrintFileDir := 'C:\';
FFullPage := false;
FFromPage := 1;
FEndPage := MaxPages;
FBorder := False;
FColLines := True;
FRowLines := False;
FTitleAlign := taCenter;
FPageNPos := pnBotCenter;
FPageNLabel := 'Page: ';
FDatePos := pnTopRight;
FDateLabel := '';
FOrientation := poLandscape;
FTitleFont.Name := 'Arial';
FTitleFont.Style := [fsBold];
FTitleFont.Size := 12;
FColHeaderFont.Name := 'Arial';
FColHeaderFont.Style := [fsBold];
FColHeaderFont.Size := 10;
FColScale := 100;
FLinesFont.Name := 'Arial';
FLinesFont.Style := [];
FLinesFont.Size := 9;
end;
destructor TPrtGrid.Destroy;
begin
FColHeaderFont.Free;
FTitleFont.Free;
FLinesFont.Free;
inherited Destroy;
end;
procedure TPrtGrid.SetColHeaderFont(Value: TFont);
begin
FColHeaderFont.Assign(Value);
end;
procedure TPrtGrid.SetTitleFont(Value: TFont);
begin
FTitleFont.Assign(Value);
end;
procedure TPrtGrid.SetLinesFont(Value: TFont);
begin
FLinesFont.Assign(Value);
end;
procedure TPrtGrid.SetDBGrid(Value: TDBGrid);
begin
FDBGrid := Value;
end;
function TPrtGrid.GetDBGrid: TDBGrid;
begin
Result := FDBGrid;
end;
procedure TPrtGrid.SetPrintMgrTitle(const TmpStr: String);
begin
FPrintMgrTitle := TmpStr;
end;
function TPrtGrid.GetPrintMgrTitle: String;
begin
Result := FPrintMgrTitle;
end;
procedure TPrtGrid.SetName(const Value: TComponentName);
var
ChangeText: Boolean;
begin
ChangeText := (Name = FPrintMgrTitle) and ((Owner = nil)
or not (Owner is TPrtGrid)
or not (csLoading in TPrtGrid(Owner).ComponentState));
inherited SetName(Value);
if ChangeText then
FPrintMgrTitle := Value;
end;
procedure TPrtGrid.WriteAllToFile;
var
OutFile: TextFile;
BookMark1: TBookMark;
FieldNo: longint;
TmpStr: String;
begin
if OutFileName = '' then
if FPrintFileName = '' then
OutFileName := 'C:\GRID.LST'
else
OutFileName := FPrintFileDir+FPrintFileName;
{$I-}
AssignFile(OutFile, OutFileName);
Rewrite(OutFile);
{$I+}
if IOResult <> 0 then begin
ShowMessage('Erro para abrir o arquivo :' + OutFileName);
Exit;
end;
with FDBGrid.DataSource.DataSet do begin
Writeln(OutFile, FTitle+' - Importa para o Excel (Delimitado por Tab)');
TmpStr := '';
for FieldNo := 0 to FieldCount - 1 do
if Fields[FieldNo].Visible then
TmpStr := TmpStr + Fields[FieldNo].DisplayLabel + #9;
WriteLn(OutFile, TmpStr);
Screen.Cursor := crHourGlass;
Bookmark1 := GetBookMark;
try
DisableControls;
RecCounter := 0;
First;
while not EOF do begin
TmpStr := '';
for FieldNo := 0 to FieldCount - 1 do
if Fields[FieldNo].Visible then
TmpStr := TmpStr + Fields[FieldNo].DisplayText + #9;
WriteLn(OutFile, TmpStr);
Inc(RecCounter);
Next;
end;
finally
Screen.Cursor := crDefault;
EnableControls;
CloseFile(OutFile);
GotoBookMark(BookMark1);
FreeBookMark(BookMark1);
end;
end;
end;
function TPrtGrid.ColHeaderWidth(const ColHeaderStr: String): longint;
var
tmpFont: TFont;
begin
with Printer.Canvas do begin
tmpFont := TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FColHeaderFont);
SetPixelsPerInch;
Result := TextWidth(ColHeaderStr);
Font.Assign(tmpFont);
tmpFont.Free;
SetPixelsPerInch;
end;
end;
function TPrtGrid.ColHeaderHeight: longint;
var
tmpFont: TFont;
begin
with Printer.Canvas do begin
tmpFont := TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FColHeaderFont);
SetPixelsPerInch;
Result := HeightScale(TextHeight('M'), FVertGap);
Font.Assign(tmpFont);
SetPixelsPerInch;
tmpFont.Free;
end;
end;
procedure TPrtGrid.CalcPrinterPositions;
var
ColWidth, FieldNo: longint;
begin
if FBorder then
Positions[1] := 1
else
Positions[1] := 0;
NPositions := 0;
with FDBGrid.DataSource.DataSet do
for FieldNo := 0 to FieldCount - 1 do
if Fields[FieldNo].Visible then begin
inc(NPositions);
ColWidth := Max(ColHeaderWidth(Fields[FieldNo].DisplayLabel),
(DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
Positions[NPositions + 1] := Positions[NPositions]
+ ColWidth + 2*FHorizGap;
end;
end;
function TPrtGrid.SetAlign(align: TAlignment; Left, Right:longint):longint;
var
PosX: longint;
begin
PosX := 0;
with Printer.Canvas do begin
case Align of
taLeftJustify:
begin
SetTextAlign(Handle, TA_LEFT);
PosX := Left + FHorizGap;
end;
taRightJustify:
begin
SetTextAlign(Handle, TA_RIGHT);
PosX := Right - FHorizGap;
end;
taCenter:
begin
SetTextAlign(Handle, TA_CENTER);
PosX := Left + Round((Right - Left) / 2);
end;
end;
end;
Result := PosX;
end;
function TPrtGrid.SetPagePosX(PagePos: TPageNumberPos; Left, Right: longint): longint;
var
PosX: longint;
begin
PosX := 0;
with Printer.Canvas do begin
case PagePos of
pnTopLeft, pnBotLeft:
begin
SetTextAlign(Handle, TA_LEFT);
PosX := Left + FHorizGap;
end;
pnTopRight, pnBotRight:
begin
SetTextAlign(Handle, TA_RIGHT);
PosX := Right - FHorizGap;
end;
pnTopCenter, pnBotCenter:
begin
SetTextAlign(Handle, TA_CENTER);
PosX := Left + Round((Right - Left)/2);
end;
end;
end;
Result := PosX;
end;
function TPrtGrid.SetPagePosY(PagePos: TPageNumberPos; Top, Bottom: longint): longint;
var
PosY: longint;
begin
case PagePos of
pnBotLeft, pnBotCenter, pnBotRight:
begin
PosY := Bottom;
end;
else
PosY := Top;
end;
Result := PosY;
end;
function TPrtGrid.PrepareAlign(Field:TField; Col:integer): longint;
begin
Result := SetAlign(Field.Alignment, Positions[col], Positions[col + 1]);
end;
procedure TPrtGrid.WriteTitleToPrinter;
var
PosX, PosY, FieldNo, tmpColHeaderHeight: longint;
TmpFont: TFont;
tmpFontCreated: boolean;
begin
if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then
with Printer.Canvas do begin
tmpColHeaderHeight := ColHeaderHeight;
tmpFont := TFont.Create;
if (FTitle <> '') or (FDatePos <> pnNone) or (FPageNPos <> pnNone) then begin
tmpFont.Assign(Font);
Font.Assign(FTitleFont);
SetPixelsPerInch;
tmpFontCreated := True;
end
else
tmpFontCreated := False;
if FDatePos <> pnNone then begin
if FDateLabel = '' then
FDateLabel := FormatDateTime('mmm d, yyyy',SysUtils.Date);
PosX := SetPagePosX(FDatePos, FLeftMargin, FLeftMargin + RealWidth);
PosY := SetPagePosY(FDatePos, FTopMargin, Printer.PageHeight - FBottomMargin);
TextOut(PosX, PosY, FDateLabel);
end;
if FTitle <> '' then begin
PosX := SetAlign(FTitleAlign, FLeftMargin, FLeftMargin + RealWidth);
TextOut(PosX, FTopMargin, FTitle);
end;
if FPageNPos <> pnNone then begin
PosX := SetPagePosX(FPageNPos, FLeftMargin, FLeftMargin + RealWidth);
PosY := SetPagePosY(FPageNPos, FTopMargin, Printer.PageHeight - FBottomMargin + 8);
TextOut(PosX, PosY, FPageNLabel + IntToStr(PrinterPageNo));
end;
if (FTitle <> '') or (FDatePos in [pnTopLeft, pnTopCenter, pnTopRight])
or (FPageNPos in [pnTopLeft, pnTopCenter, pnTopRight]) then
FirstRecordY := FTopMargin + HeightScale(TextHeight('M'), FVertGap) + tmpColHeaderHeight
else
FirstRecordY := FTopMargin + tmpColHeaderHeight;
if tmpFontCreated then begin
Font.Assign(tmpFont);
SetPixelsPerInch;
end;
tmpFont.Free;
if FFullPage then
if FColLines then
for FieldNo := 2 to NPositions do begin
MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
LineTo(FLeftMargin + Positions[FieldNo], Printer.PageHeight - FBottomMargin);
end;
if dgTitles in FDBGrid.Options then
WriteColHdrsToPrinter(FirstRecordY - tmpColHeaderHeight);
end;
end;
procedure TPrtGrid.WriteColHdrsToPrinter(PosY: longint);
var
Col, PosX: longint;
DSrcFld: longint;
TmpFont: TFont;
Rect: TRect;
begin
with FDBGrid.DataSource.DataSet, Printer.Canvas do begin
tmpFont := TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FColHeaderFont);
SetPixelsPerInch;
Rect.top := CenterY(PosY, TextHeight('M'), 2*FVertGap);
Rect.bottom := FirstRecordY+((RecCounter + 1) * TextHeight('M'));
Col := 0;
for DSrcFld := 0 to FieldCount - 1 do begin
if Fields[DSrcFld].Visible then begin
inc(Col);
PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayLabel);
end;
end;
Moveto(FLeftMargin, FirstRecordY);
Lineto(FLeftMargin + RealWidth, FirstRecordY);
Font.Assign(tmpFont);
SetPixelsPerInch;
tmpFont.Free;
end;
end;
procedure TPrtGrid.WriteRecordToPrinter;
var
Col, PosX, PosY, FieldNo: longint;
DSrcFld: longint;
tmpFont: TFont;
Rect: TRect;
begin
if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then
with FDBGrid.DataSource.DataSet, Printer.Canvas do begin
tmpFont := TFont.Create;
tmpFont.Assign(Font);
Font.Assign(FLinesFont);
SetPixelsPerInch;
Col := 0;
PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
Rect.top := CenterY(PosY, TextHeight('M'), FVertGap);
Rect.bottom:=FirstRecordY+((RecCounter+1) * DetailLineCharHeight);
for DSrcFld := 0 to FieldCount - 1 do begin
if Fields[DSrcFld].Visible then begin
inc(Col);
PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayText);
end;
end;
if FRowLines then begin
MoveTo(FLeftMargin, PosY);
LineTo(FLeftMargin + RealWidth, PosY);
end;
if not FFullPage then
if FColLines then
for FieldNo := 2 to NPositions do begin
MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
LineTo(FLeftMargin + Positions[FieldNo], PosY + DetailLineCharHeight);
end;
Font.Assign(tmpFont);
SetPixelsPerInch;
tmpFont.Free;
end;
end;
procedure TPrtGrid.PageJump;
begin
RecCounter := 0;
if (PrinterPageNo >= FFromPage) and (PrinterPageNo < FEndPage) then
Printer.NewPage;
inc(PrinterPageNo);
end;
function TPrtGrid.RealWidth: longint;
begin
Result := Printer.PageWidth - FLeftMargin - FRightMargin;
end;
function TPrtGrid.AllPageFilled: boolean;
begin
Result := (not FPrintToFile)
and ((FirstRecordY + (RecCounter + 1) * DetailLineCharHeight)
>= (Printer.PageHeight - FBottomMargin));
end;
procedure TPrtGrid.Print;
var
BMark: TBookMark;
PosY: longint;
tmpStyle: TBrushStyle;
begin
PosY := 0;
if not Assigned(FDBGrid) then
raise Exception.Create('Erro: DBGrid não associado.');
if FPrintToFile then begin
WriteAllToFile;
Exit;
end;
InitializePrinter;
with FDBGrid.DataSource.DataSet do begin
BMark := GetBookMark;
try
DisableControls;
RecCounter := 0;
PrinterPageNo := 1;
CalcPrinterPositions;
if (Positions[NPositions + 1] > RealWidth) then
begin
if MessageDlg('Impressão muito larga para o papel.'+
' Aborta a impressão?', mtConfirmation, mbYesNoCancel, 0 )<>idNo then
begin
Printer.Abort;
exit;
end;
end;
Screen.Cursor := crHourGlass;
First;
while not EOF do begin
if RecCounter = 0 then
WriteTitleToPrinter;
WriteRecordToPrinter;
Inc(RecCounter);
Next;
if AllPageFilled then begin
PageJump;
if PrinterPageNo > FEndPage then break;
end;
end;
if FRowLines then begin
PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
Printer.Canvas.MoveTo(FLeftMargin, PosY);
Printer.Canvas.LineTo(FLeftMargin + RealWidth, PosY);
end;
if FBorder then begin
tmpStyle:=Printer.Canvas.Brush.Style;
Printer.Canvas.Brush.Style:=bsClear;
if FullPage then
Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - ColHeaderHeight,
FLeftMargin + RealWidth, Printer.PageHeight - FBottomMargin)
else
Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - ColHeaderHeight,
FLeftMargin + RealWidth, PosY);
Printer.Canvas.Brush.Style:=tmpStyle;
end;
finally
EnableControls;
Screen.Cursor := crDefault;
GotoBookMark(BMark);
FreeBookMark(BMark);
Printer.EndDoc;
end;
end;
end;
procedure TPrtGrid.PrintDialog;
begin
with TPrintDialog.Create(Self) do begin
try
Options := [poPageNums, poPrintToFile, poWarning];
MinPage := 1;
MaxPage := MaxPages;
FromPage := 1;
ToPage := MaxPages;
if Execute then begin
if PrintRange = prPageNums then begin
FFromPage := FromPage;
FEndPage := EndPage;
end;
FOrientation:=GetOrientation;
if PrintToFile then
SaveToFile
else begin
FPrintToFile := false;
Print;
end;
end;
finally
Free;
end;
end;
end;
procedure TPrtGrid.SaveToFile;
begin
FPrintToFile := true;
with TSaveDialog.Create(Self) do begin
try
Filter := 'List Files (*.LST)|*.LST|Any file(*.*)|*.*';
if FPrintFileDir <> '' then InitialDir := FPrintFileDir;
if FPrintFileName <> '' then begin
FileName := FPrintFileName;
Filter := Filter + '|This file (*' + ExtractFileExt(FileName) + ')|*'
+ ExtractFileExt(FileName);
FilterIndex := 3;
end;
if Execute then begin
FPrintFileDir := ExtractFilePath(FileName);
FPrintFileName := ExtractFileName(FileName);
OutFileName := FileName;
Print;
end;
finally
Free;
end;
end;
end;
procedure TPrtGrid.SetPixelsPerInch;
var
FontSize: integer;
begin
if not Printer.Printing then
ShowMessage('Erro: BeginDoc não foi chamado antes do SetPixelsPerInch');
FontSize:=Printer.Canvas.Font.Size;
Printer.Canvas.Font.PixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
Printer.Canvas.Font.Size := FontSize;
GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
end;
function TPrtGrid.GetOrientation : TPrinterOrientation;
var
FDevice, FDriver, FPort: PChar;
FHandle: THandle;
FDeviceMode: PDevMode;
begin
result := poPortrait;
GetMem (FDevice, 255);
GetMem (FDriver, 255);
GetMem (FPort, 255);
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
if FHandle = 0 then begin
Printer.PrinterIndex := Printer.PrinterIndex;
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
end;
if FHandle <> 0 then begin
FDeviceMode := Ptr(FHandle);
case FDeviceMode^.dmOrientation of
dmOrient_Portrait: result := poPortrait;
dmOrient_Landscape: result := poLandscape;
else
result := poLandscape;
end;
end
else
ShowMessage('Erro não consigo identificar o modo de saida');
FreeMem (FDevice, 255);
FreeMem (FDriver, 255);
FreeMem (FPort, 255);
end;
procedure TPrtGrid.InitializePrinter;
begin
Printer.Orientation := FOrientation;
Printer.BeginDoc;
Printer.Title := FPrintMgrTitle;
Printer.Canvas.Font.Assign(FLinesFont);
SetPixelsPerInch;
FVertGap:= Trunc(TextMetrics.tmHeight * 0.8);
FHorizGap:= TextMetrics.tmMaxCharWidth div 4;
DetailLineCharHeight := HeightScale(TextMetrics.tmHeight,FVertGap);
DetailLineCharWidth := TextMetrics.tmMaxCharWidth;
if (FColScale <> 100) and (FColScale > 0) and (FColScale < 500) then
DetailLineCharWidth := 1+Trunc(DetailLineCharWidth * ColScale / 100);
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TPrtGrid]);
end;
end.
