rm_preview.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,231 行 · 第 1/5 页

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

  FInPainting := True;
  lScale := FPreview.FScale;
  lPages := TRMEndPages(FPreview.GetEndPages);
  lhRgn := CreateRectRgn(0, 0, Width, Height); // 创建一个区域
  try
    GetClipRgn(Canvas.Handle, lhRgn);
    for i := 0 to lPages.Count - 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
        SetLength(FVisiblePages, Length(FVisiblePages) + 1);
        FVisiblePages[Length(FVisiblePages) - 1] := i;
        ExcludeClipRect(Canvas.Handle, lRect.Left + 1, lRect.Top + 1,
          lRect.Right - 1, lRect.Bottom - 1);
      end;
    end;

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

    with Canvas do
    begin
      Brush.Color := clGray;
      FillRect(Rect(0, 0, Width, Height));
      Pen.Color := clBlack;
      Pen.Width := 1;
      Pen.Mode := pmCopy;
      Pen.Style := psSolid;
      Brush.Color := clWhite;
    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
        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 lPages.Count - 1 do
    begin
      lPage := lPages[i];
      //lPage := lPages[FVisiblePages[i]];
      if lPage.Visible then
      begin
        lRect := lPage.PageRect;
        OffsetRect(lRect, FPreview.FOffsetLeft, FPreview.FOffsetTop);
        lPage.Draw(TRMReport(FPreview.FReport), Canvas, lRect);
      end
      else
        lPage.RemoveCachePage;
    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);
    FInPainting := False;
  end;
end;

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

  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
      end
      else if lUrl[1] = '@' then // 页码
      begin
        lUrl := RMDeleteNoNumberChar(System.Copy(lUrl, 2, 9999));
        if RMIsNumeric(lUrl) then
        begin
          try
            lPageNo := StrToInt(lUrl);
          except
          end;
        end;
      end
      else // 超级连接
      begin
        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;
  try
    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;
      FPreview.CurPage := lPageNo;
      FPreview.ShowPageNum;
    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) 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]];
        lRect := lEndPage.PageRect;
        if PtInRect(lRect, lPoint) then
        begin
          lPoint := Point(Round((lPoint.X - lRect.Left) / FPReview.FScale),
            Round((lPoint.Y - lRect.Top) / FPReview.FScale));
          if _GenOnePage then
          begin
            FSavePageNo := FVisiblePages[i] + 1;
            FSaveEndPage := lEndPage;
            Break;
          end;
        end;
      end;

      Cursor := lCursor;
      FPreview.FStatusBar.Panels[1].Text := lUrlStr;
    end;
  finally
    FBusy := False;
  end;
end;

procedure TRMDrawPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (not FPreview.FPaintAllowed) then Exit;

  FDown := False;
end;

procedure TRMDrawPanel.DblClick;
begin
  FDown := False;
  FDoubleClickFlag := True;
  FPreview.EditPage(FPreview.CurPage - 1);
end;

{----------------------------------------------------------------------------}
{----------------------------------------------------------------------------}
{ TRMPreview }

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

  BevelInner := bvNone;
  BevelOuter := bvLowered;
  Caption := '';
  OnResize := OnResizeEvent;
  FParentForm := nil;
  FOnPageChanged := nil;
  FOnStatusChange := nil;

  FOutlineTreeView := TTreeView.Create(Self);
  with FOutlineTreeView do
  begin
    Parent := Self;
    Align := alLeft;
    Width := 180;
    Visible := False;
    ReadOnly := True;
    OnClick := OnOutlineClickEvent;
  end;

  FSplitter := TSplitter.Create(Self);
  with FSplitter do
  begin
    Parent := Self;
    Align := alLeft;
    Left := 10;
    Visible := False;
  end;

  FScrollBox := TRMScrollBox.Create(Self);
  with FScrollBox do
  begin
    Parent := Self;
    //BorderStyle := bsNone;
    Caption := '';
    Align := alClient;
    {$IFDEF Delphi4}
    OnMouseWheelUp := OnMouseWheelUpEvent;
    OnMouseWheelDown := OnMouseWheelDownEvent;
    {$ENDIF}
    OnChange := Self.OnScrollBoxScroll;
  end;

  FTopPanel := TPanel.Create(Self);
  with FTopPanel do
  begin
    Parent := FScrollBox;
    Caption := '';
    Height := 29;
    Align := alTop;
    BevelOuter := bvNone;
    Visible := False;
  end;
  FLeftTopPanel := TPanel.Create(Self);
  with FLeftTopPanel do
  begin
    Parent := FTopPanel;
    Caption := '';
    Width := 29;
    Align := alLeft;
    BevelOuter := bvNone;
  end;
  FTopPanel1 := TPanel.Create(Self);
  with FTopPanel1 do
  begin
    Parent := FTopPanel;
    Caption := '';
    Height := 29;
    Align := alClient;
    BevelOuter := bvNone;
  end;
  FLeftPanel := TPanel.Create(Self);
  with FLeftPanel do
  begin
    Parent := FScrollBox;
    Caption := '';
    Width := 29;
    Align := alLeft;
    BevelOuter := bvNone;
    Visible := False;
  end;

  FHRuler := TRMDesignerRuler.Create(Self);
  FHRuler.Parent := FTopPanel1;
  FHRuler.Units := RMUnits;