adfaxprn.pas

Async Professional 4.04

  FFaxPrintProgress    := ppIdle;

  StatusDisplay        := SearchForDisplay(Owner);
  FaxPrinterLog        := SearchForPrinterLog(Owner);

  if not (csDesigning in ComponentState) then begin
    FPrintDialog := TPrintDialog.Create(Self);
    FFaxUnpack := TApdFaxUnpacker.Create(Self);
  end else begin
    FPrintDialog := nil;
    FFaxUnpack := nil;
  end;
end;

destructor TApdCustomFaxPrinter.Destroy;
begin
  FFaxHeader.Free;
  FFaxFooter.Free;

  if Assigned(FPrintDialog) then
    FPrintDialog.Free;
  if Assigned(FFaxUnpack) then
    FFaxUnpack.Free;

  inherited Destroy;
end;

procedure TApdCustomFaxPrinter.Notification(AComponent: TComponent;
                                 Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  case Operation of
    opRemove :
      begin
        if AComponent = FStatusDisplay then
          FStatusDisplay := nil;
        if AComponent = FFaxPrinterLog then
          FFaxPrinterLog := nil;
      end;
    opInsert :
      begin
        if AComponent is TApdAbstractFaxPrinterStatus then begin
          if not Assigned(FStatusDisplay) then
            StatusDisplay := TApdAbstractFaxPrinterStatus(AComponent);
        end;
        if AComponent is TApdFaxPrinterLog then begin
          if not Assigned(FFaxPrinterLog) then
            FaxPrinterLog := TApdFaxPrinterLog(AComponent);
        end;
      end;
  end;
end;

procedure TApdCustomFaxPrinter.SetStatusDisplay(
              const Value: TApdAbstractFaxPrinterStatus);
begin
  if Value <> FStatusDisplay then begin
    FStatusDisplay  := Value;
    if Assigned(FStatusDisplay) then
      FStatusDisplay.FFaxPrinter := Self;
  end;
end;

procedure TApdCustomFaxPrinter.SetFaxFileName(const Value: String);
begin
  if FFileName <> Value then begin
    FFileName := Value;

    if not (csDesigning in ComponentState) then begin

      with FPrintDialog do begin
        { Set defaults for dialog }
        PrintRange := prAllPages;
        Options := [poPageNums];

        { Get the number of pages in the APF file }
        FFaxUnpack.InFileName := FFileName;
        FTotalFaxPages  := FFaxUnpack.NumPages;

        { Get detailed info for the fax }
        FFaxResolution := FFaxUnpack.FaxResolution;
        FFaxWidth  := FFaxUnpack.FaxWidth;

        { See if we have a good APF file }
        if FTotalFaxPages > 0 then begin
          FromPage := 1;
          MinPage := 1;
        end else begin
          FTotalFaxPages := 0;
          FromPage := 0;
          MinPage := 0;
        end;

        { Set page counts }
        MaxPage := FTotalFaxPages;
        ToPage := FTotalFaxPages;
        FFirstPageToPrint := FromPage;
        FLastPageToPrint := ToPage;
      end;
    end;
  end;
end;

procedure TApdCustomFaxPrinter.SetCaption(const Value: String);
begin
  { Set the job's print title in Printmanager}
  Printer.Title := Value;
end;

function TApdCustomFaxPrinter.GetCaption: String;
begin
  { Get the job's print title from print manager}
  Result := Printer.Title;
end;

procedure TApdCustomFaxPrinter.SetFaxPrintLog(const Value: TApdFaxPrinterLog);
begin
  if Value <> FFaxPrinterLog then begin
    FFaxPrinterLog := Value;
    if Assigned(FFaxPrinterLog) then
      FFaxPrinterLog.FFaxPrinter := Self;
  end;
end;

function TApdCustomFaxPrinter.ReplaceHFParams(Value: String;
                                              Page: Word): String;
var
  I, N: Word;
  T : String;
begin
  I := Pos('$', Value);
  while I > 0 do begin
    { total Length of tag }
    N := I;
    while (N <= Length(Value)) and (Value[N] <> ' ') do
      Inc(N);
    Dec(N, I);

    { preserve and delete the tag from the main string }
    T := Copy(Value, I, N);
    Delete(Value, I, N);

    { process the correct tag }
    case T[2] of
      'D', 'd' :
        T := DateToStr(Date);
      'T', 't' :
        T := TimeToStr(Time);
      'P', 'p' :
        T := IntToStr(Page);
      'N', 'n' :
        T := IntToStr(FTotalFaxPages);
      'F', 'f' :
        T := FileName;
       else
         T:= '';
    end;
    Insert(T, Value, I);

    { find the next tag }
    I := Pos('$', Value);
  end;
  Result := Value;
end;

procedure TApdCustomFaxPrinter.CreateFaxHeader(FaxCanvas : TCanvas;
                                 PN: Word; var AreaRect: TRect);
var
  Header : String;
begin
  { replace the header parameters}
  Header := ReplaceHFParams(FaxHeader.Caption, PN);

  { assign the new font for the header }
  FaxCanvas.Font := FaxHeader.Font;

  { if printing on a multipage sheet, reduce the font size }
  if MultiPage then
    FaxCanvas.Font.Size := (FaxCanvas.Font.Size div 2);

  { get the height of the header in pixels }
  FaxHeader.Height := FaxCanvas.TextHeight(Header);

  { draw the text to the printer canvas }
  with AreaRect do
    FaxCanvas.TextRect(Rect(Left, Top, Right, Top+FaxHeader.Height),
                       Left, Top, Header);

  AreaRect.Top := AreaRect.Top+FaxHeader.Height+2;

  { Draw a line under the header }
  FaxCanvas.MoveTo(AreaRect.Left, AreaRect.Top);
  FaxCanvas.LineTo(AreaRect.Right, AreaRect.Top);
  Inc(AreaRect.Top, 1);
end;

procedure TApdCustomFaxPrinter.CreateFaxFooter(FaxCanvas : TCanvas;
                                 PN: Word; var AreaRect: TRect);
var
  Footer : String;
begin
  { replace the footer parameters}
  Footer := ReplaceHFParams(FaxFooter.Caption, PN);

  { assign the new font for the footer }
  FaxCanvas.Font := FaxFooter.Font;

  { if printing on a multipage sheet, reduce the font size }
  if MultiPage then
    FaxCanvas.Font.Size := (FaxCanvas.Font.Size div 2);

  { get the height of the footer in pixels }
  FaxFooter.Height := FaxCanvas.TextHeight(Footer);

  { draw the text to the printer canvas }
  with AreaRect do
    FaxCanvas.TextRect(Rect(Left, Bottom-FaxFooter.Height, Right, Bottom),
                       Left, Bottom-FaxFooter.Height, Footer);
  AreaRect.Bottom := AreaRect.Bottom-FaxHeader.Height-2;

  { Draw a line over the footer }
  FaxCanvas.MoveTo(AreaRect.Left, AreaRect.Bottom);
  FaxCanvas.LineTo(AreaRect.Right, AreaRect.Bottom);
  Dec(AreaRect.Bottom, 1);
end;

procedure TApdCustomFaxPrinter.SetFaxPrintProgress(const NewProgress : TFaxPrintProgress);
begin
  if NewProgress <> FFaxPrintProgress then begin
    FFaxPrintProgress := NewProgress;

    { call FaxPrintStatus event if assigned }
    if Assigned(FOnFaxPrintStatus) then
      FOnFaxPrintStatus(Self, NewProgress);

    { update the display if assigned and visible }
    if Assigned(FStatusDisplay) then begin
      try
        if StatusDisplay.Display.Visible then
          StatusDisplay.UpdateDisplay(False, False);
      except
      end;
    end;
  end;
  Application.ProcessMessages;                                       
end;

procedure TApdCustomFaxPrinter.FaxPrintLog(LogCode: TFaxPLCode);
begin
  { call FaxPrintLog event if assigned }
  if Assigned(FOnFaxPrintLog) then
    FOnFaxPrintLog(Self, LogCode);

  { pass to FaxPrintLog component if assigned }
  if Assigned(FFaxPrinterLog) then
    FaxPrinterLog.UpdateLog(LogCode);
end;

procedure TApdCustomFaxPrinter.PrintAbort;
begin
  FFaxPrintProgress := ppIdle;
  if Printer.Printing then begin
    { stop any possible fax conversions }
    FFaxUnpack.Options := FFaxUnpack.Options + [uoAbort];

    { abort the print job }
    Printer.Abort;
    FCurrentPrintingPage := 0;

    { update the log }
    FaxPrintLog(lcAborted);

    { update the status display }
    if Assigned(FStatusDisplay) then
      StatusDisplay.UpdateDisplay(False, True);
  end;
  Application.ProcessMessages;                                      
end;

function TApdCustomFaxPrinter.PrintSetup : Boolean;                  
begin
  { Display the Printer setup dialog }
  if FPrintDialog.Execute then begin
    FFirstPageToPrint := FPrintDialog.FromPage;
    FLastPageToPrint  := FPrintDialog.ToPage;
    Result := True;
  end else
    Result := False;                                                
end;

procedure TApdCustomFaxPrinter.PrintFax;
var
  PageLoop    : Word;
  PagesPrinted: Word;
  Image       : Pointer;
  Info        : PBitmapInfo;
  ImageSize   : DWord;
  InfoSize    : DWord;
  PrintWidth  : LongInt;
  PrintHeight : LongInt;
  FaxPageRect : TRect;
  FaxSizeRect : TRect;
  Bitmap      : TBitmap;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}  
begin
  {$IFDEF TRIALRUN}
  TC;
  {$ENDIF}
  if TotalFaxPages > 0 then begin
    { show the printer status dialog if assigned }
    FFaxPrintProgress := ppIdle;
    if Assigned(FStatusDisplay) then
      StatusDisplay.UpdateDisplay(True, False);

    { call FaxPrintStatus event if assigned }
    if Assigned(FOnFaxPrintStatus) then
      FOnFaxPrintStatus(Self, FFaxPrintProgress);

    FaxPrintLog(lcStart);

    Printer.BeginDoc;

    for PageLoop := FirstPageToPrint to LastPageToPrint do begin
      FCurrentPrintingPage := PageLoop;

      { Increment the page / canvas to print upon}
      PagesPrinted := CurrentPrintingPage-FirstPageToPrint;
      Application.ProcessMessages;                                   
      if (PagesPrinted > 0) and Printer.Printing then begin
        if (not MultiPage) then
          Printer.NewPage
        else if MultiPage then begin
          case Printer.Orientation of
            poLandscape:
              begin
                if (((PageLoop-FirstPageToPrint) mod 2) = 0) then
                  Printer.NewPage;
              end;
            poPortrait :
              begin
                if (((PageLoop-FirstPageToPrint) mod 4) = 0) then
                  Printer.NewPage;
              end;
          end;
        end;
      end;

      Application.ProcessMessages;                                  
      if not Printer.Printing then
        Exit;

      { call the next page event if assigned }
      if Assigned(FOnNextPage) then
        FOnNextPage(Self, CurrentPrintingPage, TotalFaxPages);

      try
        SetFaxPrintProgress(ppConverting);
        Bitmap := FFaxUnpack.UnpackPageToBitmap(CurrentPrintingPage);

        Application.ProcessMessages;                                
        if not Printer.Printing then
          Exit;

        SetFaxPrintProgress(ppComposing);
        try
          GetDIBSizes(Bitmap.Handle, InfoSize, ImageSize);
          GetMem(Info, InfoSize);
          try
            GetMem(Image, ImageSize);
            try
              GetDIB(Bitmap.Handle, 0, Info^, Image^);

              { set initial area sizes for the fax page }
              FaxPageRect := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
              FaxSizeRect := Rect(0, 0, Bitmap.Width, Bitmap.Height);

              if MultiPage then begin
                FaxPageRect.Right := FaxPageRect.Right div 2;

                if Printer.Orientation = poPortrait then
                  FaxPageRect.Bottom := FaxPageRect.Bottom div 2;

                case ((PageLoop-(FirstPageToPrint)) mod 4) of
                  1 : { 2nd page }
                    begin
                      FaxPageRect.Left := FaxPageRect.Right;
                      FaxPageRect.Right := FaxPageRect.Right * 2;
                    end;
                  2 : { 3rd page of 4 }
                    begin
                      if Printer.Orientation = poPortrait then begin
                        FaxPageRect.Top := FaxPageRect.Bottom;
                        FaxPageRect.Bottom := FaxPageRect.Bottom * 2;
                      end;
                    end;
                  3 : { 4th page of 4 - or - 2nd page of 2 }
                    begin
                      FaxPageRect.Left := FaxPageRect.Right;
                      FaxPageRect.Right := FaxPageRect.Right * 2;
                      if Printer.Orientation = poPortrait then begin
                        FaxPageRect.Top := FaxPageRect.Bottom;
                        FaxPageRect.Bottom := FaxPageRect.Bottom * 2;
                      end;
                    end;
                end;
                { create a 2 pixel seperator region around pages }
                InflateRect(FaxPageRect, -2, -2);
              end;

              { place a header on the page if requested }
              Application.ProcessMessages;                          
              if Printer.Printing and FaxHeader.Enabled then
                CreateFaxHeader(Printer.Canvas, CurrentPrintingPage, FaxPageRect);

              { place a footer on the page if requested }
              Application.ProcessMessages;                          
              if Printer.Printing and FaxFooter.Enabled then
                CreateFaxFooter(Printer.Canvas, CurrentPrintingPage, FaxPageRect);

              { set the scaling options for the fax }
              case PrintScale of
                psFitToPage :
                  begin
                    PrintWidth :=
                      trunc(0.93 * (FaxPageRect.Right-FaxPageRect.Left));
                    if Bitmap.Width > 1728 then
                      PrintHeight :=
                        MulDiv(FaxPageRect.Bottom-FaxPageRect.Top,
                          Bitmap.Height,1728)
                    else
                      PrintHeight :=
                        MulDiv(FaxPageRect.Bottom-FaxPageRect.Top,
                          Bitmap.Width,1728);

                  end;
                else begin {psNone}
                  PrintWidth := MulDiv(Bitmap.Width,
                    Printer.Canvas.Font.PixelsPerInch, 200);
                  PrintHeight := MulDiv(Bitmap.Height,
                    Printer.Canvas.Font.PixelsPerInch, 200);         
                  if PrintHeight > (FaxPageRect.Bottom-FaxPageRect.Top) then
                    PrintHeight := (FaxPageRect.Bottom-FaxPageRect.Top);
                end;
              end;

              SetFaxPrintProgress(ppRendering);
              if Printer.Printing then
                with FaxSizeRect do
                  StretchDIBits(Printer.Canvas.Handle, FaxPageRect.Left,
                    FaxPageRect.Top, PrintWidth, PrintHeight, Left, Top,
                    Right, Bottom, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
              SetFaxPrintProgress(ppSubmitting);
            finally
              FreeMem(Image, ImageSize);
            end;
          finally
            FreeMem(Info, InfoSize);
          end;

        finally
          if Assigned(Bitmap) then
            Bitmap.Free
          else
            FaxPrintLog(lcFailed);
        end;
      finally
      end;
    end;

    Application.ProcessMessages;
    if Printer.Printing then
      Printer.EndDoc;

    FaxPrintLog(lcFinish);

    { remove the printer status dialog if showing }
    FFaxPrintProgress := ppIdle;
    if Assigned(FStatusDisplay) then
      StatusDisplay.UpdateDisplay(False, True);

    if Assigned(FOnFaxPrintStatus) then
      FOnFaxPrintStatus(Self, FFaxPrintProgress);
  end;
  FCurrentPrintingPage := 0;
end;

end.