ccteditoru.pas

RichView是Delphi下一个很好用的类rtf格式编辑器

  rvActionsResource.rvActionNew1.ExecuteTarget(RichViewEdit1);

  RegCreateKeyEx(HKEY_CLASSES_ROOT, 'RVF.Document', 0, '',
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hk, @ds);
  StrCopy(Buf, 'RVF Document');
  RegSetValueEx(hk, '', 0, REG_SZ, @Buf, StrLen(Buf));
  RegCloseKey(hk);

  RegCreateKeyEx(HKEY_CLASSES_ROOT, 'RVF.Document\DefaultIcon', 0, '',
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hk, @ds);
  S := ParamStr(0)+ ',1';
  StrCopy(Buf, PChar(S));
  RegSetValueEx(hk, '', 0, REG_SZ, @Buf, StrLen(Buf));
  RegCloseKey(hk);

  RegCreateKeyEx(HKEY_CLASSES_ROOT, 'RVF.Document\shell\open\command', 0, '',
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hk, @ds);
  S := ParamStr(0)+ ' "%1"';
  StrCopy(Buf, PChar(S));
  RegSetValueEx(hk, '', 0, REG_SZ, @Buf, StrLen(Buf));
  RegCloseKey(hk);

  RegCreateKeyEx(HKEY_CLASSES_ROOT, '.rvf', 0, '',
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hk, @ds);
  StrCopy(Buf, 'RVF.Document');
  RegSetValueEx(hk, '', 0, REG_SZ, @Buf, StrLen(Buf));
  RegCloseKey(hk);

  RegCreateKeyEx(HKEY_CLASSES_ROOT, '.rvf\ShellNew', 0, '',
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hk, @ds);
  StrCopy(Buf, '');
  RegSetValueEx(hk, 'NullFile', 0, REG_SZ, @Buf, StrLen(Buf)+1);
  RegCloseKey(hk);

  // Loading command line file when double click in Shell
  if ParamCount > 0 then
    rvActionsResource.rvActionOpen1.LoadFile(RichViewEdit1,
       ParamStr(1), ffiRVF);
end;

procedure TCCTEditor.FormShow(Sender: TObject);
begin
  rvActionsResource.ModifyCaption;
  if ParamCount > 0 then
  begin
    RichViewEdit1.LoadRVF(ParamStr(1));
    RichViewEdit1.Format;
  end;
  mitFile.Caption := '&F 文件';
  mitFile.Hint := '打开、保存、关闭文件';
  mitExit.Caption := '&X 退出';
  mitExit.Hint := '退出程序';
  mitEdit.Caption := '&E 编辑';
  mitEdit.Hint := '拷贝、粘贴、删除、查找';
  mitFont.Caption := '&N 字体';
  mitFont.Hint := '字体设置';
  mitPara.Caption := '&P 段落';
  mitPara.Hint := '段落、对齐、间距';
  mitFormat.Caption := '&O 格式';
  mitFormat.Hint := '背景、填充';
  mitInsert.Caption := '&I 插入';
  mitInsert.Hint := '插入对象';
  mitTable.Caption := '&T 表格';
  mitTable.Hint := '表格操作';
  Style1.Caption := '字体风格';
  Style1.Hint := '字体风格菜单';
  Size1.Caption := '字体尺寸';
  Size1.Hint := '设置字体尺寸';
  Select1.Caption := '选择';
  Select1.Hint := '选择表格内容';
  AlignCellContents1.Caption := '对齐单元格';
  AlignCellContents1.Hint := '设置表格单元格对齐方式';
  mitBorders.Caption := '单元格边框';
  mitBorders.Hint := '设置表格单元格边框';
  BackgroundColor1.Caption := '文档背景颜色 ...';
  BackgroundColor1.Hint := '设置文档背景颜色';
  extColor1.Caption := '字体颜色 ...';
  extColor1.Hint := '设置文本颜色';
  extBackgroundColor1.Caption := '背景颜色 ...';
  extBackgroundColor1.Hint := '设置文本背景颜色';
  ParagraphBackgroundColor1.Caption := '段落颜色 ...';
  ParagraphBackgroundColor1.Hint := '设置段落背景颜色';
end;

{------------------- Working with document ------------------------------------}

// When document is created, saved, loaded...
procedure TCCTEditor.rvActionSave1DocumentFileChange(Sender: TObject;
  Editor: TCustomRichViewEdit; const FileName: String;
  FileFormat: TrvFileSaveFilter; IsNew: Boolean);
