rm_view.pas

report machine 2.3 功能强大

procedure TRMPreview.SetZoom(Value: Double);
begin
  FPer := Value / 100;
  FMode := mdNone;
  LastScale := FPer;
  FLastScaleMode := mdNone;
  OnResizeEvent(nil);
  FPBox.Paint;
  DoStatusChange;
end;

function TRMPreview.GetAllPages: Integer;
begin
  Result := 0;
  if TRMEMFPages(FEMFPages) <> nil then
    Result := TRMEMFPages(FEMFPages).Count;
end;

procedure TRMPreview.SetScrollBars(Value: TScrollStyle);
begin
  FScrollBars := Value;
  FRPanel.Visible := (Value = ssBoth) or (Value = ssVertical);
  FBPanel.Visible := (Value = ssBoth) or (Value = ssHorizontal);
end;

procedure TRMPreview.OnePage;
begin
  FLastScaleMode := mdOnePage;
  FMode := FLastScaleMode;
  OnResizeEvent(nil);
  FPBox.Paint;
  DoStatusChange;
end;

procedure TRMPreview.TwoPages;
begin
  FLastScaleMode := mdTwoPages;
  FMode := FLastScaleMode;
  OnResizeEvent(nil);
  FPBox.Paint;
  DoStatusChange;
end;

procedure TRMPreview.PageWidth;
begin
  FLastScaleMode := mdPageWidth;
  FMode := FLastScaleMode;
  OnResizeEvent(nil);
  FPBox.Paint;
  DoStatusChange;
end;

procedure TRMPreview.First;
begin
  Page := 1;
end;

procedure TRMPreview.Next;
begin
  Page := Page + 1;
end;

procedure TRMPreview.Prev;
begin
  Page := Page - 1;
end;

procedure TRMPreview.Last;
begin
  Page := AllPages;
end;

type
  THackReport = class(TRMReport)
  end;

procedure TRMPreview.Print;
var
  Pages: string;
//  ind: Integer;
  FPrintForm: TRMPrintForm;
begin
  if (FEMFPages = nil) or (RMPrinters.Count = 1) then
    Exit;
//  ind := RMPrinter.PrinterIndex;
  FPrintForm := TRMPrintForm.Create(Application);
  try
    with FPrintForm do
    begin
      UpDown1.Position := TRMReport(FDoc).DefaultCopies;
      chkCollate.Checked := TRMReport(FDoc).DefaultCollate;
      chkTaoda.Checked := TRMReport(FDoc).Taoda;
      THackReport(FDoc).PageSize := -1;
      THackReport(FDoc).Scale := 100;
      if not TRMReport(Doc).ShowPrintDialog or (ShowModal = mrOk) then
      begin
        THackReport(FDoc).FFlag_Taoda := chkTaoda.Checked;
        GetPageInfo(THackReport(FDoc).PageWidth, THackReport(FDoc).PageHeight, THackReport(FDoc).PageSize);
        THackReport(FDoc).Scale := FPrintForm.Scale;
{        if RMPrinter.PrinterIndex <> ind then
        begin
          if TRMReport(FDoc).CanRebuild then
          begin
            if TRMReport(FDoc).ChangePrinter(ind, RMPrinter.PrinterIndex) then
            begin
              TRMEMFPages(FEMFPages).Free;
              FEMFPages := nil;
              TRMReport(FDoc).PrepareReport;
              Connect_1(FDoc);
            end
            else
            begin
              FPrintForm.Free;
              Exit;
            end;
          end;
        end;
}
        if rdbPrintAll.Checked then
          Pages := ''
        else if rbdPrintCurPage.Checked then
          Pages := IntToStr(FCurPage)
        else
          Pages := edtPages.Text;
        ConnectBack;

        TRMReport(FDoc).PrintPreparedReport(Pages, StrToInt(edtCopies.Text), chkCollate.Checked,
          TRMPrintPages(cmbPrintAll.ItemIndex));
