Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 14 - Project UniPrint

Project Structure

UniPrint.dpr
program UniPrint;

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

{$R *.RES}

begin
  Application.CreateForm(TNavigator, Navigator);
  Application.Run;
end.
UniPrintForm.pas
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.
UniPrintForm.dfm
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