rm_wwrtf.pas

report machine 2.3 功能强大

  FcmbFont := TRMFontComboBox.Create(ToolBar2);
  with FcmbFont do
  begin
    Parent := ToolBar2;
    Left := 0;
    Top := 0;
    Height := 21;
    Width := 150;
    Tag := 7;
    UseFonts := TRUE;
//    Device := rmfdPrinter;
    OnChange := OnCmbFontChange;
  end;
  FcmbFontSize := TRMComboBox.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;

{$IFDEF OPENPICTUREDLG}
//  Editor.OnCloseFindDialog := EditFindDialogClose;
  FOpenPictureDialog := TOpenPictureDialog.Create(Self);
{$ELSE}
  FOpenPictureDialog := TOpenDialog.Create(Self);
{$ENDIF}

  s := '*.bmp *.ico *.wmf *.emf';
  s1 := '*.bmp;*.ico;*.wmf;*.emf';
{$IFDEF JPEG}
  s := s + ' *.jpg';
  s1 := s1 + ';*.jpg';
{$ENDIF}
{$IFDEF RXGIF}
  s := s + ' *.gif';
  s1 := s1 + ';*.gif';
{$ENDIF}
  FOpenPictureDialog.Filter := RMLoadStr(SPictFile) + ' (' + s + ')|' + s1 + '|' + RMLoadStr(SAllFiles) + '|*.*';

  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;
  SetFileName('Untitled');
  HandleNeeded;
end;

procedure TRMwwRichForm.PerformFileOpen(const AFileName: string);
begin
  try
    Editor.Lines.LoadFromFile(AFileName);
  finally
  end;
  SetFileName(AFileName);
  Editor.SetFocus;
  Editor.Modified := False;
  SetModified(False);
end;

procedure TRMwwRichForm.UpdateCursorPos;
var
  CharPos: TPoint;
begin
  CharPos := Editor.CaretPos;
  StatusBar.Panels[0].Text := Format('行: %3d  列: %3d', [CharPos.Y + 1, CharPos.X + 1]);
  BtnCopy.Enabled := Editor.SelLength > 0;
  ItemEditCopy.Enabled := BtnCopy.Enabled;
  ItmCopy.Enabled := BtnCopy.Enabled;
  BtnCut.Enabled := ItemEditCopy.Enabled;
  ItmCut.Enabled := btnCut.Enabled;
  ItemEditCut.Enabled := ItemEditCopy.Enabled;
end;

procedure TRMwwRichForm.FormShow(Sender: TObject);
begin
  UpdateCursorPos;
  RichEditChange(nil);
  SetModified(FALSE);
  RefreshControls;
  FocusEditor;
end;

procedure TRMwwRichForm.RichEditChange(Sender: TObject);
begin
  SetModified(Editor.Modified);
  { Undo }
  BtnUndo.Enabled := Editor.CanUndo;
  ItemEditUndo.Enabled := btnUndo.Enabled;
  { Redo }
  ItemEditRedo.Enabled := Editor.CanRedo;
  btnRedo.Enabled := ItemEditRedo.Enabled;
end;

procedure TRMwwRichForm.SetModified(Value: Boolean);
begin
  if Value then
    StatusBar.Panels[1].Text := '修改'
  else
    StatusBar.Panels[1].Text := '';
end;

procedure TRMwwRichForm.FormDestroy(Sender: TObject);
begin
  FRuler.Free;
end;

procedure TRMwwRichForm.EditSelectAll(Sender: TObject);
begin
  Editor.SelectAll;
end;

procedure TRMwwRichForm.btnFileNewClick(Sender: TObject);
begin
  SetFileName('Untitled');
  try
    Editor.Lines.Clear;
    Editor.Modified := False;
    Editor.ReadOnly := False;
    SetModified(False);
    with Editor do
    begin
      DefAttributes.Assign(Font);
      SelAttributes.Assign(Font);
    end;
  finally
  end;
end;

procedure TRMwwRichForm.btnFileOpenClick(Sender: TObject);
begin
  OpenDialog.Filter := RMLoadStr(SRTFFile) + '(*.rtf)|*.rtf' + '|' +
    RMLoadStr(STextFile) + '(*.txt)|*.txt';
  if OpenDialog.Execute then
  begin
    PerformFileOpen(OpenDialog.FileName);
    Editor.ReadOnly := ofReadOnly in OpenDialog.Options;
  end;
end;

procedure TRMwwRichForm.btnFileSaveClick(Sender: TObject);
begin
  if FFileName = 'Untitled' then
    ItemFileSaveAs.Click
  else
  begin
    Editor.Lines.SaveToFile(FFileName);
    Editor.Modified := False;
    SetModified(False);
    RichEditChange(nil);
  end;
end;

procedure TRMwwRichForm.btnFindClick(Sender: TObject);
begin
  Editor.ExecuteFindDialog;
end;

procedure TRMwwRichForm.btnCutClick(Sender: TObject);
begin
  Editor.CutToClipboard;
end;

procedure TRMwwRichForm.btnCopyClick(Sender: TObject);
begin
  Editor.CopyToClipboard;
end;

procedure TRMwwRichForm.btnPasteClick(Sender: TObject);
begin
  Editor.PasteFromClipboard;
end;

procedure TRMwwRichForm.btnUndoApplyAlign(Sender: TObject; Align: TAlign;
  var Apply: Boolean);
begin
  Editor.Undo;
  RichEditChange(nil);
end;

procedure TRMwwRichForm.btnRedoClick(Sender: TObject);
begin
  SendMessage(Editor.Handle, EM_REDO, 0, 0);
  RefreshControls;
end;