var s: String;
begin
  s := ExtractFileName(FileName);
  rvActionsResource.rvActionPrint1.Title := s;
  rvActionsResource.rvActionQuickPrint1.Title := s;
  if IsNew then
    s := s+' (*)';
  Caption := s + ' - 文章编辑';
end;

// Prompt for saving...
procedure TCCTEditor.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := rvActionsResource.rvActionSave1.CanCloseDoc(RichViewEdit1);
end;

procedure TCCTEditor.mitExitClick(Sender: TObject);
begin
  Close;
end;

{--------------- Working with color-picking buttons ---------------------------}

// Code for making color-picking buttons pressed while
// a color-picker window is visible.
procedure TCCTEditor.ColorPickerShow(Sender: TObject);
begin
  {$IFDEF RICHVIEWDEF6}
  if (Sender as TAction).ActionComponent is TToolButton then
    TToolButton(TAction(Sender).ActionComponent).Down := True;
  {$ELSE}
  if TrvActionCustomColor(Sender).CallerControl<>nil then
    TToolButton(TrvActionCustomColor(Sender).CallerControl).Down := True;
  {$ENDIF};
end;

procedure TCCTEditor.ColorPickerHide(Sender: TObject);
begin
  {$IFDEF RICHVIEWDEF6}
  if (Sender as TAction).ActionComponent is TToolButton then
    TToolButton(TAction(Sender).ActionComponent).Down := False;
  {$ELSE}
  if TrvActionCustomColor(Sender).CallerControl<>nil then
    TToolButton(TrvActionCustomColor(Sender).CallerControl).Down := False;
  {$ENDIF}
end;

{-------------- Set of events for processing hypertext jumps ------------------}

// Hyperlink click
procedure TCCTEditor.RichViewEdit1Jump(Sender: TObject; id: Integer);
begin
  ShowMessage('vvv');
  //rvActionsResource.rvActionInsertHyperlink1.GoToLink(RichViewEdit1, id);
end;

// Importing hyperlink from RTF
procedure TCCTEditor.RichViewEdit1ReadHyperlink(Sender: TCustomRichView;
  const Target, Extras: String; DocFormat: TRVLoadFormat; var StyleNo,
  ItemTag: Integer; var ItemName: String);
var URL: String;
begin
  URL := rvActionsResource.rvActionInsertHyperlink1.EncodeTarget(Target);
  ItemTag := Integer(StrNew(PChar(URL)));
end;

// Exporting hyperlink to RTF and HTML
procedure TCCTEditor.RichViewEdit1URLNeeded(Sender: TCustomRichView;
  id: Integer; var url: String);
var RVData: TCustomRVFormattedData;
    ItemNo: Integer;
begin
  RichViewEdit1.GetJumpPointLocation(id, RVData, ItemNo);
  url := PChar(RVData.GetItemTag(ItemNo));
end;

{----------------------- Working with combo-boxes -----------------------------}

// Current font is changed. Updating the combo-boxes.
procedure TCCTEditor.RichViewEdit1CurTextStyleChanged(Sender: TObject);
var CurStyle: TFontInfo;
begin
  UpdatingCombos := True;
  try
    CurStyle := RVStyle1.TextStyles[RichViewEdit1.CurTextStyleNo];
    cmbFont.Text := CurStyle.FontName;
    cmbFont.OnClick(Sender);
    cmbFontSize.Text := IntToStr(CurStyle.Size);
  finally
    UpdatingCombos := False;
  end;
end;

// Applying the font name
procedure TCCTEditor.cmbFontClick(Sender: TObject);
var FontName: String;
begin
  if cmbFont.ItemIndex<0 then
    FontName := cmbFont.Text
  else
    FontName := cmbFont.Items[cmbFont.ItemIndex];
  cmbFontSize.FontName := FontName;
  if UpdatingCombos then
    exit;
  if cmbFont.ItemIndex<0 then
    cmbFont.ItemIndex := cmbFont.Items.IndexOf(FontName);
  if cmbFont.ItemIndex<0 then begin
      Beep
    end
  else
    with rvActionsResource.rvActionFontEx1 do begin
      UserInterface := False;
      ValidProperties := [rvfimFontName];
      Font.Name := FontName;
      Execute;
      UserInterface := True;
    end;
  RichViewEdit1.SetFocus;
end;

