home *** CD-ROM | disk | FTP | other *** search
- PROGRAM TestPrn;
- {$F+}
- {-- Sample program using the printer unit --}
-
- Uses wObjects,winProcs,repPrn,stdDlgs,WinTypes,Strings;
- const
- cmSetPrint = 1;
- cmPrintFile = 2;
-
- TYPE
- tTestApp = object(tApplication)
- procedure InitMainWindow; virtual;
- end;
-
- pPrnWindow = ^tPrnWindow;
- tPrnWindow = object(tWindow)
- aPrinter: pReportPrinter;
- constructor Init(aParent: pWindowsObject;aTitle: pChar);
- procedure setPrinter(var msg:tMessage);virtual cm_first + cmSetPrint;
- procedure filePrint(var msg: tMessage);virtual cm_first + cmPrintFile;
- end;
- pathStr = array[0..64] of Char;
-
-
- {$R test.res}
-
- procedure tPrnWindow.setPrinter(var msg:tMessage);
- begin
- aPrinter := new(preportPrinter,Init(hInstance,@self,10));
- aPrinter^.prnDeviceMode(hWindow);
- dispose(aPrinter,Done);
- End;
-
- Function fileIsOpen(var t: Text;f: pathStr): Boolean;
- var
- ioCode: integer;
- Begin
- {$I-}
- assign(t,f);
- reset(t);
- ioCode := ioResult;
- fileIsOpen := (ioCode = 0);
- {$I+}
- end;
-
- procedure tPrnWindow.filePrint(var msg: tMessage);
- {-- Gets a file name from the user, and prints it out. (the file, not
- the file name --}
- var
- fName: pathStr;
- textFile: Text;
- tLine: array[0..79] of char;
-
- Begin
- fName[0] := ' ';
- if (Application^.ExecDialog(new(pInputDialog,Init(@self,'File to Print',
- 'Enter File Name: ',@fName,SizeOf(fName)))) = id_OK) then begin
- if (FileIsOpen(textFile,fName)) then begin
-
- aPrinter := new(pReportPrinter,Init(hInstance,@self,60)); {init the printer object}
- aPrinter^.setDefaults('Heading');
- if aPrinter^.Start('PrnTest',hWindow) then begin {start the printer}
- while not eof(textFile) do begin
- readln(textFile,tLine);
- aPrinter^.outText(@tLine); {send each line to the printer object}
- End;
- close(textFile);
- aPrinter^.Finish; {finish the print job}
- dispose(aPrinter,Done);
- End;
- End;
- End;
- end;
-
- constructor tPrnWindow.Init(aParent: pWindowsObject;aTitle: pChar);
- begin
- tWindow.Init(aParent,aTitle);
- Attr.Style := WS_OverlappedWindow or ws_Vscroll or WS_Hscroll;
- attr.Menu := loadMenu(hInstance,pChar(100));
- end;
-
- Procedure tTestApp.InitMainWindow;
- Begin
- MainWindow := new(pPrnWindow,init(nil,'Printer Test'));
- End;
-
-
- var
- tApp: tTestApp;
-
- Begin
- tApp.Init('Printer Test');
- tApp.Run;
- tApp.Done;
- End.