rm_richedit.pas

这是一个功能强大

    try
      if aRender then
      begin
        lWidth := mmSaveWidth - mmSaveGapX * 2 - _CalcHFrameWidth(mmSaveFWLeft, mmSaveFWRight);
        lHeight := mmSaveHeight - mmSaveGapY * 2 - _CalcVFrameWidth(mmSaveFWTop, mmSaveFWBottom);
      end
      else
      begin
        lWidth := mmWidth - mmGapLeft * 2 - _CalcHFrameWidth(LeftFrame.mmWidth, RightFrame.mmWidth);
        lHeight := mmHeight - mmGapTop * 2 - _CalcVFrameWidth(TopFrame.mmWidth, BottomFrame.mmWidth);
      end;

      lWidth := Round(RMFromMMThousandths_Printer(lWidth, rmrtHorizontal, lPrinter));
      lHeight := Round(RMFromMMThousandths_Printer(lHeight, rmrtVertical, lPrinter));

      lCanvasRect := Rect(0, 0, lWidth, lHeight);
      lMetaFile.Width := lWidth;
      lMetaFile.Height := lHeight;

      lMetaFileCanvas := TMetaFileCanvas.Create(lMetaFile, lDC);
      lMetaFileCanvas.Brush.Style := bsClear;

      FEndCharPos := FormatRange(lMetaFileCanvas.Handle, lDC, lCanvasRect, lCharRange, aRender);
      FreeAndNil(lMetaFileCanvas);
      if lPrinter.DC = 0 then
        ReleaseDC(0, lDC);

      if aRender then
      begin
        if DocMode = rmdmDesigning then
        begin
          lBitmap := TBitmap.Create;
          lBitmap.Width := RealRect.Right - RealRect.Left + 1;
          lBitmap.Height := RealRect.Bottom - RealRect.Top + 1;
          lBitmap.Canvas.StretchDraw(Rect(0, 0, lBitmap.Width, lBitmap.Height), lMetaFile);
          Canvas.Draw(RealRect.Left, RealRect.Top, lBitmap);
        end
        else
          Canvas.StretchDraw(RealRect, lMetaFile);
      end;
    finally
      FreeAndNil(lMetaFile);
      FreeAndNil(lBitmap);
    end;
  end;

begin
  FEndCharPos := FStartCharPos;
  lCharRange.cpMax := -1;
  lCharRange.cpMin := FEndCharPos;
  if DocMode = rmdmPrinting then
    _ShowRichOnPrinter
  else
    _ShowRichOnScreen;
end;
{$WARNINGS ON}

procedure TRMRichView.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  CalcGaps;
  with aCanvas do
  begin
    ShowBackground;
    FStartCharPos := 0;
    InflateRect(RealRect, -_CalcHFrameWidth(LeftFrame.spWidth, RightFrame.spWidth),
      -_CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth));
    if (spWidth > 0) and (spHeight > 0) then
      ShowRichText(True);
    ShowFrame;
  end;
  RestoreCoord;
end;

procedure TRMRichView.Prepare;
begin
  inherited Prepare;
  FStartCharPos := 0;
end;

procedure TRMRichView.GetMemoVariables;
begin
  if OutputOnly then Exit;

  if DrawMode = rmdmAll then
  begin
    Memo1.Assign(Memo);
    InternalOnBeforePrint(Memo1, Self);
    RMRxAssignRich(SRichEdit, FRichEdit);
    if not TextOnly then
      GetRichData(SRichEdit);

    if (not OutputOnly) and Assigned(OnBeforePrint) then
      OnBeforePrint(Self);
  end;
end;

procedure TRMRichView.PlaceOnEndPage(aStream: TStream);
var
  n: integer;
begin
  BeginDraw(Canvas);
  if not Visible then Exit;

  GetMemoVariables;
  if not Visible then
  begin
    DrawMode := rmdmAll;
    Exit;
  end;

  if DrawMode = rmdmPart then
  begin
    FStartCharPos := FEndCharPos;
    ShowRichText(False);
    n := SRichEdit.GetTextLen - FEndCharPos + 1;
    if n > 0 then
    begin
      SRichEdit.SelStart := FEndCharPos;
      SRichEdit.SelLength := n;
      SRichEdit.SelText := '';
    end;

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

    FSaveCharPos := FEndCharPos;
  end;

  aStream.Write(Typ, 1);
  RMWriteString(aStream, ClassName);
  FUseSRichEdit := True;
  try
    SaveToStream(aStream);
  finally
    FUseSRichEdit := False;
  end;
