frxpreview.pas

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

      c := -1 else
      c := 1;

    if c < 0 then
      i0 := i + 1 else
      i1 := i - 1;
  end;

  { find exact page }
  if OffsetX <> 0 then
  begin
    for i := i1 - 20 to i1 + 20 do
    begin
      if (i < 0) or (i >= Count) then continue;
      Item := Items[i];
      if PtInRect(Rect(Item.OffsetX, Item.OffsetY,
        Item.OffsetX + Item.Width, Item.OffsetY + Item.Height),
        Point(OffsetX, OffsetY)) then
      begin
        i1 := i;
        break;
      end;
    end;
  end;

  Result := i1;
end;

function TfrxPageList.GetPageBounds(Index, ClientWidth: Integer;
  Scale: Extended; RTL: Boolean): TRect;
var
  ColumnOffs: Integer;
  Item: TfrxPageItem;
begin
  if (Index >= Count) or (Index < 0) then
  begin
    if 794 * Scale > ClientWidth then
      ColumnOffs := 10 else
      ColumnOffs := Round((ClientWidth - 794 * Scale) / 2);
    Result.Left := ColumnOffs;
    Result.Top := Round(10 * Scale);
    Result.Right := Result.Left + Round(794 * Scale);
    Result.Bottom := Result.Top + Round(1123 * Scale);
  end
  else
  begin
    Item := Items[Index];
    if RTL then
      Result.Left := ClientWidth - Item.Width - Item.OffsetX
    else
      Result.Left := Item.OffsetX;
    Result.Top := Item.OffsetY;
    Result.Right := Result.Left + Item.Width;
    Result.Bottom := Result.Top + Item.Height;
  end;
end;

function TfrxPageList.GetMaxBounds: TPoint;
begin
  if Count = 0 then
    Result := Point(0, 0)
  else
  begin
    Result.X := FMaxWidth;
    Result.Y := Items[Count - 1].OffsetY + Items[Count - 1].Height;
  end;
end;


{ TfrxPreviewWorkspace }

constructor TfrxPreviewWorkspace.Create(AOwner: TComponent);
begin
  inherited;
  FPageList := TfrxPageList.Create;
  OnDblClick := PrevDblClick;

  FBackColor := clGray;
  FFrameColor := clBlack;
  FActiveFrameColor := $804020;
  FZoom := 1;
  FDefaultCursor := crHand;

  LargeChange := 300;
  SmallChange := 8;
end;

destructor TfrxPreviewWorkspace.Destroy;
begin
  if FEMFImage <> nil then
    FEMFImage.Free;
  FPageList.Free;
  inherited;
end;

procedure TfrxPreviewWorkspace.OnHScrollChange(Sender: TObject);
var
  pp: Integer;
  r: TRect;
begin
  pp := FOffset.X - HorzPosition;
  FOffset.X := HorzPosition;
  r := Rect(0, 0, ClientWidth, ClientHeight);
  ScrollWindowEx(Handle, pp, 0, @r, @r, 0, nil, SW_ERASE + SW_INVALIDATE);
end;

procedure TfrxPreviewWorkspace.OnVScrollChange(Sender: TObject);
var
  i, pp: Integer;
  r: TRect;
begin
  pp := FOffset.Y - VertPosition;
  FOffset.Y := VertPosition;
  r := Rect(0, 0, ClientWidth, ClientHeight);
  ScrollWindowEx(Handle, 0, pp, @r, @r, 0, nil, SW_ERASE + SW_INVALIDATE);

  if not FIsThumbnail then
  begin
    i := FPageList.FindPage(FOffset.Y);
    FDisableUpdate := True;
    Preview.PageNo := i + 1;
    FDisableUpdate := False;
  end;
end;

