Quick Report - Imprir Tabela Filtrada

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.