rm_preview.pas

这是一个功能强大

  lSaveReport := FReport;
  try
    TRMReport(FReport).LoadPreparedReport(aFileName);
    //    SetLength(FVisiblePages, 0);
  finally
    Connect(lSaveReport);
  end;
end;

procedure TRMVirtualPreview.LoadFromFiles(aFileNames: TStrings);
var
  i: Integer;
  lSaveReport: TRMCustomReport;

  procedure _AppendReport(const aFileName: string; aEndPages: TRMEndPages);
  var
    lStream: TFileStream;
  begin
    if not FileExists(aFileName) then Exit;
    lStream := TFileStream.Create(aFileName, fmOpenRead);
    try
      aEndPages.AppendFromStream(lStream);
    finally
      lStream.Free;
    end;
  end;

begin
  if FPrepareReportFlag then Exit;
  if (FReport = nil) or (GetEndPages = nil) then Exit;

  FPaintAllowed := False;
  lSaveReport := FReport;
  try
    for i := 0 to aFileNames.Count - 1 do
    begin
      if i = 0 then
        TRMReport(FReport).LoadPreparedReport(aFileNames[i])
      else
        _AppendReport(aFileNames[i], TRMReport(FReport).EndPages);
    end;
  finally
    Connect(lSaveReport);
  end;
end;

procedure TRMVirtualPreview.SaveToFile(aFileName: string; aIndex: Integer);
begin
  if FPrepareReportFlag then Exit;
  if (FReport = nil) or (GetEndPages = nil) then Exit;

  FPaintAllowed := False;
  try
    if aIndex < 2 then
    begin
      aFileName := ChangeFileExt(aFileName, '.rmp');
      TRMReport(FReport).SavePreparedReport(aFileName);
    end
    else if (FReport <> nil) and TRMReport(FReport).CanExport then //export输出
    begin
      TRMReport(Report).ExportTo(TRMExportFilter(RMFilters(aIndex - 2).Filter),
        ChangeFileExt(aFileName, Copy(RMFilters(aIndex - 2).FilterExt, 2, 255)));
    end;
  finally
    Connect_1(FReport);
    RedrawAll(False);
  end;
end;

procedure TRMVirtualPreview.ExportToFile(aExport: TComponent; aFileName: string);
begin
  if FPrepareReportFlag then Exit;
  if (FReport = nil) or (GetEndPages = nil) then Exit;

  FPaintAllowed := False;
  try
    TRMReport(Report).ExportTo(TRMExportFilter(aExport), aFileName);
  finally
    RedrawAll(False);
  end;
end;

type
  THackExport = class(TRMExportFilter)
  end;

procedure TRMVirtualPreview.ExportToXlsFile;
var
  i: Integer;
  lXLSExport: TRMExportFilter;
  lSaveShowDialog: Boolean;
  lFound: Boolean;
begin
  if FPrepareReportFlag then Exit;
  if (FReport = nil) or (GetEndPages = nil) then Exit;
  if not TRMReport(FReport).CanExport then Exit;

  lXLSExport := nil;
  lFound := False;
  for i := 0 to RMFiltersCount - 1 do
  begin
    lXLSExport := TRMExportFilter(RMFilters(i).Filter);
    if lXLSExport.IsXLSExport then
    begin
      lFound := True;
      Break;
    end;
  end;

  if lFound then
  begin
    lSaveShowDialog := lXLSExport.ShowDialog;
    try
      if lXLSExport.ShowModal = mrOK then
      begin
        lXLSExport.ShowDialog := False;
        FPaintAllowed := False;
        ExportToFile(lXLSExport, THackExport(lXLSExport).FileName);
      end;
    finally
      lXLSExport.ShowDialog := lSaveShowDialog;
      RedrawAll(False);
    end;
  end;
end;

procedure TRMVirtualPreview.SetPageRect;
var
  i, j, y, d, maxx, maxy, lMaxHeight, lCurXOff: Integer;
  lTmpInt: Integer;
  lPageWidth, lPageHeight: Integer;
  lPages: TRMEndPages;
  lEndPage: TRMEndPage;
  lDrawPanelWidth: Integer;
