frxpreviewpages.pas

报表控件。FastReport 是非常强大的报表控件

      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 := Page.Duplex;
      ClearPageCache;
    end;

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

      if Reverse then
      begin
{$IFNDEF TRIAL}
        for i := Count - 1 downto 0 do
{$ELSE}
        for i := 4 downto 0 do
{$ENDIF}
          if not PrintPage(i) then
            break;
      end
      else
{$IFNDEF TRIAL}
        for i := 0 to Count - 1 do
{$ELSE}
        for i := 0 to 4 do
{$ENDIF}
          if not PrintPage(i) then
            break;
    end;

  begin
    Printer := frxPrinters.Printer;
    Report.Terminated := False;
    Report.InternalOnProgressStart(ptPrinting);

    if Report.ReportOptions.Name <> '' then
      Printer.Title := Report.ReportOptions.Name else
      Printer.Title := Report.FileName;
    if Copies <= 0 then
      Copies := 1;

    PagePrinted := False;
    LastDuplexMode := dmNone;

    if Collate then
      for i := 0 to Copies - 1 do
      begin
        ACopyNo := i + 1;
        PrintPages;
        if (LastDuplexMode in [dmVertical, dmHorizontal]) and (PagesPrinted mod 2 <> 0) then
        begin
          Printer.BeginPage;
          Printer.EndPage;
        end;

        if Report.Terminated then break;
      end
    else
      PrintPages;

    if PagePrinted then
      Printer.EndDoc;
    Report.InternalOnProgressStop(ptPrinting);
  end;

begin
  Result := True;

  if Report.DotMatrixReport and (frxDotMatrixExport <> nil) then
  begin
    Report.SelectPrinter;
    frxDotMatrixExport.ShowDialog := Report.PrintOptions.ShowDialog;
    Result := Export(frxDotMatrixExport);
    Exit;
  end;

  Copies := Report.PrintOptions.Copies;
  Collate := Report.PrintOptions.Collate;
  PageNumbers := Report.PrintOptions.PageNumbers;
  PrintPages := Report.PrintOptions.PrintPages;
  Reverse := Report.PrintOptions.Reverse;
  Report.SelectPrinter;

  if Report.PrintOptions.ShowDialog then
    with TfrxPrintDialog.Create(Application) do
    begin
      UpDown1.Position := Copies;
      CollateCB.Checked := Collate;
      PageNumbersE.Text := PageNumbers;
      if PageNumbers <> '' then
        PageNumbersRB.Checked := True;
      PrintPagesCB.ItemIndex := Integer(PrintPages);
      ReverseCB.Checked := Reverse;

      ShowModal;
      if ModalResult = mrOk then
      begin
        Copies := StrToInt(CopiesE.Text);
        Collate := CollateCB.Checked;
        if AllRB.Checked then
          PageNumbers := ''
        else if CurPageRB.Checked then
          PageNumbers := IntToStr(CurPreviewPage) else
          PageNumbers := PageNumbersE.Text;
        PrintPages := TfrxPrintPages(PrintPagesCB.ItemIndex);
        Reverse := ReverseCB.Checked;
        Free;
      end
      else
      begin
        Free;
        Result := False;
        Exit;
      end;
    end;

  if Assigned(Report.OnPrintReport) then
    Report.OnPrintReport(Report);

  if Report.Preview <> nil then
    Report.Preview.Lock;
  pgList := TStringList.Create;
  try
    frxParsePageNumbers(PageNumbers, pgList, Count);
    DoPrint;
  finally
    if Assigned(Report.OnAfterPrintReport) then
      Report.OnAfterPrintReport(Report);
    pgList.Free;
  end;
end;

