rm_preview.pas

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

function TRMPreview.EditPage(PageNo: Integer): Boolean;
begin
  Result := False;
  if not CanModify then Exit;
  if (PageNo >= 0) and (PageNo < TRMEndPages(GetEndPages).Count) then
  begin
    FPaintAllowed := False;
    try
      Result := TRMReport(FReport).EditPreparedReport(PageNo);
    finally
      Connect_1(FReport);
      RedrawAll(False);
    end;
  end;
end;

procedure TRMPreview.DesignReport;
begin
  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;

{$IFDEF Delphi4}

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

procedure TRMPreview.OnMouseWheelDownEvent(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VScrollBar.Position := VScrollBar.Position + VScrollBar.SmallChange * FKWheel;
end;
{$ENDIF}

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 TRMPreview.FindInEMF(lEmf: TMetafile);
begin
  FCurPreview := Self;
  FRecordNum := 0;
  EnumEnhMetafile(0, lEmf.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0));
end;

procedure TRMPreview.FindNext;
var
  lEmf: TMetafile;
  lEmfCanvas: TMetafileCanvas;
  lEndPage: TRMEndPage;
  i, nx, ny, ndx, ndy: Integer;
begin
  FStrFound := False;
  while FLastFoundPage < TRMEndPages(GetEndPages).Count do
  begin
    lEndPage := TRMEndPages(GetEndPages).Pages[FLastFoundPage];
    lEmf := TMetafile.Create;
    lEmf.Width := lEndPage.PrinterInfo.PageWidth;
    lEmf.Height := lEndPage.PrinterInfo.PageHeight;
    lEmfCanvas := TMetafileCanvas.Create(lEmf, 0);
    lEndPage.Visible := True;
    lEndPage.Draw(TRMReport(FReport), lEmfCanvas, Rect(0, 0, lEndPage.PrinterInfo.PageWidth, lEndPage.PrinterInfo.PageHeight));
    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;
      end
      else
        VScrollBar.Position := lEndPage.PageRect.Top - 10;

      if nx > FDrawPanel.Width - ndx then
      begin
        HScrollBar.Position := lEndPage.PageRect.Left + nx - FDrawPanel.Width - 10 + ndx;
        nx := FDrawPanel.Width - ndx;
      end
      else
        HScrollBar.Position := lEndPage.PageRect.Left - 10;

      LastFoundObject := FRecordNum;
      Application.ProcessMessages;

      FPaintAllowed := True;
      FDrawPanel.Paint;
      with FDrawPanel.Canvas do
      begin
        Pen.Width := 1;
        Pen.Mode := pmXor;
        Pen.Color := clWhite;
        for i := 0 to ndy do
        begin
          MoveTo(nx, ny + i);
          LineTo(nx + ndx, ny + i);
        end;
        Pen.Mode := pmCopy;
      end;

      Break;
    end
    else
    begin
      lEndPage.RemoveCachePage;
    end;

    FLastFoundObject := 0;
    Inc(FLastFoundPage);
  end;
end;

procedure TRMPreview.Find;
var
  tmp: TRMPreviewSearchForm;
begin
  if FReport = nil then Exit;

  tmp := TRMPreviewSearchForm.Create(Application);
  try
    tmp.chkCaseSensitive.Checked := FCaseSensitive;
    tmp.chkWholewords.Checked := FWholewords;
    tmp.edtSearchTxt.Text := FFindStr;
    if tmp.ShowModal = mrOk then
    begin
      FFindStr := tmp.edtSearchTxt.Text;
      FCaseSensitive := tmp.chkCaseSensitive.Checked;
      FWholewords := tmp.chkWholewords.Checked;
      if not FCaseSensitive then
        FFindStr := AnsiUpperCase(FFindStr);
      if tmp.rdbFromFirst.Checked then
      begin
        FLastFoundPage := 0;
        FLastFoundObject := 0;
      end
      else if FLastFoundPage <> FCurPage - 1 then
      begin
        FLastFoundPage := FCurPage - 1;
        FLastFoundObject := 0;
      end;

      FreeAndNil(tmp);
      FindNext;
    end;
  finally
    FreeAndNil(tmp);
  end;
