{*******************************************************} { } { RichView } { Editor Demo. } { RichView components. } { } { Copyright (c) Sergey Tkachenko } { svt@trichview.com } { http://www.trichview.com } { } {*******************************************************} { This demo uses a predefined set of styles. This demo shows how to implement: - "Edit" menu (Clipboard and Undo); - "Search" command; - checkpoints; - print preview; - inserting document or image; - inserting some controls; - working with TOleContainer; - working with table; - changing background properties and other options. It does not implement: - commands like "make bold" or "apply font"; - standard "File" commands (Open, Save, SaveAs. (see Editor 2 demo for these features) } unit Unit1; interface {$I RV_Defs.inc} uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, RVStyle, RVScroll, RichView, RVEdit, PtblRV, RVMisc, CtrlImg, RVUndoStr, RVUni, jpeg, ImgList, Clipbrd, StdCtrls, ExtCtrls, ComCtrls, Menus, OleCtnrs, RVTable, Buttons, CRVData, CRVFData, RVERVData, RVItem, RVFuncs, RVTypes; type TForm1 = class(TForm) RichViewEdit1: TRichViewEdit; StatusBar1: TStatusBar; MainMenu1: TMainMenu; mpdInsert: TMenuItem; mitPicture: TMenuItem; mpdComponent: TMenuItem; mitButtonComp: TMenuItem; mitEditBoxComp: TMenuItem; mitBreak: TMenuItem; OpenDialog1: TOpenDialog; Panel1: TPanel; cmbText: TComboBox; cmbPara: TComboBox; mpdFile: TMenuItem; N1: TMenuItem; mitExit: TMenuItem; mpdBullet: TMenuItem; mitHelpIcon: TMenuItem; mitHelpSearchIcon: TMenuItem; mitPropertiesIcon: TMenuItem; mitSave: TMenuItem; SaveDialog1: TSaveDialog; N2: TMenuItem; mitClear: TMenuItem; mpdEdit: TMenuItem; mitCopy: TMenuItem; mitPaste: TMenuItem; mitCut: TMenuItem; mitDelete: TMenuItem; PasteAs1: TMenuItem; mitPasteAsText: TMenuItem; mitPasteAsMetafile: TMenuItem; mitPasteAsBitmap: TMenuItem; mitPasteAsRVF: TMenuItem; N3: TMenuItem; mitEditCheckpoint: TMenuItem; mitEditProps: TMenuItem; PopupMenu1: TPopupMenu; mitEditProp1: TMenuItem; mitEditCheckpoint1: TMenuItem; mpdHotspot: TMenuItem; mitAddImageHS: TMenuItem; mitAddTextHS: TMenuItem; mitSelectAll: TMenuItem; mpdMisc: TMenuItem; N4: TMenuItem; mitPrint: TMenuItem; FindDialog1: TFindDialog; N6: TMenuItem; mitSearch: TMenuItem; mitPasteAsOle: TMenuItem; N8: TMenuItem; mitPreview: TMenuItem; mitSelectCurrentWord: TMenuItem; RVPrint1: TRVPrint; mpdBackground: TMenuItem; mitBackNoBitmap: TMenuItem; mitBackStretched: TMenuItem; mitBackTiled: TMenuItem; mitBackTiledandScrolled: TMenuItem; mitBackCentered: TMenuItem; N5: TMenuItem; mitCheckpointList: TMenuItem; N9: TMenuItem; mitRemovePageBreak: TMenuItem; mitInsertPageBreak: TMenuItem; N10: TMenuItem; mitUndo: TMenuItem; mitRedo: TMenuItem; mitInsertFile: TMenuItem; mitPasteAsUnicodeText: TMenuItem; mitLoad: TMenuItem; mpdTable: TMenuItem; mitInserttable1: TMenuItem; mitInsertTable2: TMenuItem; N7: TMenuItem; mitMergeCells: TMenuItem; N13: TMenuItem; mitUmRows: TMenuItem; mitUmCols: TMenuItem; mitUmRowsandCols: TMenuItem; Insert1: TMenuItem; mitRowsAbove: TMenuItem; mitRowsBelow: TMenuItem; N14: TMenuItem; mitColsLeft: TMenuItem; mitColsRight: TMenuItem; Delete1: TMenuItem; mitDelRows: TMenuItem; mitDelColumns: TMenuItem; Unmerge1: TMenuItem; Split1: TMenuItem; mitSplitVertically: TMenuItem; mitSplitHorizontally: TMenuItem; mitInsertTable3: TMenuItem; mitInsertTable4: TMenuItem; psd: TPrinterSetupDialog; mitPasteAsRTF: TMenuItem; RVStyle1: TRVStyle; N11: TMenuItem; mitReadOnly: TMenuItem; N12: TMenuItem; mitOptions: TMenuItem; mpdLists: TMenuItem; mitApplyList: TMenuItem; mitRemoveLists: TMenuItem; il: TImageList; mitBackTopLeft: TMenuItem; mitBackTopRight: TMenuItem; mitBackBottomLeft: TMenuItem; mitBackBottomRight: TMenuItem; procedure FormCreate(Sender: TObject); procedure mitPictureClick(Sender: TObject); procedure mitButtonCompClick(Sender: TObject); procedure mitEditBoxCompClick(Sender: TObject); procedure RichViewEdit1CurParaStyleChanged(Sender: TObject); procedure RichViewEdit1CurTextStyleChanged(Sender: TObject); procedure cmbParaClick(Sender: TObject); procedure cmbTextClick(Sender: TObject); procedure mitBreakClick(Sender: TObject); procedure mitExitClick(Sender: TObject); procedure mitInsertBulletClick(Sender: TObject); procedure mitSaveClick(Sender: TObject); procedure mitClearClick(Sender: TObject); procedure mpdEditClick(Sender: TObject); procedure RichViewEdit1Select(Sender: TObject); procedure mitPasteAsBitmapClick(Sender: TObject); procedure mitPasteAsMetafileClick(Sender: TObject); procedure mitPasteAsTextClick(Sender: TObject); procedure mitPasteClick(Sender: TObject); procedure mitDeleteClick(Sender: TObject); procedure mitCutClick(Sender: TObject); procedure mitCopyClick(Sender: TObject); procedure mitEditCheckpointClick(Sender: TObject); procedure mitAddHSClick(Sender: TObject); procedure mitSelectAllClick(Sender: TObject); procedure mitEditPropsClick(Sender: TObject); procedure mitPrintClick(Sender: TObject); procedure RichViewEdit1RVFPictureNeeded(Sender: TCustomRichView; Name: String; Tag: Integer; var gr: TGraphic); procedure RichViewEdit1RVFControlNeeded(Sender: TCustomRichView; Name: String; Tag: Integer; var ctrl: TControl); procedure RichViewEdit1RVFImageListNeeded(Sender: TCustomRichView; ImageListTag: Integer; var il: TCustomImageList); procedure mitSearchClick(Sender: TObject); procedure FindDialog1Find(Sender: TObject); procedure mitCheckPointListClick(Sender: TObject); procedure mitPasteAsRVFClick(Sender: TObject); procedure mitPasteAsOleClick(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure mitPreviewClick(Sender: TObject); procedure mitBackClick(Sender: TObject); procedure RichViewEdit1SaveComponentToFile(Sender: TCustomRichView; Path: String; SaveMe: TPersistent; SaveFormat: TRVSaveFormat; var OutStr: String); procedure mitSelectCurrentWordClick(Sender: TObject); procedure RichViewEdit1Jump(Sender: TObject; id: Integer); procedure RichViewEdit1Change(Sender: TObject); procedure mpdBackgroundClick(Sender: TObject); procedure mitInsertPageBreakClick(Sender: TObject); procedure mitRemovePageBreakClick(Sender: TObject); procedure mitUndoClick(Sender: TObject); procedure mitRedoClick(Sender: TObject); procedure mitInsertFileClick(Sender: TObject); procedure mitPasteAsUnicodeTextClick(Sender: TObject); procedure mitLoadClick(Sender: TObject); procedure mitInserttable1Click(Sender: TObject); procedure mitInsertTable2Click(Sender: TObject); procedure mitCellsOperationClick(Sender: TObject); procedure mpdTableClick(Sender: TObject); procedure mitInsertTable3Click(Sender: TObject); procedure mitInsertTable4Click(Sender: TObject); procedure RichViewEdit1RVMouseMove(Sender: TObject; id: Integer); procedure mitPasteAsRTFClick(Sender: TObject); procedure mitReadOnlyClick(Sender: TObject); procedure mitOptionsClick(Sender: TObject); procedure mitApplyListClick(Sender: TObject); procedure mitRemoveListsClick(Sender: TObject); procedure RichViewEdit1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure RichViewEdit1ControlAction(Sender: TCustomRichView; ControlAction: TRVControlAction; ItemNo: Integer; var ctrl: TControl); procedure RichViewEdit1WriteHyperlink(Sender: TCustomRichView; id: Integer; RVData: TCustomRVData; ItemNo: Integer; SaveFormat: TRVSaveFormat; var Target, Extras: string); private { Private declarations } ActiveOleContainer: TOleContainer; HTMLSaveOptions: TRVSaveOptions; HTMLTitle: String; procedure OnOleResize(Sender: TObject); procedure OnOleActivate(Sender: TObject); procedure OnOleDeactivate(Sender: TObject); procedure OnControlClick(Sender: TObject); procedure WMDisplayChange(var Message: TMessage{TWMDisplayChange}); message WM_DISPLAYCHANGE; procedure UpdateUndoMenu; procedure DisplayUnicodeWarning; function GetUnicodeFontName: String; function GetRVFErrors: String; procedure FillStyleCombo(Styles: TCustomRVInfos; cmb: TComboBox); procedure CloseOleContainer; public { Public declarations } end; var Form1: TForm1; implementation uses CPFrm, PropFrm, ListFrm, PreviewFrm, OptionsFrm; {$R *.DFM} { This demo uses conditional defines from RV_Defs.inc (see include directive at the beginnning of this file) RICHVIEWDEF3 is defined, if there is Delphi3 or later or C++Builder 3 or later RICHVIEWDEF4 is defined, if there is Delphi4 or later } procedure TForm1.FormCreate(Sender: TObject); begin Randomize; HTMLSaveOptions := [rvsoImageSizes,rvsoUseCheckpointsNames]; HTMLTitle := 'Demo File'; RVStyle1.TextStyles[11].FontName := GetUnicodeFontName; RVStyle1.ListStyles[0].Levels[0].Font.Charset := SYMBOL_CHARSET; // Item can have associated "tags" - integers or strings. // Comment the next line to use integer tags RichViewEdit1.Options := RichViewEdit1.Options+[rvoTagsArePChars]; // Loading the initial file. RichViewEdit1.LoadRVF(ExtractFilePath(Application.ExeName)+'Readme.rvf'); FillStyleCombo(RVStyle1.ParaStyles, cmbPara); FillStyleCombo(RVStyle1.TextStyles, cmbText); RichViewEdit1.Format; cmbPara.ItemIndex := RichViewEdit1.CurParaStyleNo; cmbText.ItemIndex := RichViewEdit1.CurTextStyleNo; UpdateUndoMenu; end; { Returning available Unicode-enabled font ---------------------------} function TForm1.GetUnicodeFontName: String; begin if Screen.Fonts.IndexOf('Arial Unicode MS')>=0 then Result := 'Arial Unicode MS' else if Screen.Fonts.IndexOf('Lucida Sans Unicode')>=0 then Result := 'Lucida Sans Unicode' else Result := 'Arial'; end; { Filling combobox with standard styles ------------------------------} procedure TForm1.FillStyleCombo(Styles: TCustomRVInfos; cmb: TComboBox); var i: Integer; begin { The simplest way to fill the combo box with style names is: cmb.Items.Assign(Styles); But this code will fill the combo box with all styles - both standard styles (i.e. real styles) and non-standard styles will be added in it. So we'll fill in the combo box manually. For simplification, we'll add only the first standard styles } cmb.Items.BeginUpdate; cmb.Items.Clear; for i := 0 to Styles.Count-1 do begin if not TCustomRVInfo(Styles.Items[i]).Standard then break; cmb.Items.Add(TCustomRVInfo(Styles.Items[i]).StyleName); end; cmb.Items.EndUpdate; end; {---------------------------------------------------------------------} procedure TForm1.UpdateUndoMenu; var UndoType : TRVUndoType; begin UndoType := RichViewEdit1.UndoAction; mitUndo.Enabled := UndoType<>rvutNone; if UndoType=rvutCustom then mitUndo.Caption := 'Undo '+RichViewEdit1.UndoName else mitUndo.Caption := 'Undo '+RVUndoTypeNamesEn[UndoType]; UndoType := RichViewEdit1.RedoAction; mitRedo.Enabled := UndoType<>rvutNone; if UndoType=rvutCustom then mitRedo.Caption := 'Redo '+RichViewEdit1.RedoName else mitRedo.Caption := 'Redo '+RVUndoTypeNamesEn[UndoType]; end; {---------------------------------------------------------------------} procedure TForm1.DisplayUnicodeWarning; var wasclear: Boolean; begin wasclear := RichViewEdit1.ItemCount=0; // This method is called before loading Unicode // (when inserting Unicode, editor automatically switches to Unicode style, // according to RVStyle1.DefUnicodeStyle, if necessary) if not RVStyle1.TextStyles[RichViewEdit1.CurTextStyleNo].Unicode then Application.MessageBox('Loading/Inserting Unicode data using non-Unicode text style.'#13+ 'Text will be converted.'#13+ 'Choose "Unicode" style in combo to use Unicode text style', 'Warning', MB_OK or MB_ICONEXCLAMATION); if wasclear then RichViewEdit1.Clear; end; {======================================================================} { Font and paragraph combos } {======================================================================} procedure TForm1.RichViewEdit1CurParaStyleChanged(Sender: TObject); begin if RichViewEdit1.CurParaStyleNo'' then Result := #13'('+Result+')'; end; { File|Save... --------------------------------------------------------} procedure TForm1.mitSaveClick(Sender: TObject); var r: Boolean; begin SaveDialog1.Title := 'Save & Export'; SaveDialog1.Filter := 'RichView Format files(*.rvf)|*.rvf|'+ 'RTF Files (*.rtf)|*.rtf|'+ 'Text (*.txt)|*.txt|'+ 'Unicode Text (*.txt)|*.txt|'+ 'HTML - with CSS (*.htm;*.html)|*.htm;*.html|'+ 'HTML - Simplified (*.htm;*.html)|*.htm;*.html'; SaveDialog1.DefaultExt := 'rvf'; if SaveDialog1.Execute then begin Screen.Cursor := crHourglass; case SaveDialog1.FilterIndex of 1: // RVF r := RichViewEdit1.SaveRVF(SaveDialog1.FileName, False); 2: // RTF r := RichViewEdit1.SaveRTF(SaveDialog1.FileName, False); 3: // ANSI Text (byte per character) r := RichViewEdit1.SaveText(SaveDialog1.FileName, 80); 4: // Unicode Text (2 bytes per character) r := RichViewEdit1.SaveTextW(SaveDialog1.FileName, 80); 5: // HTML with CSS r := RichViewEdit1.SaveHTMLEx(SaveDialog1.FileName, HTMLTitle,'img', '', '', '', HTMLSaveOptions); 6: // HTML r := RichViewEdit1.SaveHTML(SaveDialog1.FileName, HTMLTitle,'img', HTMLSaveOptions); else r := False; end; Screen.Cursor := crDefault; if not r then Application.MessageBox('Error during saving', 'Error', 0); end; end; { File|Options... --------------------------------------------------------} procedure TForm1.mitOptionsClick(Sender: TObject); var RVFOptions : TRVFOptions; begin frmOptions.SetOptions(RichViewEdit1.RVFOptions, HTMLSaveOptions, HTMLTitle); if frmOptions.ShowModal=mrOk then begin frmOptions.GetOptions(RVFOptions, HTMLSaveOptions, HTMLTitle); RichViewEdit1.RVFOptions := RVFOptions; end; end; { Event: saving controls in HTML --------------------------------------} // Note: not all browsers support tags outside
tags procedure TForm1.RichViewEdit1SaveComponentToFile(Sender: TCustomRichView; Path: String; SaveMe: TPersistent; SaveFormat: TRVSaveFormat; var OutStr: String); begin case SaveFormat of rvsfText: begin OutStr := '('+SaveMe.ClassName+')'; end; rvsfHTML: begin if SaveMe is TButton then begin OutStr := ''; exit; end; if SaveMe is TEdit then begin OutStr := ''; exit; end; end; rvsfRTF: begin OutStr := '{\plain\b ('+SaveMe.ClassName+')}'; end; end; end; { Event: saving URLs in HTML and RTF ---------------------------------} procedure TForm1.RichViewEdit1WriteHyperlink(Sender: TCustomRichView; id: Integer; RVData: TCustomRVData; ItemNo: Integer; SaveFormat: TRVSaveFormat; var Target, Extras: string); begin if not (rvoTagsArePChars in Sender.Options) then exit; Target := PChar(RVData.GetItemTag(ItemNo)); end; { File|Clear ----------------------------------------------------------} procedure TForm1.mitClearClick(Sender: TObject); begin CloseOleContainer; RichViewEdit1.Clear; RichViewEdit1.Format; cmbPara.ItemIndex := RichViewEdit1.CurParaStyleNo; cmbText.ItemIndex := RichViewEdit1.CurTextStyleNo; UpdateUndoMenu; end; { File|Print Preview --------------------------------------------------} procedure TForm1.mitPreviewClick(Sender: TObject); begin RVPrint1.AssignSource(RichViewEdit1); RVPrint1.FormatPages(rvdoALL); if RVPrint1.PagesCount>0 then begin frmPreview.rvpp.RVPrint := RVPrint1; frmPreview.Button1Click(nil); // Show First Page frmPreview.ShowModal; end; end; { File|Print on Default Printer ---------------------------------------} procedure TForm1.mitPrintClick(Sender: TObject); var PrintIt: Boolean; begin {$IFDEF RICHVIEWDEF3} PrintIt := psd.Execute; {$ELSE} PrintIt := True; {$ENDIF} if PrintIt then begin RVPrint1.AssignSource(RichViewEdit1); RVPrint1.FormatPages(rvdoALL); if RVPrint1.PagesCount>0 then RVPrint1.Print('RichView Edit Demo',1,False); end; end; { File|Exit -----------------------------------------------------------} procedure TForm1.mitExitClick(Sender: TObject); begin Close; end; {======================================================================} { Main menu: "Insert" } {======================================================================} { Insert|File... ------------------------------------------------------} procedure TForm1.mitInsertFileClick(Sender: TObject); var r: Boolean; begin OpenDialog1.Title := 'Inserting File'; OpenDialog1.Filter := 'RichView Format Files(*.rvf)|*.rvf|'+ 'RTF Files(*.rtf)|*.rtf|'+ 'Text Files - autodetect (*.txt)|*.txt|'+ 'ANSI Text Files (*.txt)|*.txt|'+ 'Unicode Text Files (*.txt)|*.txt|'+ 'OEM Text Files (*.txt)|*.txt'; if OpenDialog1.Execute then begin Screen.Cursor := crHourglass; case OpenDialog1.FilterIndex of 1: // RVF r := RichViewEdit1.InsertRVFFromFileEd(OpenDialog1.FileName); 2: // RTF r := RichViewEdit1.InsertRTFFromFileEd(OpenDialog1.FileName); 3: // Text begin if RV_TestFileUnicode(OpenDialog1.FileName)=rvutYes then r := RichViewEdit1.InsertTextFromFileW(OpenDialog1.FileName) else r := RichViewEdit1.InsertTextFromFile(OpenDialog1.FileName); end; 4: // ANSI Text r := RichViewEdit1.InsertTextFromFile(OpenDialog1.FileName); 5: // Unicode Text r := RichViewEdit1.InsertTextFromFileW(OpenDialog1.FileName); 6: // OEM Text r := RichViewEdit1.InsertOEMTextFromFile(OpenDialog1.FileName); else r := False; end; Screen.Cursor := crDefault; if not r then Application.MessageBox('Error reading file', 'Error', MB_OK or MB_ICONSTOP); end; end; { Insert|Picture... ---------------------------------------------------} procedure TForm1.mitPictureClick(Sender: TObject); var gr: TGraphic; pic: TPicture; begin OpenDialog1.Title := 'Inserting Image'; {$IFDEF RICHVIEWDEF3} OpenDialog1.Filter := 'Graphics(*.bmp;*.wmf;*.emf;*.ico;*.jpg)|*.bmp;*.wmf;*.emf;*.ico;*.jpg|All(*.*)|*.*'; {$ELSE} OpenDialog1.Filter := 'Graphics(*.bmp;*.wmf;*.emf;*.ico)|*.bmp;*.wmf;*.emf;*.ico|All(*.*)|*.*'; {$ENDIF} if OpenDialog1.Execute then try pic := TPicture.Create; try pic.LoadFromFile(OpenDialog1.FileName); gr := RV_CreateGraphics(TGraphicClass(pic.Graphic.ClassType)); gr.Assign(pic.Graphic); finally pic.Free; end; if gr<>nil then RichViewEdit1.InsertPicture('',gr,rvvaBaseLine); except Application.MessageBox(PChar('Cannot read picture from file '+OpenDialog1.FileName), 'Error', MB_OK or MB_ICONSTOP); end; end; { Event: clicking inserted control ------------------------------------} procedure TForm1.OnControlClick(Sender: TObject); begin RichViewEdit1.SelectControl(TControl(Sender)); end; { Insert|Component|Button ---------------------------------------------} procedure TForm1.mitButtonCompClick(Sender: TObject); var btn: TButton; const Captions: array[0..9] of String = ( 'Help','Exit','Cancel','Ok','Close','Run','Options...','Minimize', 'Hide','Show' ); begin btn := TButton.Create(Self); btn.Caption := Captions[Random(10)]; btn.OnClick := OnControlClick; RichViewEdit1.InsertControl('',btn,rvvaBaseline); if RichViewEdit1.CurItemStyle=rvsComponent then RichViewEdit1.SetCurrentItemExtraIntProperty(rvepResizable, 1, True); end; { Insert|Component|Edit Box -------------------------------------------} procedure TForm1.mitEditBoxCompClick(Sender: TObject); var edt: TEdit; const Captions: array[0..9] of String = ( '0','Hello','1','$0','2x2=4','enter text here','xnil then begin ActiveOleContainer.Close; ActiveOleContainer := nil; end; end; {-----------------------------------------------------------------------} procedure TForm1.OnOleResize(Sender: TObject); begin RichViewEdit1.AdjustControlPlacement2(TControl(Sender)); end; {-----------------------------------------------------------------------} procedure TForm1.OnOleActivate(Sender: TObject); begin if ActiveOleContainer<>Sender then CloseOleContainer; ActiveOleContainer := TOleContainer(Sender); RichViewEdit1.AdjustControlPlacement2(TControl(Sender)); end; {-----------------------------------------------------------------------} procedure TForm1.OnOleDeactivate(Sender: TObject); begin RichViewEdit1.AdjustControlPlacement2(TControl(Sender)); end; {-----------------------------------------------------------------------} procedure TForm1.RichViewEdit1Click(Sender: TObject); begin CloseOleContainer; end; {-----------------------------------------------------------------------} procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin CloseOleContainer; end; {-----------------------------------------------------------------------} procedure TForm1.RichViewEdit1ControlAction(Sender: TCustomRichView; ControlAction: TRVControlAction; ItemNo: Integer; var ctrl: TControl); begin if ControlAction=rvcaAfterRVFLoad then begin if ctrl is TOleContainer then begin TOleContainer(ctrl).OnResize := OnOleResize; TOleContainer(ctrl).OnActivate := OnOleActivate; TOleContainer(ctrl).OnDeactivate := OnOleDeactivate; end else if ctrl is TButton then TButton(ctrl).OnClick := OnControlClick else if ctrl is TEdit then TEdit(ctrl).OnClick := OnControlClick end; if ctrl<>ActiveOleContainer then exit; if ControlAction in [rvcaMoveToUndoList, rvcaDestroy, rvcaBeforeRVFSave] then CloseOleContainer; end; { Edit|Delete ---------------------------------------------------------} procedure TForm1.mitDeleteClick(Sender: TObject); begin // Shortcut to this item is Ctrl+Del // If you make it Del, you will be unable to use del key in editor RichViewEdit1.DeleteSelection; end; { Edit|Select All -----------------------------------------------------} procedure TForm1.mitSelectAllClick(Sender: TObject); begin { warning: SelectAll moves caret to the end of the text } RichViewEdit1.SelectAll; RichViewEdit1.SetFocus; RichViewEdit1.Invalidate; end; { Another clipboard-related action ------------------------------------} procedure TForm1.RichViewEdit1Select(Sender: TObject); begin mitCopy.Enabled := RichViewEdit1.SelectionExists; mitCut.Enabled := mitCopy.Enabled; mitDelete.Enabled := mitCopy.Enabled; end; { Edit| Insert Page Break----------------------------------------------} procedure TForm1.mitInsertPageBreakClick(Sender: TObject); begin RichViewEdit1.InsertPageBreak; end; { Edit| Remove Page Break----------------------------------------------} procedure TForm1.mitRemovePageBreakClick(Sender: TObject); begin RichViewEdit1.RemoveCurrentPageBreak; end; {----------------------------------------------------------------------} { This demo understands both tag modes: 1. rvoTagsArePChars is in Options (tags are strings) 2. rvoTagsArePChars is not in Options (tags are integers). So this demo uses two simple universal functions below for convering tag to String and String to tag. } function GetTagStr(Tag: Integer): String; begin if (rvoTagsArePChars in Form1.RichViewEdit1.Options) then if Tag = 0 then Result := '' else Result := PChar(Tag) else Result := IntToStr(Tag); end; function MakeTag(TagStr: String): Integer; begin if (TagStr<>'') and (rvoTagsArePChars in Form1.RichViewEdit1.Options) then Result := Integer(StrNew(PChar(TagStr))) else Result := StrToIntDef(TagStr,0); end; { Edit|Checkpoint... --------------------------------------------------} procedure TForm1.mitEditCheckpointClick(Sender: TObject); var CpNo, Tag: Integer; Name: String; CheckPointData: TCheckPointData; RaiseEvent: Boolean; begin CheckPointData := RichViewEdit1.GetCurrentCheckpoint; if CheckPointData<>nil then begin RichViewEdit1.GetCheckpointInfo(CheckPointData,Tag,Name,RaiseEvent); CpNo := RichViewEdit1.GetCheckpointNo(CheckPointData); frmCp.lblStatus.Caption := 'Editing checkpoint #'+IntToStr(CpNo); frmCp.txtName.Text := Name; frmCp.txtTag.Text := GetTagStr(Tag); frmCp.btnOk.Caption := 'OK'; frmCp.btnDelete.Enabled := True; end else begin frmCp.lblStatus.Caption := 'Checkpoint does not exist'; frmCp.txtName.Text := ''; frmCp.txtTag.Text := GetTagStr(0); frmCp.btnOk.Caption := 'Add'; frmCp.btnDelete.Enabled := False; end; case frmCP.ShowModal of mrOk: { add new checkpoint or modify existed one } RichViewEdit1.SetCurrentCheckpointInfo(MakeTag(frmCp.txtTag.Text), frmCp.txtName.Text,False); mrYes: { delete checkpoint } RichViewEdit1.RemoveCurrentCheckpoint; end; end; { Edit|Search... -------------------------------------} procedure TForm1.mitSearchClick(Sender: TObject); begin FindDialog1.Execute; end; {-----------------------------------------------------------------------} procedure TForm1.FindDialog1Find(Sender: TObject); begin if not RichViewEdit1.SearchText(FindDialog1.FindText, GetRVESearchOptions(FindDialog1.Options)) then Application.MessageBox('Can''t find', 'Search complete', MB_OK or MB_ICONEXCLAMATION); end; { Edit|Select Current Word -------------------------------------} procedure TForm1.mitSelectCurrentWordClick(Sender: TObject); begin RichViewEdit1.SelectCurrentWord; // now you can do something with current word: // translate or spell check, for example... end; { Edit|Current Item Properties... -------------------------------------} procedure TForm1.mitEditPropsClick(Sender: TObject); var s: TRVAnsiString; Tag, Index: Integer; VAlign: TRVVAlign; ImageList: TCustomImageList; gr: TGraphic; ctrl: TControl; BreakColor: TColor; BreakStyle: TRVBreakStyle; BreakWidth: Byte; begin frmProp.PageControl1.Visible := True; frmProp.tsBullet.TabVisible := False; frmProp.tsHotSpot.TabVisible := False; frmProp.tsPicture.TabVisible := False; frmProp.tsText.TabVisible := False; frmProp.tsComponent.TabVisible := False; frmProp.tsBreak.TabVisible := False; frmProp.txtName.Enabled := True; case RichViewEdit1.CurItemStyle of rvsBullet: begin RichViewEdit1.GetCurrentBulletInfo(s, Index, ImageList, Tag); frmProp.tsBullet.TabVisible := True; frmProp.rgBullet.ItemIndex := Index; frmProp.txtName.Text := String(s); frmProp.txtTag.Text := GetTagStr(Tag); end; rvsHotspot: begin // you can use GetCurrentBulletInfo or GetCurrentHotspotInfo // to receive info about hotspot in caret position. // in this demo we do not need HotImageIndex, because here // HotImageIndex = ImageIndex+2 // and so we can use GetCurrentBulletInfo RichViewEdit1.GetCurrentBulletInfo(s, Index, ImageList, Tag); frmProp.tsHotspot.TabVisible := True; frmProp.rgHotspot.ItemIndex := Index-3; frmProp.txtName.Text := String(s); frmProp.txtTag.Text := GetTagStr(Tag); end; rvsPicture, rvsHotPicture: begin RichViewEdit1.GetCurrentPictureInfo(s, gr, VAlign, Tag); frmProp.tsPicture.TabVisible := True; frmProp.Image1.Picture.Graphic := gr; frmProp.txtName.Text := String(s); frmProp.txtTag.Text := GetTagStr(Tag); frmProp.rgPicVAlign.ItemIndex := Integer(VAlign); end; rvsComponent: begin RichViewEdit1.GetCurrentControlInfo(s, ctrl, VAlign, Tag); frmProp.tsComponent.TabVisible := True; frmProp.txtWidth.Text := IntToStr(ctrl.Width); frmProp.txtHeight.Text := IntToStr(ctrl.Height); frmProp.txtName.Text := String(s); frmProp.lblComponent.Caption := ctrl.ClassName; frmProp.txtTag.Text := GetTagStr(Tag); frmProp.rgCtrlVAlign.ItemIndex := Integer(VAlign); end; rvsBreak: begin frmProp.tsBreak.TabVisible := True; RichViewEdit1.GetCurrentBreakInfo(BreakWidth, BreakStyle, BreakColor, Tag); frmProp.txtBreakWidth.Text := IntToStr(BreakWidth); case BreakColor of clNone: frmProp.rgBreakColor.ItemIndex := 0; clRed: frmProp.rgBreakColor.ItemIndex := 1; clGreen: frmProp.rgBreakColor.ItemIndex := 2; clBlue: frmProp.rgBreakColor.ItemIndex := 3; end; frmProp.rgBreakStyle.ItemIndex := ord(BreakStyle); frmProp.txtName.Text := '(not available for breaks)'; frmProp.txtName.Enabled := False; frmProp.txtTag.Text := GetTagStr(Tag); end; rvsTable: begin frmProp.txtName.Text := RichViewEdit1.GetCurrentItemText; frmProp.txtTag.Text := GetTagStr(RichViewEdit1.GetCurrentTag); frmProp.PageControl1.Visible := False; end; else begin frmProp.lblText.Caption := RichViewEdit1.GetCurrentItemText; frmProp.txtTag.Text := GetTagStr(RichViewEdit1.GetCurrentTag); frmProp.tsText.TabVisible := True; frmProp.txtName.Text := '(not available for text)'; frmProp.txtName.Enabled := False; end; end; if frmProp.ShowModal=mrOk then case RichViewEdit1.CurItemStyle of rvsBullet: begin RichViewEdit1.SetCurrentBulletInfo( TRVAnsiString(frmProp.txtName.Text), frmProp.rgBullet.ItemIndex, nil, MakeTag(frmProp.txtTag.Text)); end; rvsHotspot: begin RichViewEdit1.SetCurrentHotspotInfo( TRVAnsiString(frmProp.txtName.Text), frmProp.rgHotspot.ItemIndex+3, frmProp.rgHotspot.ItemIndex+3+2, nil, MakeTag(frmProp.txtTag.Text)); end; rvsPicture, rvsHotPicture: begin { first we need to create a copy of image ...} gr := TGraphic(frmProp.Image1.Picture.Graphic.ClassType.Create); gr.Assign(frmProp.Image1.Picture.Graphic); RichViewEdit1.SetCurrentPictureInfo( TRVAnsiString(frmProp.txtName.Text), gr, TRVVAlign(frmProp.rgPicVAlign.ItemIndex), MakeTag(frmProp.txtTag.Text)); end; rvsComponent: begin // we want these setting to be undone as one action, // so we use BeginUndoGroup, SetUndoGroupMode(True), settings, SetUndoGroupMode(False) RichViewEdit1.BeginUndoGroup(rvutModifyItem); // you can use BeginUndoCustomGroup instead of BeginUndoGroup // example: // RichViewEdit1.BeginUndoCustomGroup('modifying control'); // In this case undo type will be rvutCustom // (look at TForm1.UpdateUndoMenu in this file) RichViewEdit1.SetUndoGroupMode(True); RichViewEdit1.SetCurrentControlInfo( TRVAnsiString(frmProp.txtName.Text), TRVVAlign(frmProp.rgCtrlVAlign.ItemIndex), MakeTag(frmProp.txtTag.Text)); RichViewEdit1.ResizeCurrentControl( StrToIntDef(frmProp.txtWidth.Text, ctrl.Width), StrToIntDef(frmProp.txtHeight.Text, ctrl.Height)); RichViewEdit1.SetUndoGroupMode(False); end; rvsBreak: begin case frmProp.rgBreakColor.ItemIndex of -1,0: BreakColor := clNone; 1: BreakColor := clRed; 2: BreakColor := clGreen; 3: BreakColor := clBlue; end; BreakWidth := StrToIntDef(frmProp.txtBreakWidth.Text,1); BreakStyle := TRVBreakStyle(frmProp.rgBreakStyle.ItemIndex); RichViewEdit1.SetCurrentBreakInfo(BreakWidth,BreakStyle,BreakColor, MakeTag(frmProp.txtTag.Text)); end; rvsTable: begin RichViewEdit1.BeginUndoGroup(rvutModifyItem); RichViewEdit1.SetUndoGroupMode(True); RichViewEdit1.SetCurrentItemText(frmProp.txtName.Text); RichViewEdit1.SetCurrentTag(MakeTag(frmProp.txtTag.Text)); RichViewEdit1.SetUndoGroupMode(False); end; else begin RichViewEdit1.SetCurrentTag(MakeTag(frmProp.txtTag.Text)); end; end; end; {======================================================================} { Main menu : "Misc" } {======================================================================} { Misc | Go to checkpoint ... -----------------------------------------} procedure TForm1.mitCheckPointListClick(Sender: TObject); var X,Y,Tag: Integer; Name: String; CheckpointData: TCheckpointData; RaiseEvent: Boolean; s: String; begin { Does not work for checkpoints in table cells } frmList.lst.Items.Clear; CheckpointData := RichViewEdit1.GetFirstCheckPoint; while CheckpointData<>nil do begin RichViewEdit1.GetCheckpointInfo(CheckpointData,Tag,Name,RaiseEvent); RichViewEdit1.GetCheckpointXY(CheckpointData,X,Y); s := Format('(X:%d,Y:%d) Name:"%s" Tag:"%s"', [X,Y,Name,GetTagStr(Tag)]); frmList.lst.Items.Add(s); CheckpointData := RichViewEdit1.GetNextCheckpoint(CheckpointData); end; if frmList.ShowModal=mrOk then with RichViewEdit1 do ScrollTo(GetCheckPointY(frmList.lst.ItemIndex)); end; { Misc | Read-Only -----------------------------------------------------} procedure TForm1.mitReadOnlyClick(Sender: TObject); begin RichViewEdit1.ReadOnly := not RichViewEdit1.ReadOnly; mitReadOnly.Checked := RichViewEdit1.ReadOnly; end; { Misc | Background submenu popups ------------------------------------} procedure TForm1.mpdBackgroundClick(Sender: TObject); begin // Displaying RichViewEdit1.BackgroundStyle as checkmark in submenu... mitBackNoBitmap.Checked := RichViewEdit1.BackgroundStyle=bsNoBitmap; mitBackStretched.Checked := RichViewEdit1.BackgroundStyle=bsStretched; mitBackTiledAndScrolled.Checked := RichViewEdit1.BackgroundStyle=bsTiledAndScrolled; mitBackTiled.Checked := RichViewEdit1.BackgroundStyle=bsTiled; mitBackCentered.Checked := RichViewEdit1.BackgroundStyle=bsCentered; mitBackTopLeft.Checked := RichViewEdit1.BackgroundStyle=bsTopLeft; mitBackTopRight.Checked := RichViewEdit1.BackgroundStyle=bsTopRight; mitBackBottomLeft.Checked := RichViewEdit1.BackgroundStyle=bsBottomLeft; mitBackBottomRight.Checked := RichViewEdit1.BackgroundStyle=bsBottomRight; end; { Misc | Background options -------------------------------------------} procedure TForm1.mitBackClick(Sender: TObject); begin RichViewEdit1.BackgroundStyle := TBackgroundStyle(TMenuItem(Sender).Tag); end; {======================================================================} { On Popup -------------------------------------------------------------} procedure TForm1.PopupMenu1Popup(Sender: TObject); begin mitEditProp1.Enabled := not RichViewEdit1.SelectionExists; end; {-----------------------------------------------------------------------} {OnChange event handler. {-----------------------------------------------------------------------} procedure TForm1.RichViewEdit1Change(Sender: TObject); begin UpdateUndoMenu; end; {-----------------------------------------------------------------------} // You should manually update palette info when user changes color mode // without restarting Windows procedure TForm1.WMDisplayChange(var Message: TMessage{TWMDisplayChange}); begin RichViewEdit1.UpdatePaletteInfo; RVPrint1.UpdatePaletteInfo; end; {-----------------------------------------------------------------------} { Event: OnJump (when user clicks hypertext item with pressed Ctrl key } procedure TForm1.RichViewEdit1Jump(Sender: TObject; id: Integer); var RVData: TCustomRVFormattedData; ItemNo: Integer; s: String; begin // NOTE: OnJump is called after the caret is repositioned to clicked item // But warning: a clicked event is not necessarily an active item // (when clicking on left part of picture or left part of first character in text item, // caret moves before item and previous item becomes active!) RichViewEdit1.GetJumpPointLocation(id, RVData, ItemNo); s := GetTagStr(RVData.GetItemTag(ItemNo)); Application.MessageBox(PChar(Format('Tag of clicked hyperlink is "%s"', [s])), 'Hyperlink', MB_OK or MB_ICONINFORMATION); end; {------------------------------------------------------------------------------} { Event: OnRVMouseMove (when user moves mouse above hypertext item with pressed Ctrl key } procedure TForm1.RichViewEdit1RVMouseMove(Sender: TObject; id: Integer); var RVData: TCustomRVFormattedData; ItemNo: Integer; s: String; begin if id=-1 then begin StatusBar1.SimpleText := ''; end else begin RichViewEdit1.GetJumpPointLocation(id, RVData, ItemNo); s := GetTagStr(RVData.GetItemTag(ItemNo)); StatusBar1.SimpleText := Format('Tag of hyperlink is "%s"', [s]); end; end; {======================================================================} { Main menu : "Lists" } {======================================================================} { Lists | Apply -------------------------------------------------------} procedure TForm1.mitApplyListClick(Sender: TObject); begin // See more demos about list styles in Demos\Delphi\Assorted\ListStyles\ if (RVStyle1.ListStyles.Count=0) or (RVStyle1.ListStyles[0].Levels.Count=0) then begin Application.MessageBox('Default list style is not defined', '', 0); exit; end; RichViewEdit1.ApplyListStyle(0, 0, 1, False, False); end; { Lists | Remove ------------------------------------------------------} procedure TForm1.mitRemoveListsClick(Sender: TObject); begin RichViewEdit1.RemoveLists(False); end; {======================================================================} { Main menu : "Table" } {======================================================================} { Table | Insert Table Example 1 --------------------------------------} procedure TForm1.mitInserttable1Click(Sender: TObject); var table: TRVTableItemInfo; r,c: Integer; begin table := TRVTableItemInfo.CreateEx(4,3, RichViewEdit1.RVData); table.BorderStyle := rvtbRaisedColor; table.CellBorderStyle := rvtbLoweredColor; table.BorderLightColor := $00FAF1C9; table.BorderColor := $00A98E10; table.CellBorderLightColor := $00FAF1C9; table.CellBorderColor := $00A98E10; table.Color := $00EAC724; table.BorderWidth := 5; table.CellBorderWidth := 2; table.CellPadding := 5; table.CellVSpacing := 1; table.CellHSpacing := 1; table.BorderVSpacing := 1; table.BorderHSpacing := 1; for r := 0 to table.Rows.Count-1 do for c := 0 to table.Rows[r].Count-1 do table.Cells[r,c].BestWidth := 100; table.MergeCells(0,0,3,1, False); table.MergeCells(1,0,1,3, False); with table.Cells[0,0] do begin Color := clInfoBk; Clear; AddBulletEx( '',0,il,2); AddNL(' Example 1 ',1,-1); AddBulletEx( '',0,il,-1); AddNL('All cells have 100 pixels width, width of table itself is calculated basing on width of cells.', 0,0); end; if RichViewEdit1.InsertItem('', table) then begin end; end; { Table | Insert Table Example 2 --------------------------------------} procedure TForm1.mitInsertTable2Click(Sender: TObject); var table: TRVTableItemInfo; btn: TButton; begin table := TRVTableItemInfo.CreateEx(10,6, RichViewEdit1.RVData); table.Color := clWhite; table.BorderStyle := rvtbRaisedColor; table.CellBorderStyle := rvtbLoweredColor; table.BorderLightColor := clWhite; table.BorderColor := clBlack; table.CellBorderLightColor := clWhite; table.CellBorderColor := clBlack; table.BorderWidth := 2; table.BorderVSpacing := 0; table.BorderHSpacing := 0; table.CellBorderWidth := 2; table.CellPadding := 3; table.CellVSpacing := 0; table.CellHSpacing := 0; table.Cells[0,0].BestWidth := -16; table.Cells[0,1].BestWidth := -16; table.Cells[0,2].BestWidth := -16; table.Cells[0,3].BestWidth := -16; table.Cells[0,4].BestWidth := -16; table.Cells[0,5].BestWidth := -16; // table.Rows.MergeCells(1,0,6,1); table.MergeCells(2,0,2,8, False); with table.Cells[2,0] do begin Clear; AddNL('Another example.',0,0); btn := TButton.Create(nil); btn.Caption := 'With button inside'; btn.Width := 150; btn.OnClick := OnControlClick; AddControlEx('',btn,2,rvvaBaseline); SetItemExtraIntProperty(ItemCount-1, rvepResizable, 1); AddNL('Width of table = 90% of document width. Widths of cells = 16%',0,0); end; table.BestWidth := -90; if RichViewEdit1.InsertItem('', table) then begin end; end; { Table | Insert Table Example 3 --------------------------------------} procedure TForm1.mitInsertTable3Click(Sender: TObject); var table: TRVTableItemInfo; r,c: Integer; begin table := TRVTableItemInfo.CreateEx(5,6, RichViewEdit1.RVData); table.Color := $00A5CCE7; table.BorderStyle := rvtbColor; table.CellBorderStyle := rvtbColor; table.BorderColor := $002E1234; table.CellBorderColor := $002E1234; table.BorderWidth := 2; table.BorderVSpacing := 2; table.BorderHSpacing := 2; table.CellBorderWidth := 1; table.CellPadding := 3; table.CellVSpacing := 0; table.CellHSpacing := 0; table.Options := table.Options + [rvtoHideGridLines]; for c := 0 to table.Rows[0].Count-1 do table.Cells[0,c].Color := $00A5E1F8; for r := 1 to table.Rows.Count-1 do table.Cells[r,0].Color := $00A5E1F8; for r := 1 to table.Rows.Count-1 do for c := 1 to table.Rows[r].Count-1 do begin table.Cells[r,c].Color := $007AB4DA; if c>1 then table.Cells[r,c].VisibleBorders.Left := False; if cnil)); mitSplitVertically.Enabled := SelectionRectangular; mitSplitHorizontally.Enabled := SelectionRectangular; mitUmRows.Enabled := SelectionRectangular; mitUmCols.Enabled := SelectionRectangular; mitUmRowsAndCols.Enabled := SelectionRectangular; end; { Table | All other commands --------------------------------------} procedure TForm1.mitCellsOperationClick(Sender: TObject); var item: TCustomRVItemInfo; table: TRVTableItemInfo; Data: Integer; r,c,cs,rs: Integer; s: String; rve: TCustomRichViewEdit; ItemNo: Integer; begin if not RichViewEdit1.CanChange or not RichViewEdit1.GetCurrentItemEx(TRVTableItemInfo, rve, item) then exit; table := TRVTableItemInfo(item); ItemNo := rve.GetItemNo(table); rve.BeginItemModify(ItemNo, Data); case TMenuItem(Sender).Tag of 1: table.InsertRowsAbove(1); 2: table.InsertRowsBelow(1); 3: table.InsertColsLeft(1); 4: table.InsertColsRight(1); 5: begin table.GetNormalizedSelectionBounds(True,r,c,cs,rs); if rs=table.Rows.Count then begin // deleting the whole table rve.SetSelectionBounds(ItemNo,0,ItemNo,1); rve.DeleteSelection; exit; end; rve.BeginUndoGroup(rvutModifyItem); rve.SetUndoGroupMode(True); table.DeleteSelectedRows; // it's possible all-nil rows/cols appear after deleting table.DeleteEmptyRows; table.DeleteEmptyCols; rve.SetUndoGroupMode(False); end; 6: begin table.GetNormalizedSelectionBounds(True,r,c,cs,rs); if cs=table.Rows[0].Count then begin // deleting the whole table rve.SetSelectionBounds(ItemNo,0,ItemNo,1); rve.DeleteSelection; exit; end; rve.BeginUndoGroup(rvutModifyItem); rve.SetUndoGroupMode(True); table.DeleteSelectedCols; // it's possible all-nil rows/cols appear after deleting table.DeleteEmptyRows; table.DeleteEmptyCols; rve.SetUndoGroupMode(False); end; 7: begin // 3 methods: MergeSelectedCells, DeleteEmptyRows, DeleteEmptyCols // must be undone as one action. // So using BeginUndoGroup - SetUndoGroupMode(True) - ... - SetUndoGroupMode(False) rve.BeginUndoGroup(rvutModifyItem); rve.SetUndoGroupMode(True); table.MergeSelectedCells(True); table.DeleteEmptyRows; table.DeleteEmptyCols; rve.SetUndoGroupMode(False); // table.MergeSelectedCells(False) will not allow to create empty columns // or rows end; 8: table.UnmergeSelectedCells(True, False); 9: table.UnmergeSelectedCells(False, True); 10: table.UnmergeSelectedCells(True, True); 11: begin s := '2'; if InputQuery('Split Vertically','Columns (in each selected cell):',s) then begin table.SplitSelectedCellsVertically(StrToIntDef(s,0)); end; end; 12: begin s := '2'; if InputQuery('Split Horizontally','Rows (in each selected cell):',s) then begin table.SplitSelectedCellsHorizontally(StrToIntDef(s,0)); end; end; end; rve.EndItemModify(ItemNo, Data); rve.Change; end; initialization // We need to register classes in order to load them from rvf files RegisterClasses([TButton, TEdit, TOleContainer]); end.