Printing Files from Delphi using Printers, WinSpool units.
I needed to print .PRN files thru’ an application. I did some search on the internet and found out various options on sending the data to the printer. We could use the DOS command option as one of the forums suggested. Also we could use the WinSpool and Printers units in Delphi. So I just thought that I could put together an application in Delphi to do just that. With this application, we could not just print .PRN files but any files.
----------------------------------
PrintFiles.dpr
----------------------------------
program PrintFiles;
uses
Forms,
uPrintFile in 'uPrintFile.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
--------------------------------
uPrintFile.dfm
--------------------------------
object Form1: TForm1
Left = 234
Top = 74
Width = 567
Height = 566
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'Print PRN Files'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 559
Height = 539
Align = alClient
BevelInner = bvLowered
Caption = 'Panel1'
TabOrder = 0
object Label1: TLabel
Left = 4
Top = 89
Width = 80
Height = 13
Caption = 'Directory List:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 281
Top = 40
Width = 49
Height = 13
Caption = 'File List:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 281
Top = 4
Width = 89
Height = 13
Caption = 'File Type Filter:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label9: TLabel
Left = 4
Top = 4
Width = 35
Height = 13
Caption = 'Drive:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 228
Top = 44
Width = 27
Height = 13
Caption = '(OR)'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 4
Top = 51
Width = 102
Height = 13
Caption = 'Type in Directory:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 5
Top = 416
Width = 22
Height = 13
Caption = 'Log'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object SpeedButton1: TSpeedButton
Left = 32
Top = 408
Width = 23
Height = 22
Hint = 'Save Log'
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
04000000000080000000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00999999999999
999996366666666666699666660F006666699660000000F66669960000000066
666996000000806666699E078880000EEEE99EE0F0EE8407EEF99EE010EEEEEE
EEE99EEE0EEEEE8F8FE99EEE0EEFFEFFFFE998888EEEEEEFFEE99888EEEEEEFF
FEE998EEEEEE8EFFEEE99EEFEEEEEEFFEEE99999999999999999}
ParentShowHint = False
ShowHint = True
OnClick = SpeedButton1Click
end
object Label7: TLabel
Left = 243
Top = 384
Width = 44
Height = 13
Caption = 'Printers'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object FilterComboBox1: TFilterComboBox
Left = 281
Top = 18
Width = 275
Height = 21
Hint = 'Select the File Filter'
FileList = FileListBox1
Filter = 'PRN Files (*.PRN)|*.PRN|All Files(*.*)|*.*'
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnEnter = Edit1Enter
end
object FileListBox1: TFileListBox
Left = 281
Top = 53
Width = 275
Height = 324
Hint = 'Press F10 to Select All Files'
ItemHeight = 16
Mask = '*.PRN'
MultiSelect = True
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnClick = FileListBox1Click
OnEnter = Edit1Enter
OnKeyDown = FileListBox1KeyDown
end
object DirectoryListBox1: TDirectoryListBox
Left = 4
Top = 104
Width = 275
Height = 273
Hint = 'Directory Browser'
FileList = FileListBox1
ItemHeight = 16
ParentShowHint = False
ShowHint = True
TabOrder = 3
OnEnter = Edit1Enter
end
object DriveComboBox1: TDriveComboBox
Left = 4
Top = 18
Width = 270
Height = 19
Hint = 'Drive List'
DirList = DirectoryListBox1
ParentShowHint = False
ShowHint = True
TabOrder = 0
TextCase = tcUpperCase
OnEnter = Edit1Enter
end
object StatusBar1: TStatusBar
Left = 2
Top = 518
Width = 555
Height = 19
Panels = <>
SimplePanel = True
SimpleText = 'Ready'
end
object btnPrint: TButton
Left = 403
Top = 404
Width = 75
Height = 25
Hint = 'Print Selected PRNs on the File List'
Caption = '&Print'
ParentShowHint = False
ShowHint = True
TabOrder = 6
OnClick = btnPrintClick
end
object Edit1: TEdit
Left = 4
Top = 66
Width = 274
Height = 21
Hint = 'Type in Directory Name'
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnEnter = Edit1Enter
end
object Button1: TButton
Left = 326
Top = 404
Width = 75
Height = 25
Hint = 'Print All PRN on the File List'
Caption = 'Print &All'
ParentShowHint = False
ShowHint = True
TabOrder = 7
OnClick = Button1Click
end
object Button5: TButton
Left = 480
Top = 404
Width = 75
Height = 25
Hint = 'Exit the Application'
Caption = 'E&xit'
ParentShowHint = False
ShowHint = True
TabOrder = 8
OnClick = Button5Click
end
object Memo1: TMemo
Left = 4
Top = 432
Width = 552
Height = 85
Color = clMenu
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 9
end
object ComboBox1: TComboBox
Left = 282
Top = 381
Width = 275
Height = 21
AutoDropDown = True
Style = csDropDownList
ItemHeight = 13
TabOrder = 10
end
end
object OpenDialog1: TOpenDialog
DefaultExt = '*.log'
Filter = 'Log Files(*.log)|*.log'
InitialDir = 'c:\'
Left = 272
Top = 272
end
end
--------------------------------
uPrintFile.pas
--------------------------------
unit uPrintFile;
{
--------------------------------------------------------------------------------
Unit Name : uPrintFile.pas
Purpose : Printing PRN files and any other files
Developed By : S S B Magesh Puvananthiran
Date Created : Sept 16, 2004
Last Modified : Sept 17, 2004
Last Modified By : S S B Magesh Puvananthiran
--------------------------------------------------------------------------------
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DateUtils, ExtCtrls, ComCtrls, Mask, Printers, Winspool,
FileCtrl, Buttons ;
type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
FilterComboBox1: TFilterComboBox;
FileListBox1: TFileListBox;
DirectoryListBox1: TDirectoryListBox;
Label9: TLabel;
DriveComboBox1: TDriveComboBox;
StatusBar1: TStatusBar;
btnPrint: TButton;
Label3: TLabel;
Label5: TLabel;
Edit1: TEdit;
Button1: TButton;
Button5: TButton;
Memo1: TMemo;
Label6: TLabel;
SpeedButton1: TSpeedButton;
OpenDialog1: TOpenDialog;
ComboBox1: TComboBox;
Label7: TLabel;
procedure FileListBox1Click(Sender: TObject);
procedure Edit1Exit(Sender: TObject);
procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FileListBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Edit1Enter(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure PrintFile(const sFileName: string);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FileListBox1Click(Sender: TObject);
begin
if FileListBox1.SelCount > 0 then
StatusBar1.SimpleText := IntToStr(FileListBox1.SelCount) + ' File(s) Selected';
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
if DirectoryExists(Edit1.Text) then
DirectoryListBox1.Directory := Edit1.Text;
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_Return then
if DirectoryExists(Edit1.Text) then
DirectoryListBox1.Directory := Edit1.Text;
end;
procedure TForm1.FileListBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key = VK_F10) then
begin
FileListBox1.SelectAll;
StatusBar1.SimpleText := IntToStr(FileListBox1.SelCount) + ' File(s) Selected';
end;
end;
procedure TForm1.Edit1Enter(Sender: TObject);
begin
StatusBar1.SimpleText := 'Ready';
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.PrintFile(const sFileName: string);
const
iBufferSize = 32768;
var
Count, BytesWritten: Cardinal;
hPrinter, hDeviceMode: THandle;
sDevice : array[0..255] of char;
sDriver : array[0..255] of char;
sPort : array[0..255] of char;
DocInfo: TDocInfo1A;
f: File;
pBuffer: Pointer;
begin
Printer.PrinterIndex := ComboBox1.ItemIndex;
Printer.GetPrinter(sDevice, sDriver, sPort, hDeviceMode);
if not WinSpool.OpenPrinter(@sDevice, hPrinter, nil) then
exit;
DocInfo.pDocName := 'Document';
DocInfo.pDatatype := 'RAW';
DocInfo.pOutputFile := nil;
if StartDocPrinter(hPrinter, 1, @DocInfo) = 0 then
begin
WinSpool.ClosePrinter(hPrinter);
exit;
end;
if not StartPagePrinter(hPrinter) then
begin
EndDocPrinter(hPrinter);
WinSpool.ClosePrinter(hPrinter);
exit;
end;
System.Assign(f, sFileName);
try
Reset(f, 1);
GetMem(pBuffer, iBufferSize);
while not eof(f) do
begin
Blockread(f, pBuffer^, iBufferSize, Count);
if Count > 0 then
begin
if not WritePrinter(hPrinter, pBuffer, Count, BytesWritten) then
begin
EndPagePrinter(hPrinter);
EndDocPrinter(hPrinter);
WinSpool.ClosePrinter(hPrinter);
FreeMem(pBuffer, iBufferSize);
exit;
end;
end;
end;
FreeMem(pBuffer, iBufferSize);
EndDocPrinter(hPrinter);
WinSpool.ClosePrinter(hPrinter);
finally
System.Closefile(f);
end;
end;
procedure TForm1.btnPrintClick(Sender: TObject);
var
iCounter, iNoOfFilesPrinted : Integer;
begin
iNoOfFilesPrinted := 0; iCounter := 0;
if FileListBox1.SelCount > 0 then
begin
for iCounter := 0 to FileListBox1.Items.Count - 1 do
begin
if FileListBox1.Selected[iCounter] then
begin
if FileExists(FileListBox1.Items.Strings[iCounter]) then
begin
iNoOfFilesPrinted := iNoOfFilesPrinted + 1;
try
PrintFile(FileListBox1.Items.Strings[iCounter]);
Memo1.Lines.Add(DateTimeToStr(Now) + ': File ' + FileListBox1.Items.Strings[iCounter] + ' Printed');
except on e:exception do
Memo1.Lines.Add('Error printing file : ' + FileListBox1.Items.Strings[iCounter] + ' ' + e.Message);
end;
end
else
Memo1.Lines.Add(DateTimeToStr(Now) + ': File ' + FileListBox1.Items.Strings[iCounter] + ' does not exist');
end;
end;
Memo1.Lines.Add( DateTimeToStr(Now) + ': No Of files Printed : ' + IntToStr(iNoOfFilesPrinted));
end
else if FileListBox1.Items.Count = 0 then
Memo1.Lines.Add(DateTimeToStr(Now) + ': No files available to print')
else
Memo1.Lines.Add(DateTimeToStr(Now) + ': No files selected; Please select atleast one file from the File List Box and print')
end;
procedure TForm1.Button1Click(Sender: TObject);
var
iCounter, iNoOfFilesPrinted : Integer;
begin
iNoOfFilesPrinted := 0; iCounter := 0;
if FileListBox1.Items.Count > 0 then
begin
for iCounter := 0 to FileListBox1.Items.Count - 1 do
begin
if FileExists(FileListBox1.Items.Strings[iCounter]) then
begin
iNoOfFilesPrinted := iNoOfFilesPrinted + 1;
try
PrintFile(FileListBox1.Items.Strings[iCounter]);
Memo1.Lines.Add(DateTimeToStr(Now) + ': File ' + FileListBox1.Items.Strings[iCounter] + ' Printed');
except on e:exception do
Memo1.Lines.Add('Error printing file : ' + FileListBox1.Items.Strings[iCounter] + ' ' + e.Message);
end;
end
else
Memo1.Lines.Add(DateTimeToStr(Now) + ': File ' + FileListBox1.Items.Strings[iCounter] + ' does not exist');
end;
Memo1.Lines.Add( DateTimeToStr(Now) + ': No Of files Printed : ' + IntToStr(iNoOfFilesPrinted));
end
else
Memo1.Lines.Add(DateTimeToStr(Now) + ': No files available to print');
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
//Saving the log info
if OpenDialog1.Execute then
begin
Memo1.Lines.SaveToFile(OpenDialog1.FileName);
StatusBar1.SimpleText := 'Log details saved successfully in ' + OpenDialog1.FileName ;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//Listing all the printers added to the current machine
ComboBox1.Items.Assign(Printer.Printers);
end;
end.
As usual, feel free to share your comments and thoughts