rm_preview.pas

这是一个功能强大

procedure TRMVirtualPreview.Next;
begin
  CurPage := CurPage + 1;
end;

procedure TRMVirtualPreview.Prev;
begin
  CurPage := CurPage - 1;
end;

procedure TRMVirtualPreview.Last;
begin
  CurPage := TotalPages;
end;

procedure TRMVirtualPreview.Print;
var
  lSavePrinterIndex: Integer;
  lNeedSave: Boolean;
  lPages: string;
  lForm: TRMPrintDialogForm;
begin
  if FPrepareReportFlag then Exit;
  if (GetEndPages = nil) or (RMPrinters.Count = 2) then Exit;

  lForm := TRMPrintDialogForm.Create(nil);
  try
    with lForm do
    begin
      CurrentPrinter := TRMReport(FReport).ReportPrinter;
      Copies := TRMReport(FReport).DefaultCopies;
      chkCollate.Checked := TRMReport(FReport).DefaultCollate;
      chkTaoda.Checked := TRMReport(FReport).PrintBackGroundPicture;
      chkColorPrint.Checked := TRMReport(FReport).ColorPrint;
      THackReport(FReport).ScalePageSize := -1;
      THackReport(FReport).ScaleFactor := 100;
      PrintOffsetTop := TRMReport(FReport).PrintOffsetTop;
      PrintOffsetLeft := TRMReport(FReport).PrintOffsetLeft;
      if TRMReport(Report).ShowPrintDialog then
        lSavePrinterIndex := TRMReport(FReport).ReportPrinter.PrinterIndex
      else
        lSavePrinterIndex := -1;

      if (not TRMReport(Report).ShowPrintDialog) or (ShowModal = mrOK) then
      begin
        if TRMReport(FReport).CanRebuild and (lForm.NeedRebuild or
          (TRMReport(FReport).ReportPrinter.PrinterIndex <> lSavePrinterIndex)) then // 改变了打印机设置
        begin
          {          if TRMReport(FReport).ChangePrinter(liSavePrinterIndex, TRMReport(FReport).ReportPrinter.PrinterIndex) then
                    begin
                      TRMEndPages(FEndPages).Free;
                      FEndPages := nil;
                      TRMReport(FReport).PrepareReport;
                      Connect(FReport);
                    end
                    else
                    begin
                      Free;
                      Exit;
                    end;
                  }
        end;

        TRMReport(FReport).ColorPrint := chkColorPrint.Checked;
        THackReport(FReport).Flag_PrintBackGroundPicture := not chkTaoda.Checked;
        GetPageInfo(THackReport(FReport).ScalePageWidth, THackReport(FReport).ScalePageHeight, THackReport(FReport).ScalePageSize);
        THackReport(FReport).ScaleFactor := lForm.ScaleFactor;
        lNeedSave := (TRMReport(FReport).PrintOffsetTop <> PrintOffsetTop) or
          (TRMReport(FReport).PrintOffsetLeft <> PrintOffsetLeft);
        TRMReport(FReport).PrintOffsetTop := PrintOffsetTop;
        TRMReport(FReport).PrintOffsetLeft := PrintOffsetLeft;
        if rdbPrintAll.Checked then
          lPages := ''
        else if rbdPrintCurPage.Checked then
          lPages := IntToStr(FCurPage)
        else
          lPages := edtPages.Text;

        if lNeedSave then
          TRMReport(FReport).SaveReportOptions.SaveReportSetting(TRMReport(FReport), '', False);

        FPaintAllowed := False;
        try
          TRMReport(FReport).PrintPreparedReport(lPages, Copies, chkCollate.Checked,
            TRMPrintPages(cmbPrintAll.ItemIndex));
        finally
          Connect_1(FReport);
          RedrawAll(False);
        end;
      end;
    end;
  finally
    lForm.Free;
  end;
end;

procedure TRMVirtualPreview.PrintCurrentPage; //打印当前页
begin
  if FPrepareReportFlag then Exit;
  if (GetEndPages = nil) or (RMPrinters.Count = 2) then Exit;

  FPaintAllowed := False;
  try
    THackReport(FReport).Flag_PrintBackGroundPicture := TRMReport(FReport).PrintbackgroundPicture;
    THackReport(FReport).ScalePageSize := -1;
    THackReport(FReport).ScaleFactor := 100;

    TRMReport(FReport).PrintPreparedReport(IntToStr(CurPage), 1, TRMReport(FReport).DefaultCollate,
      rmppAll);
  finally
    RedrawAll(False);
  end;
