rm_preview.pas

这是一个功能强大

    FPreview.FVRuler.Top := lRect.Top;
    FPreview.FHRuler.Width := lRect.Right - lRect.Left;
    FPreview.FVRuler.Height := lRect.Bottom - lRect.Top;

    FPreview.FHRuler.ScrollOffset := 0;
    FPreview.FVRuler.ScrollOffset := 0;
    FHRulerOffset := 10 - lRect.Left;
    FVRulerOffset := 10 - lRect.Top;
  end;

  procedure _DrawMargins;
  begin
    with lPage, lPage.PrinterInfo do
    begin
      lRect1.Left := RMToScreenPixels(mmMarginLeft * lScale, rmutMMThousandths);
      lRect1.Top := RMToScreenPixels(mmMarginTop * lScale, rmutMMThousandths);
      lRect1.Right := Round((ScreenPageWidth - RMToScreenPixels(mmMarginRight, rmutMMThousandths)) * lScale);
      lRect1.Bottom := Round((ScreenPageHeight - RMToScreenPixels(mmMarginBottom, rmutMMThousandths)) * lScale);

      OffsetRect(lRect1, lRect.Left, lRect.Top);
    end;

    with Canvas do
    begin
      Pen.Width := 1;
      Pen.Color := clGray;
      Pen.Style := psSolid;
      MoveTo(lRect1.Left, lRect1.Top);
      LineTo(lRect1.Left, lRect1.Top - Round(20 * lScale)); //左上
      MoveTo(lRect1.Left, lRect1.Top);
      LineTo(lRect1.Left - Round(20 * lScale), lRect1.Top);
      MoveTo(lRect1.Right, lRect1.Top);
      LineTo(lRect1.Right, lRect1.Top - Round(20 * lScale)); //右上
      MoveTo(lRect1.Right, lRect1.Top);
      LineTo(lRect1.Right + Round(20 * lScale), lRect1.Top);
      MoveTo(lRect1.Left, lRect1.Bottom);
      LineTo(lRect1.Left, lRect1.Bottom + Round(20 * lScale)); //左下
      MoveTo(lRect1.Left, lRect1.Bottom);
      LineTo(lRect1.Left - Round(20 * lScale), lRect1.Bottom);
      MoveTo(lRect1.Right, lRect1.Bottom);
      LineTo(lRect1.Right, lRect1.Bottom + Round(20 * lScale)); //右下
      MoveTo(lRect1.Right, lRect1.Bottom);
      LineTo(lRect1.Right + Round(20 * lScale), lRect1.Bottom);
    end;

    if FPreview.Options.DrawBorder then
    begin
      Canvas.Pen.Width := FPreview.Options.BorderPen.Width;
      Canvas.Pen.Color := FPreview.Options.BorderPen.Color;
      Canvas.Pen.Style := FPreview.Options.BorderPen.Style;
      if Canvas.Pen.Width = 1 then
        Canvas.Rectangle(lRect1.Left, lRect1.Top, lRect1.Right + 1, lRect1.Bottom + 1)
      else
      begin
        lRect1.Left := lRect1.Left - Canvas.Pen.Width div 2;
        lRect1.Right := lRect1.Right + Canvas.Pen.Width div 2;
        lRect1.Top := lRect1.Top - Canvas.Pen.Width div 2;
        lRect1.Bottom := lRect1.Bottom + Canvas.Pen.Width div 2;

        _SetPS;
        lbr.lbStyle := BS_NULL;
        lnbr := CreateBrushIndirect(lbr);
        lobr := SelectObject(Canvas.Handle, lnbr);

        Windows.MoveToEx(Canvas.Handle, lRect1.Left, lRect1.Top, nil); // Left
        Windows.LineTo(Canvas.Handle, lRect1.Left, lRect1.Bottom);

        Windows.MoveToEx(Canvas.Handle, lRect1.Left, lRect1.Top, nil); // Top
        Windows.LineTo(Canvas.Handle, lRect1.Right, lRect1.Top);

        Windows.MoveToEx(Canvas.Handle, lRect1.Right, lRect1.Top, nil); // Right
        Windows.LineTo(Canvas.Handle, lRect1.Right, lRect1.Bottom);

        Windows.MoveToEx(Canvas.Handle, lRect1.Left, lRect1.Bottom, nil); // Bottom
        Windows.LineTo(Canvas.Handle, lRect1.Right, lRect1.Bottom);

        SelectObject(Canvas.Handle, lobr);
        DeleteObject(lnbr);
        SelectObject(Canvas.Handle, lOldH);
        DeleteObject(lNewH);
      end;
    end;
  end;

  procedure _DrawbkPicture;
  var
    lbkPic: TRMbkPicture;
    lPic: TPicture;
    lPicWidth, lPicHeight: Integer;
  begin
    lbkPic := lPages.bkPictures[lPage.bkPictureIndex];
    if lbkPic = nil then Exit;

    lPic := lbkPic.Picture;
    if lPic.Graphic <> nil then
    begin
      lPicWidth := lbkPic.Width;
      lPicHeight := lbkPic.Height;

      lRect1 := Rect(0, 0, Round(lPicWidth * lScale), Round(lPicHeight * lScale));
      OffsetRect(lRect1, Round(lbkPic.Left * lScale), Round(lbkPic.Top * lScale));
      OffsetRect(lRect1, lRect.Left, lRect.Top);
      try
        IntersectClipRect(Canvas.Handle, lRect.Left + 1, lRect.Top + 1,
          lRect.Right - 1, lRect.Bottom - 1);
        RMPrintGraphic(Canvas, lRect1, lPic.Graphic, False, False, False);
      finally
        SelectClipRgn(Canvas.Handle, lhRgn);
      end;
    end;
  end;

