frxpreview.pas

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

  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);

  i := FPageList.FindPage(FOffset.Y, FPreview.Zoom);
  FDisableUpdate := True;
  FPreview.PageNo := i + 1;
  FDisableUpdate := False;
end;

procedure TfrxPreviewWorkspace.Paint;
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 := FPreview.FrameColor;
      Pen.Width := 1;
      Pen.Mode := pmCopy;
      Pen.Style := psSolid;
      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      Dec(Bottom);
      Rectangle(Left, Top, Right, Bottom);
      Polyline([Point(Left + 1, Bottom),
                Point(Right, Bottom),
                Point(Right, Top + 1)]);
    end;

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

    { highlight text found }
    TxtBounds := Rect(Round(TextBounds.Left * FPreview.Zoom),
      Round(TextBounds.Top * FPreview.Zoom),
      Round(TextBounds.Right * FPreview.Zoom),
      Round(TextBounds.Bottom * FPreview.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
  { draw an empty page area to prevent flickering }
  if FPreview.FLocked or (FPageList.Count = 0) then
  begin
    Canvas.Brush.Color := FPreview.BackColor;
    Canvas.FillRect(Rect(0, 0, ClientWidth, ClientHeight));
    Exit;

    if FPageList.Count = 0 then
      n := -1 else
      n := 0;
    PageBounds := FPageList.GetPageBounds(n, Width, FPreview.Zoom);
    OffsetRect(PageBounds, -FOffset.X, -FOffset.Y);
    h := CreateRectRgn(0, 0, ClientWidth, ClientHeight);

    with Canvas, PageBounds do
    begin
      GetClipRgn(Handle, h);
      ExcludeClipRect(Handle, Left + 1, Top + 1, Right - 1, Bottom - 1);
      Brush.Color := FPreview.BackColor;
      FillRect(Rect(0, 0, ClientWidth, ClientHeight));

      SelectClipRgn(Handle, h);
      Pen.Color := FPreview.FrameColor;
      Pen.Width := 1;
      Pen.Mode := pmCopy;
      Pen.Style := psSolid;
      Brush.Color := clWhite;
      Rectangle(Left, Top, Right, Bottom);
      Polyline([Point(Left + 1, Bottom),
                Point(Right, Bottom),
                Point(Right, Top + 1)]);
    end;

    DeleteObject(h);
    Exit;
  end;

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

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

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

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

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

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

  { draw visible pages }
  for i := n - 20 to n + 20 do
  begin
    if i < 0 then continue;
    if i >= FPageList.Count then break;

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

  DeleteObject(h);
end;

procedure TfrxPreviewWorkspace.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (FPageList.Count = 0) or FPreview.FLocked 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 FPreview.FLocked then Exit;

  if FDown then
  begin
    if FPreview.Tool = ptHand then
    begin
      HorzPosition := HorzPosition - (X - FLastPoint.X);
      VertPosition := VertPosition - (Y - FLastPoint.Y);
      FLastPoint.X := X;
      FLastPoint.Y := Y;
    end
  end
  else
  begin
    PageNo := FPageList.FindPage(FOffset.Y + Y, FPreview.Zoom, True);
    PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, FPreview.Zoom);
    if (X < PageBounds.Left) and (FPreview.ZoomMode = zmManyPages) then
    begin
      if PageNo > 0 then
        Dec(PageNo);
      PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, FPreview.Zoom);
    end;
    Cur := FDefaultCursor;
    PreviewPages.ObjectOver(PageNo, X, Y, mbLeft, [], FPreview.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;
begin
  if Assigned(FPreview.OnClick) then
    FPreview.OnClick(FPreview);
  if (FPageList.Count = 0) or FPreview.FLocked then Exit;

  FDown := False;
  if FPreview.Tool = ptZoom then
  begin
    if Button = mbLeft then
      FPreview.Zoom := FPreview.Zoom + 0.25;
    if Button = mbRight then
      FPreview.Zoom := FPreview.Zoom - 0.25;
  end
  else
  begin
    PageNo := FPageList.FindPage(FOffset.Y + Y, FPreview.Zoom, True);
    PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, FPreview.Zoom);
    if (X < PageBounds.Left) and (FPreview.ZoomMode = zmManyPages) then
    begin
      if PageNo > 0 then
        Dec(PageNo);
      PageBounds := FPageList.GetPageBounds(PageNo, ClientWidth, FPreview.Zoom);
    end;

    PreviewPages.ObjectOver(PageNo, X, Y, Button, Shift, FPreview.Zoom,
      PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur);
  end;