procedure TRMwwRichForm.btnFontBoldClick(Sender: TObject);
begin
  Editor.SetStyleAttribute(fsBold, not TempDown);
  RefreshControls;
end;

procedure TRMwwRichForm.btnFontItalicClick(Sender: TObject);
begin
  Editor.SetStyleAttribute(fsItalic, not TempDown);
  RefreshControls;
end;

procedure TRMwwRichForm.btnFontUnderlineClick(Sender: TObject);
begin
  Editor.SetStyleAttribute(fsUnderline, not TempDown);
  RefreshControls;
end;

procedure TRMwwRichForm.btnAlignLeftClick(Sender: TObject);
begin
  Editor.Paragraph.Alignment := TAlignment(TComponent(Sender).Tag);
  RefreshControls;
end;

procedure TRMwwRichForm.btnBulletsClick(Sender: TObject);
begin
  Editor.SetBullet(not TempDown);
  RefreshControls;
end;

procedure TRMwwRichForm.btnBulletsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  tempdown := TToolButton(Sender).down;
end;

procedure TRMwwRichForm.ItemFileSaveAsClick(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    Editor.Lines.SaveToFile(SaveDialog.FileName);
    SetFileName(SaveDialog.FileName);
    Editor.Modified := False;
    SetModified(False);
    RichEditChange(nil);
  end;
  FocusEditor;
end;

procedure TRMwwRichForm.ItemFilePrintClick(Sender: TObject);
begin
  if PrintDialog.Execute then
    Editor.Print(FFileName);
end;

procedure TRMwwRichForm.ItemFileExitClick(Sender: TObject);
begin
  Close;
end;

procedure TRMwwRichForm.ItemFormatFontClick(Sender: TObject);
begin
  Editor.ExecuteFontDialog;
  RefreshControls;
end;

procedure TRMwwRichForm.ItemInserObjectClick(Sender: TObject);
begin
  Editor.InsertObjectDialog;
end;

procedure TRMwwRichForm.btnUndoClick(Sender: TObject);
begin
  SendMessage(Editor.Handle, EM_UNDO, 0, 0);
  RefreshControls;
end;

procedure TRMwwRichForm.ItemEditFindNextClick(Sender: TObject);
begin
  Editor.FindNextMatch;
end;

procedure TRMwwRichForm.ItemEditReplaceClick(Sender: TObject);
begin
  Editor.ExecuteReplaceDialog;
end;

procedure TRMwwRichForm.btnInsertFieldClick(Sender: TObject);
var
  s: string;
begin
  if RMDesigner <> nil then
  begin
    s := RMDesigner.InsertExpression;
    if s <> '' then
      Editor.SelText := s;
  end;
end;

procedure TRMwwRichForm.ItemEditSelectAllClick(Sender: TObject);
begin
  Editor.SelectAll;
end;

procedure TRMwwRichForm.OnCmbFontChange(Sender: TObject);
var
  Format: TCharFormat;
begin
  if Editor.selAttributes.Name = FCmbFont.FontName then
    exit;
  FillChar(Format, SizeOf(TCharFormat), 0);
  Format.cbSize := SizeOf(TCharFormat);
  with Format do
  begin
    dwMask := CFM_FACE or CFM_CHARSET;
    StrPLCopy(szFaceName, FCmbFont.FontName, SizeOf(szFaceName));
    bCharSet := Editor.GetCharSetOfFontName(FCmbFont.FontName);
  end;
  SendMessage(Editor.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format));
end;

procedure TRMwwRichForm.OnCmbFontSizeChange(Sender: TObject);
begin
  Editor.SelAttributes.Size := RMGetFontSize(TComboBox(FCmbFontSize));
  Editor.SetFocus;
  RefreshControls;
end;

procedure TRMwwRichForm.btnOKClick(Sender: TObject);
begin
  OnResize := nil;
  ModalResult := mrOK;
end;

procedure TRMwwRichForm.btnCancelClick(Sender: TObject);
begin
  OnResize := nil;
  ModalResult := mrCancel;
end;

procedure TRMwwRichForm.ItemInsertPictureClick(Sender: TObject);
var
  Pict: TPicture;
begin
  with FOpenPictureDialog do
  begin
    if Execute then
    begin
      Pict := TPicture.Create;
      try
        Pict.LoadFromFile(FileName);
        Clipboard.Assign(Pict);
        Editor.PasteFromClipboard;
      finally
        Pict.Free;
      end;
    end;
  end;
end;

procedure TRMwwRichForm.FormResize(Sender: TObject);
begin
  SelectionChange(Sender);
end;

procedure TRMwwRichForm.OnColorChangeEvent(Sender: TObject);
begin
  if Sender = FBtnFontColor then
    Editor.SelAttributes.Color := FBtnFontColor.CurrentColor
  else
  begin
    Editor.SetTextBackgroundColor(FBtnBackColor.CurrentColor);
    RefreshControls;
  end;
end;

procedure TRMwwRichForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  OnResize := nil;
end;

procedure TRMwwRichForm.btnSubscriptClick(Sender: TObject);
begin
  if FUpdating then
    Exit;
  if btnSuperscript.Down then
    RMSetSubscriptStyle(Editor, rmssSuperscript)
  else if btnSubscript.Down then
    RMSetSubscriptStyle(Editor, rmssSubscript)
  else
    RMSetSubscriptStyle(Editor, rmssNone);
end;

initialization
  RMRegisterObjectByRes(TRMWWRichView, 'RM_WWRichObject', RMLoadStr(SInsWwRichObject), nil);

finalization
  if Assigned(RMDialogForm) and Assigned(FRichEdit) then
  begin
    FRichEdit.Free; FRichEdit := nil;
  end;

{$ENDIF}
end.