procedure TfrxPreviewWorkspace.DrawPages(BorderOnly: Boolean);
var
  i, n: Integer;
  PageBounds: TRect;
  h: HRGN;

  function PageVisible: Boolean;
  begin
    if (PageBounds.Top > ClientHeight) or (PageBounds.Bottom < 0) then
      Result := False
    else
      Result := RectVisible(Canvas.Handle, PageBounds);
  end;

  procedure DrawPage(Index: Integer);
  var
    i: Integer;
    TxtBounds: TRect;
  begin
    with Canvas, PageBounds do
    begin
      Pen.Color := FrameColor;
      Pen.Width := 1;
      Pen.Mode := pmCopy;
      Pen.Style := psSolid;
      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      Dec(Bottom);
      Rectangle(Left, Top, Right, Bottom);
    end;

    PreviewPages.DrawPage(Index, Canvas, Zoom, Zoom, PageBounds.Left, PageBounds.Top);

    if FIsThumbnail then
      with Canvas do
      begin
        Font.Name := 'Arial';
        Font.Size := 8;
        Font.Style := [];
        Font.Color := clWhite;
        Brush.Style := bsSolid;
        Brush.Color := BackColor;
        TextOut(PageBounds.Left + 1, PageBounds.Top + 1, ' ' + IntToStr(Index + 1) + ' ');
      end;

    { highlight text found }
    TxtBounds := Rect(Round(TextBounds.Left * Zoom),
      Round(TextBounds.Top * Zoom),
      Round(TextBounds.Right * Zoom),
      Round(TextBounds.Bottom * Zoom));
    if TextFound and (Index = FLastFoundPage) then
      with Canvas, TxtBounds do
      begin
        Pen.Width := 1;
        Pen.Style := psSolid;
        Pen.Mode := pmXor;
        Pen.Color := clWhite;
        for i := 0 to Bottom - Top do
        begin
          MoveTo(PageBounds.Left + Left - 1, PageBounds.Top + Top + i);
          LineTo(PageBounds.Left + Right + 1, PageBounds.Top + Top + i);
        end;
        Pen.Mode := pmCopy;
      end;
  end;

begin
  if not Visible then Exit;

  if Locked or (FPageList.Count = 0) then
  begin
    Canvas.Brush.Color := BackColor;
    Canvas.FillRect(Rect(0, 0, ClientWidth, ClientHeight));
    Exit;
  end;

  if PreviewPages = nil then Exit;

  h := CreateRectRgn(0, 0, ClientWidth, ClientHeight);
  GetClipRgn(Canvas.Handle, h);

  { index of first visible page }
  n := FPageList.FindPage(FOffset.Y);

  { exclude page areas to prevent flickering }
  for i := n - 40 to n + 40 do
  begin
    if i < 0 then continue;
    if i >= FPageList.Count then break;

    PageBounds := FPageList.GetPageBounds(i, ClientWidth, Zoom, FRTLLanguage);
    OffsetRect(PageBounds, -FOffset.X, -FOffset.Y);
    if PageVisible then
      with PageBounds do
        ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  end;

  { now draw background on the non-clipped area}
  with Canvas do
  begin
    Brush.Color := BackColor;
    Brush.Style := bsSolid;
    FillRect(Rect(0, 0, ClientWidth, ClientHeight));
  end;

  { restore clipregion }
  SelectClipRgn(Canvas.Handle, h);

  { draw border around the active page }
  PageBounds := FPageList.GetPageBounds(PageNo - 1, ClientWidth, Zoom, FRTLLanguage);
  OffsetRect(PageBounds, -FOffset.X, -FOffset.Y);
  with Canvas, PageBounds do
  begin
    Pen.Color := ActiveFrameColor;
    Pen.Width := 2;
    Pen.Mode := pmCopy;
    Pen.Style := psSolid;
    Polyline([Point(Left - 1, Top - 1),
              Point(Right + 1, Top - 1),
              Point(Right + 1, Bottom + 1),
              Point(Left - 1, Bottom + 1),
              Point(Left - 1, Top - 2)]);
  end;
  if not BorderOnly then
  begin
    { draw visible pages }
    for i := n - 40 to n + 40 do
    begin
      if i < 0 then continue;
      if i >= FPageList.Count then break;

      PageBounds := FPageList.GetPageBounds(i, ClientWidth, Zoom, FRTLLanguage);
      OffsetRect(PageBounds, -FOffset.X, -FOffset.Y);
      Inc(PageBounds.Bottom);
      if PageVisible then
        DrawPage(i);
    end;
  end;

  DeleteObject(h);