end;

function TRMRichView.CalcHeight: Integer;
begin
  FEndCharPos := 0;
  FSaveCharPos := 0;
  Result := 0;
  if not Visible then
    Exit;

  CalcGaps;
  DrawMode := rmdmAll;
  GetMemoVariables;
//  DrawMode := rmdmAfterCalcHeight;

  FStartCharPos := 0;
  CalculatedHeight := RMToMMThousandths(spGapTop * 2 + _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth), rmutScreenPixels) +
    DoCalcHeight;
  RestoreCoord;
  Result := CalculatedHeight;
end;

function TRMRichView.RemainHeight: Integer;
begin
  DrawMode := rmdmAll;
  GetMemoVariables;
//  DrawMode := rmdmAfterCalcHeight;

  FStartCharPos := FEndCharPos + 1;
  ActualHeight := RMToMMThousandths(spGapTop * 2 + _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth), rmutScreenPixels) +
    DoCalcHeight;
  Result := ActualHeight;
end;

procedure TRMRichView.LoadFromStream(aStream: TStream);
var
  b: Byte;
  liSavePos: Integer;
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  b := RMReadByte(aStream);
  liSavePos := RMReadInt32(aStream);
  if b > 0 then
    FRichEdit.Lines.LoadFromStream(aStream);
  aStream.Seek(liSavePos, soFromBeginning);
end;

procedure TRMRichView.SaveToStream(aStream: TStream);
var
  b: Byte;
  liSavePos, liPos: Integer;
  liRichEdit: TJvRichEdit;
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  if FUseSRichEdit then
    liRichEdit := SRichEdit
  else
    liRichEdit := FRichEdit;

  if liRichEdit.Lines.Count > 0 then b := 1 else b := 0;
  RMWriteByte(aStream, b);

  liSavePos := aStream.Position;
  RMWriteInt32(aStream, liSavePos);
  if b > 0 then
    liRichEdit.Lines.SaveToStream(aStream);

  liPos := aStream.Position;
  aStream.Seek(liSavePos, soFromBeginning);
  RMWriteInt32(aStream, liPos);
  aStream.Seek(liPos, soFromBeginning);
end;

procedure TRMRichView.GetBlob;
var
  liStream: TMemoryStream;
begin
  liStream := TMemoryStream.Create;
  try
    if not ParentReport.Flag_TableEmpty then
      FDataSet.AssignBlobFieldTo(FDataFieldName, liStream);
    FRichEdit.Lines.LoadFromStream(liStream);
  finally
    liStream.Free;
  end;
end;

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

procedure TRMRichView.DefinePopupMenu(Popup: TRMCustomMenuItem);
begin
  inherited DefinePopupMenu(Popup);
end;

procedure TRMRichView.LoadFromRichEdit(aRichEdit: TJvRichEdit);
begin
  RMRxAssignRich(FRichEdit, aRichEdit);
end;

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

procedure TRMRichView.ClearContents;
begin
  FRichEdit.Clear;
  inherited;
end;

function TRMRichView.GetExportMode: TRMExportMode;
begin
  Result := rmemRtf;
end;

function TRMRichView.GetExportData: string;
var
  lTmp: TMemoryStream;
begin
  lTmp := TMemoryStream.Create;
  try
    FRichEdit.Lines.SaveToStream(lTmp);
    SetLength(Result, lTmp.Size);
    lTmp.Position := 0;
    lTmp.Read(Result[1], lTmp.Size);
  finally
    lTmp.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMRxRichView }

constructor TRMRxRichView.Create;
begin
  inherited Create;
  BaseName := 'RxRich';
end;

destructor TRMRxRichView.Destroy;
begin
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMRxRichForm}

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

