rm_rich.pas

report machine 2.3 功能强大

    HighDY := 1000000;
    while HighDy - LowDy > 1 do
    begin
      NewDY := LowDy + (HighDy - LowDy) div 2;
      rc := Rect(0, 0, Round((DX - GapX * 2) * 1440 / LogX), Round(NewDY * 1440.0 / LogY));
      rcPage := rc;
      LastChar := FCharFrom;
      MaxLen := SRichEdit.GetTextLen;
      chrg.cpMax := -1;
      repeat
        chrg.cpMin := LastChar;
        LastChar := SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range));
        Fit := (LastChar >= MaxLen) or (LastChar = -1) or (LastChar = 0);
        StopRender := ((LastChar < MaxLen) and (LastChar <> -1)) or Fit;
      until StopRender;

      if Fit then
        HighDy := NewDY
      else
        LowDy := NewDY;
    end;
    ReleaseDC(0, hdc);
  end;
  SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
  if HighDy < 2 then
    HighDy := 8;
  Result := HighDy + 2 * GapY;
end;

{$WARNINGS OFF}

procedure TRMRichView.ShowRich(Render: Boolean);
var
  Range: TFormatRange;
  LogX, LogY, mm: Integer;
  EMF: TMetafile;
  EMFCanvas: TMetafileCanvas;
  BMP: TBitmap;
  re: TRichEdit;
begin
  if Render then
    re := RichEdit
  else
    re := SRichEdit;
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Range do
  begin
    if Render then
      hdc := Canvas.Handle
    else
      hdc := GetDC(0);
    if Render then
    begin
      if IsPrinting then
      begin
        if FillColor = clNone then
          SetBkMode(hdc, Transparent);
        LogX := GetDeviceCaps({RMPrinter.Canvas.Handle} hdc, LOGPIXELSX);
        LogY := GetDeviceCaps({RMPrinter.Canvas.Handle} hdc, LOGPIXELSY);
        rc := Rect(DRect.Left * 1440 div LogX, DRect.Top * 1440 div LogY,
          DRect.Right * 1440 div LogX, DRect.Bottom * 1440 div LogY);
      end
      else
      begin
        LogX := Screen.PixelsPerInch;
        LogY := LogX;
        rc := Rect(0, 0, Round((SaveDX - SaveGX * 2) * 1440 / LogX),
          Round((SaveDY - SaveGY * 2) * 1440 / LogY));

        EMF := TMetafile.Create;
        EMF.Width := SaveDX - SaveGX * 2;
        EMF.Height := SaveDY - SaveGY * 2;
        EMFCanvas := TMetafileCanvas.Create(EMF, 0);
        EMFCanvas.Brush.Style := bsClear;
        hdc := EMFCanvas.Handle;
      end;
    end
    else
    begin
      LogX := Screen.PixelsPerInch;
      LogY := LogX;
      rc := Rect(0, 0, Round((DX - GapX * 2) * 1440 / LogX),
        Round((DY - GapY * 2) * 1440 / LogY));
    end;

    hdcTarget := hdc;
    rcPage := rc;
    FLastChar := FCharFrom;
    chrg.cpMax := -1;
    chrg.cpMin := FLastChar;
    mm := SetMapMode(hdc, MM_TEXT);
    FLastChar := re.Perform(EM_FORMATRANGE, Integer(Render), Integer(@Range));
    SetMapMode(hdc, mm);
  end;

  re.Perform(EM_FORMATRANGE, 0, 0);
  if not Render then
    ReleaseDC(0, Range.hdc)
  else if not IsPrinting then
  begin
    EMFCanvas.Free;
    if DocMode <> dmDesigning then
      Canvas.StretchDraw(DRect, EMF)
    else
    begin
      BMP := TBitmap.Create;
      BMP.Width := DRect.Right - DRect.Left + 1;
      BMP.Height := DRect.Bottom - DRect.Top + 1;
      BMP.Canvas.StretchDraw(Rect(0, 0, BMP.Width, BMP.Height), EMF);
      Canvas.Draw(DRect.Left, DRect.Top, BMP);
      BMP.Free;
    end;
    EMF.Free;
  end;
