home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
w3_prog
/
tprint.arj
/
PDEVICE.PAS
next >
Wrap
Pascal/Delphi Source File
|
1991-05-10
|
9KB
|
325 lines
{$V-}
{.LW 132}
UNIT pDevice;
INTERFACE
USES WObjects,WinTypes,WinProcs,Strings,WinDos;
Type
devArray = array[0..79] of Char;
prnErrors = (spAbortErr,spGenErr,spOutDiskErr,spOutMemErr,spUserAbortErr,
prnStartError,prnDlgError,AbortProcError);
pPrnDevice = ^tPrnDevice;
tprnDevice = object(tObject)
hPrintDC: hDC; {print device context}
hWindow: hWnd; {parent window}
docName: pChar; {name of the document}
device: devArray; {device name from windows}
driver: devArray; {driver name from windows}
dMode: tDevMode; {device mode record}
noSpooler: Boolean; {if spooler is operating}
prnPort: devArray; {printer port}
CONSTRUCTOR Init;
DESTRUCTOR Done; virtual;
Function DeleteContext: Boolean; virtual;
Function prnDeviceMode(wnd: hWnd):Integer; virtual;
Function GetPrinterParms: Boolean; virtual;
Function DCCreated: Boolean; virtual;
Function beginDoc: Boolean; virtual;
Function endDocument: Boolean; virtual;
Function doNewFrame: Boolean; virtual;
Function printerPort: pChar; virtual;
Function okPrint: Boolean; virtual;
Function deviceName: pChar; virtual;
Function driverName: pChar; virtual;
Function clearEnv: Integer; virtual;
Function endOfFile: Integer; virtual;
Function callEscape(code,count: Integer; inData,outData: pointer): Integer; virtual;
Function prnError(msgNum: prnErrors): Integer; virtual;
Function DocAbort: Integer; virtual;
Function abortPrn: Integer; virtual;
Function FlushPrn: Boolean; virtual;
Function initAbortProc(procAddr: pointer): Boolean; virtual;
Function draftModeOn: boolean; virtual;
Function draftModeOff: boolean; virtual;
Function AppAbortError: Boolean; virtual;
Function GeneralError: Boolean; virtual;
Function OutOfDiskError: Boolean; virtual;
Function OutOfMemoryError: Boolean; virtual;
Function UserAbortError: Boolean; virtual;
Function PrintStartError: Boolean; virtual;
Function PrintDlgError: Boolean; virtual;
Function AbortProcErr: Boolean; virtual;
End;
tGetDevMode = function(hWindow: hWnd; dHan: tHandle; devName,output: pChar): Boolean;
tGetExtDevMode = function(hWIndow: hWnd;
dHan: tHandle;
outMode: tDevMode;
devName: pChar;
outPut: pChar;
inMode: tDevMode;
profile: pChar;
pMode: word): Boolean;
tMode= tDeviceMode;
IMPLEMENTATION
Type
errMsgArray =array[0..1] of devArray;
Const
eMsg:array[prnErrors] of errMsgArray = (
('The application has terminated the print job',
'Application Termination'),
('An unidentified printer error has occured',
'General Error'),
('There is not enough disk space for spooling',
'Out of disk space'),
('There is not enough memory for spooling',
'Out of memory'),
('The user terminated the print job from the spooler',
'User Termination'),
('Cannot start the printer',
'Printer Error'),
('Cannot create the print dialog',
'Printer Error'),
('Error setting Abort Procedure',
'Abort Proc Error'));
CONSTRUCTOR tPrnDevice.Init;
Begin
tObject.Init;
End;
DESTRUCTOR tPrnDevice.Done;
Begin
tObject.Done;
End;
FUNCTION tPrnDevice.PrinterPort: pChar;
Begin
printerPort := prnPort;
End;
Function tPrnDevice.OkPrint: Boolean;
Begin
okPrint := (hPrintDC > 0);
End;
Function tPrnDevice.deviceName: pChar;
Begin
deviceName := device;
End;
Function tPrnDevice.driverName: pChar;
Begin
driverName := driver;
End;
Function tPrnDevice.clearEnv: Integer;
Begin
SetEnvironment(prnPort,nil,0);
End;
Function tPrnDevice.EndOfFile: Integer;
Begin
if doNewFrame then
EndDocument;
deleteContext;
End;
Function tPrnDevice.deleteContext;
begin
deleteDC(hPrintDC);
End;
Function tPrnDevice.prnDeviceMode;
var
dHandle: tHandle; {handle of the load library for the current printer}
drvName: pChar; {name of the driver used to get dHandle}
pAddr: tFarProc; {address of the function in the DLL we want to EXEC}
Begin
if getPrinterParms then begin {retrieve printer info from windows}
drvName := driver;
strCat(drvName,'.drv'); {make a file name out of the driver}
dHandle := LoadLibrary(drvName); {load the DLL for the printer}
pAddr := getProcAddress(dHandle,'ExtDeviceMode');
if (pAddr <> nil) then begin
tGetExtDevMode(pAddr)(wnd,dHandle,dMode,drvName,prnPort,dMode,nil,dm_prompt OR dm_copy);
end else begin
pAddr := GetProcAddress(dHandle,'DEVICEMODE');
if (pAddr <> nil) then begin
tGetDevMode(pAddr)(wnd,dHandle,drvName,prnPort);
End;
End;
FreeLibrary(dHandle); {the library is freed when we are done with it}
End;
end;
Function tPrnDevice.GetPrinterParms;
var
astr: array[0..255] of char;
result: Integer;
cPtr: pChar;
cPos: pChar;
Begin
result := GetProfileString('windows','device',nil,astr,sizeOF(astr));
cPtr := aStr;
cPos := strScan(cPtr,',');
strLcopy(device,cPtr,(cPos - cPtr));
cPtr := cPos + 1;
cPos := strScan(cPtr,',');
strLcopy(driver,cPtr,(cPos - cptr));
cPtr := cPos + 1;
strLcopy(prnPort,cPtr,strLen(cPtr));
result := GetProfileString('windows','spooler',nil,astr,sizeOf(aStr));
noSpooler := (strPas(aStr) = 'no');
End;
FUNCTION tPrnDevice.DCcreated;
Begin
hPrintDC := CreateDC(driver,device,prnPort,nil);
DCCreated := (hPrintDC > 0);
End;
Function tPrnDevice.beginDoc: Boolean;
Begin
beginDoc := (callEscape(startDoc,sizeOf(docName),docName,nil) > 0);
end;
Function tPrnDevice.EndDocument: Boolean;
Begin
endDocument := (callEscape(EndDoc,0,nil,nil) > 0);
End;
Function tPrnDevice.doNewFrame: Boolean;
Begin
doNewFrame := (callEscape(NewFrame,0,nil,nil) > 0);
End;
Function tPrnDevice.callEscape(code,count: Integer; inData,outData: pointer): Integer;
var
result: Integer;
Begin
result := escape(hPrintDC,code,count,inData,OutData);
if (result < 0) then begin
case result of
sp_appAbort: prnError(spAbortErr);
sp_error: prnError(spGenErr);
sp_OutOfDisk: prnError(spOutDiskErr);
sp_OutOfMemory: prnError(spOutMemErr);
sp_UserAbort: prnError(spUserAbortErr);
End; {case}
End;
callEscape := result;
End;
Function tPrnDevice.DocAbort:Integer;
Begin
callEscape(AbortDoc,0,nil,nil)
End;
Function tPrnDevice.AbortPrn: Integer;
Begin
DocAbort;
deleteContext;
End;
Function tPrnDevice.flushPrn: boolean;
Begin
flushPrn := (callEscape(FlushOutput,0,nil,nil) > 0);
End;
Function tPrnDevice.InitAbortProc(procAddr: Pointer): Boolean;
Begin
InitAbortProc := (callEscape(SetAbortProc,0,procAddr,nil) > 0);
end;
Function tPrnDevice.DraftModeOn: Boolean;
var
funct: word;
Begin
funct := 1000;
draftModeOn := (callEscape(draftMode,sizeOf(funct),@funct,nil) > 0);
End;
Function tPrnDevice.draftModeOff: Boolean;
var
funct: word;
Begin
funct := 0;
draftModeOff := (callEscape(draftMode,sizeOf(funct),@funct,nil) > 0);
End;
Function tPrnDevice.prnError(msgNum: prnErrors):integer;
Begin
case msgNum OF
spAbortErr: appAbortError;
spGenErr: GeneralError;
spOutDiskErr: OutOfDiskError;
spOutMemErr: OutOfMemoryError;
spUserAbortErr: UserAbortError;
prnStartError: PrintStartError;
prnDlgError: PrintDlgError;
AbortProcError: AbortProcErr;
End;
End;
Function tPrnDevice.appAbortError;
Begin
MessageBox(HWindow, @emsg[spAbortErr,0], @eMsg[spAbortErr,1],
mb_Ok or mb_IconExclamation);
End;
Function tPrnDevice.GeneralError: Boolean;
Begin
MessageBox(HWindow, @emsg[spGenErr,0],@eMsg[spGenErr,1],
mb_Ok or mb_IconExclamation);
end;
Function tPrnDevice.OutOfDiskError: Boolean;
Begin
MessageBox(HWindow, @emsg[spOutDiskErr,0], @eMsg[spOutDiskErr,1],
mb_Ok or mb_IconExclamation);
End;
Function tPrnDevice.OutOfMemoryError: Boolean;
Begin
MessageBox(HWindow, @emsg[spOutMemErr,0], @eMsg[spOutMemErr,1],
mb_Ok or mb_IconExclamation);
End;
Function tPrnDevice.UserAbortError: Boolean;
Begin
MessageBox(HWindow, @emsg[spUserAbortErr,0], @eMsg[spUserAbortErr,1],
mb_Ok or mb_IconExclamation);
End;
Function tPrnDevice.PrintStartError: Boolean;
Begin
MessageBox(HWindow, @emsg[prnStartError,0], @eMsg[prnStartError,1],
mb_Ok or mb_IconExclamation);
End;
Function tPrnDevice.PrintDlgError: Boolean;
Begin
MessageBox(HWindow, @emsg[prnDlgError,0], @eMsg[prnDlgError,1],
mb_Ok or mb_IconExclamation);
End;
Function tPrnDevice.AbortProcErr: Boolean;
Begin
MessageBox(HWindow, @emsg[AbortProcError,0], @eMsg[AbortProcError,1],
mb_Ok or mb_IconExclamation);
End;
end.