//        if RMPrinter.PrinterIndex <> ind then
//        begin
//          TRMReport(FDoc).ChangePrinter(RMPrinter.PrinterIndex, ind)
//        end;
        Connect_1(FDoc);
        RedrawAll(FALSE);
      end;
    end;
  finally
    FPrintForm.Free;
  end;
end;

procedure TRMPreview.PrintCurrentPage; //打印当前页
begin
  if (FEMFPages = nil) or (RMPrinters.Count = 1) then Exit;
  THackReport(FDoc).PageSize := -1;
  ConnectBack;
  TRMReport(FDoc).PrintPreparedReport(IntToStr(Page), 1, TRMReport(FDoc).DefaultCollate,
    rmAll);
  Connect_1(FDoc);
  RedrawAll(FALSE);
end;

procedure TRMPreview.OnPgUpClick(Sender: TObject);
begin
  Page := Page - 1;
end;

procedure TRMPreview.OnPgDnClick(Sender: TObject);
begin
  Page := Page + 1;
end;

procedure TRMPreview.ClearScreen;
begin
  if FEMFPages <> nil then
  begin
    TRMEMFPages(FEMFPages).Free;
    FEMFPages := nil;
  end;
end;

procedure TRMPreview.FindInEMF(emf: TMetafile);
begin
  CurPreview := Self;
  RecordNum := 0;
  EnumEnhMetafile(0, emf.Handle, @EnumEMFRecordsProc, nil, Rect(0, 0, 0, 0));
end;

procedure TRMPreview.FindNext;
var
  EMF: TMetafile;
  EMFCanvas: TMetafileCanvas;
  PageInfo: PRMPageInfo;
  i, nx, ny, ndx, ndy: Integer;
begin
  FStrFound := False;
  while FLastFoundPage < TRMEMFPages(FEMFPages).Count do
  begin
    PageInfo := TRMEMFPages(FEMFPages).Pages[FLastFoundPage];
    EMF := TMetafile.Create;
    EMF.Width := PageInfo.PrnInfo.PgW;
    EMF.Height := PageInfo.PrnInfo.PgH;
    EMFCanvas := TMetafileCanvas.Create(EMF, 0);
    PageInfo.Visible := True;
    TRMEMFPages(FEMFPages).Draw(FLastFoundPage, EMFCanvas,
      Rect(0, 0, PageInfo.PrnInfo.PgW, PageInfo.PrnInfo.PgH));
    EMFCanvas.Free;

    FindInEMF(EMF);
    EMF.Free;
    if FStrFound then
    begin
      FCurPage := FLastFoundPage + 1;
      ShowPageNum;
      nx := PageInfo.r.Left + Round(StrBounds.Left * FPer);
      ny := Round(StrBounds.Top * FPer) + 10;
      ndx := Round((StrBounds.Right - StrBounds.Left) * FPer);
      ndy := Round((StrBounds.Bottom - StrBounds.Top) * FPer);

      if ny > FPBox.Height - ndy then
      begin
        VScrollBar.Position := PageInfo.r.Top + ny - FPBox.Height - 10 + ndy;
        ny := FPBox.Height - ndy;
      end
      else
        VScrollBar.Position := PageInfo.r.Top - 10;

      if nx > FPBox.Width - ndx then
      begin
        HScrollBar.Position := PageInfo.r.Left + nx - FPBox.Width - 10 + ndx;
        nx := FPBox.Width - ndx;
      end
      else
        HScrollBar.Position := PageInfo.r.Left - 10;

      LastFoundObject := RecordNum;
      Application.ProcessMessages;

      FPaintAllowed := True;
      FPBox.Paint;
      with FPBox.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;
//        VScrollBar.Position := PageInfo.r.Top + Round(FStrBounds.Top * Fper) - 10;
//        HScrollBar.Position := PageInfo.r.Left + Round(FStrBounds.Left * Fper) - 10;
//        FLastFoundObject := RecordNum;
//        break;
    end
    else
    begin
      PageInfo.Visible := False;
      TRMEMFPages(FEMFPages).Draw(FLastFoundPage, EMFCanvas,
        Rect(0, 0, PageInfo.PrnInfo.PgW, PageInfo.PrnInfo.PgH));
    end;
    FLastFoundObject := 0;
    Inc(FLastFoundPage);
  end;
