frxpreviewpages.pas

这个是功能强大的报表软件

  SaveRightMargin := Page.RightMargin;
  if Page.MirrorMargins and (Index mod 2 = 1) then
  begin
    Page.LeftMargin := SaveRightMargin;
    Page.RightMargin := SaveLeftMargin;
  end;

  IsPrinting := Canvas is TfrxPrinterCanvas;
  rgn := 0;
  if not IsPrinting then
  begin
    rgn := CreateRectRgn(0, 0, 10000, 10000);
    GetClipRgn(Canvas.Handle, rgn);
    IntersectClipRect(Canvas.Handle,
      Round(OffsetX),
      Round(OffsetY),
      Round(OffsetX + Page.PaperWidth * fr01cm * ScaleX) - 1,
      Round(OffsetY + Page.PaperHeight * fr01cm * ScaleY) - 1);
  end;

  Page.IsPrinting := IsPrinting;
  Page.Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
  OffsetX := OffsetX + Page.LeftMargin * fr01cm * ScaleX;
  OffsetY := OffsetY + Page.TopMargin * fr01cm * ScaleY;

  l := Page.AllObjects;

  for i := 0 to l.Count - 1 do
  begin
    c := l[i];
    if (c is TfrxView) and ViewVisible(c) then
      if not IsPrinting or TfrxView(c).Printable then
      begin
        c.IsPrinting := IsPrinting;
        { needed for TOTALPAGES macro }
        if c is TfrxCustomMemoView then
        begin
          THackMemoView(c).FTotalPages := Count;
          THackMemoView(c).FCopyNo := FCopyNo;
          THackMemoView(c).FPrintScale := FPrintScale;
        end;
        { draw the object }
        TfrxView(c).Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
        c.IsPrinting := False;
      end;
  end;

  Page.LeftMargin := SaveLeftMargin;
  Page.RightMargin := SaveRightMargin;
  if not IsPrinting then
  begin
    SelectClipRgn(Canvas.Handle, rgn);
    DeleteObject(rgn);
  end;
end;

