rm_preview.pas

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

  FHRuler.Orientation := roHorizontal;
  FHRuler.SetBounds(FLeftPanel.Width, 0, FTopPanel1.Width, FTopPanel1.Height);

  FVRuler := TRMDesignerRuler.Create(Self);
  FVRuler.Parent := FLeftPanel;
  FVRuler.Units := RMUnits;
  FVRuler.Orientation := roVertical;
  FVRuler.SetBounds(0, 0, FLeftPanel.Width, FLeftPanel.Height);

  FStatusBar := TStatusBar.Create(Self);
  with FStatusBar do
  begin
    Parent := Self;
    Align := alBottom;
    with Panels.Add do
    begin
      Width := 100;
    end;
    with Panels.Add do
    begin
      Width := 260;
    end;
    with Panels.Add do
    begin
      Width := 100;
    end;
  end;

  FDrawPanel := TRMDrawPanel.Create(FScrollBox);
  with FDrawPanel do
  begin
    Parent := FScrollBox;
    Caption := '';
    Align := alClient;
    BevelInner := bvNone;
    BevelOuter := bvNone;
    Color := clGray;
    FPreview := Self;
  end;

  FLastScale := 1;
  FZoomMode := mdNone;
  FKWheel := 30;
end;

destructor TRMPreview.Destroy;
begin
  if FReport <> nil then
    TRMReport(FReport).ReportInfo := FSaveReportInfo;

  ClearOutLine;

  inherited Destroy;
end;

function TRMPreview.CanModify: Boolean;
begin
  Result := (RMDesignerClass <> nil) and Assigned(FReport) and TRMReport(Report).ModifyPrepared;
end;

procedure TRMPreview.Connect_1(aReport: TObject);
begin
  FReport := aReport;
end;

{$HINTS OFF}

procedure TRMPreview.ShowReport(aReport: TObject);
begin
  if Assigned(FOnBeforeShowReport) then FOnBeforeShowReport(aReport);
  Connect(aReport);
end;

procedure TRMPreview.Disconnect;
begin
  if FReport <> nil then
    TRMReport(FReport).ReportInfo := FSaveReportInfo;

  FReport := nil;
end;

procedure TRMPreview.ClearOutLine;
var
  i: Integer;
  lNode: TTreeNode;
begin
  for i := 0 to FOutLineTreeView.Items.Count - 1 do
  begin
    lNode := FOutLineTreeView.Items[i];
    if lNode.Data <> nil then
    begin
      Dispose(lNode.Data);
      lNode.Data := nil;
    end;
  end;
  FOutLineTreeView.Items.Clear;
end;

procedure TRMPreview.OnOutlineClickEvent(Sender: TObject);
var
  lNode: TTreeNode;
  lPages: TRMEndPages;
  lPageNo, lPagePosition: Integer;
  lPageRectHeight: Integer;
  lPageHeight: Integer;
begin
  lNode := FOutLineTreeView.Selected;
  if (lNode = nil) or (lNode.Data = nil) then Exit;

  lPages := TRMEndPages(GetEndPages);
  lPageNo := PRMPreviewNodeDataInfo(lNode.Data).PageNo;
  if (lPageNo < 0) or (lPageNo >= lPages.Count) then Exit;

  lPagePosition := Round(PRMPreviewNodeDataInfo(lNode.Data).Position * FScale) +
    RMToScreenPixels(lPages[lPageNo].mmMarginTop * FScale, rmutMMThousandths);
  if lPageNo > 0 then
    lPageRectHeight := lPages[lPageNo].PageRect.Bottom - lPages[lPageNo - 1].PageRect.Bottom
  else
    lPageRectHeight := lPages[lPageNo].PageRect.Bottom;

  lPageRectHeight := lPageRectHeight - 10;
  lPageHeight := Round(lPages[lPageNo].PrinterInfo.PageHeight * FScale);

  FCurPage := -1;
  CurPage := lPageNo + 1;
  VScrollBar.Position := VScrollBar.Position +
    Round(lPagePosition * lPageRectHeight / lPageHeight) + 10 - 5;
