{$V-}
UNIT pDevice;
INTERFACE
USES WObjects,WinTypes,WinProcs,Strings,WinDos;
Type
  devArray = array[0..64] of Char;    {holds results of params call}
  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}
	outPort:   devArray;             {printer port}
	okPrint:   boolean;				 {flag}

	CONSTRUCTOR Init;
	Function DeleteContext: Boolean;
	Procedure prnDeviceMode(wnd: hWnd);
	Function GetPrinterParms: Boolean;
	Function DCCreated: Boolean;
	Function beginDoc: Boolean;
	Function endDocument: Boolean;
	Function doNewFrame: Boolean; virtual;
  End;

  {-- These are types used to call the device mode dialog from a printer
	  driver.  They are used in the tPrnDevice.prnDeviceMode function.
	  tGetDevMode is used for drivers not written for windows 3.  The
	  ExtDevMode is for windows 3 printer drivers --}

  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;

  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}

	constructor Init;
	FUNCTION Start(dName: pChar;hw: hWnd): Boolean;
	Function CheckStart: Boolean;
	Function newAbortProc: Boolean;
	Function textLine(aStr: pChar): Boolean;
	Function Finish: Boolean;
	Function pageSize(var ps: tPoint): Boolean;
	Function height: word;
	Function endLine: Boolean;
	Function checkNewPage: Boolean;
	Function newPage: Boolean;
	Function resetPos: Boolean;
	Function doNewFrame: Boolean;virtual;
  End;

IMPLEMENTATION

CONSTRUCTOR tPrnDevice.Init;
Begin
  tObject.Init;
End;

Function tPrnDevice.deleteContext;
{-- Delete the device context for the printer --}
begin
  deleteDC(hPrintDC);
End;

Procedure tPrnDevice.prnDeviceMode;
{-- Displays the printer driver dialog box to allow the user to change
	default print parameters.  If the driver is for window 3, this call
	will only affect the current application.  Other drivers will affect
	all applications.  --}
 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}
  {-- the next instruction requests the address of a procedure called
	  ExtDeviceMode from the DLL. Drivers written for windows 3 should
	  contain this procedure.  if successful, that address is typecast
	  to the tGetExtDevMode function type, and executed. --}

	pAddr := getProcAddress(dHandle,'ExtDeviceMode');
	if (pAddr <> nil) then begin
	  tGetExtDevMode(pAddr)(wnd,dHandle,dMode,drvName,outPort,dMode,nil,dm_prompt OR dm_copy);
	end else begin
  {-- If the drivers is not written for windows 3, or there is no extDeviceMode
	  procedure, the standard device mode function is called --}

	  pAddr := GetProcAddress(dHandle,'DEVICEMODE');
	  if (pAddr <> nil) then begin
		tGetDevMode(pAddr)(wnd,dHandle,drvName,outPort);
	  End;
	End;
	FreeLibrary(dHandle);   {the library is freed when we are done with it}
  End;
end;

Function tPrnDevice.GetPrinterParms;
{-- This function retrieves the printer parameters from the WIN.INI file --}
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(outPort,cPtr,strLen(cPtr));
  result := GetProfileString('windows','spooler',nil,astr,sizeOf(aStr));
  noSpooler := (strPas(aStr) = 'no');
End;

FUNCTION tPrnDevice.DCcreated;
{-- Creates the device context for the printer --}
Begin
  hPrintDC := CreateDC(driver,device,outPort,nil);
  DCCreated := (hPrintDC > 0);
End;

Function tPrnDevice.beginDoc: Boolean;
{-- sends the startdoc escape sequence to windows --}
Begin
  beginDoc := (escape(hPrintDC,startDoc,sizeOf(docName),docName,nil) > 0);
end;

Function tPrnDevice.EndDocument: Boolean;
{-- Ends the document.  Closes the print manager, if used, and sends output
	to the printer --}
Begin
  doNewFrame;
  escape(hPrintDC,EndDoc,0,nil,nil);
End;

Function tPrnDevice.doNewFrame: Boolean;
{-- sends the newFrame escape code to windows. In the case of a printer,
	this results in a form feed --}

Begin
  doNewFrame := (escape(hPrintDC,NewFrame,0,nil,nil) > 0);
End;

(***********************************************************)
Constructor tPrinter.Init;
Begin
  tPrnDevice.Init;
End;

Function tPrinter.Start;
{-- after initialization, this method sets the printer up to print --}
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}
{-- the next line retrieves the printer parms from WIN.INI, and creates
	the device context --}
  if (getPrinterParms and DCcreated) then begin
	docName := dName;
{-- The next few lines deal with the physical fonts.  GetTextMetrics
	retrieves the information for the printer.  Page size returns a tPoint
	record with the X and Y values for the DeviceCaps page heigth and width.
	maxX and maxY are then set at one less that these values --}

	getTextMetrics(hPrintDC,Metrics);
	pageSize(ap);
	maxX := ap.x-1;
	maxY := ap.y-1;
	start := CheckStart;
  end
  else
	start := false;
End;

Function tPrinter.CheckStart;
{-- This function will eventually set up a printer abort proc. Now, it
	only calls the beginDoc function  --}
Begin
  okPrint := true;
  newAbortProc;
  okPrint := BeginDoc;
  CheckStart := okPrint;
End;

Function tPrinter.NewAbortProc;
begin
end;

Function tPrinter.textLine(aStr: pChar): Boolean;
{-- sends a line of text to the printer, starting at the X and Y
	co-ordinates.  End line adjusts the row based on the height of
	the font from the textMetrics record  --}
Begin
  if OkPrint then begin
	if TextOut(hPrintDC,posX,posY,aStr,strLen(aStr)) then
	  endLine;
  End;
end;

Function tPrinter.Finish;
{-- Ends the print job --}
Begin
  EndDocument;
  deleteContext;
End;

Function tPrinter.PageSize(var ps: tPoint): Boolean;
{-- Calls the device caps function to get the size of the page --}
Begin
  ps.X := GetDeviceCaps(hPrintDC,HorzRes);
  ps.Y := GetDeviceCaps(hPrintDC,VertRes);
end;

Function tPrinter.height: word;
{-- returns the height of the font. If your line spacing
	is to tight, you can return a different value, and
	increase it.   --}
Begin
  height := metrics.tmHeight;
End;

Function tPrinter.EndLine: Boolean;
{-- causes a 'line feed' by incrementing the row by the height of the font --}
Begin
  posX := 0;
  posY := posY + height;
  checkNewPage;
End;

Function tPrinter.CheckNewPage: Boolean;
{-- compares the row with the page height to see if a new page is required --}
Begin
  if (posY > maxY) then
	newPage;
End;

Function tPrinter.NewPage: boolean;
{-- Causes a form feed to be sent to the printer --}
Begin
  resetPos;
  doNewFrame;
End;

Function tPrinter.ResetPos: Boolean;
{-- resets the row and column to zero --}
Begin
  posX := 0;
  posY := 0;
End;

Function tPrinter.doNewFrame: Boolean;
{-- this function will do more when this unit is finished. Right now,
	it calls the ancestor new frame method to cause a line feed. --}
Begin
  if OkPrint then
	doNewFrame := tPrnDevice.doNewFrame;
End;

end.