adfaxprn.pas

测试用例

      '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;
begin
  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.