Project Structure

• UniPrint.dpr
• UniPrintForm.pas
• UniPrintForm.dfm

program UniPrint;

uses
  Forms,
  UniPrintForm in 'UniPrintForm.pas' {Navigator};

{$R *.RES}

begin
  Application.CreateForm(TNavigator, Navigator);
  Application.Run;
end.

unit UniPrintForm;

interface

uses
  SysUtils, Dialogs, ExtCtrls, DBCtrls, StdCtrls, Graphics,
  Mask, DB, DBTables, Printers, FMTBcd, SqlExpr, ComCtrls,
  Classes, Controls, Forms, math, DBXpress;

type
  TNavigator = class(TForm)
    PrintAllButton: TButton;
    SQLConnection1: TSQLConnection;
    EmplData: TSQLDataSet;
    ProgressBar1: TProgressBar;
    EmplCountData: TSQLDataSet;
    procedure PrintAllButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Navigator: TNavigator;

implementation

{$R *.DFM}

procedure PrintOutDataSet (data: TDataSet;
  progress: TProgressBar; Font: TFont; maxSize: Integer = 30);
var
  PrintFile: TextFile;
  I: Integer;
  sizeStr: string;
  oldFont: TFontRecall;
begin
  // assign the printer to a file
  AssignPrn (PrintFile);
  Rewrite (PrintFile);

  // set the font and keep the original one
  oldFont := TFontRecall.Create (Printer.Canvas.Font);
  try
    Printer.Canvas.Font := Font;
    try
      data.Open;
      try
        // print header (field names) in bold
        Printer.Canvas.Font.Style := [fsBold];
        for I := 0 to data.FieldCount - 1 do
        begin
          sizeStr := IntToStr (min (
            data.Fields[i].DisplayWidth, maxSize));
          Write (PrintFile, Format ('%-' + sizeStr + 's',
            [data.Fields[i].FieldName]));
        end;
        Writeln (PrintFile);

        // for each record of the dataset
        Printer.Canvas.Font.Style := [];
        while not data.EOF do
        begin
          // print out each field of the record
          for I := 0 to data.FieldCount - 1 do
          begin
            sizeStr := IntToStr (min (
              data.Fields[i].DisplayWidth, maxSize));
            Write (PrintFile, Format ('%-' + sizeStr + 's',
              [data.Fields[i].AsString]));
          end;
          Writeln (PrintFile);
          // advance ProgressBar
          progress.Position := progress.Position + 1;
          data.Next;
        end;
      finally
        // close the dataset
        data.Close;
      end;
    finally
      // reassign the original printer font
      oldFont.Free;
    end;
  finally
    // close the printer/file
    System.CloseFile (PrintFile);
  end;
end;

procedure TNavigator.PrintAllButtonClick(Sender: TObject);
var
  Font: TFont;
begin
  // set ProgressBar range
  EmplCountData.Open;
  try
    ProgressBar1.Max := EmplCountData.Fields[0].AsInteger;
  finally
    EmplCountData.Close;
  end;

          Font := TFont.Create;
  try
    Font.Name := 'Courier New';
    Font.Size := 9;
    PrintOutDataSet (EmplData, ProgressBar1, Font);
  finally
    Font.Free;
  end;
end;

end.

object Navigator: TNavigator
  Left = 148
  Top = 122
  Width = 288
  Height = 161
  Caption = 'UniPrint'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object PrintAllButton: TButton
    Left = 96
    Top = 40
    Width = 81
    Height = 25
    Caption = 'Print All'
    TabOrder = 0
    OnClick = PrintAllButtonClick
  end
  object ProgressBar1: TProgressBar
    Left = 56
    Top = 96
    Width = 150
    Height = 16
    Min = 0
    Max = 100
    TabOrder = 1
  end
  object SQLConnection1: TSQLConnection
    ConnectionName = 'IBLocal'
    DriverName = 'Interbase'
    GetDriverFunc = 'getSQLDriverINTERBASE'
    LibraryName = 'dbexpint.dll'
    LoginPrompt = False
    Params.Strings = (
      'BlobSize=-1'
      'CommitRetain=False'

              'Database=c:\program files\interbase corp\interbase6\examples\dat' +
        'abase\employee.gdb'
      'DriverName=Interbase'
      'LocaleCode=0x0000'
      'Password=masterkey'
      'RoleName=RoleName'
      'ServerCharSet=ASCII'
      'SQLDialect=1'
      'Interbase TransIsolation=ReadCommited'
      'User_Name=sysdba'
      'WaitOnLocks=True')
    VendorLib = 'GDS32.DLL'
    Left = 24
    Top = 16
  end
  object EmplData: TSQLDataSet
    SQLConnection = SQLConnection1
    CommandText =
       'select d.DEPARTMENT, e.FULL_NAME, e.JOB_COUNTRY, e.HIRE_DATE'#13#10'fr'   +
      'om EMPLOYEE e'#13#10'inner join DEPARTMENT d on d.dept_no = e.dept_no'
      Params = <>
    Left = 24
    Top = 72
  end
  object EmplCountData: TSQLDataSet
    SQLConnection = SQLConnection1
    CommandText = 'select count(*) from EMPLOYEE'
    Params = <>
    Left = 208
    Top = 16
  end
end