function TfrxPreviewPages.Export(Filter: TfrxCustomExportFilter): Boolean;
var
  pgList: TStringList;
  tempBMP: TBitmap;

  procedure ExportPage(Index: Integer);
  var
    i, j: Integer;
    Page: TfrxReportPage;
    c: TfrxComponent;
    p: TfrxPictureView;
{$IFDEF TRIAL}
    m: TfrxCustomMemoView;
{$ENDIF}

    procedure ExportObject(c: TfrxComponent);
    begin
      if c is TfrxCustomMemoView then
      begin
        { set up font if Highlight is active }
        if TfrxCustomMemoView(c).Highlight.Active then
          TfrxCustomMemoView(c).Font.Assign(TfrxCustomMemoView(c).Highlight.Font);
        { needed for TOTALPAGES macro }
        THackMemoView(c).FTotalPages := Count;
        THackMemoView(c).ExtractTotalPages;
        { needed if memo has AutoWidth and Align properties }
        if THackMemoView(c).AutoWidth then
          THackMemoView(c).Draw(tempBMP.Canvas, 1, 1, 0, 0);
      end;
      Filter.ExportObject(c);
    end;

  begin
    if Index >= Count then Exit;
    if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
    Page := GetPage(Index);
    if Page = nil then Exit;

    if Filter.ShowProgress then
      Report.InternalOnProgress(ptExporting, Index + 1);

    Filter.StartPage(Page, Index);
    try
      { set the offset of the page objects }
      if Page.MirrorMargins and (Index mod 2 = 1) then
        Page.Left := Page.RightMargin * fr01cm else
        Page.Left := Page.LeftMargin * fr01cm;
      Page.Top := Page.TopMargin * fr01cm;

      { export the page background picture and frame }
      p := TfrxPictureView.Create(nil);
      p.Name := '_pagebackground';
      p.Color := Page.Color;
      p.Frame.Assign(Page.Frame);
      p.Picture.Assign(Page.BackPicture);
      p.Stretched := True;
      p.KeepAspectRatio := False;
      try
        p.SetBounds(Page.Left, Page.Top,
          Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm,
          Page.Height - (Page.TopMargin + Page.BottomMargin) * fr01cm);
        Filter.ExportObject(p);
      finally
        p.Free;
      end;
{$IFDEF TRIAL}
      m := TfrxCustomMemoView.Create(nil);
      try
        m.SetBounds(Page.Left, Page.Top - 10,
          Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm, 10);
        m.Text := frxReverseString(FR_UNREG);
        m.HAlign := haRight;
        m.Font.Size := 7;
        m.Font.Color := clGray;
        Filter.ExportObject(m);
      finally
        m.Free;
      end;
{$ENDIF}

      for i := 0 to Page.Objects.Count - 1 do
      begin
        c := Page.Objects[i];
        if c is TfrxBand then
        begin
          if c is TfrxPageHeader then
          begin
            { suppress a header }
            if Filter.SuppressPageHeadersFooters and (Index <> 0) then continue;
          end;
          if c is TfrxPageFooter then
          begin
            { suppress a footer }
            if Filter.SuppressPageHeadersFooters and (Index <> Count - 1) then continue;
          end;
        end;

        ExportObject(c);
        if c.Objects.Count <> 0 then
          for j := 0 to c.Objects.Count - 1 do
            ExportObject(c.Objects[j]);
      end;

    finally
      Filter.FinishPage(Page, Index);
    end;

    if Report.Preview = nil then
      ClearPageCache
    else
    begin
      Page.Left := 0;
      Page.Top := 0;
    end;
  end;

  procedure DoExport;
  var
    i: Integer;
  begin
    if Filter.Start then
      try
        if Report.Preview <> nil then
        begin
          Report.Preview.Refresh;
          Report.Preview.Lock;
        end;

        if Filter.ShowProgress then
          Report.InternalOnProgressStart(ptExporting);

{$IFNDEF TRIAL}
        for i := 0 to Count - 1 do
{$ELSE}
        for i := 0 to 4 do
{$ENDIF}
        begin
          ExportPage(i);
          if Report.Terminated then break;
          Application.ProcessMessages;
        end;

      finally
        if Report.Preview <> nil then
        begin
          TfrxPreview(Report.Preview).HideMessage;
          Report.Preview.Refresh;
        end;

        if Filter.ShowProgress then
          Report.InternalOnProgressStop(ptExporting);

        Filter.Finish;
      end;
  end;