end;

procedure TRMVirtualPreview.DlgPageSetup;
var
  lSaveReport: TRMCustomReport;
  tmpForm: TRMPageSetupForm;
  liEndPage: TRMEndPage;
  lPage: TRMCustomPage;
  i: Integer;
  lPageWidth, lhRgn, lPageSize: Integer;
  lOldIndex: Integer;
begin
  if FPrepareReportFlag or (GetEndPages = nil) then Exit;

  liEndPage := TRMEndPages(GetEndPages)[Self.CurPage - 1];
  if liEndPage = nil then Exit;

  lOldIndex := RMPrinter.PrinterIndex;
  tmpForm := TRMPageSetupForm.Create(nil);
  try
    tmpForm.CurReport := TRMReport(Report);
    tmpForm.CurPrinter := TRMReport(Report).ReportPrinter;
    with liEndPage do
    begin
      tmpForm.PageSetting.PrinterName := RMPrinters.Printers[RMPrinter.PrinterIndex];
      tmpForm.PageSetting.Title := TRMReport(Report).ReportInfo.Title;
      tmpForm.PageSetting.DoublePass := TRMReport(Report).DoublePass;
      tmpForm.PageSetting.PrintBackGroundPicture := TRMReport(Report).PrintbackgroundPicture;
      tmpForm.PageSetting.ColorPrint := TRMReport(Report).ColorPrint;
      tmpForm.PageSetting.MarginLeft := RMFromMMThousandths(mmMarginLeft, rmutMillimeters);
      tmpForm.PageSetting.MarginTop := RMFromMMThousandths(mmMarginTop, rmutMillimeters);
      tmpForm.PageSetting.MarginRight := RMFromMMThousandths(mmMarginRight, rmutMillimeters);
      tmpForm.PageSetting.MarginBottom := RMFromMMThousandths(mmMarginBottom, rmutMillimeters);
      tmpForm.PageSetting.PageOr := PageOrientation;
      tmpForm.PageSetting.PageBin := PageBin;
      tmpForm.PageSetting.PageSize := PageSize;
      tmpForm.PageSetting.PageWidth := PageWidth;
      tmpForm.PageSetting.PageHeight := PageHeight;
      tmpForm.PageSetting.UnlimitedHeight := True;
      if tmpForm.PreviewPageSetup then
      begin
        if lOldIndex <> tmpForm.cmbPrinterNames.ItemIndex then
          TRMReport(Report).ChangePrinter(RMPrinter.PrinterIndex, tmpForm.cmbPrinterNames.ItemIndex);

        TRMReport(Report).ReportInfo.Title := tmpForm.PageSetting.Title;
        TRMReport(Report).DoublePass := tmpForm.PageSetting.DoublePass;
        TRMReport(Report).PrintbackgroundPicture := tmpForm.PageSetting.PrintbackgroundPicture;
        TRMReport(Report).ColorPrint := tmpForm.PageSetting.ColorPrint;

        mmMarginLeft := RMToMMThousandths(tmpForm.PageSetting.MarginLeft, rmutMillimeters);
        mmMarginTop := RMToMMThousandths(tmpForm.PageSetting.MarginTop, rmutMillimeters);
        mmMarginRight := RMToMMThousandths(tmpForm.PageSetting.MarginRight, rmutMillimeters);
        mmMarginBottom := RMToMMThousandths(tmpForm.PageSetting.MarginBottom, rmutMillimeters);

        PageOrientation := tmpForm.PageSetting.PageOr;
        PageBin := tmpForm.PageSetting.PageBin;
        lPageSize := tmpForm.PageSetting.PageSize;
        lPageWidth := tmpForm.PageSetting.PageWidth;
        lhRgn := tmpForm.PageSetting.PageHeight;
        if tmpForm.chkUnlimitedHeight.Checked then
        begin
          for i := 0 to TRMReport(Report).Pages.Count - 1 do
          begin
            lPage := TRMReport(Report).Pages[i];
            if lPage is TRMReportPage then
            begin
              TRMReportPage(lPage).mmMarginLeft := mmMarginLeft;
              TRMReportPage(lPage).mmMarginTop := mmMarginTop;
              TRMReportPage(lPage).mmMarginRight := mmMarginRight;
              TRMReportPage(lPage).mmMarginBottom := mmMarginBottom;
              TRMReportPage(lPage).ChangePaper(lPageSize, lPageWidth, lhRgn, liEndPage.PageBin, liEndPage.PageOrientation);
            end;
          end;
        end;

        TRMReport(Report).SaveReportOptions.SaveReportSetting(TRMReport(Report), '', False);
        if Assigned(OnAfterPageSetup) then
          OnAfterPageSetup(tmpForm.PageSetting);

        if TRMReport(Report).CanRebuild then
        begin
          FPaintAllowed := False;
          //SetLength(FVisiblePages, 0);
          lSaveReport := FReport;
          TRMReport(Report).PrepareReport;
          Connect_1(lSaveReport);
        end;

        RedrawAll(True);
      end;
    end;
  finally
    tmpForm.Free;
  end;