end;

procedure TRMPreview.Find;
var
  p: TRMPreviewSearchForm;
begin
  if Doc = nil then Exit;
  FPaintAllowed := False;
  p := TRMPreviewSearchForm.Create(Application);
  with p do
  begin
    if ShowModal = mrOk then
    begin
      FFindStr := edtSearchTxt.Text;
      FCaseSensitive := chkCaseSensitive.Checked;
      if not FCaseSensitive then FFindStr := AnsiUpperCase(FFindStr);
      if rdbFromFirst.Checked then
      begin
        FLastFoundPage := 0;
        FLastFoundObject := 0;
      end
      else if FLastFoundPage <> FCurPage - 1 then
      begin
        FLastFoundPage := FCurPage - 1;
        FLastFoundObject := 0;
      end;
      Free;
      FindNext;
    end;
  end;
  FPaintAllowed := True;
end;

procedure TRMPreview.DlgPageSetup;
var
  tmpForm: TRMPageSetupForm;
  pg: PRMPageInfo;
  pg1: TRMPage;
  i: Integer;
  w, h, p: Integer;
  lOldIndex: Integer;
begin
  if (FEMFPages = nil) or (not TRMReport(Doc).CanRebuild) then Exit;
  lOldIndex := RMPrinter.PrinterIndex;
  pg := TRMEMFPages(FEMFPages)[0]; //TRMReport(Doc).Pages[0];
  tmpForm := TRMPageSetupForm.Create(nil);
  with tmpForm, pg^ do
  begin
    PageSetting.PrinterName := RMPrinters.Printers[RMPrinter.PrinterIndex];
    PageSetting.PrintToDefault := TRMReport(Doc).PrintToDefault;
    PageSetting.DoublePass := TRMReport(Doc).DoublePass;
    PageSetting.Taoda := TRMReport(Doc).Taoda;
    PageSetting.UseMargins := UseMargins;
    PageSetting.MarginLeft := RMRound(RMConvertFromPixels(pgMargins.Left, rmsuMM) / 10, 1);
    PageSetting.MarginTop := RMRound(RMConvertFromPixels(pgMargins.Top, rmsuMM) / 10, 1);
    PageSetting.MarginRight := RMRound(RMConvertFromPixels(pgMargins.Right, rmsuMM) / 10, 1);
    PageSetting.MarginBottom := RMRound(RMConvertFromPixels(pgMargins.Bottom, rmsuMM) / 10, 1);
    PageSetting.PageOr := pgOr;
    PageSetting.PageWidth := pgWidth;
    PageSetting.PageHeight := pgHeight;
    PageSetting.PageBin := pgBin;
    PageSetting.PageSize := pgSize;
    if ShowModal = mrOk then
    begin
      if lOldIndex <> cmbPrinterNames.ItemIndex then
      begin
        TRMReport(Doc).ChangePrinter(RMPrinter.PrinterIndex, cmbPrinterNames.ItemIndex);
        TRMReport(Doc).PrinterName := cmbPrinterNames.Items[cmbPrinterNames.ItemIndex];
      end;

      TRMReport(Doc).PrintToDefault := PageSetting.PrintToDefault;
      TRMReport(Doc).DoublePass := PageSetting.DoublePass;
      UseMargins := PageSetting.UseMargins;
      TRMReport(Doc).Taoda := PageSetting.Taoda;
