frxpreviewpages.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  xi:TfrxXMLItem;
  p:TfrxReportPage;
begin
  if (Count = 0) or (Index < 0) or (Index >= Count) then
  begin
    Result:= Point(0, 0);
    Exit;
  end;

  xi:= FPagesItem[Index];
  if (CompareText(xi.Name, 'TfrxReportPage') = 0) or
    (CompareText(xi.Name, 'TfrxDMPPage') = 0) then
    p:= GetPage(Index) else
    p:= FSourcePages[StrToInt(Copy(xi.Name, 5, 256))];
  Result.X:= Round(p.Width);
  Result.Y:= Round(p.Height);
end;

procedure TfrxPreviewPages.AddEmptyPage(Index:Integer);
var
  xi:TfrxXMLItem;
begin
  if Count = 0 then Exit;

  xi:= TfrxXMLItem.Create;
  xi.Name:= FPagesItem[Index].Name;
  FPagesItem.InsertItem(Index, xi);
  ClearPageCache;
end;

procedure TfrxPreviewPages.DeletePage(Index:Integer);
begin
  if Count < 2 then Exit;

  FPagesItem[Index].Free;
  ClearPageCache;
end;

procedure TfrxPreviewPages.ModifyPage(Index:Integer; Page:TfrxReportPage);
var
  xs:TfrxXMLSerializer;
begin
  xs:= TfrxXMLSerializer.Create(nil);
  try
    FPagesItem[Index].Clear;
    xs.WriteRootComponent(Page, True, FPagesItem[Index]);
    FPagesItem[Index].Unloadable:= False;
    ClearPageCache;
  finally
    xs.Free;
  end;
end;

procedure TfrxPreviewPages.DrawPage(Index:Integer; Canvas:TCanvas;
  ScaleX, ScaleY, OffsetX, OffsetY:Extended);
var
  i:Integer;
  Page:TfrxReportPage;
  l:TList;
  c:TfrxComponent;
  IsPrinting:Boolean;
  SaveLeftMargin, SaveRightMargin:Extended;

  function ViewVisible(c:TfrxComponent):Boolean;
  var
    r:TRect;
  begin
    with c do
      r:= Rect(Round(AbsLeft * ScaleX)-20, Round(AbsTop * ScaleY)-20,
                Round((AbsLeft+Width) * ScaleX+20),
                Round((AbsTop+Height) * ScaleY+20));
    OffsetRect(r, Round(OffsetX), Round(OffsetY));
    Result:= RectVisible(Canvas.Handle, r) or (Canvas is TMetafileCanvas);
  end;

begin
  Page:= GetPage(Index);
  if Page = nil then Exit;

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

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

  l:= Page.AllObjects;
  IsPrinting:= Canvas is TfrxPrinterCanvas;

  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
          THackMemoView(c).FTotalPages:= Count;
        { draw the object }
        TfrxView(c).Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
        c.IsPrinting:= False;
      end;
  end;

  Page.LeftMargin:= SaveLeftMargin;
  Page.RightMargin:= SaveRightMargin;
end;

function TfrxPreviewPages.Print:Boolean;
var
  Copies:Integer;
  Collate:Boolean;
  PageNumbers:String;
  PrintPages:TfrxPrintPages;
  Reverse:Boolean;
  pgList:TStringList;

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

    function PrintPage(Index:Integer):Boolean;
    var
      Bin:Integer;
    begin
      Result:= True;
      if Index >= Count then Exit;

      if (pgList.Count<>0) and (pgList.IndexOf(IntToStr(Index+1)) =-1) then Exit;
      if ((PrintPages = ppOdd) and ((Index+1) mod 2 = 0)) or
         ((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 not PagePrinted then
        Printer.BeginDoc;
      if Index = 0 then
        Bin:= Page.Bin else
        Bin:= Page.BinOtherPages;
      Printer.SetPrintParams(Page.PaperSize, Page.PaperWidth, Page.PaperHeight,
        Page.Orientation, Bin, c, Integer(Page.Duplex)+1);

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

      Report.InternalOnProgress(ptPrinting, Index+1);

{$IFDEF TRIAL}
      with Printer.Canvas do
      begin
        Font.Size:= 12;
        Font.Color:= clBlack;
        TextOut(0, 0, 'FastReport-Unregistered version');
      end;
{$ENDIF}
      Printer.EndPage;
      Application.ProcessMessages;
      PagePrinted:= True;
      ClearPageCache;
    end;

    procedure PrintPages;
    var
      i:Integer;
    begin
      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;
    if Collate then
      c:= 1 else
      c:= Copies;

    PagePrinted:= False;
    if Collate then
      for i:= 0 to Copies-1 do
      begin
        PrintPages;
        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;
      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:Integer;
    Page:TfrxReportPage;
    l:TList;
    c:TfrxComponent;
    p:TfrxPictureView;
  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;

    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;

      { enum objects }
      l:= Page.AllObjects;
      { prepare text objects }
      for i:= 0 to l.Count-1 do
      begin
        c:= l[i];
        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;
      end;

      { export objects }
      for i:= 0 to l.Count-1 do
      begin
        c:= l[i];
        Filter.ExportObject(c);
      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;

        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;

        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
    if Report.Preview<>nil then
      Filter.PageNumbers:= IntToStr(CurPreviewPage) else
      Filter.PageNumbers:= '1';

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

  pgList:= TStringList.Create;
  tempBMP:= TBitmap.Create;
  frxParsePageNumbers(Filter.PageNumbers, pgList, Count);
  try
    DoExport;
  except
    on e:Exception do
    begin
      Result:= False;
      Report.Errors.Text:= e.Message;
      if not Report.EngineOptions.SilentMode then
        frxErrorMsg(frxResources.Get('clErrors')+#13#10+Report.Errors.Text);
    end;
  end;

  pgList.Free;
  tempBMP.Free;
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
  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.