end;

procedure TRMVirtualPreview.AddPage;
begin
  if FPrepareReportFlag then Exit;
  if FReport = nil then Exit;

  TRMEndPages(GetEndPages).InsertFromEndPage(FTotalPages,
    TRMEndPages(GetEndPages).Pages[FTotalPages - 1]);
  FTotalPages := TRMEndPages(GetEndPages).Count;
  RedrawAll(False);
end;

procedure TRMVirtualPreview.InsertPageBefore;
var
  liEndPage: TRMEndPage;
  liPageNo: Integer;
begin
  if FPrepareReportFlag then Exit;
  if FReport = nil then Exit;

  if FCurPage > FTotalPages then
  begin
    liEndPage := TRMEndPages(GetEndPages).Pages[FTotalPages - 1];
    liPageNo := FTotalPages - 1;
  end
  else
  begin
    liEndPage := TRMEndPages(GetEndPages).Pages[FCurPage - 1];
    liPageNo := FCurPage - 1;
  end;

  TRMEndPages(GetEndPages).InsertFromEndPage(liPageNo, liEndPage);
  TRMReport(FReport).Modified := True;
  FTotalPages := TRMEndPages(GetEndPages).Count;
  RedrawAll(False);
end;

procedure TRMVirtualPreview.InsertPageAfter;
begin
  if FPrepareReportFlag then Exit;
  if FReport = nil then Exit;

  if FCurPage > FTotalPages then
    AddPage
  else
  begin
    TRMEndPages(GetEndPages).InsertFromEndPage(FCurPage, TRMEndPages(GetEndPages).Pages[FCurPage - 1]);
    RedrawAll(False);
  end;

  FTotalPages := TRMEndPages(GetEndPages).Count;
  TRMReport(FReport).Modified := True;
end;

procedure TRMVirtualPreview.DeletePage(PageNo: Integer);
begin
  if FPrepareReportFlag then Exit;
  if (FReport = nil) or (GetEndPages = nil) then Exit;

  if (PageNo >= 0) and (FTotalPages > 1) then
  begin
    if MessageBox(0, PChar(RMLoadStr(SRemovePg)), PChar(RMLoadStr(SConfirm)),
      mb_YesNo + mb_IconQuestion) = mrYes then
    begin
      TRMEndPages(GetEndPages).Delete(PageNo);
      FTotalPages := TRMEndPages(GetEndPages).Count;
      RedrawAll(True);
      TRMReport(FReport).Modified := True;
    end;
  end;
end;

function TRMVirtualPreview.EditPage(PageNo: Integer): Boolean;
begin
  Result := False;

  if FPrepareReportFlag then Exit;
  if not CanModify then Exit;
  if (PageNo >= 0) and (PageNo < FTotalPages) then
  begin
    FPaintAllowed := False;
    try
      Result := TRMReport(FReport).EditPreparedReport(PageNo);
    finally
      Connect_1(FReport);
      RedrawAll(False);
    end;
  end;
end;

procedure TRMVirtualPreview.DesignReport;
begin
  if FPrepareReportFlag then Exit;
  if not ((RMDesignerClass <> nil) and Assigned(FReport)) then Exit;
  if (not TRMReport(FReport).CanRebuild) or (TRMReport(FReport) is TRMCompositeReport) then
    Exit;

  FPaintAllowed := False;
  try
    TRMReport(FReport).DesignPreviewedReport;
  finally
    Connect_1(FReport);
    RedrawAll(False);
  end;
end;

