(*  PRTGRID.PAS  -- TPrintGrid v3.0b.
    Update as of Mar 22, 1997.  This minor update fixes some bugs
    and adds a few new features.  Nothing of any Earth-shaking
    importance, but it does make a nice VCL a little nicer.
   
  Thanks to these folks who helped fix bugs and add new features:
     - Rene' Schwietzke. Nov 29, 1996 - new features
     - Steve Turner - the best fix for the "range error"/GPF 
       regarding the check of the printer orientation.

  Several others also sent fixes for the printer orientation bug,
  but Steve's seemed like the best solution.  

  Changes since v3.0:
  - FullPage property added; lets you choose to print a full page,
    or only the used part (Page number stays at bottom)

  - RowLine now prints a line after the last record, if you
    are using lines between each row of text

  - If the printed text line is wider than the paper, a user dialog 
    now comes up asking if user wants to cancel the print

  - Some printer drivers caused a "range error"/GPF when the
    VCL checked the printer orientation.  This has been fixed by
    Steve Turner.
*)

(* PRTGRID.PAS  -- TPrintGrid v3.0b.
  This is a Delphi v1 component that lets you print a DBGrid.
  Public domain by Eric W. Engler.  Mar 21, 1997.

     User can select DPI and Orientation using the std printer
  configuration dialog.  As this code is now, there will be slight
  variances in sizing and proportions for different DPI settings,
  but it will look acceptable.  I have tested with 300 and 600 DPI
  laser printers, but I haven't tested with 1200 DPI yet.
     I think the user can chg printers via the dialog at run time and
  this will still work OK, but I haven't tested this.
     This will need modifications if you modify a DBGrid to allow
  multi-row column headers or data values (or if you embed bitmaps),
  but most owner-draw code added to the grid to control colors won't
  conflict with this component.

  By the way: this component goes along nicely with the TDBSearch
  component, which searches for text in grids.
*)

(* to do:
   1. chg HorizGap to a percentage of a char size using
      detail line font
   2. Although VertGapPct is already supposed to be based on
      a percent of char size, I had to tweak it in a DPI-dependant
      manner to get reasonable sizing at both 300 and 600 DPI. Why?
   3. Change margin specs to a DPI-independant measurement, instead
      of pixel counts (perhaps keyed to detail font char size; or
      if you feel agressive, tie them to inches.  Pay attention to
      Orientation and paper size differences).
   4. Make sure that all sizing formulas produce identically-
      sized and proportioned reports at both 300 DPI and 600 DPI
      (and up!).  As I said, this now works much better but it's
      output isn't identically sized at 300 and 600.
   5. Automatically default Orientation depending on how wide
      the grid is.  Also, perhaps you want to use larger fonts
      for the printed report if the screen grid is small.  Maybe
      call this an "autolayout" property?
   6. Perhaps the "Print to File" option should bring up a dialog
      box giving format options like quoted comma-separated fields,
      etc.
*)

unit Prtgrid;

interface

uses
  SysUtils,  WinTypes,  WinProcs,  Messages,  Classes,  Graphics,  Controls,
  Forms,  Dialogs, DBGrids, DB, Printers, ExtCtrls;

const
  MaxPages = 1000;
  MaxCols = 100;

type
   TPageNumberPos = (pnNone,  pnTopLeft, pnTopCenter, pnTopRight,
                     pnBotLeft, pnBotCenter, pnBotRight);


   {TPrintEvent = (pePrintingRecord)}
   TPrintEventHandler =
     procedure(Sender:TObject; var DoIt:boolean) of object;


   TPrintGrid = class(TComponent)
   private
        FFullPage: Boolean;   { new property  RS 29.11.1996 }
        OutFileName : TFileName;
        FDBGrid: TDBGrid;
        FTitleFont: TFont;
        FColHeaderFont: TFont;
        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; { number of pixels bet. grid columns }
        FVertGap: integer;  { percent of vert char hgt }
        FOnPrintRecord: TPrintEventHandler;
        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;
        {function RealToStr(x: Real): String;}
        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 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;
        property OnPrintRecord:TPrintEventHandler read FOnPrintRecord
          write FOnPrintRecord;
    end;