function TfrxPreviewPages.Print: Boolean;
var
  MaxCount: Integer;
  PagesPrinted, ACopyNo: Integer;
  pgList: TStringList;
  LastDuplexMode: TfrxDuplexMode;
  LastPaperSize, LastPaperWidth, LastPaperHeight, LastBin: Integer;
  LastOrientation: TPrinterOrientation;
  SplitAddX, SplitAddY: Extended;
  DuplexMode: TfrxDuplexMode;
  SavePrintOptions: TfrxPrintOptions;
  SheetWidth, SheetHeight: Extended;


  function GetNextPage(var Index: Integer): TfrxReportPage;
  begin
    Result := nil;
    while Index < Count - 1 do
    begin
      Inc(Index);
      if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then
        continue
      else
      begin
        Result := GetPage(Index);
        break;
      end;
    end;
  end;

  procedure SplitPage(a, b, c, d: Extended; var x, y: Integer; var NeedRotate: Boolean);
  var
    tempX, tempY: Integer;
    tempC: Extended;

    procedure TrySplit;
    begin
      if Abs(Trunc(a / c) * c - a) < 11 then
        x := Round(a / c)
      else
        x := Trunc(a / c) + 1;

      if Abs(Trunc(b / d) * d - b) < 11 then
        y := Round(b / d)
      else
        y := Trunc(b / d) + 1;
    end;

  begin
    NeedRotate := False;

    TrySplit;

    tempX := x;
    tempY := y;

    tempC := c;
    c := d;
    d := tempC;

    TrySplit;

    if x * y >= tempX * tempY then
    begin
      x := tempX;
      y := tempY;
    end
    else
      NeedRotate := True;
  end;

  procedure DoPrint;
  var
    i: Integer;
    Printer: TfrxCustomPrinter;
    PagePrinted: Boolean;
    Page: TfrxReportPage;

    function PrintSplittedPage(Index: Integer): Boolean;
    var
      Bin, ACopies, x, y, countX, countY: Integer;
      pieceX, pieceY, offsX, offsY, marginX, marginY, printedX, printedY: Extended;
      orient: TPrinterOrientation;
      NeedChangeOrientation: Boolean;
      dup: TfrxDuplexMode;
    begin
      Result := True;
      if Index >= Count then Exit;

      if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
      if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
         ((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
      if Report.Terminated then
      begin
        Printer.Abort;
        Result := False;
        Exit;
      end;

      Page := GetPage(Index);

      if Report.PrintOptions.Collate then
      begin
        ACopies := 1;
        FCopyNo := ACopyNo;
      end
      else
      begin
        ACopies := Report.PrintOptions.Copies;
        FCopyNo := 1;
      end;

      if Assigned(Report.OnPrintPage) then
        Report.OnPrintPage(Page, FCopyNo);

      if Index = 0 then
        Bin := Page.Bin else
        Bin := Page.BinOtherPages;

      SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth, SheetHeight,
        countX, countY, NeedChangeOrientation);

      orient := poPortrait;
      if NeedChangeOrientation then
        orient := poLandscape;

      dup := Page.Duplex;
      if DuplexMode <> dmNone then
        dup := DuplexMode;

      if not PagePrinted or (orient <> LastOrientation) then
        Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
          SheetWidth, SheetHeight, orient, Bin, Integer(dup) + 1, ACopies);
      if not PagePrinted then
        Printer.BeginDoc;

      if orient = poPortrait then
      begin
        pieceX := SheetWidth * (Printer.DPI.X / 25.4);
        pieceY := SheetHeight * (Printer.DPI.Y / 25.4);
      end
      else
      begin
        pieceX := SheetHeight * (Printer.DPI.X / 25.4);
        pieceY := SheetWidth * (Printer.DPI.Y / 25.4);
      end;

      marginY := 0;
      printedY := 0;
      offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;

      for y := 1 to countY do
      begin
        marginX := 0;
        printedX := 0;
        offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;

        for x := 1 to countX do
        begin
          Printer.BeginPage;
          DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96, Printer.DPI.Y / 96,
            offsX, offsY);


          Printer.EndPage;

          printedX := printedX + (pieceX - marginX - Printer.RightMargin * Printer.DPI.X / 25.4) -
            SplitAddX * Printer.DPI.X / 25.4;
          offsX := -printedX;
          marginX := Printer.LeftMargin * Printer.DPI.X / 25.4;
        end;

        printedY := printedY + (pieceY - marginY - Printer.BottomMargin * Printer.DPI.Y / 25.4) -
          SplitAddY * Printer.DPI.Y / 25.4;
        offsY := -printedY;
        marginY := Printer.TopMargin * Printer.DPI.Y / 25.4;
      end;

      Report.InternalOnProgress(ptPrinting, Index + 1);
      Application.ProcessMessages;

      PagePrinted := True;
      Inc(PagesPrinted);

      LastOrientation := Page.Orientation;
      ClearPageCache;
    end;


    function PrintPage(Index: Integer): Boolean;
    var
      Bin, ACopies: Integer;
      dup: TfrxDuplexMode;
      ZoomX, ZoomY: Extended;
    begin
      Result := True;
      if Index >= Count then Exit;

      if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
      if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
         ((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
      if Report.Terminated then
      begin
        Printer.Abort;
        Result := False;
        Exit;
      end;

      Page := GetPage(Index);

      if Report.PrintOptions.Collate then
      begin
        ACopies := 1;
        FCopyNo := ACopyNo;
      end
      else
      begin
        ACopies := Report.PrintOptions.Copies;
        FCopyNo := 1;
      end;

      if Assigned(Report.OnPrintPage) then
        Report.OnPrintPage(Page, FCopyNo);

      if Index = 0 then
        Bin := Page.Bin else
        Bin := Page.BinOtherPages;

      dup := Page.Duplex;
      if DuplexMode <> dmNone then
        dup := DuplexMode;

      if Report.PrintOptions.PrintMode = pmDefault then
      begin
        if (not PagePrinted) or
          (LastPaperSize <> Page.PaperSize) or
          (LastPaperWidth <> Round(Page.PaperWidth)) or
          (LastPaperHeight <> Round(Page.PaperHeight)) or
          (LastBin <> Bin) or
          (LastOrientation <> Page.Orientation) or
          (LastDuplexMode <> dup) then
          Printer.SetPrintParams(Page.PaperSize, Page.PaperWidth, Page.PaperHeight,
            Page.Orientation, Bin, Integer(dup) + 1, ACopies);
      end
      else
        if (not PagePrinted) or
          (LastBin <> Bin) or
          (LastOrientation <> Page.Orientation) or
          (LastDuplexMode <> dup) then
        begin
          Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
            SheetWidth, SheetHeight, Page.Orientation, Bin, Integer(dup) + 1, ACopies);
          SheetWidth := frxPrinters.Printer.PaperWidth;
          SheetHeight := frxPrinters.Printer.PaperHeight;
        end;
      if not PagePrinted then
        Printer.BeginDoc;

      Printer.BeginPage;

      if Report.PrintOptions.PrintMode = pmDefault then
      begin
        ZoomX := 1;
        ZoomY := 1;
      end
      else
      begin
        ZoomX := SheetWidth / Page.PaperWidth;
        ZoomY := SheetHeight / Page.PaperHeight;
        if ZoomY < ZoomX then
          FPrintScale := ZoomY
        else
          FPrintScale := ZoomX;
      end;

      DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96 * ZoomX, Printer.DPI.Y / 96 * ZoomY,
        -Printer.LeftMargin * Printer.DPI.X / 25.4,
        -Printer.TopMargin * Printer.DPI.Y / 25.4);

      Report.InternalOnProgress(ptPrinting, Index + 1);


      Printer.EndPage;
      Application.ProcessMessages;

      PagePrinted := True;
      Inc(PagesPrinted);

      LastPaperSize := Page.PaperSize;
      LastPaperWidth := Round(Page.PaperWidth);
      LastPaperHeight := Round(Page.PaperHeight);
      LastBin := Bin;
      LastOrientation := Page.Orientation;
      LastDuplexMode := dup;
      ClearPageCache;
    end;

    procedure PrintPages;
    var
      i: Integer;
    begin
      PagesPrinted := 0;

      if Report.PrintOptions.Reverse then
      begin
        for i := MaxCount - 1 downto 0 do
          if not PrintPage(i) then
            break;
      end
      else
        for i := 0 to MaxCount - 1 do
          if not PrintPage(i) then
            break;
    end;

    procedure PrintSplittedPages;
    var
      i: Integer;
    begin
      PagesPrinted := 0;

      if Report.PrintOptions.Reverse then
      begin
        for i := MaxCount - 1 downto 0 do
          if not PrintSplittedPage(i) then
            break;
      end
      else
        for i := 0 to MaxCount - 1 do
          if not PrintSplittedPage(i) then
            break;
    end;

    procedure PrintJoinedPages;
    var
      Index, cp, x, y, countX, countY: Integer;
      pieceX, pieceY, offsX, offsY: Extended;
      orient: TPrinterOrientation;
      NeedChangeOrientation: Boolean;
      dup: TfrxDuplexMode;
    begin
      PagesPrinted := 0;
      if Count = 0 then Exit;

      { get the first page and calculate the join options }
      Index := -1;
      Page := GetNextPage(Index);

      SplitPage(SheetWidth, SheetHeight, Page.PaperWidth, Page.PaperHeight,
        countX, countY, NeedChangeOrientation);
      orient := poPortrait;
      if NeedChangeOrientation then
      begin
        orient := poLandscape;
        x := countX;
        countX := countY;
        countY := x;
      end;

      { setup the printer }
      dup := Page.Duplex;
      if DuplexMode <> dmNone then
        dup := DuplexMode;
      Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
        SheetWidth, SheetHeight, orient, Page.Bin, Integer(dup) + 1, 1);
      PagePrinted := True;
      Printer.BeginDoc;

      { start the cycle }
      pieceX := Page.PaperWidth * (Printer.DPI.X / 25.4);
      pieceY := Page.PaperHeight * (Printer.DPI.Y / 25.4);

      Index := -1;
      while Index < MaxCount - 1 do
      begin
        cp := 1;
        offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
        Printer.BeginPage;

        for y := 1 to countY do
        begin
          offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;

          for x := 1 to countX do
          begin
            { get the next page }
            FCopyNo := cp;
            if cp = 1 then
              Page := GetNextPage(Index);
            Inc(cp);
            if cp > Report.PrintOptions.Copies then
              cp := 1;

            if Page = nil then break;

            DrawPage(Index, Printer.Canvas, Printer.DPI.X / 96, Printer.DPI.Y / 96,
              offsX, offsY);

            offsX := offsX + pieceX;
          end;

          if Page = nil then break;
          offsY := offsY + pieceY;
        end;


        Printer.EndPage;

        Report.InternalOnProgress(ptPrinting, Index);
        Application.ProcessMessages;
        if Report.Terminated then
        begin
          Printer.Abort;
          Exit;
        end;