Windows Shareware GOLD/NuclearComputingVol3No1.cdr/utils/f1498/printer.pas

Pascal/Delphi Source File | 1991-08-06 | 6KB | 259 lines

{$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.