end;

procedure TRMPreview.Connect(aReport: TObject);
var
  lParentForm: TForm;

  procedure _SetOutLine; // 设置outline
  var
    i, j: Integer;
    lStr: string;
    lInfo: PRMPreviewNodeDataInfo;
    lParentNode, lNode: TTreeNode;
    lCaption: string;
    lPageNo, lPosition, lNodeLevel: Integer;
    lTmpPos, lOldNodeLevel: Integer;
    lEndPages: TRMEndPages;
  begin
    FOutLineTreeView.Items.BeginUpdate;
    try
      lEndPages := TRMEndPages(GetEndPages);
      ClearOutLine;
      //      lNode := FOutLine.Items.AddChild(nil, '目录');
      //      lNode.Data := nil;
      lNode := nil;
      lParentNode := lNode;
      lOldNodeLevel := 0;

      {      lEndPages.OutLines.Add('1' + #1 + '0' + #1 + '100' + #1 + '0');
            lEndPages.OutLines.Add('2' + #1 + '1' + #1 + '100' + #1 + '1');
            lEndPages.OutLines.Add('3' + #1 + '1' + #1 + '100' + #1 + '1');
            lEndPages.OutLines.Add('4' + #1 + '1' + #1 + '100' + #1 + '2');
            lEndPages.OutLines.Add('5' + #1 + '1' + #1 + '100' + #1 + '2');
            lEndPages.OutLines.Add('6' + #1 + '1' + #1 + '100' + #1 + '1');
            lEndPages.OutLines.Add('7' + #1 + '1' + #1 + '100' + #1 + '0');
           }for i := 0 to lEndPages.OutLines.Count - 1 do
      begin
        lStr := lEndPages.OutLines[i];
        lTmpPos := 1;
        lCaption := RMStrGetToken(lStr, #1, lTmpPos);
        lPageNo := StrToInt(RMStrGetToken(lStr, #1, lTmpPos));
        lPosition := StrToInt(RMStrGetToken(lStr, #1, lTmpPos));
        lNodeLevel := StrToInt(RMStrGetToken(lStr, #1, lTmpPos));

        if lNodeLevel > lOldNodeLevel then
        begin
          lParentNode := lNode;
        end
        else if lNodeLevel < lOldNodeLevel then
        begin
          lParentNode := lNode;
          for j := lNodeLevel to lOldNodeLevel do
          begin
            if lParentNode = nil then Break;
            lParentNode := lParentNode.Parent;
          end;
        end;

        lNode := FOutLineTreeView.Items.AddChild(lParentNode, lCaption);

        New(lInfo);
        lInfo.PageNo := lPageNo;
        lInfo.Position := lPosition;
        lNode.Data := lInfo;

        lOldNodeLevel := lNodeLevel;
      end;
    finally
      FOutLineTreeView.FullExpand;
      FOutLineTreeView.Items.EndUpdate;
      ShowOutline(FOutLineTreeView.Items.Count > 0);
    end;
  end;

begin
  FLeftPanel.Visible := Options.RulerVisible;
  FTopPanel.Visible := Options.RulerVisible;
  FHRuler.Units := Options.RulerUnit;
  FVRuler.Units := Options.RulerUnit;

  Connect_1(aReport);
  if aReport = nil then Exit;

  FSaveReportInfo := TRMReport(FReport).ReportInfo;
  case TRMReport(FReport).InitialZoom of
    pzDefault:
      begin
        FScale := 1;
        FZoomMode := mdNone;
      end;
    pzPageWidth: FZoomMode := mdPageWidth;
    pzOnePage: FZoomMode := mdOnePage;
    pzTwoPages: FZoomMode := mdTwoPages;
  end;

  _SetOutLine;

  CurPage := 1;
  RedrawAll(True);

  {$IFDEF Delphi4}
  lParentForm := FParentForm;
  if (lParentForm = nil) and (Parent <> nil) and (Parent is TForm) then
    lParentForm := TForm(Parent);
  if lParentForm <> nil then
  begin
    //    lParentForm.OnMouseWheelUp := OnMouseWheelUpEvent;
    //    lParentForm.OnMouseWheelDown := OnMouseWheelDownEvent;
  end;
  {$ENDIF}
end;
{$HINTS ON}

procedure TRMPreview.DoStatusChange;
begin
  if Assigned(FOnStatusChange) then
    FOnStatusChange(Self);
end;

procedure TRMPreview.SetToCurPage;
begin
  if (GetEndPages = nil) or (FCurPage < 1) then Exit;

  TRMEndPages(GetEndPages).CurPageNo := FCurPage; //by waw
  if FOffsetTop <> TRMEndPages(GetEndPages)[FCurPage - 1].PageRect.Top - 10 then
    VScrollBar.Position := TRMEndPages(GetEndPages)[FCurPage - 1].PageRect.Top - 10;
end;

procedure TRMPreview.ShowPageNum;
begin
  if GetEndPages = nil then
    FStatusBar.Panels[0].Text := ''
      //    FLabel.Caption := ''
  else
  begin
    if Assigned(FOnPageChanged) then
      FOnPageChanged(Self);

    FStatusBar.Panels[0].Text {FLabel.Caption} := RMLoadStr(SPg) + ' ' + IntToStr(FCurPage) + '/' +
    IntToStr(TRMEndPages(GetEndPages).Count);
    TRMEndPages(GetEndPages).CurPageNo := FCurPage;
  end;
end;

procedure TRMPreview.LoadFromFile(aFileName: string);
begin
  if (FReport = nil) or (GetEndPages = nil) then Exit;

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

procedure TRMPreview.LoadFromFiles(aFileNames: TStrings);
var
  i: Integer;

  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 (FReport = nil) or (GetEndPages = nil) then Exit;

  FPaintAllowed := False;
  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(FReport);
  end;
end;

procedure TRMPreview.SaveToFile(aFileName: string; aIndex: Integer);
begin
  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 //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 TRMPreview.ExportToFile(aExport: TComponent; aFileName: string);
begin
  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 TRMPreview.ExportToXlsFile;
var
  i: Integer;
  lXLSExport: TRMExportFilter;
  lSaveShowDialog: Boolean;
  lFound: Boolean;
begin
  if (FReport = nil) or (GetEndPages = nil) 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
    FPaintAllowed := False;
    lSaveShowDialog := lXLSExport.ShowDialog;
    try
      if lXLSExport.ShowModal = mrOK then
      begin
        lXLSExport.ShowDialog := False;
        ExportToFile(lXLSExport, THackExport(lXLSExport).FileName);
      end;
    finally
      lXLSExport.ShowDialog := lSaveShowDialog;
      RedrawAll(False);
    end;
  end;
end;

procedure TRMPreview.OnResizeEvent(Sender: TObject);
var
  i, j, y, d, nx, maxx, maxy, maxdy, curx: Integer;
  lPageWidth, lPageHeight: Integer;
  lPages: TRMEndPages;
begin
  if (GetEndPages = nil) or (TRMEndPages(GetEndPages).Count < 1) then Exit;

  lPages := TRMEndPages(GetEndPages);
  FPaintAllowed := False;

  lPageWidth := lPages[FCurPage - 1].PrinterInfo.PageWidth;
  lPageHeight := lPages[FCurPage - 1].PrinterInfo.PageHeight;
  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;

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

  if nx = 0 then
    nx := 1;
  if FZoomMode = mdOnePage then
    nx := 1;
  if FZoomMode = mdTwoPages then
    nx := 2;
  y := 10;
  i := 0;
  maxx := 0;