procedure TRMVirtualPreview.OnMouseWheelUpEvent(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VScrollBar.Position := VScrollBar.Position - VScrollBar.SmallChange;
end;

procedure TRMVirtualPreview.OnMouseWheelDownEvent(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VScrollBar.Position := VScrollBar.Position + VScrollBar.SmallChange;
end;

function EnumEMFRecordsProc(DC: HDC; HandleTable: PHandleTable;
  EMFRecord: PEnhMetaRecord; nObj: Integer; OptData: Pointer): Bool; stdcall;
var
  Typ: Byte;
  s: string;
  t: TEMRExtTextOut;
  s1: PChar;

  function _FindText(const aStr: string): Boolean;
  var
    liPos, liLen: Integer;
  begin
    Result := False;
    liPos := Pos(aStr, s);
    liLen := Length(aStr);
    while (liPos > 0) and (not Result) do
    begin
      if liPos < Length(s) then
      begin
        if (s[liPos + liLen] in RMBreakChars) or (s[liPos + liLen] in LeadBytes) then
          Result := True;
      end
      else
        Result := True;

      if not Result then
      begin
        System.Delete(s, 1, liPos - 1 + liLen);
        liPos := Pos(aStr, s);
      end;
    end;
  end;

begin
  Result := True;
  Typ := EMFRecord^.iType;
  if Typ in [83, 84] then
  begin
    t := PEMRExtTextOut(EMFRecord)^;
    if RMGetWindowsVersion <> 'NT' then
    begin
      s1 := StrAlloc(t.EMRText.nChars + 1);
      StrLCopy(s1, PChar(PChar(EMFRecord) + t.EMRText.offString), t.EMRText.nChars);
      s := StrPas(s1);
      StrDispose(s1);
    end
    else
      s := WideCharLenToString(PWideChar(PChar(EMFRecord) + t.EMRText.offString),
        t.EMRText.nChars);

    if not FCurPreview.CaseSensitive then
      s := AnsiUpperCase(s);

    if FCurPreview.Wholewords then
    begin
      FCurPreview.StrFound := _FindText(FCurPreview.FindStr);
    end
    else
      FCurPreview.StrFound := Pos(FCurPreview.FindStr, s) <> 0;

    if FCurPreview.StrFound and (FRecordNum >= FCurPreview.LastFoundObject) then
    begin
      FCurPreview.StrBounds := t.rclBounds;
      Result := False;
    end;
  end;
  Inc(FRecordNum);
end;

procedure TRMVirtualPreview.FindInEMF(lEmf: TMetafile);
begin
  FCurPreview := Self;
  FRecordNum := 0;
  EnumEnhMetafile(0, lEmf.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0));
end;

procedure TRMVirtualPreview.FindNext;
var
  lEmf: TMetafile;
  lEmfCanvas: TMetafileCanvas;
  lEndPage: TRMEndPage;
  i, nx, ny, ndx, ndy: Integer;
begin
  if FPrepareReportFlag then Exit;

  FStrFound := False;
  while FLastFoundPage < FTotalPages do
  begin
    lEndPage := TRMEndPages(GetEndPages).Pages[FLastFoundPage];
    lEmf := TMetafile.Create;
    lEmf.Width := lEndPage.PrinterInfo.ScreenPageWidth;
    lEmf.Height := lEndPage.PrinterInfo.ScreenPageHeight;
    lEmfCanvas := TMetafileCanvas.Create(lEmf, 0);
    lEndPage.Visible := True;
    lEndPage.Draw(TRMReport(FReport), lEmfCanvas,
      Rect(0, 0, lEndPage.PrinterInfo.ScreenPageWidth, lEndPage.PrinterInfo.ScreenPageHeight));
    lEmfCanvas.Free;

    FindInEMF(lEmf);
    lEmf.Free;
    if FStrFound then
    begin
      FCurPage := FLastFoundPage + 1;
      ShowPageNum;
      nx := lEndPage.PageRect.Left + Round(StrBounds.Left * FScale);
      ny := Round(StrBounds.Top * FScale) + 10;
      ndx := Round((StrBounds.Right - StrBounds.Left) * FScale);
      ndy := Round((StrBounds.Bottom - StrBounds.Top) * FScale);

      if ny > FDrawPanel.Height - ndy then
      begin
        VScrollBar.Position := lEndPage.PageRect.Top + ny - FDrawPanel.Height - 10 + ndy;
        ny := FDrawPanel.Height - ndy