end;

{$WARNINGS ON}

procedure TRMRichView.Draw(Canvas: TCanvas);
begin
  BeginDraw(Canvas);
  CalcGaps;
  with Canvas do
  begin
    ShowBackground;
    InflateRect(DRect, -gapx, -gapy);
    FCharFrom := 0;
    if (dx > 0) and (dy > 0) then
      ShowRich(True);
    ShowFrame;
  end;
  RestoreCoord;
end;

procedure TRMRichView.StreamOut(Stream: TStream);
var
  SaveTag: string;
  n: integer;
begin
  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  RMInterpretator.DoScript(Script);
  if not Visible then
    Exit;

  SaveTag := Tag;
  if (Tag <> '') and (Pos('[', Tag) <> 0) then
    ExpandVariables(Tag);

  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  if DrawMode = drPart then
  begin
    FCharFrom := FLastChar;
    ShowRich(False);
    n := SRichEdit.GetTextLen - FLastChar + 1;
    if n > 0 then
    begin
      SRichEdit.SelStart := FLastChar;
      SRichEdit.SelLength := n;
      SRichEdit.SelText := '';
    end;

    SRichEdit.SelStart := 0;
    SRichEdit.SelLength := FCurChar;
    SRichEdit.SelText := '';

    FCurChar := FLastChar;
  end;

  Stream.Write(Typ, 1);
  RMWriteString(Stream, ClassName);
  FFlag := True;
  SaveToStream(Stream);
  FFlag := False;

  RMInterpretator.DoScript(Script_AfterPrint);
  Tag := SaveTag;
end;

function TRMRichView.CalcHeight: Integer;
begin
  FLastChar := 0;
  FCurChar := 0;
  Result := 0;
  RMInterpretator.DoScript(Script);
  if not Visible then
    Exit;

  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  RMInterpretator.DoScript(Script_AfterPrint);
  FCharFrom := 0;
  Result := DoCalcHeight;
end;

function TRMRichView.MinHeight: Integer;
begin
  Result := 8;
end;

function TRMRichView.LostSpace: Integer;
var
  n, lc, cc: Integer;
begin
  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  lc := FLastChar;
  cc := FCurChar;
  FCharFrom := 0;

  SRichEdit.SelStart := 0;
  SRichEdit.SelLength := FLastChar;
  SRichEdit.SelText := '';

  ShowRich(False);
  n := SRichEdit.GetTextLen - FLastChar + 1;
  if n > 0 then
  begin
    SRichEdit.SelStart := FLastChar;
    SRichEdit.SelLength := n;
    SRichEdit.SelText := '';
  end;

  FCharFrom := 0;
//  Result := Round(Abs(dy - DoCalcHeight)) + gapy * 2 + Round(FrameWidth * 2);
  Result := 0;
  FLastChar := lc;
  FCurChar := cc;
end;

function TRMRichView.RemainHeight: Integer;
begin
  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  AssignRich(SRichEdit, RichEdit);
  if (Flags and flTextOnly) = 0 then
    GetRichData(SRichEdit);

  FCharFrom := FLastChar;
  Result := DoCalcHeight;
end;

procedure TRMRichView.LoadFromStream(Stream: TStream);
var
  b: Byte;
  n: Integer;
begin
  inherited LoadFromStream(Stream);
  Stream.Read(b, 1);
  Stream.Read(n, 4);
  if b <> 0 then
    RichEdit.Lines.LoadFromStream(Stream);
  Stream.Seek(n, soFromBeginning);
end;

procedure TRMRichView.SaveToStream(Stream: TStream);
var
  b: Byte;
  n, o: Integer;
  re: TRichEdit;
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  re := RichEdit;
  if FFlag then
    re := SRichEdit;
  b := 0;
  if re.Lines.Count <> 0 then
    b := 1;
  Stream.Write(b, 1);
  n := Stream.Position;
  Stream.Write(n, 4);
  if b <> 0 then
    re.Lines.SaveToStream(Stream);
  o := Stream.Position;
  Stream.Seek(n, soFromBeginning);
  Stream.Write(o, 4);
  Stream.Seek(0, soFromEnd);