begin
  if (not FPreview.FPaintAllowed) or (FPreview.FReport = nil) then
  begin
    inherited;
    Exit;
  end;

  {  SetLength(lSavePages, Length(FVisiblePages));
    for i := 0 to Length(FVisiblePages) - 1 do
      lSavePages[i] := FVisiblePages[i];}

  SetLength(FVisiblePages, 0);
  if FPreview.GetEndPages = nil then
  begin
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(ClientRect);
    Exit;
  end;

  lScale := FPreview.FScale;
  lPages := TRMEndPages(FPreview.GetEndPages);
  lhRgn := CreateRectRgn(0, 0, Width, Height); // 创建一个区域
  try
    GetClipRgn(Canvas.Handle, lhRgn);
    for i := 0 to FPreview.FTotalPages - 1 do
    begin
      lPage := lPages[i];
      lRect := lPage.PageRect;
      OffsetRect(lRect, FPreview.FOffsetLeft, FPreview.FOffsetTop);
      if (lRect.Top > 2000) or (lRect.Bottom < 0) then
        lPage.Visible := False
      else
        lPage.Visible := RectVisible(Canvas.Handle, lRect);

      if lPage.Visible then // 去掉一个矩形区
      begin
        ExcludeClipRect(Canvas.Handle, lRect.Left + 1, lRect.Top + 1,
          lRect.Right - 1, lRect.Bottom - 1);
      end;

      if ((lRect.Bottom >= 0) and (lRect.Bottom <= Self.Height)) or
        ((lRect.Top >= 0) and (lRect.Top <= Self.Height)) then
      begin
        SetLength(FVisiblePages, Length(FVisiblePages) + 1);
        FVisiblePages[Length(FVisiblePages) - 1] := i;
      end;
    end;

    if (Length(FVisiblePages) = 0) and
      ((FPreview.CurPage - 1) >= 0) and ((FPreview.CurPage - 1) < FPreview.FTotalPages) then
    begin
      SetLength(FVisiblePages, 1);
      FVisiblePages[0] := FPreview.CurPage - 1;
    end;

    with Canvas do
    begin
      Brush.Color := clGray;
      FillRect(Rect(0, 0, Width, Height));
    end;

    SelectClipRgn(Canvas.Handle, lhRgn);
    //for i := 0 to Length(FVisiblePages) - 1 do
    for i := 0 to lPages.Count - 1 do // drawing page background
    begin
      //lPage := lPages[FVisiblePages[i]];
      lPage := lPages[i];
      if lPage.Visible then
      begin
        Canvas.Pen.Color := clBlack;
        Canvas.Pen.Width := 1;
        Canvas.Pen.Mode := pmCopy;
        Canvas.Pen.Style := psSolid;
        Canvas.Brush.Color := clWhite;

        lRect := lPage.PageRect;
        OffsetRect(lRect, FPreview.FOffsetLeft, FPreview.FOffsetTop);
        Canvas.Rectangle(lRect.Left, lRect.Top, lRect.Right, lRect.Bottom);
        Canvas.Polyline([Point(lRect.Left + 1, lRect.Bottom), Point(lRect.Right, lRect.Bottom),
          Point(lRect.Right, lRect.Top + 1)]);

        _DrawMargins;
        _DrawbkPicture;
      end;
    end;

    //    for i := 0 to Length(FVisiblePages) - 1 do
    for i := 0 to FPreview.FTotalPages - 1 do
    begin
      lPage := lPages[i];
      //lPage := lPages[FVisiblePages[i]];
      if lPage.Visible then
      begin
        if i = FRepaintPageNo then
          lPage.RemoveCachePage;

        lRect := lPage.PageRect;
        OffsetRect(lRect, FPreview.FOffsetLeft, FPreview.FOffsetTop);
        lPage.Draw(TRMReport(FPreview.FReport), Canvas, lRect);
      end
      else
      begin
        lFlag := True;
        for j := 0 to Length(FVisiblePages) - 1 do
        begin
          if i = FVisiblePages[j] then
          begin
            lFlag := False;
            Break;
          end;
        end;

        if lFlag then
          lPage.RemoveCachePage;
      end;
    end;

    {    for i := 0 to Length(lSavePages) - 1 do
        begin
          lPage := lPages[lSavePages[i]];
          if not lPage.Visible then
            lPage.RemoveCachePage;
        end;}

    _SetRuler(FPreview.CurPage);
  finally
    DeleteObject(lhRgn);
    FRepaintPageNo := -1;
  end;
