Impressao - como imprimir arquivo prn via programacao

Top  Previous  Next

Printing Files from Delphi using Printers, WinSpool units. 

Answer:

 

 

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..255of char; 

  sDriver : array[0..255of char; 

  sPort   : array[0..255of 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. 

 

Please find the attached PrintFiles.Zip with the .exe. It should be available shortly as I've sent the attachment to the webmaster.