//  Caption := RMLoadStr(rmRes + 560);
  RMSetStrProp(btnFileNew, 'Hint', rmRes + 155);
  RMSetStrProp(btnFileOpen, 'Hint', rmRes + 561);
  RMSetStrProp(btnFileSave, 'Hint', rmRes + 562);
  RMSetStrProp(btnUndo, 'Hint', rmRes + 94);
  RMSetStrProp(btnRedo, 'Hint', rmRes + 95);
  RMSetStrProp(btnFind, 'Hint', rmRes + 582);
  RMSetStrProp(btnFontBold, 'Hint', rmRes + 564);
  RMSetStrProp(btnFontItalic, 'Hint', rmRes + 565);
  RMSetStrProp(btnFontUnderline, 'Hint', rmRes + 569);
  RMSetStrProp(btnAlignLeft, 'Hint', rmRes + 566);
  RMSetStrProp(btnAlignCenter, 'Hint', rmRes + 567);
  RMSetStrProp(btnAlignRight, 'Hint', rmRes + 568);
  RMSetStrProp(btnBullets, 'Hint', rmRes + 570);
  RMSetStrProp(btnInsertField, 'Hint', rmRes + 575);
  RMSetStrProp(btnCut, 'Hint', rmRes + 91);
  RMSetStrProp(btnCopy, 'Hint', rmRes + 92);
  RMSetStrProp(btnPaste, 'Hint', rmRes + 93);
  RMSetStrProp(btnSuperscript, 'Hint', rmRes + 580);
  RMSetStrProp(btnSubscript, 'Hint', rmRes + 581);

  ItmCut.Caption := btnCut.Hint;
  ItmCopy.Caption := btnCopy.Hint;
  ItmPaste.Caption := btnPaste.Hint;
  RMSetStrProp(MenuFile, 'Caption', rmRes + 154);
  RMSetStrProp(ItemFileNew, 'Caption', rmRes + 155);
  RMSetStrProp(ItemFileOpen, 'Caption', rmRes + 156);
  RMSetStrProp(ItemFileSaveAs, 'Caption', rmRes + 188);
  RMSetStrProp(ItemFilePrint, 'Caption', rmRes + 159);
  RMSetStrProp(ItemFileExit, 'Caption', rmRes + 162);
  RMSetStrProp(MenuEdit, 'Caption', rmRes + 163);
  RMSetStrProp(ItemEditUndo, 'Caption', rmRes + 164);
  RMSetStrProp(ItemEditRedo, 'Caption', rmRes + 165);
  RMSetStrProp(ItemEditCut, 'Caption', rmRes + 166);
  RMSetStrProp(ItemEditCopy, 'Caption', rmRes + 167);
  RMSetStrProp(ItemEditPaste, 'Caption', rmRes + 168);
  RMSetStrProp(ItemEditPasteSpecial, 'Caption', rmRes + 572);
  RMSetStrProp(ItemEditSelectAll, 'Caption', rmRes + 170);
  RMSetStrProp(ItemEditFind, 'Caption', rmRes + 582);
  RMSetStrProp(ItemEditFindNext, 'Caption', rmRes + 583);
  RMSetStrProp(ItemEditReplace, 'Caption', rmRes + 584);
  RMSetStrProp(ItemEditObjProps, 'Caption', rmRes + 585);
  RMSetStrProp(MenuInsert, 'Caption', rmRes + 586);
  RMSetStrProp(ItemInserObject, 'Caption', rmRes + 587);
  RMSetStrProp(ItemInsertPicture, 'Caption', rmRes + 588);
  RMSetStrProp(ItemInsertField, 'Caption', rmRes + 575);
  RMSetStrProp(MenuFormat, 'Caption', rmRes + 589);
  RMSetStrProp(ItemFormatFont, 'Caption', rmRes + 576);
  RMSetStrProp(ItemFormatParagraph, 'Caption', rmRes + 852);

  btnOK.Hint := RMLoadStr(rmRes + 573);
  btnCancel.Hint := RMLoadStr(rmRes + 574);
end;

procedure TRMRichForm.FocusEditor;
begin
  with Editor do
  begin
    if CanFocus then
      SetFocus;
  end;
end;

procedure TRMRichForm.SelectionChange(Sender: TObject);
var
  lFont: TFont;
  lFontHeight: Integer;