end;

procedure TRMDrawPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  lPageNo: Integer;
  lNeedChangePage: Boolean;

  procedure _SetToAnchor(aAnchor: string);
  var
    lValue: Variant;
    lTmpPos: Integer;
    lVal1, lVal2: Integer;
  begin
    if THackReport(FPreview.FReport).AnchorList = nil then Exit;

    lValue := THackReport(FPreview.FReport).AnchorList[aAnchor];
    if lValue <> Null then
    begin
      lTmpPos := 1;
      lVal1 := StrToInt(RMStrGetToken(string(lValue), #1, lTmpPos));
      lVal2 := StrToInt(RMStrGetToken(string(lValue), #1, lTmpPos));
      FPreview.GotoPosition(lVal1 - 1, lVal2);

      lPageNo := FPreview.CurPage;
      lNeedChangePage := True;
    end;
  end;

  function _GenOnePage: Boolean;
  var
    t: TRMView;
    lReport: TRMReport;
    lModified: Boolean;
    lUrl: string;
  begin
    Result := False;

    lReport := TRMReport(FPreview.Report);
    lModified := False;
    t := TRMView(FSaveFoundView);
    lUrl := THackReportView(t).Url;
    if Length(lUrl) > 0 then
    begin
      if lUrl[1] = '#' then // 书签
      begin
        _SetToAnchor(Copy(lUrl, 2, 9999))
      end
      else if lUrl[1] = '@' then // 页码
      begin
        lUrl := RMDeleteNoNumberChar(System.Copy(lUrl, 2, 9999));
        if RMIsNumeric(lUrl) then
        begin
          try
            lPageNo := StrToInt(lUrl);
            lNeedChangePage := True;
          except
          end;
        end;
      end
      else // 超级连接
      begin
        if Assigned(THackReportView(t).OnPreviewClickUrl) then
        begin
          Result := True;
          THackReportView(t).OnPreviewClickUrl(TRMReportView(t));
        end
        else
          ShellExecute(0, nil, PChar(lUrl), nil, nil, SW_RESTORE);
      end;
    end;

    if Assigned(THackReportView(t).OnPreviewClick) then
    begin
      Result := True;
      THackReportView(t).OnPreviewClick(TRMReportView(t), Button, Shift, lModified);
    end;

    if Assigned(lReport.OnObjectClick) then
    begin
      Result := True;
      lReport.OnObjectClick(TRMReportView(t), Button, Shift, lModified);
    end;

    if lModified then // 修改内容了，需要保存
    begin
      TRMEndPage(FSaveEndPage).ObjectsToStream(lReport);
      TRMEndPage(FSaveEndPage).StreamToObjects(lReport, True);
      if FPreview.CurPage = lPageNo then
        FPreview.ReDrawAll(False);
    end;
  end;

begin
  if FBusy or (FPreview.GetEndPages = nil) or (not FPreview.FPaintAllowed) then Exit;

  if FDoubleClickFlag then
  begin
    FDoubleClickFlag := False;
    Exit;
  end;

  FBusy := True; lNeedChangePage := False;
  try
    FPreview.ScrollBox.SetFocus;
    if Button = mbLeft then
    begin
      FDown := True;
      lPageNo := FPreview.CurPage;
      if FSaveFoundView <> nil then
      begin
        //lPageNo := FSavePageNo;
        if _GenOnePage then
          FDown := False;
      end;

      FLastX := X; FLastY := Y;
      if lNeedChangePage then
      begin
        FPreview.CurPage := lPageNo;
        FPreview.ShowPageNum;
      end;
    end
    else if Button = mbRight then
    begin
    end;
  finally
    FBusy := False;
  end;
end;

procedure TRMDrawPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  lPoint: TPoint;
  lRect: TRect;
  lEndPages: TRMEndPages;
  lEndPage: TRMEndPage;
  lCursor: TCursor;
  lUrlStr: string;

  function _GenOnePage: Boolean;
  var
    i: Integer;
    t: TRMView;
    lScaleX, lScaleY, lOffsetX, lOffsetY: Double;
  begin
    Result := False;
    if THackEndPage(lEndPage).FPage = nil then Exit;

    lScaleX := 1; lScaleY := 1;
    lOffsetX := RMToScreenPixels(lEndPage.mmMarginLeft, rmutMMThousandths);
    lOffsetY := RMToScreenPixels(lEndPage.mmMarginTop, rmutMMThousandths);
    for i := lEndPage.Page.Objects.Count - 1 downto 0 do
    begin
      t := lEndPage.Page.Objects[i];
      if PtInRect(Rect(Round(t.spLeft * lScaleX + lOffsetX), Round(t.spTop * lScaleY + lOffsetY),
        Round(t.spRight * lScaleX + lOffsetX), Round(t.spBottom * lScaleX + lOffsetY)), lPoint) then
      begin
        Result := True;
        FSaveFoundView := t;
        if Length(THackReportView(t).Url) >= 1 then
        begin
          lUrlStr := THackReportView(t).Url;
          lCursor := crHandPoint;
        end
        else
          lCursor := THackReportView(t).Cursor;

        Break;
      end;
    end;
  end;

begin
  if FBusy or (not FPreview.FPaintAllowed) or (FPreview.FReport = nil) then Exit;

  FBusy := True;
  FSaveFoundView := nil;
  try
    if FDown then
    begin
      FPreview.HScrollBar.Position := FPreview.HScrollBar.Position - (X - FLastX);
      FPreview.VScrollBar.Position := FPreview.VScrollBar.Position - (Y - FLastY);
      FLastX := X;
      FLastY := Y;
    end
    else
    begin
      lCursor := crDefault;
      lUrlStr := '';
      FPreview.FHRuler.SetGuides(x - 10 + FHRulerOffset, 0);
      FPreview.FVRuler.SetGuides(y - 10 + FVRulerOffset, 0);

      lPoint := Point(x { - FPreview.FOffsetLeft}, y { - FPreview.FOffsetTop});
      lEndPages := TRMEndPages(FPreview.GetEndPages);
      for i := 0 to Length(FVisiblePages) - 1 do
      begin
        lEndPage := lEndPages[FVisiblePages[i]];