[DUG] Printing text line by line

Paul Lowman paul_lowman at xtra.co.nz
Fri Aug 12 09:39:37 NZST 2005


Pedrocelli

I did this some time ago and wrote a simple text file driver as per the help
file ..

{**********************************************************


Copywrite (C) 1987 .. 00 Paul Lowman

Name - GenericLPT.Pas

Purpose - Write directly to LPT1

Created - 3rd Aug 2000

Last edit -

**********************************************************}

unit GenericLPT;

interface

uses Windows,
        Dialogs,
        SysUtils,
        Ascii;

procedure AssignPrn(var F : Text);

implementation

var
Lpt : HWND;

function Ignore(var F : TTextRec) : integer;
begin
        Ignore := 0;
end;


function PrnOutput(var F : TTextRec) : integer;
var
tW : DWORD;

begin
        with F do
        begin
                WriteFile(Lpt, Buffer, BufPos, tW, nil);
                BufPos := 0;
        end;
        PrnOutPut := 0;
end;

function PrnClose(var F : TTextRec) : integer;
begin
        CloseHandle(Lpt);
        Result := 0;
end;

function PrnOpen(var F : TTextRec) : integer;
begin
        Lpt := CreateFile('LPT1',
            GENERIC_WRITE,
            0,
            nil,
            OPEN_EXISTING,
            0,
            0);
        with F do
        begin
                i f Mode = fmInput then
                begin
                        InOutFunc := @Ignore;
                        FlushFunc := @Ignore;
                end
                else
                begin
                        Mode := fmOutput;
                        InOutFunc := @PrnOutput;
                        FlushFunc := @PrnOutPut;
                end;
                CloseFunc := @PrnClose;
        end;
        PrnOpen := 0;
end;

procedure AssignPrn(var F : Text);
begin
        with TTextRec(F) do
        begin
                Handle := $FFFF;
                Mode := fmClosed;
                BufSize := Sizeof(Buffer);
                BufPtr := @Buffer;
                BufPos := 0;
                OpenFunc := @PrnOpen;
                Name[0] := #0;
        end;
end;

end.



More information about the Delphi mailing list