begin
  if (GetEndPages = nil) or (FTotalPages < 1) or (FCurPage < 1) then Exit;

  FPaintAllowed := False;
  lPages := TRMEndPages(GetEndPages);
  lPageWidth := lPages[FCurPage - 1].PrinterInfo.ScreenPageWidth;
  lPageHeight := lPages[FCurPage - 1].PrinterInfo.ScreenPageHeight;
  case FZoomMode of
    mdPageWidth: FScale := (FDrawPanel.Width - 20) / lPageWidth;
    mdOnePage: FScale := (FDrawPanel.Height - 20) / lPageHeight;
    mdTwoPages: FScale := (FDrawPanel.Width - 30) / (2 * lPageWidth);
    mdPrinterZoom: FScale := RMPrinter.FactorY;
  end;

  FColumns := 0;
  maxx := 10;
  j := 0;
  for i := 0 to lPages.Count - 1 do
  begin
    d := maxx + 10 + Round(lPages[i].PrinterInfo.ScreenPageWidth * FScale);
    if d > FDrawPanel.Width then
    begin
      if FColumns < j then
        FColumns := j;
      j := 0;
      maxx := 10;
    end
    else
    begin
      maxx := d;
      Inc(j);
      if i = lPages.Count - 1 then
      begin
        if FColumns < j then
          FColumns := j;
      end;
    end;
  end;

  if FColumns = 0 then
    FColumns := 1;
  if FZoomMode = mdOnePage then
    FColumns := 1;
  if FZoomMode = mdTwoPages then
    FColumns := 2;

  y := 10;
  i := 0;
  maxx := 0; maxy := 0;
  lDrawPanelWidth := FDrawPanel.Width;
  if VScrollBar.PageSize > VScrollBar.Range then
    lDrawPanelWidth := lDrawPanelWidth - VScrollBar.Width;

  while i < lPages.Count do
  begin
    lMaxHeight := 0; lCurXOff := 10;
    for j := 0 to FColumns - 1 do
    begin
      lEndPage := lPages[i];
      lPageWidth := Round(lEndPage.PrinterInfo.ScreenPageWidth * FScale);
      lPageHeight := Round(lEndPage.PrinterInfo.ScreenPageHeight * FScale);
      if (FColumns = 1) and (lPageWidth < lDrawPanelWidth) then
      begin
        lTmpInt := (lDrawPanelWidth - lPageWidth) div 2;
        lEndPage.PageRect := Rect(lTmpInt, y, lTmpInt + lPageWidth, y + lPageHeight);
      end
      else
        lEndPage.PageRect := Rect(lCurXOff, y, lCurXOff + lPageWidth, y + lPageHeight);

      maxx := Max(maxx, lEndPage.PageRect.Right);
      maxy := Max(maxy, lEndPage.PageRect.Bottom);
      lMaxHeight := Max(lMaxHeight, lPageHeight);
      Inc(lCurXOff, lPageWidth + 10);
      Inc(i);
      if i >= lPages.Count then Break;
    end;

    Inc(y, lMaxHeight + 10);
  end;

  HScrollBar.Range {Max} := maxx + 10;
  HScrollBar.PageSize := FScrollBox.ClientWidth;
  if HScrollBar.Position > HScrollBar.Range {Max} - HScrollBar.LargeChange then
    HScrollBar.Position := HScrollBar.Range {Max} - HScrollBar.LargeChange;
  if (HScrollBar.Position > 0) and (HScrollBar.PageSize > HScrollBar.Range) then
    HScrollBar.Position := 0;

  VScrollBar.Range {Max} := maxy + 10;
  VScrollBar.PageSize := FScrollBox.ClientHeight;
  if VScrollBar.Position > VScrollBar.Range {Max} - VScrollBar.LargeChange then
    VScrollBar.Position := VScrollBar.Range {Max} - VScrollBar.LargeChange;

//  if lDrawPanelWidth <> FDrawPanel.Width then
//  begin
//  end;

  FPaintAllowed := True;
end;

procedure TRMVirtualPreview.BeginPrepareReport(aReport: TRMCustomReport);
begin
  NeedRepaint := False;
  FPrepareReportFlag := True;
  TRMPreview(Self).SetButtonsVisible;
end;

procedure TRMVirtualPreview.InternalOnProgress(aReport: TRMCustomReport;
  aPercent: Integer);
begin
  if TRMReport(aReport).DoublePass and (not TRMReport(aReport).FinalPass) then
    FTotalPages := 0
  else
    FTotalPages := TRMEndPages(GetEndPages).Count;

  SetPageRect;
  if FTotalPages = 1 then
    FDrawPanel.Repaint;

  if TRMReport(aReport).DoublePass and (not TRMReport(aReport).FinalPass) then
  begin
    FStatusBar.Panels[0].Text := Format('%s %d', [RMLoadStr(SFirstPass), TRMEndPages(GetEndPages).Count]);
  end
  else
  begin
    FStatusBar.Panels[0].Text := Format('%s %d/%d', [RMLoadStr(SPg), FCurPage, FTotalPages]);
  end;
end;

procedure TRMVirtualPreview.EndPrepareReport(aReport: TRMCustomReport);
begin
  FPrepareReportFlag := False;
  if GetEndPages = nil then Exit;

  FTotalPages := TRMEndPages(GetEndPages).Count;
  TRMPreview(Self).SetButtonsVisible;
  SetOutLineInfo;
  SetPageRect;
  if (FColumns > 1) or TRMReport(aReport).AutoSetPageLength or NeedRepaint then
  begin
    FDrawPanel.FRepaintPageNo := CurPage - 1;
    FDrawPanel.Repaint;
  end;