procedure Register;

implementation

var
  TextMetrics: TTextMetric;
{  CurrentOrientation: TPrinterOrientation;}

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 TPrintGrid.Create(AOwner:TComponent);
begin
    inherited Create(AOwner);

    { We need to create new font objects because we're not going to
      use any from the caller's program.  We will, however, "borrow"
      a pointer to the caller's TDBGrid object, so we don't want to
      allocate a new TDBGrid object here.  Note that the declarations
      of these objects near the top of this file is just allocating
      pointers - not actual storage locations. }
    FColHeaderFont := TFont.Create;
    FTitleFont := TFont.Create;
    FLinesFont := TFont.Create;

    { DEFAULT VALUES FOR ALL PROPERTIES }
    { These defaults will be overridden by the developer's changes made
      in the Object Inspector at design time.  These defaults are only the
      starting values that will initially be shown in the Object Inspector.
      Once changed, the new values will be automatically written to the
      Form file (which is often called object serialization).  All property
      values are automatically made persistant bec. of class TPersistant
      in the Object inheritance tree for all controls. However, changes
      made to properties at run time will not be persistant between different
      program runs. }
    { Note: If you change these defaults, you must rebuild the component
      library in order for the new defaults to take effect.  Some developers
      forget this step, since a compile of a user's program will include a
      compile of the latest components - most changes to this file will take
      effect without recompiling the component library.  The component
      library itself is only used to interact with developer during design
      time. }
    FDBGrid := nil;  { Will point to caller's DBGrid object }
    FTitle := '';
    FPrintMgrTitle := '';
    RecCounter := 0;
    FHorizGap := 8;  { pixels bet grid columns, in addition to width
                        of a space character }
    FVertGap := 40;  { percent of char height }

    { Margin settings: pixels, in addition to the std printer "gutter"
      of .25" (which is the edge area that printer can't print on).
      We need at least a small number here to ensure consistant output
      with different printers; some of which have overly optimistic
      minimum gutter specs. }
    { The fixed top gutter is normally bigger than the bottom fixed
      gutter on our HP printers, so we'll give a little smaller top
      margin for our use }
    FTopMargin := 60;
    FBottomMargin := 110;
    FLeftMargin := 30;
    FRightMargin := 30;

    FPrintToFile := False;
    FPrintFileName := 'PRN.LST';
    FPrintFileDir := 'C:\';

    FFullPage := false; {RS 29.11.1996}
    FFromPage := 1;
    FEndPage := MaxPages;
    FBorder := False;      { box around entire page }
    FColLines := True;     { vert lines bet grid columns }
    FRowLines := False;    { horiz lines bet grid rows }

    FTitleAlign := taCenter;
    FPageNPos := pnBotCenter;
    FPageNLabel := 'Page: ';
    FDatePos := pnTopRight;
    FDateLabel := '';  { actual date is put here automatically, but the calling
                         program can specify a date here to override dflt }
    FOrientation := poLandscape;

    FTitleFont.Name := 'Arial';
    FTitleFont.Style := [fsBold];
    FTitleFont.Size := 12;
    FColHeaderFont.Name := 'Arial';
    FColHeaderFont.Style := [fsBold];
    FColHeaderFont.Size := 10;
    FLinesFont.Name := 'Arial';
    FLinesFont.Style := [];
    FLinesFont.Size := 9;
end;

destructor TPrintGrid.Destroy;
begin
   FColHeaderFont.Free;
   FTitleFont.Free;
   FLinesFont.Free;
   inherited Destroy;
end;

procedure TPrintGrid.SetColHeaderFont(Value: TFont);
begin
   FColHeaderFont.Assign(Value);
end;

procedure TPrintGrid.SetTitleFont(Value: TFont);
begin
   FTitleFont.Assign(Value);
end;

procedure TPrintGrid.SetLinesFont(Value: TFont);
begin
   FLinesFont.Assign(Value);
end;

procedure TPrintGrid.SetDBGrid(Value: TDBGrid);
begin
   FDBGrid := Value;
   { Same as: FDBGrid.Assign(Value); }
end;

function TPrintGrid.GetDBGrid: TDBGrid;
begin
   Result := FDBGrid;
end;

procedure TPrintGrid.SetPrintMgrTitle(const TmpStr: String);
begin
   FPrintMgrTitle := TmpStr;
end;

function TPrintGrid.GetPrintMgrTitle: String;
begin
   Result := FPrintMgrTitle;
end;

procedure TPrintGrid.SetName(const Value: TComponentName);
var
   ChangeText: Boolean;
begin
   ChangeText := (Name = FPrintMgrTitle) and ((Owner = nil)
      or not (Owner is TPrintGrid)
      or not (csLoading in TPrintGrid(Owner).ComponentState));
   inherited SetName(Value);
   if ChangeText then
      FPrintMgrTitle := Value;
end;
{----------------------------------------------------------------}

{ only used for file output }
procedure TPrintGrid.WriteAllToFile;
var
   OutFile: TextFile;
   BookMark1: TBookMark;
   FieldNo: longint;
   TmpStr: String;
begin
   if OutFileName = '' then
      OutFileName := 'PRN.LST';

   {$I-}   { turn off exception generation }
   AssignFile(OutFile, OutFileName);
   Rewrite(OutFile);  { Open for Write }
   {$I+}   { re-enable exceptions }
   if IOResult <> 0 then
   begin
      ShowMessage('Error opening output file:' + OutFileName);
      Exit; { go back to caller }
   end;

   with FDBGrid.DataSource.DataSet do
   begin
      { Write main title line to a file }
      Writeln(OutFile, FTitle+' - Import me into Excel (tab delimited)');
      { We only print the main title and col headers one time
        if output is to a file.  The file is meant to be
        imported into MicroSoft Excel - excess headers just
        get in the way }

      TmpStr := '';  { reset String }
      { Accumulate the column names into string TmpStr }
      for FieldNo := 0 to FieldCount - 1 do
        if Fields[FieldNo].Visible then
            { Note: #9 is the dflt delimiter ("tab") for fields in Excel }
            TmpStr := TmpStr + Fields[FieldNo].DisplayLabel + #9;
      WriteLn(OutFile, TmpStr);  { write column header line }

      { loop thru all records, printing them to a file }
      try
         Screen.Cursor := crHourGlass;
         Bookmark1 := GetBookMark; { save our datasource location }
         DisableControls;   { momentarily stop DBGrid display updates }
         RecCounter := 0;

         { useful message for debugging:
         if Positions[NPositions+1] > RealWidth then
            ShowMessage('NOTE: Report Width Is Greater Than Paper Width.');}

         First;  { read first rec from datasource }
         while not EOF do
         begin
            TmpStr := '';  { reset String }

            { Accumulate the data from each column into TmpStr }
            for FieldNo := 0 to FieldCount - 1 do
               if Fields[FieldNo].Visible then
                  { Note: #9 is the dflt delimiter ("tab") for fields in Excel }
                  TmpStr := TmpStr + Fields[FieldNo].DisplayText + #9;

            WriteLn(OutFile, TmpStr); { write current record to file }
            Inc(RecCounter);
            Next; { read next rec from datasource }
         end; { end "while not EOF" }

      finally
         Screen.Cursor := crDefault;
         EnableControls;    { re-enable DBGrid display }
         CloseFile(OutFile);
         GotoBookMark(BookMark1); { re-position datasrc back to where it was }
         FreeBookMark(BookMark1);
      end; { end of try...finally }
   end; { end with }
end;
{--------------------------------------------------------------------}
{ From here down, most procs/fun's are only used for printer output. }

{ return the width of a column header in pixels }
function TPrintGrid.ColHeaderWidth(const ColHeaderStr: String): longint;
var
   tmpFont: TFont;
begin
   with Printer.Canvas do
   begin
      tmpFont := TFont.Create;  { make a temp font object }
      tmpFont.Assign(Font);     { save orig Printer font in temp object }
      Font.Assign(FColHeaderFont); { select Column Header font }
      SetPixelsPerInch;
      { get width in pixels }
      Result := TextWidth(ColHeaderStr);
      Font.Assign(tmpFont);     { put the orig printer font back }
      tmpFont.Free;             { free the temp font object }
      SetPixelsPerInch;
   end;
end;

{ return the height of the column header in pixels }
function TPrintGrid.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 TPrintGrid.CalcPrinterPositions;
var
   ColWidth, FieldNo: longint;
begin
   { Print column indexes are 1-based }
   { Datasource indexes are 0-based }
   { Positions[1] is x-coord or where to strt printing first column }
   if FBorder then
      Positions[1] := 1
   else
      Positions[1] := 0;

   NPositions := 0;  { we'll keep count to determine tot. # of print columns }
   with FDBGrid.DataSource.DataSet do
      for FieldNo := 0 to FieldCount - 1 do
         if Fields[FieldNo].Visible then
         begin
            inc(NPositions); { increment column index }

{--------------------------------------------------------------------------
    The width of each column (in pixels) should be the greater of:
        col. header width ( := ColHeaderWidth(Fields[t].DisplayLabel) )
                            or
        col. data width ( := DetailLineCharWidth * Fields[t].DisplayWidth )
    The units of each of these is "width of 1 avg char in the current font. }

            { DisplayWidth is max no. of detail line chars }
            { DisplayLabel is the text of the column header }
         (* ShowMessage('hdr wd='
             + IntToStr(ColHeaderWidth(Fields[FieldNo].DisplayLabel)));
            ShowMessage('dsp wd='
             + IntToStr(DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
            ShowMessage('fld siz='
             + IntToStr(Fields[FieldNo].DisplayWidth));
         *)
            ColWidth := Max(ColHeaderWidth(Fields[FieldNo].DisplayLabel),
                    (DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
            { Set starting loc. of next column }
            { Positions[NPositions] is the start loc of current column }
            { FHorizGap is gap between columns }
            Positions[NPositions + 1] := Positions[NPositions]
                           + ColWidth + FHorizGap;
{--------------------------------------------------------------------------}
     end; { end with }
end;

function TPrintGrid.SetAlign(align: TAlignment; Left, Right:longint):longint;
var
   PosX: longint;
begin
   with Printer.Canvas do
   begin
      case Align of
         taLeftJustify:
            begin
               SetTextAlign(Handle, TA_LEFT);
               { PosX is where to begin printing this col }
               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 case }
   end; { end of "with Printer.Canvas" }
   Result := PosX;
end;

function TPrintGrid.SetPagePosX(PagePos: TPageNumberPos;
                                Left, Right: longint): longint;
var
   PosX: longint;
begin
   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;
         else
           PosX := 0;
      end; { end case }
   end; { end of "with Printer.Canvas" }
   Result := PosX;
end;

function TPrintGrid.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; { end case }
   Result := PosY;
end;

function TPrintGrid.PrepareAlign(Field:TField; Col:integer): longint;
begin
   Result := SetAlign(Field.Alignment, Positions[col], Positions[col + 1]);
end;

{ Note that the Windows printer interface gives you a "full-page"
  paradigm.  We can print to any part of the current page, similar
  in concept to using cursor positioning codes on a CRT.  This
  procedure will print the main title, column headers, and footer
  line, as-needed. }
procedure TPrintGrid.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;
      { We will print a footer and/or main title line if any one
        of these is true:
           a) main title text has been set
           b) date has been requested on the listing
           c) page number has been requested on the listing }
      if (FTitle <> '') or (FDatePos <> pnNone) or (FPageNPos <> pnNone) then
      begin
         tmpFont := TFont.Create;
         tmpFont.Assign(Font);    { save active font }
         Font.Assign(FTitleFont); { select the title font }
         SetPixelsPerInch;
         tmpFontCreated := True;
      end else
        tmpFontCreated := False;  { we didn't need a footer or title line }

      if FDatePos <> pnNone then
      begin
         { Use date string specified by caller, if one was set }
         if FDateLabel = '' then
            FDateLabel := FormatDateTime('mmm d, yyyy',SysUtils.Date);
         { Print the date at specified location }
         PosX := SetPagePosX(FDatePos, FLeftMargin,
                  FLeftMargin + RealWidth);
         PosY := SetPagePosY(FDatePos, FTopMargin,
                  Printer.PageHeight - FBottomMargin);
         TextOut(PosX, PosY, FDateLabel); { title font is active }
      end;

      if FTitle <> '' then
      begin
         { Print the report Title; title font is active }
         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);  { restore original font }
         SetPixelsPerInch;
         tmpFont.Free;
      end;

      { RS 29.11.1996 }
      {if FBorder then
      begin
         Rectangle(FLeftMargin,
                   FirstRecordY - tmpColHeaderHeight,
                   FLeftMargin + RealWidth,
                   Printer.PageHeight - FBottomMargin);
      end; }{ end of "if FBorder" }

      {RS 29.11.1996}
      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; { ends both "for" and "if" }

      if dgTitles in FDBGrid.Options then
         WriteColHdrsToPrinter(FirstRecordY - tmpColHeaderHeight);
   end;
end;

{ This procedure prints column headers. This is similar to
  WriteRecordToPrinter, but this one accepts the Y position as an
  argument, and prints headers instead of data. }
procedure TPrintGrid.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);        { save current font }
      Font.Assign(FColHeaderFont); { set column hdr font active }
      SetPixelsPerInch;
      { find top and bottom loc's of box surrounding detail lines }
      Rect.top := CenterY(PosY, TextHeight('M'), 2*FVertGap); { EWE: added 2* }
      Rect.bottom := FirstRecordY+((RecCounter + 1) * TextHeight('M'));

      { "DSrcFld" will point to the DBGrid's datasource fields,
         and "Col" will point to the printed columns }
      Col := 0;
      for DSrcFld := 0 to FieldCount - 1 do
      begin
         if Fields[DSrcFld].Visible then
         begin
            inc(Col);
            { FHorizGap is the gap between columns (in pixels) }
            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;
      { Underline col headers }
      Moveto(FLeftMargin, FirstRecordY);
      Lineto(FLeftMargin + RealWidth, FirstRecordY);

      Font.Assign(tmpFont);  { restore original font }
      SetPixelsPerInch;
      tmpFont.Free;
   end; { end with }
end;

{ Print all columns of one detail line to the printer }
procedure TPrintGrid.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);    { save current font }
      Font.Assign(FLinesFont); { set detail line font active }
      SetPixelsPerInch;

      Col := 0;
      PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
      Rect.top := CenterY(PosY, TextHeight('M'), FVertGap);
      Rect.bottom:=FirstRecordY+((RecCounter+1) * DetailLineCharHeight);

      { "DSrcFld" will point to the DBGrid's datasrc fields, and "Col"
         will point to the printed columns }
      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;

      {RS 29.11.1996}
      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; { ends both "for" and "if" }

      Font.Assign(tmpFont);  { restore orig font }
      SetPixelsPerInch;
      tmpFont.Free;
   end;
end;

procedure TPrintGrid.PageJump;
begin
   RecCounter := 0;
   if (PrinterPageNo >= FFromPage) and (PrinterPageNo < FEndPage) then
      Printer.NewPage;
   inc(PrinterPageNo);
end;

{ return the real width of the paper in units of "# of chars" using
  the current font }
function TPrintGrid.RealWidth: longint;
begin
   Result := Printer.PageWidth - FLeftMargin - FRightMargin;
end;

function TPrintGrid.AllPageFilled: boolean;
begin
   Result := (not FPrintToFile)
      and ((FirstRecordY + (RecCounter + 1) * DetailLineCharHeight)
            >= (Printer.PageHeight - FBottomMargin));
end;

{ Print the Grid to EITHER a File or a Printer; no dialog used }
procedure TPrintGrid.Print;
var
{   return_code: boolean;}
{   St: array[0..255] of Char;}
   aBookMark: TBookMark;
{   t: integer;
   tmpFont: TFont;
   FieldNo, }PosY: longint;
{   TmpStr: String;
  CurrentOrientation: TPrinterOrientation;}
   tmpStyle: TBrushStyle;
   DoIt:boolean;
begin
   if not Assigned(FDBGrid) then
      raise Exception.Create('Error: FDBGrid Not Assigned.');
   if FPrintToFile then
   begin
      WriteAllToFile;
      Exit;  { go back to caller }
   end;

   { We're "Printing All" to Printer from here on ...}
   InitializePrinter;

   with FDBGrid.DataSource.DataSet do
   begin
      try
         aBookmark := GetBookMark; { save our datasource location }
         DisableControls;   { momentarily stop DBGrid display updates }
         RecCounter := 0;
         PrinterPageNo := 1;

         { calc where to place each field in horizontal plane }
         CalcPrinterPositions;

         { useful message for debugging: }
         { and useful for the users: RS 29.11.1996 }
         if (Positions[NPositions + 1] > RealWidth) then
         begin
            if MessageDlg('Printed width is larger than paper width.'+
                       ' Abort the print-out?',
                       mtConfirmation, mbYesNoCancel, 0 )<>idNo then
            begin
               { stop printing }
               Printer.Abort;
               exit; { leaves this place immediately }
            end;
         end;

         Screen.Cursor := crHourGlass;

         First;  { read first rec from datasource }
         while not EOF do
         begin
            if RecCounter = 0 then
               WriteTitleToPrinter;
            DoIt := true;
            if Assigned(FOnPrintRecord) then
              FOnPrintRecord(Self, DoIt);
            if DoIt then
              WriteRecordToPrinter;
            Inc(RecCounter);
            Next;   { read next rec from datasource }

            { page break processing }
            if AllPageFilled then
            begin
               PageJump;
               if PrinterPageNo > FEndPage then
                  break;  { exit from loop; we're done }
            end;
         end; { end "while not EOF" }

         { Underline last Record }
         { RS 26.11.1996 }
         if FRowLines then
          begin
           PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
           Printer.Canvas.MoveTo(FLeftMargin, PosY);
           Printer.Canvas.LineTo(FLeftMargin + RealWidth, PosY);
          end;

         { draws a rectangle around the sheet but only
           if needed and fullpage changed
           RS 29.11.1996 }
         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; { end of "if FBorder" }

      finally
         EnableControls;         { re-enable DBGrid display }
         Screen.Cursor := crDefault;
         GotoBookMark(aBookMark);
         FreeBookMark(aBookMark);
         Printer.EndDoc;
      end; { end of try...finally }
   end; { end with }
end;

{ used for BOTH File and Printer output; always gives std dialog }
procedure TPrintGrid.PrintDialog;
{var
   M: integer;}
begin
   with TPrintDialog.Create(Self) do
   begin
      try
         Options := [poPageNums, poPrintToFile, poWarning];
         MinPage := 1;
         MaxPage := MaxPages;
         FFromPage := 1;
         FEndPage := MaxPages;
         { In order to make the dialog box default to the Orientation
           selected by calling pgm, we need to set it now via the
           "TPrinter" object - not via the TPrintDialog!
             Note that "Printer.Orientation" isn't a readable property:
           we can set it, but not check it.
             The Dialog gets it's initial Orientation setting by
           checking the current print driver status. }
         {Printer.Orientation := FOrientation; RS 29.11.1996}

         { "Execute" runs the Common Control Print Dialog }
         if Execute then
         begin
            { NOTE: In Delphi v1, we can NOT check Printer.Orientation
              upon coming back from the dialog to see which exact
              orientation the user selected.  But the actual Windows
              printer will use the correct orientation specified by
              the dialog box, we just can't tell here what that is. }

            { We can now check the page range user wants to print,
              and whether he wants to print to a file }
            if PrintRange = prPageNums then
            begin
               FFromPage := FromPage;
               FEndPage := EndPage;
            end;
            { Set our orientation var to what user selected in dialog }
            FOrientation:=GetOrientation;
            if PrintToFile then
               SaveToFile { go and print to a file }
            else
               begin
                  FPrintToFile := false; { Don't print to file }
                  Print;  { go and print to printer }
               end;
         end; { end Execute }

      finally
         Free;
      end; { end of "try...finally" }
   end; { end of "with TPrintDialog" }
end;

{ only used for File output }
{ Call this function ONLY if you know beforehand that the user
  will want to print to a File.  This will prompt the user for
  a filename. If you don't want to prompt the user for a name (if
  you just want to use the dflt name specified in Object inspector),
  then do this:  set property "PrintToFile" to TRUE, and call method
  "Print", instead of this one. }
procedure TPrintGrid.SaveToFile;
begin
   { Use the "File Save as" dialog to get a filename}
   FPrintToFile := true;
   with TSaveDialog.Create(Self) do
   begin
      try
         { Set the filemask filter for the File...Save
           Common Dialog }
         Filter :=
              'List Files (*.LST)|*.LST|Any file(*.*)|*.*';
         if FPrintFileDir <> '' then
            InitialDir := FPrintFileDir;
         if FPrintFileName <> '' then  { do we have a dflt fname? }
         begin
            FileName := FPrintFileName;
            Filter := Filter + '|This file (*'
                   + ExtractFileExt(FileName) + ')|*'
                   + ExtractFileExt(FileName);
            FilterIndex := 3;
         end;

         { Run the File...Save dialog }
         if Execute then
         begin
            { FileName is now set to what the user picked }
            FPrintFileDir := ExtractFilePath(FileName);
            FPrintFileName := ExtractFileName(FileName);
            OutFileName := FileName;
            { ShowMessage('Now printing to file: ' + FileName); }
            Print;  { do the print to the file }
         end;

      finally
         Free;
      end; { end of "try...finally" }
   end; { end of "with TSaveDialog" }
end;

{ This is mostly a bug fix function to make up for weaknesses in Delphi's
  TPrinter object. TPrinter scales the font based on printer's PixelsPerInch.
  However, the bug prevented it from scaling correctly bec. it didn't have the
  printer's handle when it tried to get the PixelsPerInch.  Here, we force
  it to get the handle, then we set PixelsPerInch, then we reassign the font
  size back to force it to get scaled again (this time correctly).
     This code causes no trouble with Delphi v2.01, but it may only be NEEDED
  on Delphi v1.xx (most pgmmers use it on v2.xx also).
     You must call this immed. after you change the printer font! }
procedure TPrintGrid.SetPixelsPerInch;
var
  FontSize: integer;
begin
   if not Printer.Printing then
      ShowMessage('Error: BeginDoc not called before SetPixelsPerInch');

  { PixelsPerInch of any font is just the printer resolution, which is usu.
    300 or more (except for dot matrix printers, where it could be as low
    as 90, depending on the printer setting: draft vs. NLQ vs. LQ).
    This isn't going to change for different fonts, but it must be
    set right for all of them in order for the automatic size scaling
    to work right.  Note that some printers have different resolutions in
    the X and Y directions. }

  { NOTE: GetTextMetrics uses handle of printer canvas, but
          GetDeviceCaps uses handle of printer. }
  FontSize:=Printer.Canvas.Font.Size;   { save size in points }
  Printer.Canvas.Font.PixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
  { restore size in points; will correctly scale Font size units now }
  Printer.Canvas.Font.Size := FontSize;

  { Call the Windows API function GetTextMetrics() to get the specifics
    of the particular font. }
  GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
end;

{ This convoluted code is from EDSPRINT.PAS.  We just want to get
  the actual printer orientation currently in effect.  Note that the
  "Orientation" property of TPrinter is write-only (at least in
  Delphi v1 it is). }
{ Call this function once, after user is done with print dialog,
  but before BeginDoc }
function TPrintGrid.GetOrientation : TPrinterOrientation;
var
   FDevice:     PChar;
   FDriver:     PChar;
   FPort:       PChar;
   FHandle:     THandle;
   FDeviceMode: PDevMode;
begin
   GetMem (FDevice, 255);
   GetMem (FDriver, 255);
   GetMem (FPort, 255);
   Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
   if FHandle = 0 then
   begin
     { driver not loaded }
     Printer.PrinterIndex := Printer.PrinterIndex;
     { force Printer object to load driver }
     Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
   end;
   if FHandle <> 0 then {tprinter}
   begin
      FDeviceMode := {$IFDEF WIN32}PDevMode(FHandle){$ELSE}Ptr(FHandle, 0){$ENDIF};
      { FDeviceMode now points to Printer.DeviceMode }
      { Following fix is from Steve Turner }
      case FDeviceMode^.dmOrientation of
         dmOrient_Portrait:   result := poPortrait;
         dmOrient_Landscape:  result := poLandscape;
      else
         result := poLandscape;
      end; { end case }
   end
   else
   begin
      ShowMessage('Error getting printer device mode');
   end;
   FreeMem (FDevice, 255);
   FreeMem (FDriver, 255);
   FreeMem (FPort, 255);
end;

procedure TPrintGrid.InitializePrinter;
begin
   { Orientation must be set before BeginDoc, because it also
     ensures that the right printer driver is being used. }
   Printer.Orientation := FOrientation;
   { Once we do the "BeginDoc", we're committed to using
     at least 1 sheet of paper! The output will start printing
     after EndDoc if nothing else is in the queue. }
   Printer.BeginDoc;
   Printer.Title := FPrintMgrTitle;
   Printer.Canvas.Font.Assign(FLinesFont); { set detail line font active }
   SetPixelsPerInch;

   FVertGap:= Trunc(TextMetrics.tmHeight * 0.8);
   FHorizGap:= TextMetrics.tmMaxCharWidth div 4;

   DetailLineCharHeight := HeightScale(TextMetrics.tmHeight,FVertGap);
   {DetailLineCharWidth := TextMetrics.tmMaxCharWidth;}
   DetailLineCharWidth := Printer.Canvas.TextWidth('M');

   (* Display metric/sizing info here for debugging.
   Here's some typical metrics:
   Printer = HP4, network laser printer, max res=600 DPI
   Arial, 8 point, style=normal
   paper width=8 inches, Portrait Orientation
   paper height=11.5 inches
           300 DPI                       600 DPI
 ------------------------------------------------------
                pg wid=2400   |          pg wid=4800
                pg hgt=3168   |          pg hgt=6336
              Font PPI=300    |        Font PPI=600

      using FontMetrics:
            avg char wid=15   |      avg char wid=30
            max char wid=35   |      max char wid=70

      using Printer.Canvas.TextWidth:
            'W' char wid=34   |      'W' char wid=63

      Sample text using Printer.Canvas.TextWidth:
         width samp text=394  |   width samp text=824

    ShowMessage('printer page width: ' + IntToStr(Printer.PageWidth));
    ShowMessage('printer page height: ' + IntToStr(Printer.PageHeight));
    ShowMessage('Font PPI: ' + IntToStr(Printer.Canvas.Font.PixelsPerInch));
    ShowMessage('Font name, size: ' + Printer.Canvas.Font.Name + ',  '
               + IntToStr(Printer.Canvas.Font.Size));

    ShowMessage('max char width (TextMetrics): '
             + IntToStr(TextMetrics.tmMaxCharWidth));
    ShowMessage('max char width (Canvas.TextWidth - auto scaled): '
             + IntToStr(Printer.Canvas.TextWidth('W')));
    ShowMessage('Avg char width (TextMetrics): '
             + IntToStr(TextMetrics.tmAveCharWidth));
    ShowMessage('Avg char width (Canvas.TextWidth - auto scaled): '
             + IntToStr(Printer.Canvas.TextWidth('j')));

    ShowMessage('Width of sample text: ' +
       IntToStr(Printer.Canvas.TextWidth('this is sample text for sizing')));
 *)
end;

{function TPrintGrid.RealToStr(x: Real): String;
var
   Str1: String[15];
begin
   Str(x, Str1);
   result:=Str1;
end;
}
procedure Register;
begin
   RegisterComponents('Samples', [TPrintGrid]);
end;

end.

