home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPRINT.ZIP / PDEVICE.PAS next >
Encoding:
Pascal/Delphi Source File  |  1991-05-10  |  9.0 KB  |  325 lines
  1. {$V-}
  2. {.LW 132}
  3. UNIT pDevice;
  4. INTERFACE
  5. USES WObjects,WinTypes,WinProcs,Strings,WinDos;
  6. Type
  7.   devArray = array[0..79] of Char;
  8.   prnErrors = (spAbortErr,spGenErr,spOutDiskErr,spOutMemErr,spUserAbortErr,
  9.                prnStartError,prnDlgError,AbortProcError);
  10.   pPrnDevice = ^tPrnDevice;
  11.   tprnDevice = object(tObject)
  12.     hPrintDC:  hDC;           {print device context}
  13.     hWindow:   hWnd;          {parent window}
  14.     docName:   pChar;         {name of the document}
  15.     device:    devArray;      {device name from windows}
  16.     driver:    devArray;      {driver name from windows}
  17.     dMode:     tDevMode;      {device mode record}
  18.     noSpooler: Boolean;       {if spooler is operating}
  19.     prnPort:   devArray;      {printer port}
  20.  
  21.     CONSTRUCTOR Init;
  22.     DESTRUCTOR Done; virtual;
  23.     Function DeleteContext: Boolean; virtual;
  24.     Function prnDeviceMode(wnd: hWnd):Integer; virtual;
  25.     Function GetPrinterParms: Boolean; virtual;
  26.     Function DCCreated: Boolean; virtual;
  27.     Function beginDoc: Boolean; virtual;
  28.     Function endDocument: Boolean; virtual;
  29.     Function doNewFrame: Boolean; virtual;
  30.     Function printerPort: pChar; virtual;
  31.     Function okPrint: Boolean; virtual;
  32.     Function deviceName: pChar; virtual;
  33.     Function driverName: pChar; virtual;
  34.     Function clearEnv: Integer; virtual;
  35.     Function endOfFile: Integer; virtual;
  36.     Function callEscape(code,count: Integer; inData,outData: pointer): Integer; virtual;
  37.     Function prnError(msgNum: prnErrors): Integer; virtual;
  38.     Function DocAbort: Integer; virtual;
  39.     Function abortPrn: Integer; virtual;
  40.     Function FlushPrn: Boolean; virtual;
  41.     Function initAbortProc(procAddr: pointer): Boolean; virtual;
  42.     Function draftModeOn: boolean; virtual;
  43.     Function draftModeOff: boolean; virtual;
  44.     Function AppAbortError: Boolean; virtual;
  45.     Function GeneralError: Boolean; virtual;
  46.     Function OutOfDiskError: Boolean; virtual;
  47.     Function OutOfMemoryError: Boolean; virtual;
  48.     Function UserAbortError: Boolean; virtual;
  49.     Function PrintStartError: Boolean; virtual;
  50.     Function PrintDlgError: Boolean; virtual;
  51.     Function AbortProcErr: Boolean; virtual;
  52.   End;
  53.  
  54.   tGetDevMode = function(hWindow: hWnd; dHan: tHandle; devName,output: pChar): Boolean;
  55.   tGetExtDevMode = function(hWIndow: hWnd;
  56.                             dHan: tHandle;
  57.                             outMode: tDevMode;
  58.                             devName: pChar;
  59.                             outPut: pChar;
  60.                             inMode: tDevMode;
  61.                             profile: pChar;
  62.                             pMode: word): Boolean;
  63.   tMode= tDeviceMode;
  64.  
  65. IMPLEMENTATION
  66. Type
  67.   errMsgArray =array[0..1] of devArray;
  68.  
  69. Const
  70.  
  71.   eMsg:array[prnErrors] of errMsgArray = (
  72.        ('The application has terminated the print job',
  73.         'Application Termination'),
  74.        ('An unidentified printer error has occured',
  75.         'General Error'),
  76.        ('There is not enough disk space for spooling',
  77.         'Out of disk space'),
  78.        ('There is not enough memory for spooling',
  79.         'Out of memory'),
  80.        ('The user terminated the print job from the spooler',
  81.         'User Termination'),
  82.        ('Cannot start the printer',
  83.         'Printer Error'),
  84.        ('Cannot create the print dialog',
  85.         'Printer Error'),
  86.        ('Error setting Abort Procedure',
  87.         'Abort Proc Error'));
  88.  
  89.  
  90.  
  91. CONSTRUCTOR tPrnDevice.Init;
  92. Begin
  93.   tObject.Init;
  94. End;
  95.  
  96. DESTRUCTOR tPrnDevice.Done;
  97. Begin
  98.   tObject.Done;
  99. End;
  100.  
  101. FUNCTION tPrnDevice.PrinterPort: pChar;
  102. Begin
  103.   printerPort := prnPort;
  104. End;
  105.  
  106. Function tPrnDevice.OkPrint: Boolean;
  107. Begin
  108.   okPrint := (hPrintDC > 0);
  109. End;
  110.  
  111. Function tPrnDevice.deviceName: pChar;
  112. Begin
  113.   deviceName := device;
  114. End;
  115.  
  116. Function tPrnDevice.driverName: pChar;
  117. Begin
  118.   driverName := driver;
  119. End;
  120.  
  121. Function tPrnDevice.clearEnv: Integer;
  122. Begin
  123.   SetEnvironment(prnPort,nil,0);
  124. End;
  125.  
  126. Function tPrnDevice.EndOfFile: Integer;
  127. Begin
  128.   if doNewFrame then
  129.     EndDocument;
  130.   deleteContext;
  131. End;
  132.  
  133. Function tPrnDevice.deleteContext;
  134. begin
  135.   deleteDC(hPrintDC);
  136. End;
  137.  
  138. Function tPrnDevice.prnDeviceMode;
  139.  var
  140.   dHandle: tHandle;     {handle of the load library for the current printer}
  141.   drvName: pChar;       {name of the driver used to get dHandle}
  142.   pAddr:   tFarProc;    {address of the function in the DLL we want to EXEC}
  143.  
  144.  
  145. Begin
  146.   if getPrinterParms then begin            {retrieve printer info from windows}
  147.     drvName := driver;
  148.     strCat(drvName,'.drv');             {make a file name out of the driver}
  149.     dHandle := LoadLibrary(drvName);    {load the DLL for the printer}
  150.     pAddr := getProcAddress(dHandle,'ExtDeviceMode');
  151.     if (pAddr <> nil) then begin
  152.       tGetExtDevMode(pAddr)(wnd,dHandle,dMode,drvName,prnPort,dMode,nil,dm_prompt OR dm_copy);
  153.     end else begin
  154.       pAddr := GetProcAddress(dHandle,'DEVICEMODE');
  155.       if (pAddr <> nil) then begin
  156.         tGetDevMode(pAddr)(wnd,dHandle,drvName,prnPort);
  157.       End;
  158.     End;
  159.     FreeLibrary(dHandle);   {the library is freed when we are done with it}
  160.   End;
  161. end;
  162.  
  163. Function tPrnDevice.GetPrinterParms;
  164. var
  165.   astr: array[0..255] of char;
  166.   result: Integer;
  167.   cPtr: pChar;
  168.   cPos: pChar;
  169.  
  170. Begin
  171.   result := GetProfileString('windows','device',nil,astr,sizeOF(astr));
  172.   cPtr := aStr;
  173.   cPos := strScan(cPtr,',');
  174.   strLcopy(device,cPtr,(cPos - cPtr));
  175.   cPtr := cPos + 1;
  176.   cPos := strScan(cPtr,',');
  177.   strLcopy(driver,cPtr,(cPos - cptr));
  178.   cPtr := cPos + 1;
  179.   strLcopy(prnPort,cPtr,strLen(cPtr));
  180.   result := GetProfileString('windows','spooler',nil,astr,sizeOf(aStr));
  181.   noSpooler := (strPas(aStr) = 'no');
  182. End;
  183.  
  184. FUNCTION tPrnDevice.DCcreated;
  185. Begin
  186.   hPrintDC := CreateDC(driver,device,prnPort,nil);
  187.   DCCreated := (hPrintDC > 0);
  188. End;
  189.  
  190. Function tPrnDevice.beginDoc: Boolean;
  191. Begin
  192.   beginDoc := (callEscape(startDoc,sizeOf(docName),docName,nil) > 0);
  193. end;
  194.  
  195. Function tPrnDevice.EndDocument: Boolean;
  196. Begin
  197.   endDocument := (callEscape(EndDoc,0,nil,nil) > 0);
  198. End;
  199.  
  200. Function tPrnDevice.doNewFrame: Boolean;
  201. Begin
  202.   doNewFrame := (callEscape(NewFrame,0,nil,nil) > 0);
  203. End;
  204.  
  205. Function tPrnDevice.callEscape(code,count: Integer; inData,outData: pointer): Integer;
  206. var
  207.   result: Integer;
  208.  
  209. Begin
  210.   result := escape(hPrintDC,code,count,inData,OutData);
  211.   if (result < 0) then begin
  212.     case result of
  213.       sp_appAbort:    prnError(spAbortErr);
  214.       sp_error:       prnError(spGenErr);
  215.       sp_OutOfDisk:   prnError(spOutDiskErr);
  216.       sp_OutOfMemory: prnError(spOutMemErr);
  217.       sp_UserAbort:   prnError(spUserAbortErr);
  218.  
  219.     End; {case}
  220.   End;
  221.   callEscape := result;
  222. End;
  223.  
  224. Function tPrnDevice.DocAbort:Integer;
  225. Begin
  226.   callEscape(AbortDoc,0,nil,nil)
  227. End;
  228.  
  229. Function tPrnDevice.AbortPrn: Integer;
  230. Begin
  231.   DocAbort;
  232.   deleteContext;
  233. End;
  234.  
  235. Function tPrnDevice.flushPrn: boolean;
  236. Begin
  237.   flushPrn := (callEscape(FlushOutput,0,nil,nil) > 0);
  238. End;
  239.  
  240. Function tPrnDevice.InitAbortProc(procAddr: Pointer): Boolean;
  241. Begin
  242.   InitAbortProc := (callEscape(SetAbortProc,0,procAddr,nil) > 0);
  243. end;
  244.  
  245. Function tPrnDevice.DraftModeOn: Boolean;
  246. var
  247.   funct: word;
  248.  
  249. Begin
  250.   funct := 1000;
  251.   draftModeOn := (callEscape(draftMode,sizeOf(funct),@funct,nil) > 0);
  252. End;
  253.  
  254. Function tPrnDevice.draftModeOff: Boolean;
  255. var
  256.   funct: word;
  257.  
  258. Begin
  259.   funct := 0;
  260.   draftModeOff := (callEscape(draftMode,sizeOf(funct),@funct,nil) > 0);
  261. End;
  262.  
  263. Function tPrnDevice.prnError(msgNum: prnErrors):integer;
  264. Begin
  265.   case msgNum OF
  266.     spAbortErr:     appAbortError;
  267.     spGenErr:       GeneralError;
  268.     spOutDiskErr:   OutOfDiskError;
  269.     spOutMemErr:    OutOfMemoryError;
  270.     spUserAbortErr: UserAbortError;
  271.     prnStartError:  PrintStartError;
  272.     prnDlgError:    PrintDlgError;
  273.     AbortProcError: AbortProcErr;
  274.   End;
  275. End;
  276.  
  277. Function tPrnDevice.appAbortError;
  278. Begin
  279.   MessageBox(HWindow, @emsg[spAbortErr,0], @eMsg[spAbortErr,1],
  280.                       mb_Ok or mb_IconExclamation);
  281. End;
  282.  
  283. Function tPrnDevice.GeneralError: Boolean;
  284. Begin
  285.   MessageBox(HWindow, @emsg[spGenErr,0],@eMsg[spGenErr,1],
  286.                       mb_Ok or mb_IconExclamation);
  287. end;
  288.  
  289. Function tPrnDevice.OutOfDiskError: Boolean;
  290. Begin
  291.   MessageBox(HWindow, @emsg[spOutDiskErr,0], @eMsg[spOutDiskErr,1],
  292.                       mb_Ok or mb_IconExclamation);
  293. End;
  294.  
  295. Function tPrnDevice.OutOfMemoryError: Boolean;
  296. Begin
  297. MessageBox(HWindow, @emsg[spOutMemErr,0], @eMsg[spOutMemErr,1],
  298.                       mb_Ok or mb_IconExclamation);
  299. End;
  300.  
  301. Function tPrnDevice.UserAbortError: Boolean;
  302. Begin
  303.   MessageBox(HWindow, @emsg[spUserAbortErr,0], @eMsg[spUserAbortErr,1],
  304.                       mb_Ok or mb_IconExclamation);
  305. End;
  306.  
  307. Function tPrnDevice.PrintStartError: Boolean;
  308. Begin
  309.   MessageBox(HWindow, @emsg[prnStartError,0], @eMsg[prnStartError,1],
  310.                       mb_Ok or mb_IconExclamation);
  311. End;
  312.  
  313. Function tPrnDevice.PrintDlgError: Boolean;
  314. Begin
  315.   MessageBox(HWindow, @emsg[prnDlgError,0], @eMsg[prnDlgError,1],
  316.                       mb_Ok or mb_IconExclamation);
  317. End;
  318.  
  319. Function tPrnDevice.AbortProcErr: Boolean;
  320. Begin
  321.   MessageBox(HWindow, @emsg[AbortProcError,0], @eMsg[AbortProcError,1],
  322.                       mb_Ok or mb_IconExclamation);
  323. End;
  324.  
  325. end.