end;

procedure TfrxPreviewWorkspace.Paint;
begin
  DrawPages(False);
end;

procedure TfrxPreviewWorkspace.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (FPageList.Count = 0) or Locked then Exit;

  if Button = mbLeft then
  begin
    FDown := True;
    FLastPoint.X := X;
    FLastPoint.Y := Y;
  end;
end;

procedure TfrxPreviewWorkspace.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  PageNo: Integer;
  PageBounds: TRect;
  Cur: TCursor;
begin
  if (FPageList.Count = 0) or Locked or FIsThumbnail then Exit;

  if FDown then
  begin
    HorzPosition := HorzPosition - (X - FLastPoint.X);
    VertPosition := VertPosition - (Y - FLastPoint.Y);
    FLastPoint.X := X;
    FLastPoint.Y := Y;
  end
  else
  begin
    PageNo := FPageList.FindPage(FOffset.Y + Y, FOffset.X + X);
    PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, Zoom, FRTLLanguage);
    Cur := FDefaultCursor;
    PreviewPages.ObjectOver(PageNo, X, Y, mbLeft, [], Zoom,
      PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, False, Cur);
    Cursor := Cur;
  end;
end;

procedure TfrxPreviewWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  PageNo: Integer;
  PageBounds: TRect;
  Cur: TCursor;
  XOffSet: Integer;
begin
  if not FIsThumbnail and Assigned(Preview.OnClick) then
    Preview.OnClick(Preview);
  if (FPageList.Count = 0) or Locked then Exit;

  FDown := False;
  if FRTLLanguage then
    XOffSet := ClientWidth - (FOffset.X + X)
  else
    XOffSet := FOffset.X + X;

  PageNo := FPageList.FindPage(FOffset.Y + Y, XOffSet);
  FDisableUpdate := True;
  Preview.PageNo := PageNo + 1;
  FDisableUpdate := False;

  if not FIsThumbnail and (Button <> mbRight) then
  begin
    PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, Zoom, FRTLLanguage);
    if (GetTickCount - FTimeOffset <= GetDoubleClickTime) then
    begin
      FTimeOffset := 0;
      PreviewPages.ObjectOver(PageNo, X, Y, Button, Shift, Zoom,
      PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur, True);
    end
    else
    begin
      FTimeOffset := GetTickCount;
      PreviewPages.ObjectOver(PageNo, X, Y, Button, Shift, Zoom,
      PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur);
    end;
  end;
end;

procedure TfrxPreviewWorkspace.FindText;
var
  EMFCanvas: TMetafileCanvas;
  PageBounds, TxtBounds: TRect;
begin
  TextFound := False;

  while FLastFoundPage < FPageList.Count do
  begin
    if (FEMFImage = nil) or (FEMFImagePage <> FLastFoundPage) then
    begin
      if FEMFImage <> nil then
        FEMFImage.Free;
      FEMFImage := TMetafile.Create;
      EMFCanvas := TMetafileCanvas.Create(FEMFImage, 0);
      PreviewPages.DrawPage(FLastFoundPage, EMFCanvas, 1, 1, 0, 0);
      EMFCanvas.Free;
    end;

    FEMFImagePage := FLastFoundPage;
    RecordNo := 0;
    EnumEnhMetafile(0, FEMFImage.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0));

    if TextFound then
    begin
      PageBounds := FPageList.GetPageBounds(FLastFoundPage, ClientWidth, Zoom, FRTLLanguage);
      TxtBounds := Rect(Round(TextBounds.Left * Zoom),
        Round(TextBounds.Top * Zoom),
        Round(TextBounds.Right * Zoom),
        Round(TextBounds.Bottom * Zoom));

      if (PageBounds.Top + TxtBounds.Top < FOffset.Y) or
        (PageBounds.Top + TxtBounds.Bottom > FOffset.Y + ClientHeight) then
        VertPosition := PageBounds.Top + TxtBounds.Bottom - ClientHeight + 20;
      if (PageBounds.Left + TxtBounds.Left < FOffset.X) or
        (PageBounds.Left + TxtBounds.Right > FOffset.X + ClientWidth) then
        HorzPosition := PageBounds.Left + TxtBounds.Right - ClientWidth + 20;
      Repaint;
      break;
    end;

    LastFoundRecord := -1;
    Inc(FLastFoundPage);
  end;