// Changing the font size
procedure TCCTEditor.cmbFontSizeClick(Sender: TObject);
var FontSize: Integer;
begin
  if UpdatingCombos then
    exit;
  try
    FontSize := StrToInt(cmbFontSize.Text);
    with rvActionsResource.rvActionFontEx1 do begin
      UserInterface := False;
      ValidProperties := [rvfimSize];
      Font.Size := FontSize;
      Execute;
      UserInterface := True;
    end;
  except
    Beep;
  end;
  RichViewEdit1.SetFocus;
end;

procedure TCCTEditor.cmbKeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then begin
    Key := #0;
    TComboBox(Sender).OnClick(Sender);
  end;
end;

{---------------------------- Localization ------------------------------------}

procedure TCCTEditor.Button1Click(Sender: TObject);
begin
  if RVA_ChooseLanguage then
    Localize;
end;

procedure TCCTEditor.Localize;
begin
  // Fonts
  Font.Charset            := RVA_GetCharset;
  StatusBar1.Font.Charset := RVA_GetCharset;
  {$IFDEF RICHVIEWDEF6}
  Screen.HintFont.Charset := RVA_GetCharset;
  Screen.MenuFont.Charset := RVA_GetCharset;
  {$ENDIF}
  // Localizing all actions on rvActionsResource
  RVA_LocalizeForm(rvActionsResource);
  // Localizing all actions on this form
  RVA_LocalizeForm(Self);
  // Localizing menus (not all menus in this demo are translated)
  mitFile.Caption := RVA_GetS(rvam_menu_File);
  mitEdit.Caption := RVA_GetS(rvam_menu_Edit);
  mitFont.Caption := RVA_GetS(rvam_menu_Font);
  mitPara.Caption := RVA_GetS(rvam_menu_Para);
  mitFormat.Caption := RVA_GetS(rvam_menu_Format);
  mitInsert.Caption := RVA_GetS(rvam_menu_Insert);
  mitTable.Caption := RVA_GetS(rvam_menu_Table);
  mitExit.Caption := RVA_GetS(rvam_menu_Exit);
  // In your application, you can use either TrvActionFonts or TrvActionFontEx
  rvActionsResource.rvActionFonts1.Caption := rvActionsResource.rvActionFonts1.Caption+' (Standard)';
  rvActionsResource.rvActionFontEx1.Caption := rvActionsResource.rvActionFontEx1.Caption+' (Advanced)';

//  RVAddictSpell31.UILanguage := GetAddictSpellLanguage(RVA_GetLanguageName);
//  RVThesaurus31.UILanguage := GetAddictThesLanguage(RVA_GetLanguageName);
end;

{--------------------- Support for Gif and Png --------------------------------}

{$IFNDEF RICHVIEWDEF6}
// Workaround for D2-D5 bug
function CreateGraphics(GraphicClass: TGraphicClass): TGraphic;
begin
  if GraphicClass=TBitmap then
    Result := TBitmap.Create
  else if GraphicClass=TMetafile then
    Result := TMetafile.Create
  else if GraphicClass=TIcon then
    Result := TIcon.Create
  else
  {$IFDEF USE_GIFIMAGE}
  if GraphicClass=TGifImage then
    Result := TGifImage.Create
  else
  {$ENDIF}
  {$IFDEF USE_PNGOBJECT}
  if GraphicClass=TPngObject then
    Result := TPngObject.Create
  else
  {$ENDIF}
  Result := GraphicClass.Create;
end;
{$ENDIF}

procedure TCCTEditor.mitFileClick(Sender: TObject);
var
  hURWM: HWND;
  LTP: TPoint;
  URWMR: TRect;
begin
  LTP.X := 3;
  LTP.Y := 3;
  hURWM := WindowFromPoint(LTP);
  GetWindowRect(hURWM, URWMR);
end;

procedure TCCTEditor.mitAboutClick(Sender: TObject);
begin
  AboutW.ShowModal;
end;

initialization

{$IFDEF USE_GIFIMAGE}
  RegisterClasses([TGifImage]);
  // uncomment the line below if Gif does not appear in Insert | Image
  //TPicture.RegisterFileFormat('gif', 'Gif Image', TGifImage);
  RV_RegisterHTMLGraphicFormat(TGifImage);
{$ENDIF}
{$IFDEF USE_PNGOBJECT}
  RegisterClass(TPngObject);
  RV_RegisterHTMLGraphicFormat(TPngObject);
{$ENDIF}
{$IFNDEF RICHVIEWDEF6}
  RV_CreateGraphics := CreateGraphics;
{$ENDIF}


end.