end;

procedure TRMRichView.GetBlob(b: TField);
var
  s: TMemoryStream;
begin
  s := TMemoryStream.Create;
  if not Flag_TableEmpty then
    RMAssignBlobTo(b, s);
  RichEdit.Lines.LoadFromStream(s);
  s.Free;
end;

procedure TRMRichView.ShowEditor;
var
  tmpForm: TRMRichForm;
begin
  tmpForm := TRMRichForm.Create(Application);
  try
    AssignRich(tmpForm.Editor, RichEdit);
    if tmpForm.ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
      AssignRich(RichEdit, tmpForm.Editor);
      RMDesigner.AfterChange;
    end;
  finally
    tmpForm.Free;
  end;
end;

procedure TRMRichView.RichEditor(Sender: TObject);
begin
  ShowEditor;
end;

procedure TRMRichView.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  inherited DefinePopupMenu(Popup);
  m := TMenuItem.Create(Popup);
  m.Caption := RMLoadStr(STextOnly);
  m.OnClick := P1Click;
  m.Checked := (Flags and flTextOnly) <> 0;
  Popup.Items.Add(m);
end;

procedure TRMRichView.P1Click(Sender: TObject);
var
  i: Integer;
  t: TRMView;
begin
  RMDesigner.BeforeChange;
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    for i := 0 to RMDesigner.Page.Objects.Count - 1 do
    begin
      t := RMDesigner.Page.Objects[i];
      if t.Selected then
        t.Flags := (t.Flags and not flTextOnly) + Word(Checked) * flTextOnly;
    end;
  end;
  RMDesigner.AfterChange;
end;

function TRMRichView.GetViewCommon: string;
begin
  Result := '[Rich]';
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMRichForm}

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

//  Caption := RMLoadStr(rmRes + 560);
  btnFileOpen.Hint := RMLoadStr(rmRes + 561);
  btnFileSave.Hint := RMLoadStr(rmRes + 562);
  btnFilePrint.Hint := RMLoadStr(rmRes + 159);
  btnUndo.Hint := RMLoadStr(rmRes + 563);
  btnCut.Hint := RMLoadStr(rmRes + 91);
  btnCopy.Hint := RMLoadStr(rmRes + 92);
  btnPaste.Hint := RMLoadStr(rmRes + 93);
  btnFontBold.Hint := RMLoadStr(rmRes + 564);
  btnFontItalic.Hint := RMLoadStr(rmRes + 565);
  btnFontUnderline.Hint := RMLoadStr(rmRes + 569);
  btnAlignLeft.Hint := RMLoadStr(rmRes + 566);
  btnAlignCenter.Hint := RMLoadStr(rmRes + 567);
  btnAlignRight.Hint := RMLoadStr(rmRes + 568);
  btnBullets.Hint := RMLoadStr(rmRes + 570);
  btnFont.Hint := RMLoadStr(rmRes + 571);
  btnOK.Hint := RMLoadStr(rmRes + 573);
  btnCancel.Hint := RMLoadStr(rmRes + 574);
  btnInsertField.Hint := RMLoadStr(rmRes + 575);

  FileMenu.Caption := RMLoadStr(rmRes + 154);
  FileNewItem.Caption := RMLoadStr(rmRes + 155);
  FileOpenItem.Caption := RMLoadStr(rmRes + 156);
  FileSaveAsItem.Caption := RMLoadStr(rmRes + 188);
  FileExitItem.Caption := RMLoadStr(rmRes + 162);
  EditMenu.Caption := RMLoadStr(rmRes + 163);
  EditUndoItem.Caption := RMLoadStr(rmRes + 164);
  EditCutItem.Caption := RMLoadStr(rmRes + 166);
  EditCopyItem.Caption := RMLoadStr(rmRes + 167);
  EditPasteItem.Caption := RMLoadStr(rmRes + 168);
  EditInsertFieldItem.Caption := RMLoadStr(rmRes + 575);
  EditFontItem.Caption := RMLoadStr(rmRes + 576);
  btnSuperscript.Hint := RMLoadStr(rmRes + 580);