end;

procedure TfrxPreviewWorkspace.Resize;
begin
  inherited; 
  HorzPage := ClientWidth;
  VertPage := ClientHeight;
end;

procedure TfrxPreviewWorkspace.SetToPageNo(PageNo: Integer);
begin
  if FDisableUpdate then Exit;
  VertPosition :=
    FPageList.GetPageBounds(PageNo - 1, ClientWidth, Zoom, FRTLLanguage).Top - 10;
end;

procedure TfrxPreviewWorkspace.UpdateScrollBars;
var
  MaxSize: TPoint;
begin
  MaxSize := FPageList.GetMaxBounds;
  HorzRange := MaxSize.X + 10;
  VertRange := MaxSize.Y + 10;
end;

procedure TfrxPreviewWorkspace.SetPosition(PageN, Top: Integer);
var
  Pos: Integer;
  Page: TfrxReportPage;
begin
  Page := PreviewPages.Page[PageN - 1];
  if Page = nil then
    exit;
  if Top = 0 then
    Pos := 0
  else
    Pos := Round((Top + Page.TopMargin * fr01cm) * Zoom);

  VertPosition := FPageList.GetPageBounds(PageN - 1, ClientWidth, Zoom, FRTLLanguage).Top - 10 + Pos;
end;

function TfrxPreviewWorkspace.GetTopPosition: Integer;
var
  Page: TfrxReportPage;
begin
  Result := 0;
  Page := PreviewPages.Page[Preview.PageNo - 1];
  if Page <> nil then
    Result := Round((VertPosition - FPageList.GetPageBounds(Preview.PageNo - 1,ClientWidth, Zoom, FRTLLanguage).Top + 10)/ Zoom - Page.TopMargin * fr01cm);
end;

procedure TfrxPreviewWorkspace.AddPage(AWidth, AHeight: Integer);
begin
  FPageList.AddPage(AWidth, AHeight, Zoom);
end;

procedure TfrxPreviewWorkspace.CalcPageBounds(ClientWidth: Integer);
begin
  FPageList.CalcBounds(ClientWidth);
end;

procedure TfrxPreviewWorkspace.ClearPageList;
begin
  FPageList.Clear;
end;


procedure TfrxPreviewWorkspace.PrevDblClick(Sender: TObject);
begin
  if not IsThumbnail and Assigned(FPreview.OnDblClick) then
    FPreview.OnDblClick(Sender);
end;

{ TfrxPreview }

constructor TfrxPreview.Create(AOwner: TComponent);
var
  m: TMenuItem;
begin
  inherited;

  FOutlinePopup := TPopupMenu.Create(Self);
  FOutlinePopup.Images := frxResources.PreviewButtonImages;
  m := TMenuItem.Create(FOutlinePopup);
  FOutlinePopup.Items.Add(m);
  m.Caption := frxGet(601);
  m.ImageIndex := 13;
  m.OnClick := OnCollapseClick;
  m := TMenuItem.Create(FOutlinePopup);
  FOutlinePopup.Items.Add(m);
  m.Caption := frxGet(600);
  m.ImageIndex := 14;
  m.OnClick := OnExpandClick;

  FOutline := TTreeView.Create(Self);
  with FOutline do
  begin
    Parent := Self;
    Align := alLeft;
    HideSelection := False;