frxpreview.pas

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

  Result.Bottom:= Result.Top+Round(Item.Height * Scale);
end;

function TfrxPageList.GetMaxBounds(ClientWidth:Integer;
  Scale:Extended):TPoint;
begin
  if Count = 0 then
  begin
    Result:= Point(0, 0);
    Exit;
  end;

  Result.X:= Round(FMaxWidth * Scale);
  Result.Y:= GetPageBounds(Count-1, ClientWidth, Scale).Bottom;
end;

{ TfrxPreviewWorkspace }

constructor TfrxPreviewWorkspace.Create(AOwner:TComponent);
begin
  inherited;
  FPreview:= TfrxPreview(AOwner);
  FPageList:= TfrxPageList.Create;
  Color:= clGray;
  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);

  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:= clBlack;
      Pen.Width:= 1;
      Pen.Mode:= pmCopy;
      Pen.Style:= psSolid;
      Brush.Color:= clWhite;
      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.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:= clGray;
    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:= clGray;
      FillRect(Rect(0, 0, ClientWidth, ClientHeight));

      SelectClipRgn(Handle, h);
      Pen.Color:= clBlack;
      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, Width, 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:= clGray;
    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, Width, 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);
    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);
    PreviewPages.ObjectOver(PageNo, X, Y, Button, Shift, FPreview.Zoom,
      PageBounds.Left-FOffset.X, PageBounds.Top-FOffset.Y, True, Cur);
  end;
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;

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

procedure TfrxPreview.Resize;
begin
  inherited;
  if PreviewPages<>nil then
    UpdateZoom;
end;

procedure TfrxPreview.SetZoom(const Value:Extended);