//      ColCount := PageSetting.ColCount;
//      ColGap := Round(PageSetting.ColGap * 18 / 5);

      pgMargins.Left := Round(RMConvertToPixels(PageSetting.MarginLeft * 10, rmsuMM));
      pgMargins.Top := Round(RMConvertToPixels(PageSetting.MarginTop * 10, rmsuMM));
      pgMargins.Right := Round(RMConvertToPixels(PageSetting.MarginRight * 10, rmsuMM));
      pgMargins.Bottom := Round(RMConvertToPixels(PageSetting.MarginBottom * 10, rmsuMM));

      pgOr := PageSetting.PageOr;
      pgBin := PageSetting.PageBin;
      p := PageSetting.PageSize;
      w := PageSetting.PageWidth;
      h := PageSetting.PageHeight;

      for i := 0 to TRMReport(Doc).Pages.Count - 1 do
      begin
        pg1 := TRMReport(Doc).Pages[i];
        if pg1.PageType = ptReport then
        begin
          pg1.pgMargins := pgMargins;
          pg1.ChangePaper(p, w, h, pg.pgBin, pg.pgOr);
        end;
      end;

      if Assigned(OnAfterPageSetup) then
        OnAfterPageSetup(PageSetting);
      TRMReport(Doc).PrepareReport;
      TRMEMFPages(FEMFPages).Free;
      FEMFPages := nil;
      Connect_1(Doc);
      RedrawAll(True);
    end;
  end;
  tmpForm.Free;
end;

procedure TRMPreview.AddPage;
var
  liPageInfo: PRMPageInfo;
begin
  if FDoc = nil then Exit;

  if FCurPage > TRMEMFPages(FEMFPages).Count then
  	liPageInfo := TRMEMFPages(FEMFPages).Pages[TRMEMFPages(FEMFPages).Count - 1]
  else
  	liPageInfo := TRMEMFPages(FEMFPages).Pages[FCurPage - 1];


  TRMEMFPages(FEMFPages).InsertFromPageInfo(FCurPage - 1, liPageInfo^);
//  TRMEMFPages(FEMFPages).Insert(FCurPage, TRMReport(FDoc).Pages[0]);
  RedrawAll(TRUE);
end;

procedure TRMPreview.DeletePage(PageNo: integer);
begin
  if FDoc = nil then Exit;
  if (PageNo >= 0) and (TRMEMFPages(FEMFPages).Count > 1) then
  begin
    if MessageBox(0, PChar(RMLoadStr(SRemovePg)), PChar(RMLoadStr(SConfirm)),
      mb_YesNo + mb_IconQuestion) = mrYes then
    begin
      TRMEMFPages(FEMFPages).Delete(PageNo);
      RedrawAll(True);
    end;
  end;
end;

procedure TRMPreview.EditPage(PageNo: integer);
begin
  if not CanModify then Exit;
  if (PageNo >= 0) and (PageNo < TRMEMFPages(FEMFPages).Count) then
  begin
    ConnectBack;
    TRMReport(FDoc).EditPreparedReport(PageNo);
    Connect_1(FDoc);
    RedrawAll(FALSE);
  end;
end;

procedure TRMPreview.DesignReport;
begin
  if (not CanModify) or (TRMReport(FDoc) is TRMCompositeReport) then Exit;
  ConnectBack;
  TRMReport(FDoc).DesignPreviewedReport;
  Connect_1(FDoc);
  RedrawAll(FALSE);
end;

procedure TRMPreview.SetAutoScale(Value: Boolean);
begin
  if FAutoScale <> Value then
  begin
    FAutoScale := Value;
  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 DefineCursor(Identifier: PChar): TCursor;
var
  Handle: HCursor;
  i: Integer;
begin
  Handle := LoadCursor(hInstance, Identifier);
  if Handle = 0 then raise EOutOfResources.Create('Cannot load cursor resource');
  for i := 1 to High(TCursor) do
  begin
    if Screen.Cursors[i] = Screen.Cursors[crArrow] then
    begin
      Screen.Cursors[i] := Handle;
      Result := i;
      Exit;
    end;
  end;
  raise EOutOfResources.Create('Too many user-defined cursors');
end;

initialization
  crMagnifier := DefineCursor('RM_MAGNIFIEREH');

end.