Category : Pascal Source Code
Archive   : TPWPRINT.ZIP
Filename : PRINTER.PAS

{$V-,F+}
{.LW 132}
UNIT printer;
INTERFACE
USES WObjects,WinTypes,WinProcs,Strings,WinDos,PDevice;
Type
pPrnDialog = ^tPrnDialog;
tPrnDialog = object(tDialog)
Procedure cancel(var msg: tMessage); virtual id_First + id_Cancel;
End;

pPrinter = ^tPrinter;
tPrinter = object(tprnDevice)
maxX: word; {max width of page}
maxY: Word; {max height of page}
posX: Word; {current column}
posY: Word; {current row}
metrics: TTextMetric; {text metric information}
okToPrint: Boolean;
lpAbortProc: tFarProc;
hInst: tHandle;
theParent: pWindowsObject;

constructor Init(inst: tHandle;par: pWindowsObject);
Function Start(dName: pChar;hw: hWnd): Boolean; virtual;
Function CheckStart: Boolean; virtual;
Function newAbortProc: Boolean; virtual;
Function print(aStr: pChar): Boolean; virtual;
Function PrintLine(aStr: pChar): Boolean; virtual;
Function printString(aStr: pChar): Boolean; virtual;
Function Finish: Boolean; virtual;
Function pageSize(var ps: tPoint): Boolean; virtual;
Function height: word; virtual;
Function newLine: Boolean; virtual;
Function checkNewPage: Boolean; virtual;
Function newPage: Boolean; virtual;
Function resetPos: Boolean; virtual;
Function doNewFrame: Boolean; virtual;
Function printDlg: Boolean; virtual;
Function removeDialog: Boolean; virtual;
Function stopPrinter: Boolean; virtual;
Function LineWidth(aStr: pChar): Integer; virtual;
Function textWidth: Integer; virtual;
Function textHeight: Integer; virtual;
End;

IMPLEMENTATION
{$R prt.res}
var
userAbort: Boolean;
printDialog: pPrnDialog;

(***********************************************************)
Function AbortProc(hPrnDC: hDC; nCode: Word): Boolean;Export;
var
prnMsg: tMsg;

Begin
While not userAbort and PeekMessage(prnMsg,0,0,0,pm_Remove) do begin
if not IsDialogMessage(PrintDialog^.hWindow,prnMsg) then begin
TranslateMessage(prnMsg);
DispatchMessage(prnMsg);
End;
End;
abortProc := not UserAbort;
End;

Procedure tPrnDialog.Cancel(var Msg: tMessage);
Begin
userAbort := True;
end;

Constructor tPrinter.Init(inst: tHandle; par: pWindowsObject);
Begin
tPrnDevice.Init;
theParent := par;
hInst := inst;
UserAbort := False;
End;

Function tPrinter.Start;
var
ap: tPoint;

Begin
hWindow := Hw; {save the parent window. Seemed like a good idea}
hPrintDC := 0; {init the device context to 0}
GlobalCompact(0); {compacts global memory}
if (getPrinterParms and DCcreated) then begin
docName := dName;
getTextMetrics(hPrintDC,Metrics);
pageSize(ap);
maxX := ap.x-1;
maxY := ap.y-1;
start := CheckStart;
end
else
start := false;
End;

Function tPrinter.printDlg;
Begin
printDlg := false;
printDialog := new(pPrnDialog,Init(TheParent,'PrintDlgBox'));
if (printDialog <> nil) then begin
printDlg := printDialog^.Create;
End;
printDlg := true;
End;

Function tPrinter.RemoveDialog;
Begin
printDialog^.Destroy;
dispose(printDialog,Done);
End;

Function tPrinter.CheckStart;
Begin
OkToPrint := false;
if printDlg then begin
if newAbortProc then begin
enableWindow(getParent(hWindow),false);
if BeginDoc then
okToPrint := true
else begin
deleteContext;
removeDialog;
enableWindow(getParent(hWindow),true);
freeProcInstance(lpAbortProc);
prnError(prnStartError);
End;
End else begin
deleteContext;
removeDialog;
prnError(abortProcError);
End;
end else begin
deleteContext;
prnError(prnDlgError);
End;
checkStart := okToPrint;
End;

Function tPrinter.NewAbortProc;
begin
lpAbortProc := makeProcInstance(@abortProc,hInst);
newAbortProc := (CallEscape(SetAbortProc,0,lpAbortProc,nil) > 0);
end;

Function tPrinter.lineWidth(aStr: pChar): Integer;
Begin
if (aStr <> nil) then
LineWidth := (lo(GetTextExtent(hPrintDC,aStr,strLen(aStr))))
else
LineWidth := 0;
End;

Function tPrinter.Print(astr: pChar): Boolean;
var
extent: Integer;

Begin
extent := lineWidth(aStr);
if ((PosX + extent) > maxX) then
newLine;
if printString(aStr) then begin
PosX := PosX + Extent;
print := true;
End else
print := false;
End;

Function tPrinter.PrintLine(aStr: pChar): Boolean;
Begin
if print(aStr) then begin
newLine;
printLine := true;
End else
printLine := false;
End;

Function tPrinter.PrintString(aStr: pChar): Boolean;
Begin
if OkPrint then
PrintString := TextOut(hPrintDC,posX,posY,aStr,strLen(aStr))
else
printString := false;
end;

Function tPrinter.StopPrinter;
Begin
enableWindow(getParent(hWindow),true);
removeDialog;
okToPrint := false;
End;

Function tPrinter.Finish;
Begin
endOfFile;
stopPrinter;
freeProcInstance(lpAbortProc);
End;

Function tPrinter.PageSize(var ps: tPoint): Boolean;
Begin
ps.X := GetDeviceCaps(hPrintDC,HorzRes);
ps.Y := GetDeviceCaps(hPrintDC,VertRes);
end;

Function tPrinter.height: word;
Begin
height := metrics.tmHeight + metrics.tmExternalLeading;
End;

Function tPrinter.NewLine: Boolean;
Begin
posX := 0;
posY := posY + height;
checkNewPage;
End;

Function tPrinter.CheckNewPage: Boolean;
Begin
if (posY > maxY) then
newPage;
End;

Function tPrinter.NewPage: boolean;
Begin
if okToPrint then begin
resetPos;
doNewFrame;
End;
End;

Function tPrinter.ResetPos: Boolean;
Begin
posX := 0;
posY := 0;
End;

Function tPrinter.doNewFrame: Boolean;
Begin
if OkPrint then
doNewFrame := tPrnDevice.doNewFrame;
End;

Function tPrinter.textWidth: Integer;
Begin
textWidth := metrics.tmAveCharWidth;
End;

Function tPrinter.textHeight: Integer;
Begin
textHeight := metrics.tmHeight;
End;

end.