end;

procedure TRMVirtualPreview.OnResizeEvent(Sender: TObject);
begin
  if (GetEndPages = nil) or (FTotalPages < 1) then
  begin
    HScrollBar.Range := 2;
    HScrollBar.PageSize := 1;
    VScrollBar.Range := 2;
    HScrollBar.PageSize := 1;
    Exit;
  end;

  if FCurPage < 1 then Exit;

  SetPageRect;
  SetToCurPage;
  DoStatusChange;
end;

procedure TRMVirtualPreview.OnSplitterMovedEvent(Sender: TObject);
begin
  OnResizeEvent(nil);
end;

procedure TRMVirtualPreview.RedrawAll(aResetPage: Boolean);
var
  i: Integer;
begin
  FPaintAllowed := True;
  FScale := FLastScale;
  if aResetPage then
  begin
    FCurPage := 1;
    FOffsetLeft := 0;
    FOffsetTop := 0;
    FOldHPos := 0;
    FOldVPos := 0;
    HScrollBar.Position := 0;
    VScrollBar.Position := 0;
  end;
  ShowPageNum;
  OnResizeEvent(nil);

  if GetEndPages <> nil then
  begin
    for i := 0 to FTotalPages - 1 do
    begin
      TRMEndPages(GetEndPages).Pages[i].RemoveCachePage;
    end;
  end;

  FDrawPanel.Repaint;
end;

procedure TRMVirtualPreview.OnScrollBoxScroll(Sender: TObject; Kind: TRMScrollBarKind);
var
  i, p, pp: Integer;
  lRect: TRect;
  lPages: TRMEndPages;
begin
  if GetEndPages = nil then Exit;

  if Kind = rmsbHorizontal then
  begin
    p := HScrollBar.Position;
    pp := FOldHPos - p;
    FOldHPos := p;
    FOffsetLeft := -p;
    lRect := Rect(0, 0, FDrawPanel.Width, FDrawPanel.Height);
    ScrollWindow(FDrawPanel.Handle, pp, 0, @lRect, @lRect);
  end
  else
  begin
    lPages := TRMEndPages(GetEndPages);
    p := VScrollBar.Position;
    pp := FOldVPos - p;
    FOldVPos := p;
    FOffsetTop := -p;
    lRect := Rect(0, 0, FDrawPanel.Width, FDrawPanel.Height);
    ScrollWindow(FDrawPanel.Handle, 0, pp, @lRect, @lRect);
    for i := 0 to lPages.Count - 1 do
    begin
      if (lPages[i].PageRect.Top < -FOffsetTop + 11) and (lPages[i].PageRect.Bottom > -FOffsetTop + 11) then
      begin
        FCurPage := i + 1;
        ShowPageNum;
        Break;
      end;
    end;
  end;
end;

procedure TRMVirtualPreview.SetPage(Value: Integer);
begin
  if FCurPage <> Value then
  begin
    if Value < 1 then
      Value := 1;
    if Value > TotalPages then
      Value := TotalPages;
    FCurPage := Value;
    SetToCurPage;
    if Assigned(FOnPageChanged) then
      FOnPageChanged(Self);
  end;
end;

function TRMVirtualPreview.GetZoom: Double;
begin
  Result := FScale * 100;
end;

procedure TRMVirtualPreview.SetZoom(Value: Double);
begin
  FScale := Value / 100;
  FZoomMode := mdNone;
  LastScale := FScale;
  OnResizeEvent(nil);
  FDrawPanel.Paint;
  DoStatusChange;
end;

procedure TRMVirtualPreview.OnePage;
begin
  FZoomMode := mdOnePage;
  OnResizeEvent(nil);
  FDrawPanel.Paint;
  DoStatusChange;
end;

procedure TRMVirtualPreview.TwoPages;
begin
  FZoomMode := mdTwoPages;
  OnResizeEvent(nil);
  FDrawPanel.Paint;
  DoStatusChange;
end;

procedure TRMVirtualPreview.PageWidth;
begin
  FZoomMode := mdPageWidth;
  OnResizeEvent(nil);
  FDrawPanel.Paint;
  DoStatusChange;
end;

procedure TRMVirtualPreview.PrinterZoom;
begin
  if RMPrinter.PrinterInfo.IsValid then
    FZoomMode := mdPrinterZoom
  else
    FZoomMode := mdPageWidth;

  OnResizeEvent(nil);
  FDrawPanel.Paint;
  DoStatusChange;
end;

procedure TRMVirtualPreview.First;
begin
  CurPage := 1;
end;