[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]
(* Insert a '.' before the statment '$DEFINE' to *)
(* compile without debugging information. *)
{.$DEFINE DebugMode}
{$IFDEF DebugMode}
{$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P-,R+,S+,V+,X-}
{$ELSE}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,R-,S-,V-,X-}
{$ENDIF}
(**********************************************************************)
(* PRINTIT.PAS - Public-domain TP printer unit by Guy McLoughlin. *)
(* version 1.10 (July, 1993) *)
(* Min TP version: 4+ *)
(**********************************************************************)
unit PrintIt;
(* BIT-MAP OF THE PRINTER "STATUS-BYTE" *)
(* ------------------------------------ *)
(* *)
(* BIT NUMBER 7 6 5 4 3 2 1 0 *)
(* | | | | | | | +-- Printer "timed-out" *)
(* | | | | | +--+----- These bits are NOT used *)
(* | | | | +----------- Printer I/O error *)
(* | | | +-------------- Printer "selected" *)
(* | | +----------------- Printer is out of paper *)
(* | +-------------------- Acknowlegment from printer *)
(* +----------------------- Printer NOT busy *)
interface
type
st_8 = string[8];
(***** Initialize printer port. *)
(* *)
function InitPrinterPort({ input} wo_PrinterNum : word) : {output} byte;
(***** Check the status of the printer. *)
(* *)
function CheckPrinter({ input} wo_PrinterNum : word) : {output} byte;
(***** Initialize PrintIt variables, and check printer status. *)
(* *)
function InitPrintIt({ input} st_PrinterID : st_8;
by_PrinterNum : byte;
bo_InitPort : boolean;
{update} var fi_Printer : text;
var by_Status : byte)
{output} : boolean;
(***** Position printer "head" to X columns across, Y rows down. *)
(* *)
procedure P2xy({ input} var fi_Printer : text;
by_Xaxis,
by_Yaxis : byte);
(***** Print string at position X columns across, Y rows down. *)
(* *)
procedure Pwrite({ input} var fi_Printer : text;
st_Data : string;
by_Xaxis,
by_Yaxis : byte);
implementation
const (* Line-feed, Carriage-return, Space character constant *)
co_Lf = #10;
co_Cr = #13;
co_Space = #32;
var (* "space" character, and line-feed string variables. *)
st_Spaces,
st_LineFeeds : string;
(***** Initialize printer port. *)
(* *)
function InitPrinterPort({ input} wo_PrinterNum : word) :
{output} byte; assembler;
asm
mov ax, 0100h
mov dx, wo_PrinterNum
int 17h
mov al, ah
end; (* InitPrinterPort. *)
(***** Check the staus of the printer. *)
(* *)
function CheckPrinter({ input} wo_PrinterNum : word) :
{output} byte; assembler;
asm
mov ax, 0200h
mov dx, wo_PrinterNum
int 17h
mov al, ah
end; (* CheckPrinter. *)
(***** Initialize PrintIt variables, and check printer status. *)
(* *)
function InitPrintIt({ input} st_PrinterID : st_8;
by_PrinterNum : byte;
bo_InitPort : boolean;
{update} var fi_Printer : text;
var by_Status : byte)
{output} : boolean;
begin
(* Initialize "PrintIt" variables. *)
fillchar(st_Spaces, sizeof(st_Spaces), co_Space);
fillchar(st_LineFeeds, sizeof(st_LineFeeds), co_Lf);
(* Try to open text-device printer variable. *)
assign(fi_Printer, st_PrinterID);
{$I-}
rewrite(fi_Printer);
{$I+}
if (ioresult <> 0) then
begin
by_Status := $FF;
InitPrintIt := false
end
else
begin
(* Initialize printer-port if required. *)
if bo_InitPort then
by_Status := InitPrinterPort(by_PrinterNum)
else
(* Else, check the status of the printer. *)
by_Status := CheckPrinter(by_PrinterNum);
(* Check for error-flags in the printer status byte. *)
if ((by_Status AND $29) = 0) then
InitPrintIt := true
else
InitPrintIt := false
end
end; (* InitPrinter. *)
(***** Position printer "head" to X columns across, Y rows down. *)
(* *)
procedure P2xy({ input} var fi_Printer : text;
by_Xaxis,
by_Yaxis : byte);
begin
if (by_Yaxis > 0) then
begin
st_LineFeeds[0] := chr(by_Yaxis);
write(fi_Printer, st_LineFeeds)
end;
if (by_Xaxis > 0) then
begin
st_Spaces[0] := chr(pred(by_Xaxis));
write(fi_Printer, co_Cr + st_Spaces)
end
end; (* P2xy. *)
(***** Print string at position X columns across, Y rows down. *)
(* *)
procedure Pwrite({ input} var fi_Printer : text;
st_Data : string;
by_Xaxis,
by_Yaxis : byte);
begin
P2xy(fi_Printer, by_Xaxis, by_Yaxis);
write(fi_Printer, st_Data)
end; (* Pwrite. *)
END.
{-------------------------------- CUT HERE -----------------------------}
(* Program to demo "PrintIt" unit. *)
program DemoPrintIt;
uses
PrintIt;
const (* Form-feed character. *)
co_FF = #12;
var (* Printer "status" byte. Check "bit-map" in PrintIt *)
(* unit for table of bit-flags. *)
by_PrinterStatus : byte;
(* Our text-device interface variable. *)
fi_Printer : text;
(* Main program block. *)
BEGIN
(* Initialize "PrintIt" variables, and check the *)
(* status of the printer. *)
if NOT InitPrintIt('PRN', 0, false, fi_Printer, by_PrinterStatus) then
(* InitPrintIt failed. Inform user of this, and halt. *)
begin
writeln('Error accessing printer!');
writeln('Printer error = ', by_PrinterStatus);
halt
end;
(* Print "SECRET" meaning of life symbol!!! <g> *)
(* Position printer head to column 45, 5 rows down. *)
P2xy(fi_Printer, 45, 5);
(* Write some text to the printer. *)
write(fi_Printer, '_)');
P2xy(fi_Printer, 43, 0);
write(fi_Printer, '(_');
P2xy(fi_Printer, 45, 1);
write(fi_Printer, '@)');
P2xy(fi_Printer, 43, 0);
write(fi_Printer, '(@');
P2xy(fi_Printer, 41, 1);
write(fi_Printer, '---\/');
P2xy(fi_Printer, 36, 0);
write(fi_Printer, '/----');
P2xy(fi_Printer, 35, 1);
write(fi_Printer, '/ | ||');
P2xy(fi_Printer, 40, 1);
write(fi_Printer, '---||');
P2xy(fi_Printer, 34, 0);
write(fi_Printer, '* ||-');
P2xy(fi_Printer, 37, 1);
write(fi_Printer, '^^ ^^');
(* Print "SECRET" number code, using "Pwrite" routine.*)
Pwrite(fi_Printer, '10', 45, 5);
Pwrite(fi_Printer, '2', 37, 0);
Pwrite(fi_Printer, '8', 43, 0);
Pwrite(fi_Printer, '7', 42, 0);
Pwrite(fi_Printer, '1', 36, 0);
Pwrite(fi_Printer, '6', 41, 0);
Pwrite(fi_Printer, '3', 38, 0);
Pwrite(fi_Printer, '9', 44, 0);
Pwrite(fi_Printer, '5', 40, 0);
Pwrite(fi_Printer, '0', 35, 0);
Pwrite(fi_Printer, '4', 39, 0);
(* Say good-bye, Guy. *)
Pwrite(fi_Printer, '...Thats All Folks!!!', 30, 2);
(* Send form-feed to printer. *)
write(fi_Printer, co_FF)
END.
[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]