end;

procedure TRMPreview.ShowOutline(aVisible: Boolean);
begin
  FOutlineTreeView.Visible := aVisible;
  FSplitter.Visible := FOutlineTreeView.Visible;
  FSplitter.Left := FOutLineTreeView.Left + 10;
end;

function TRMPreview.GetHScrollBar: TRMScrollBar;
begin
  Result := FScrollBox.HorzScrollBar;
end;

function TRMPreview.GetVScrollBar: TRMScrollBar;
begin
  Result := FScrollBox.VertScrollBar;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPreviewForm }
var
  LastScale: Double = 1;
  LastScaleMode: TRMScaleMode = mdNone;

procedure TRMPreviewForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(itmPageWidth, 'Caption', rmRes + 020);
  RMSetStrProp(itmOnePage, 'Caption', rmRes + 021);
  RMSetStrProp(itmDoublePage, 'Caption', rmRes + 022);
  RMSetStrProp(itmNewPage, 'Caption', rmRes + 030);
  RMSetStrProp(itmDeletePage, 'Caption', rmRes + 031);
  RMSetStrProp(itmEditPage, 'Caption', rmRes + 029);
  RMSetStrProp(itmPrint, 'Caption', rmRes + 1866);
  RMSetStrProp(itmPrintCurrentPage, 'Caption', rmRes + 376);
  RMSetStrProp(InsertBefore1, 'Caption', rmRes + 1867);
  RMSetStrProp(InsertAfter1, 'Caption', rmRes + 1868);
  RMSetStrProp(Append1, 'Caption', rmRes + 1869);

  RMSetStrProp(btnOpen, 'Hint', rmRes + 025);
  RMSetStrProp(btnSave, 'Hint', rmRes + 026);
  RMSetStrProp(btnPrint, 'Hint', rmRes + 027);
  RMSetStrProp(btnFind, 'Hint', rmRes + 028);
  RMSetStrProp(btnOnePage, 'Hint', rmRes + 1858);
  RMSetStrProp(btnPageWidth, 'Hint', rmRes + 1857);
  RMSetStrProp(btnTop, 'Hint', rmRes + 32);
  RMSetStrProp(btnPrev, 'Hint', rmRes + 33);
  RMSetStrProp(btnNext, 'Hint', rmRes + 34);
  RMSetStrProp(btnLast, 'Hint', rmRes + 35);
  RMSetStrProp(btnPageSetup, 'Hint', rmRes + 24);
  RMSetStrProp(btnShowOutline, 'Hint', rmRes + 1871);
  RMSetStrProp(btnExit, 'Hint', rmRes + 23);
  RMSetStrProp(cmbZoom, 'Hint', rmRes + 7);
  //  RMSetStrProp(btnAutoScale, 'Hint', rmRes + 8);
  RMSetStrProp(btnSaveToXLS, 'Hint', rmRes + 9);
  RMSetStrProp(btnDesign, 'Hint', rmRes + 10);
  RMSetStrProp(ToolbarStand, 'Caption', rmRes + 11);
end;

procedure TRMPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveIni;
  if FormStyle <> fsMDIChild then
  begin
    RMSaveFormPosition('', Self);
  end;
  Action := caFree;
end;

procedure TRMPreviewForm.Execute(ADoc: Pointer);
var
  i: Integer;
  lFound: Boolean;