begin
  with Editor.Paragraph do
  begin
    try
      FUpdating := True;
      FRuler.UpdateInd;
      BtnFontBold.Down := fsBold in CurrText.Style;
      BtnFontItalic.Down := fsItalic in CurrText.Style;
      BtnFontUnderline.Down := fsUnderline in CurrText.Style;
      BtnBullets.Down := Boolean(Numbering);
      BtnSuperscript.Down := CurrText.SubscriptStyle = ssSuperscript;
      BtnSubscript.Down := CurrText.SubscriptStyle = ssSubscript;

      lFont := TFont.Create;
      lFont.Size := CurrText.Size;
      lFontHeight := lFont.Height;
      lFont.Free;
      RMSetFontSize(TComboBox(FCmbFontSize), lFontHeight, CurrText.Size);

      FCmbFont.FontName := CurrText.Name;
      case Ord(Alignment) of
        0: BtnAlignLeft.Down := True;
        1: BtnAlignRight.Down := True;
        2: BtnAlignCenter.Down := True;
      end;
      UpdateCursorPos;
    finally
      FUpdating := False;
    end;
  end;
end;

function TRMRichForm.CurrText: TJvTextAttributes;
begin
  if Editor.SelLength > 0 then
    Result := Editor.SelAttributes
  else
    Result := Editor.WordAttributes;
end;

procedure TRMRichForm.SetFileName(const FileName: string);
begin
  FFileName := FileName;
  Editor.Title := ExtractFileName(FileName);
end;

procedure TRMRichForm.SetEditRect;
var
  R: TRect;
  Offs: Integer;
begin
  with Editor do
  begin
    if SelectionBar then
      Offs := 3
    else
      Offs := 0;
    R := Rect(GutterWid + Offs, 0, ClientWidth - GutterWid, ClientHeight);
    SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  end;
end;

{ Event Handlers }

procedure TRMRichForm.FormCreate(Sender: TObject);
var
  i, liOffset: Integer;
  s, s1: string;
begin
  Localize;
  Editor := TJvRichEdit.Create(Self);
  with Editor do
  begin
    Parent := Self;
    Align := alClient;
    HideSelection := False;
    Editor.PopupMenu := Self.EditPopupMenu;
    WantTabs := False;
    ScrollBars := ssBoth;

    OnTextNotFound := EditorTextNotFound;
    OnSelectionChange := SelectionChange;
    OnProtectChange := EditorProtectChange;
    OnChange := RichEditChange;
  end;

  FcmbFont := TRMFontComboBox.Create(ToolBar2);
  with FcmbFont do
  begin
    Parent := ToolBar2;
    Left := 0;
    Top := 0;
    Height := 21;
    Width := 150;
    Tag := 7;
//    Device := rmfdPrinter;
    OnChange := OnCmbFontChange;
  end;
  FcmbFontSize := TComboBox.Create(ToolBar2);
  with FcmbFontSize do
  begin
    Parent := ToolBar2;
    Left := 150;
    Top := 0;
    Height := 21;
    Width := 59;
    Tag := 8;
    DropDownCount := 12;
    if RMIsChineseGB then
      liOffset := 0
    else
      liOffset := 13;
    for i := Low(RMDefaultFontSizeStr) + liOffset to High(RMDefaultFontSizeStr) do
      Items.Add(RMDefaultFontSizeStr[i]);
    OnChange := OnCmbFontSizeChange;
  end;
  FBtnFontColor := TRMColorPickerButton.Create(ToolBar2);
  with FBtnFontColor do
  begin
    Parent := ToolBar2;
    Left := ToolButton18.Left + ToolButton18.Width;
    Top := 0;
    ColorType := rmptFont;
    OnColorChange := OnColorChangeEvent;
  end;
  FBtnBackColor := TRMColorPickerButton.Create(ToolBar2);
  with FBtnBackColor do
  begin
    Parent := ToolBar2;
    Left := FBtnFontColor.Left + FBtnFontColor.Width;
    Top := 0;
    ColorType := rmptFill;
    OnColorChange := OnColorChangeEvent;
  end;

  FRuler := TRMRuler.Create(Self);
  with FRuler do
  begin
    Top := ToolBar2.Top + ToolBar2.Height;
    RichEdit := TCustomRichEdit(Editor);
    Align := alTop;
    Height := 26;
    OnIndChanged := SelectionChange;
  end;

  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;