Category : Pascal Source Code
Archive   : HPROUT.ZIP
Filename : HPUNIT.PAS

Unit HPUnit;

Interface

Uses
Crt,
Dos,
FastTTT5,
StrnTTT5;

Const
Esc = #27;
HPReset = #27'E';

(* Page sizes... *)
Executive = #27'&l1A';
Letter = #27'&l2A';
Legal = #27'&l3A';
A4 = #27'&l26A';
Monarch = #27'&l80A';
Commercial10 = #27'&l81A';
InternationalDL = #27'&l90A';
InternationalCS = #27'&l91A';

(* orintation *)

Portrait = #27'&l0O';
Landscape = #27'&l1O';

(* symbol set... *)

HpRoman8 = #27'(8U';
PC8 = #27'(10U';

(* spacQcing... *)

Fixed = #27'(s0P';
Proportional = #27'(s1P';

(* style... *)

Upright = #27'(s0S';
Italic = #27'(s1S';

(* stroke... *)

Medium = #27'(s0B';
Bold = #27'(s1B';

(* typeface... *)

Lineprinter = #27'(s0T';
Courier = #27'(s3T';
Helv = #27'(s4T';
TmsRoman = #27'(s5T';
LetterGothic= #27'(s6T';
Prestige = #27'(s8T';
Presentations= #27'(s11T';
Optima = #27'(s17T';
TCGaramond = #27'(s18T';
CooperBlack = #27'(s19T';
CooperBold = #27'(s20T';
Broadway = #27'(s21T';
BauerBodoniBlackCondensed = #27'(s22T';
CenturySchoolBook = #27'(s23T';
UniversityRoman = #27'(s24T';

StartUnderLine = #27'&d0D';
StopUnderLine = #27'&d@';

(* functions and procedures ... *)

function Copies(CopyCount : Integer) : String;
function LinesPerPage(LineCount : Integer) : String;
function LinesPerInch(LineCount : Integer) : String;
function PrimaryPitch(Pitch : Integer) : String;
function PointSize(Points : Real) : String;
function PitchSize(Pitch : Real) : String;
function AbsHorizPos(Inches : Real) : String;
function AbsVertPos(Inches : Real) : String;
procedure PlotXY(Var PrnFile : Text;X,Y : Real);
procedure PlotX(Var PrnFile : Text; X : Real);
procedure PlotY(Var PrnFile : Text;Y : Real);
function FontId(Id : Integer) : String;
function FontStatus(ID : Integer; Status : Char) : String;
Function FontPrimORSec(ID : Integer; Status : Char) : String;
Procedure DownloadFont(FontFileName: String; Id : Integer; Status : Char;
StatusX,StatusY,StatusFore,StatusBack: Integer);
Procedure EjectPage(Var PrnFile : Text);

Implementation

Const
BlockSize = 4096;

Type
BufferType = Array[0..BlockSize - 1] of byte;

Var
St : String;

procedure Dta2Prn(BufferAddr:Pointer;
BufferSize: LongInt); external;

{$L Dta2Prn.OBJ}

function Copies;

(* Get the string for the copycount... *)

begin
Str(CopyCount,St);
Copies := Esc + '&l' + St + 'X';
end;

function LinesPerPage;

begin
Str(LineCount,St);
LinesPerPage := Esc + '&l' + St + 'F';
end;

function LinesPerInch;

begin
Str(LineCount,St);
LinesPerInch := Esc + '&l' + St + 'D';
end;

function PrimaryPitch;

begin
Str(Pitch,St);
PrimaryPitch := Esc + '(s' + St + 'H';
end;

function PointSize;

begin
St := Real_To_Str(Points,2);
PointSize := Esc + '(s' + St + 'V';
end;

function PitchSize;

begin
St := Real_To_Str(Pitch,2);
PitchSize := Esc + '(s' + St + 'H'
end;

function AbsHorizPos;

var
Dots : Real;
DotSt : String;

begin
Dots := Inches * 300;
Str(Round(Dots),DotSt);
AbsHorizPos := Esc + '*p' + DotSt + 'X';
end;

function AbsVertPos;

var
Dots : Real;
DotSt : String;

begin
Dots := Inches * 300;
Str(Round(Dots),DotSt);
AbsVertPos := Esc + '*p' + DotSt + 'Y';
end;

procedure PlotXY(Var PrnFile:Text; X,Y: Real);

begin
Write(PrnFile,AbsHorizPos(X));
Write(PrnFile,AbsVertPos(Y));
end;

procedure PlotX(Var PrnFile:Text; X:Real);

begin
Write(PrnFile,AbsHorizPos(X));
end;

procedure PlotY(Var PrnFile:Text; Y : Real);

begin
Write(PrnFile,AbsVertPos(Y));
end;

function FontID;

Var
IdSt : String;

begin
Str(Id,IdSt);
FontID := Esc + '*c' + IdSt + 'D';
end;

Function FontPrimORSec;

(* Is the font you're about to send primary or secondary? Send *)
(* the function 'P' or 'S' *)

var
IdSt : String;

begin
Status := UpCase(Status);
Str(Id,IdSt);
Case Status of
'P': FontPrimORSec := Esc + '(' + IdSt + 'X';
'S': FontPrimORSec := Esc + ')' + IdSt + 'X'
else FontPrimORSec := '';
end; (* Case *)
end;

Function FontStatus;

Var
IdSt : String;

begin
Status := UpCase(Status);
Str(Id,IdSt);
Case Status of
'P': FontStatus := Esc + '*c5' + 'F'; (* Permanent *)
'T': FontStatus := Esc + '*c4' + 'F'; (* Temp *)
else FontStatus := '';
end; (* Case *)
end;

procedure DownloadFont;

Var
ListFile : Text;
PrnFile,
FontFile: File;
Buffer: BufferType;
RecsRead: Integer;

begin
Assign(FontFile,FontFileName);
Reset(FontFile,1);
Assign(PrnFile,'PRN');
Rewrite(PrnFile,1);
Assign(ListFile,'PRN');
Rewrite(ListFile);
Write(ListFile,HPReset);
Write(ListFile,FontID(Id));
While not(eof(FontFile)) do
begin
BlockRead(FontFile,Buffer,SizeOf(Buffer),RecsRead);
If (StatusX <> 0) OR (StatusY <> 0) then
WriteAt(StatusX,StatusY,StatusFore,StatusBack,
Int_To_Str(Round(FilePos(FontFile)/FileSize(FontFile) * 100))+
' % downloaded...');
Dta2Prn(@Buffer,RecsRead);
end;
Close(FontFile);
Write(ListFile,FontStatus(Id,Status));
Write(ListFile,FontPrimORSec(Id,'P'));
Close(PrnFile);
Close(ListFile);
end;

Procedure EjectPage(Var PrnFile : Text);

begin
Write(PrnFile,Esc+'&l0H');
end;

End. (* unit *)