begin
  Result := False;
  if Filter = nil then Exit;

  Filter.Report := Report;
  if (Filter.ShowDialog and (Filter.ShowModal <> mrOk)) then
    Exit;
  if Filter.CurPage then
  begin
    if Report.Preview <> nil then
      Filter.PageNumbers := IntToStr(CurPreviewPage) else
      Filter.PageNumbers := '1';
  end
{$IFDEF FR_COM}
  else
    Filter.PageNumbers := Report.PrintOptions.PageNumbers
{$ENDIF};

  Result := True;
  Report.Terminated := False;

  pgList := TStringList.Create;
  tempBMP := TBitmap.Create;
  try
    frxParsePageNumbers(Filter.PageNumbers, pgList, Count);

    if Filter = frxDotMatrixExport then
      if Assigned(Report.OnPrintReport) then
        Report.OnPrintReport(Report);

    try
      DoExport;
    except
      on e: Exception do
      begin
        Result := False;
        Report.Errors.Text := e.Message;
        frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text);
      end;
    end;

    if Filter = frxDotMatrixExport then
      if Assigned(Report.OnAfterPrintReport) then
        Report.OnAfterPrintReport(Report);
  finally
    pgList.Free;
    tempBMP.Free;
  end;
end;

procedure TfrxPreviewPages.ObjectOver(Index: Integer; X, Y: Integer;
  Button: TMouseButton; Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
  Click: Boolean; var Cursor: TCursor);
var
  Page: TfrxReportPage;
  c: TfrxComponent;
  l: TList;
  i: Integer;
  Flag: Boolean;
  v: TfrxView;

  function MouseInView(c: TfrxComponent): Boolean;
  var
    r: TRect;
  begin
    with c do
      r := Rect(Round(AbsLeft * Scale), Round(AbsTop * Scale),
                Round((AbsLeft + Width) * Scale),
                Round((AbsTop + Height) * Scale));
    OffsetRect(r, Round(OffsetX), Round(OffsetY));
    Result := PtInRect(r, Point(X, Y));
  end;

  procedure SetToAnchor(const Text: String);
  var
    Item: TfrxXMLItem;
    PageN, Top: Integer;
  begin
    Item := FindAnchor(Text);
    if Item <> nil then
    begin
      PageN := StrToInt(Item.Prop['page']);
      Top := StrToInt(Item.Prop['top']);
      TfrxPreview(Report.Preview).SetPosition(PageN + 1, Top);
    end;
  end;

begin
  if (Index < 0) or (Index >= Count) or Engine.Running then Exit;
  Page := GetPage(Index);
  if Page = nil then Exit;

  if Page.MirrorMargins and (Index mod 2 = 1) then
    OffsetX := OffsetX + Page.RightMargin * fr01cm * Scale else
    OffsetX := OffsetX + Page.LeftMargin * fr01cm * Scale;
  OffsetY := OffsetY + Page.TopMargin * fr01cm * Scale;

//  Report.SetProgressMessage('');
  Page := GetPage(Index); // get page again to ensure it was not cleared during export
  if Page = nil then Exit;

  l := Page.AllObjects;

  for i := l.Count - 1 downto 0 do
  begin
    c := l[i];
    if (c is TfrxView) and MouseInView(c) then
    begin
      v := TfrxView(c);
      if v.Cursor <> crDefault then
        Cursor := v.Cursor;
      if v.URL <> '' then
      begin
        Report.SetProgressMessage(v.URL);
        if v.Cursor = crDefault then
          Cursor := crHandPoint;
      end;

      if Click then
      begin
        if v.URL <> '' then
          if Pos('@', v.URL) = 1 then
            TfrxPreview(Report.Preview).PageNo := StrToInt(Copy(v.URL, 2, 255))
          else if Pos('#', v.URL) = 1 then
            SetToAnchor(Copy(v.URL, 2, 255))
          else
            ShellExecute(GetDesktopWindow, nil, PChar(v.URL), nil, nil, sw_ShowNormal);

        Flag := False;
        Report.DoPreviewClick(v, Button, Shift, Flag);
        if Flag then
        begin
          ModifyPage(Index, Page);
          Report.Preview.Invalidate;
        end;
      end
      else if Assigned(Report.OnMouseOverObject) then
        Report.OnMouseOverObject(v);
      break;
    end;
  end;
end;

end.


//<censored>