end;

procedure TfrxPreviewWorkspace.DblClick;
begin
  inherited;
  if FPreview.Owner is TfrxPreviewForm then
    if TfrxPreviewForm(FPreview.Owner).FFullScreen then
      TfrxPreviewForm(FPreview.Owner).SwitchToFullScreen;
end;

function TfrxPreviewWorkspace.PreviewPages: TfrxCustomPreviewPages;
begin
  Result := FPreview.PreviewPages;
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, FPreview.Zoom);
      TxtBounds := Rect(Round(TextBounds.Left * FPreview.Zoom),
        Round(TextBounds.Top * FPreview.Zoom),
        Round(TextBounds.Right * FPreview.Zoom),
        Round(TextBounds.Bottom * FPreview.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.HandleKey(Key: Word; Shift: TShiftState);
begin
  if Key = vk_Up then
    VertPosition := VertPosition - 8
  else if Key = vk_Down then
    VertPosition := VertPosition + 8
  else if Key = vk_Left then
    HorzPosition := HorzPosition - 8
  else if Key = vk_Right then
    HorzPosition := HorzPosition + 8
  else if Key = vk_Prior then
    if ssCtrl in Shift then
      FPreview.PageNo := FPreview.PageNo - 1
    else
      VertPosition := VertPosition - 300
  else if Key = vk_Next then
    if ssCtrl in Shift then
      FPreview.PageNo := FPreview.PageNo + 1
    else
      VertPosition := VertPosition + 300
  else if Key = vk_Home then
    FPreview.PageNo := 1
  else if Key = vk_End then
    FPreview.PageNo := FPreview.PageCount
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, FPreview.Zoom).Top - 10;
end;

procedure TfrxPreviewWorkspace.UpdateScrollBars;
var
  MaxSize: TPoint;
begin
  MaxSize := FPageList.GetMaxBounds(ClientWidth, FPreview.Zoom);
  HorzRange := MaxSize.X + 10;
  VertRange := MaxSize.Y + 10;
end;


{ TfrxPreview }

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

  FBackColor := clGray;
  FFrameColor := clBlack;

  FOutline := TTreeView.Create(Self);
  FOutline.Parent := Self;
  FOutline.Width := 120;
  FOutline.Align := alLeft;
  FOutline.ReadOnly := True;
  FOutline.HideSelection := False;
  FOutline.OnClick := TreeClick;

  FSplitter := TSplitter.Create(Self);
  FSplitter.Parent := Self;
  FSplitter.SetBounds(1000, 0, 2, 0);
  FSplitter.MinSize := 1;

  FWorkspace := TfrxPreviewWorkspace.Create(Self);
  FWorkspace.Parent := Self;
  FWorkspace.Align := alClient;

  FMessagePanel := TPanel.Create(Self);
  FMessagePanel.Parent := Self;
  FMessagePanel.Visible := False;
  FMessagePanel.SetBounds(0, 0, 0, 0);

  FMessageLabel := TLabel.Create(FMessagePanel);
  FMessageLabel.Parent := FMessagePanel;
  FMessageLabel.AutoSize := False;
  FMessageLabel.Alignment := taCenter;
  FMessageLabel.SetBounds(4, 20, 255, 20);

  FCancelButton := TButton.Create(FMessagePanel);
  FCancelButton.Parent := FMessagePanel;
  FCancelButton.SetBounds(92, 44, 75, 25);
  FCancelButton.Caption := frxResources.Get('clCancel');
  FCancelButton.Visible := False;
  FCancelButton.OnClick := OnCancel;

  FPageNo := 1;
  FScrollBars := ssBoth;
  FZoom := 1;
  FZoomMode := zmDefault;

  Tool := ptHand;

  Width := 100;
  Height := 100;
end;

destructor TfrxPreview.Destroy;
begin
  if Report <> nil then
    Report.Preview := nil;
  inherited;
end;

procedure TfrxPreview.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
    if AComponent = Report then
    begin
      Clear;
      Report := nil;
      PreviewPages := nil;
    end;
end;

procedure TfrxPreview.Init;
begin
  TextFound := False;
  FWorkspace.FLastFoundPage := 0;
  LastFoundRecord := -1;
  FAllowF3 := False;

  FWorkspace.DoubleBuffered := Report.PreviewOptions.DoubleBuffered;
  OutlineVisible := Report.PreviewOptions.OutlineVisible;
  OutlineWidth := Report.PreviewOptions.OutlineWidth;
  UpdatePages;
  UpdateZoom;
  UpdateOutline;
  First;
end;

procedure TfrxPreview.WMEraseBackground(var Message: TMessage);
begin
end;

procedure TfrxPreview.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

procedure TfrxPreview.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  FWorkspace.HandleKey(Key, Shift);
  if (Key = vk_F3) and (pbFind in Report.PreviewOptions.Buttons) then
    FindNext
  else if ssCtrl in Shift then
  begin
    if (Key = Ord('P')) and (pbPrint in Report.PreviewOptions.Buttons) then
      Print
    else if (Key = Ord('S')) and (pbSave in Report.PreviewOptions.Buttons) then
      SaveToFile
    else if (Key = Ord('F')) and (pbFind in Report.PreviewOptions.Buttons) then
      Find
    else if (Key = Ord('O')) and (pbLoad in Report.PreviewOptions.Buttons) then
      LoadFromFile
  end;
end;

procedure TfrxPreview.Resize;
begin
  inherited;
  if PreviewPages <> nil then
  begin
    UpdateZoom;
    { avoid positioning errors when resizing }
    FWorkspace.HorzPosition := FWorkspace.HorzPosition;
    FWorkspace.VertPosition := FWorkspace.VertPosition;
  end;
end;

procedure TfrxPreview.SetZoom(const Value: Extended);
begin
  FZoom := Value;
  if FZoom < 0.25 then
    FZoom := 0.25;

  if FZoomMode = zmManyPages then
    ZoomMode := zmDefault;

  FZoomMode := zmDefault;
  UpdateZoom;
end;

procedure TfrxPreview.SetZoomMode(const Value: TfrxZoomMode);
begin
  FZoomMode := Value;
  UpdatePages;
  UpdateZoom;
end;

function TfrxPreview.GetOutlineVisible: Boolean;
begin
  Result := FOutline.Visible;
end;

procedure TfrxPreview.SetOutlineVisible(const Value: Boolean);
begin
  FOutline.Visible := Value;
  FSplitter.Visible := Value;
  FSplitter.SetBounds(1000, 0, 2, 0);
end;

function TfrxPreview.GetOutlineWidth: Integer;
begin
  Result := FOutline.Width;
end;

procedure TfrxPreview.SetOutlineWidth(const Value: Integer);
begin
  FOutline.Width := Value;
end;

procedure TfrxPreview.SetTool(const Value: TfrxPreviewTool);
var
  c: TCursor;
begin
  FTool := Value;

  if FTool = ptHand then
    c := crHand
  else if FTool = ptZoom then
    c := crZoom else
    c := crDefault;

  FWorkspace.FDefaultCursor := c;
  FWorkspace.Cursor := c;
end;

procedure TfrxPreview.SetPageNo(const Value: Integer);
begin
  FPageNo := Value;
  if FPageNo < 1 then
    FPageNo := 1;
  if FPageNo > PageCount then
    FPageNo := PageCount;