begin
  FDoc := ADoc;
  FViewer.Connect(ADoc);

  OpenDialog.InitialDir := FViewer.InitialDir;
  SaveDialog.InitialDir := FViewer.InitialDir;
  N4.Visible := RMDesignerClass <> nil;
  itmNewPage.Visible := N4.Visible;
  itmDeletePage.Visible := N4.Visible;
  itmEditPage.Visible := N4.Visible;

  if not (csDesigning in TRMReport(ADoc).ComponentState) then
  begin
    cmbZoom.Visible := pbZoom in TRMReport(ADoc).PreviewButtons;
    if not cmbZoom.Visible then tbLine.Free;

    btnShowOutline.Down := FViewer.FOutlineTreeView.Visible;
    btnShowOutline.Visible := (FViewer.FOutLineTreeView.Items.Count > 0);
    btnFind.Visible := pbFind in TRMReport(ADoc).PreviewButtons;
    ToolbarSep972.Visible := btnFind.Visible;

    btnOpen.Visible := pbLoad in TRMReport(ADoc).PreviewButtons;
    btnSave.Visible := pbSave in TRMReport(ADoc).PreviewButtons;
    btnSaveToXLS.Visible := pbSavetoXLS in TRMReport(ADoc).PreviewButtons;
    btnPrint.Visible := pbPrint in TRMReport(ADoc).PreviewButtons;
    btnPageSetup.Visible := pbPageSetup in TRMReport(ADoc).PreviewButtons;
    ToolbarSep975.Visible := btnOpen.Visible or btnSave.Visible or btnPrint.Visible or
      btnPageSetup.Visible or btnSaveToXLS.Visible;

    btnDesign.Visible := pbDesign in TRMReport(FDoc).PreviewButtons;
    ToolbarSep971.Visible := btnDesign.Visible;

    btnExit.Visible := pbExit in TRMReport(ADoc).PreviewButtons;
    ToolbarSep973.Visible := btnExit.Visible;

    itmPrint.Visible := btnPrint.Visible;
    itmPrintCurrentPage.Visible := btnPrint.Visible;
    if btnSaveToXLS.Visible then
    begin
      lFound := False;
      for i := 0 to RMFiltersCount - 1 do
      begin
        if TRMExportFilter(RMFilters(i).Filter).IsXLSExport then
        begin
          lFound := True;
          Break;
        end;
      end;

      if not lFound then
        btnSaveToXLS.Visible := False;
    end;
  end;

  case TRMReport(ADoc).InitialZoom of
    pzPageWidth: btnPageWidth.Down := TRUE;
    pzOnePage: btnOnePage.Down := TRUE;
  else
    FViewer.LastScale := LastScale;
    FViewer.ZoomMode := LastScaleMode;
    //    btn100.Down := TRUE;
  end;

  btnPrint.Enabled := RMPrinters.Count > 2; // Printer.Printers.Count > 0;

  if btnPageWidth.Down then
    cmbZoom.ItemIndex := 7
  else if btnOnePage.Down then
    cmbZoom.ItemIndex := 8
  else if btn100.Down then
    cmbZoom.ItemIndex := 2
  else if FViewer.FZoomMode = mdTwoPages then
    cmbZoom.ItemIndex := 9
  else
  begin
    cmbZoom.ItemIndex := -1;
    cmbZoom.Text := IntToStr(Round(FViewer.Zoom)) + '%';
  end;

  if TRMReport(ADoc).ModalPreview and (not TRMReport(ADoc).MDIPreview) then
    ShowModal
  else
    Show;
end;

procedure TRMPreviewForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
  with Msg.MinMaxInfo^ do
  begin
    ptMaxSize.x := Screen.Width;
    ptMaxSize.y := Screen.Height;
    ptMaxPosition.x := 0;
    ptMaxPosition.y := 0;
  end;
end;

procedure TRMPreviewForm.btnTopClick(Sender: TObject);
begin
  FViewer.First;
end;

procedure TRMPreviewForm.btnPrevClick(Sender: TObject);
begin
  FViewer.Prev;
end;

procedure TRMPreviewForm.btnNextClick(Sender: TObject);
begin
  FViewer.Next;
end;

procedure TRMPreviewForm.btnLastClick(Sender: TObject);
begin
  FViewer.Last;
end;

procedure TRMPreviewForm.btn100Click(Sender: TObject);
begin
  FViewer.Zoom := 100;
  LastScale := FViewer.LastScale;
  LastScaleMode := FViewer.ZoomMode;
end;

procedure TRMPreviewForm.btnOnePageClick(Sender: TObject);
begin
  FViewer.OnePage;
  LastScale := FViewer.LastScale;
  LastScaleMode := FViewer.ZoomMode;
end;

procedure TRMPreviewForm.bt