Archivado/Componentes.Terceros.TRichView
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
Componentes.Terceros.TRichView/12.0.4/Demos/DelphiUnicode/Editors/Editor 1/Unit1.pas
david fddb8c1dff Importación inicial con versión 12.0.4 
NO HAY CÓDIGO FUENTE

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TRichView@1 b34d35ef-135b-4489-b9d1-9916e9c25524
2010-01-11 12:26:42 +00:00

1604 lines
60 KiB
ObjectPascal
Raw Permalink Blame History

{*******************************************************}
{ }
{ 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<cmbPara.Items.Count then
cmbPara.ItemIndex := RichViewEdit1.CurParaStyleNo
else
cmbPara.ItemIndex := -1;
end;
{----------------------------------------------------------------------}
procedure TForm1.RichViewEdit1CurTextStyleChanged(Sender: TObject);
begin
if RichViewEdit1.CurTextStyleNo<cmbText.Items.Count then
cmbText.ItemIndex := RichViewEdit1.CurTextStyleNo
else
cmbText.ItemIndex := -1;
end;
{----------------------------------------------------------------------}
procedure TForm1.cmbParaClick(Sender: TObject);
begin
RichViewEdit1.ApplyParaStyle(cmbPara.ItemIndex);
RichViewEdit1.SetFocus;
end;
{----------------------------------------------------------------------}
procedure TForm1.cmbTextClick(Sender: TObject);
begin
RichViewEdit1.ApplyTextStyle(cmbText.ItemIndex);
RichViewEdit1.SetFocus;
end;
{======================================================================}
{ Main menu: "File" }
{======================================================================}
{ File|Load... --------------------------------------------------------}
procedure TForm1.mitLoadClick(Sender: TObject);
var CurTextStyleNo, CurParaStyleNo: Integer;
r: Boolean;
ErrorMessage: String;
begin
OpenDialog1.Title := 'Loading & Import';
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';
if OpenDialog1.Execute then begin
Screen.Cursor := crHourglass;
CurTextStyleNo := RichViewEdit1.CurTextStyleNo;
CurParaStyleNo := RichViewEdit1.CurParaStyleNo;
CloseOleContainer;
RichViewEdit1.Clear;
RVStyle1.DefUnicodeStyle := -1;
RichViewEdit1.CurTextStyleNo := CurTextStyleNo;
RichViewEdit1.CurParaStyleNo := CurParaStyleNo;
case OpenDialog1.FilterIndex of
1: // RVF
r := RichViewEdit1.LoadRVF(OpenDialog1.FileName);
2: // RTF
r := RichViewEdit1.LoadRTF(OpenDialog1.FileName);
3: // Text
if RV_TestFileUnicode(OpenDialog1.FileName)=rvutYes then begin
DisplayUnicodeWarning;
r := RichViewEdit1.LoadTextW(OpenDialog1.FileName,CurTextStyleNo,CurParaStyleNo,False)
end
else
r := RichViewEdit1.LoadText(OpenDialog1.FileName,CurTextStyleNo,CurParaStyleNo,False);
4: // ANSI text
r := RichViewEdit1.LoadText(OpenDialog1.FileName,CurTextStyleNo,CurParaStyleNo,False);
5: // Unicode text
begin
DisplayUnicodeWarning;
r := RichViewEdit1.LoadTextW(OpenDialog1.FileName,CurTextStyleNo,CurParaStyleNo,False)
end;
else
r := False;
end;
Screen.Cursor := crDefault;
if not r then begin
ErrorMessage := 'Error during loading';
if OpenDialog1.FilterIndex=1 then
ErrorMessage := ErrorMessage + GetRVFErrors;
Application.MessageBox(PChar(ErrorMessage), 'Error', 0);
end;
FillStyleCombo(RVStyle1.ParaStyles, cmbPara);
FillStyleCombo(RVStyle1.TextStyles, cmbText);
RichViewEdit1.Format;
cmbPara.ItemIndex := RichViewEdit1.CurParaStyleNo;
cmbText.ItemIndex := RichViewEdit1.CurTextStyleNo;
UpdateUndoMenu;
end;
end;
{ Event: picture needed while reading from RVF ------------------------}
procedure TForm1.RichViewEdit1RVFPictureNeeded(Sender: TCustomRichView;
Name: String; Tag: Integer; var gr: TGraphic);
begin
gr := TBitmap.Create;
gr.LoadFromFile(ExtractFilePath(Application.ExeName)+'default.bmp');
end;
{ Event: control needed while reading from RVF ------------------------}
procedure TForm1.RichViewEdit1RVFControlNeeded(Sender: TCustomRichView;
Name: String; Tag: Integer; var ctrl: TControl);
begin
ctrl := TButton.Create(RichViewEdit1);
TButton(ctrl).Caption := 'from file';
end;
{ Event: imagelist needed while reading from RVF ----------------------}
procedure TForm1.RichViewEdit1RVFImageListNeeded(Sender: TCustomRichView;
ImageListTag: Integer; var il: TCustomImageList);
begin
il := Self.il;
end;
{---------------------------------------------------------------------}
function TForm1.GetRVFErrors: String;
begin
Result := '';
if rvfwUnknownPicFmt in RichViewEdit1.RVFWarnings then
Result := Result+'unknown picture format;';
if rvfwUnknownCtrls in RichViewEdit1.RVFWarnings then
Result := Result+'unknown control class;';
if rvfwConvUnknownStyles in RichViewEdit1.RVFWarnings then
Result := Result+'text, paragraph or list style is not present;';
if rvfwConvLargeImageIdx in RichViewEdit1.RVFWarnings then
Result := Result+'invalid image-list index;';
if rvfwUnknownStyleProperties in RichViewEdit1.RVFWarnings then
Result := Result+'unknown property of text, paragraph or list style;';
if Result<>'' 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 <INPUT> tags outside <FORM></FORM> 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 := '<input type="button" value="'+TButton(SaveMe).Caption+'" '+
'onClick="alert(''Just a demo'')">';
exit;
end;
if SaveMe is TEdit then begin
OutStr := '<input type="text" value="'+TEdit(SaveMe).Text+'">';
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','x<y','to be or not to be?',
'(empty)','(full)'
);
begin
edt := TEdit.Create(Self);
edt.Text := Captions[Random(10)];
edt.OnClick := OnControlClick;
RichViewEdit1.InsertControl('',edt,rvvaBaseline);
if RichViewEdit1.CurItemStyle=rvsComponent then
RichViewEdit1.SetCurrentItemExtraIntProperty(rvepResizable, 1, True);
end;
{ Insert|Bullet|"XXX" -------------------------------------------------}
procedure TForm1.mitInsertBulletClick(Sender: TObject);
begin
RichViewEdit1.InsertBullet(TMenuItem(Sender).Tag, il);
end;
{ Insert|Hot Spot|"XXX" -----------------------------------------------}
procedure TForm1.mitAddHSClick(Sender: TObject);
begin
RichViewEdit1.InsertHotSpot(TMenuItem(Sender).Tag, TMenuItem(Sender).Tag+2, il);
end;
{ Insert|Break --------------------------------------------------------}
procedure TForm1.mitBreakClick(Sender: TObject);
begin
RichViewEdit1.InsertBreak(1, rvbsLine, clNone);
end;
{======================================================================}
{ Main menu : "Edit" }
{======================================================================}
{ Edit ----------------------------------------------------------------}
procedure TForm1.mpdEditClick(Sender: TObject);
begin
mitPasteAsRTF.Enabled := RichViewEdit1.CanPasteRTF;
mitPasteAsText.Enabled := Clipboard.HasFormat(CF_TEXT);
mitPasteAsUnicodeText.Enabled := Clipboard.HasFormat(CF_UNICODETEXT);
mitPasteAsMetafile.Enabled := Clipboard.HasFormat(CF_METAFILEPICT);
mitPasteAsBitmap.Enabled := Clipboard.HasFormat(CF_BITMAP);
mitPasteAsRVF.Enabled := RichViewEdit1.CanPasteRVF;
mitPaste.Enabled := RichViewEdit1.CanPaste;
mitInsertPageBreak.Enabled := (RichViewEdit1.InplaceEditor=nil);
mitRemovePageBreak.Enabled :=
(RichViewEdit1.InplaceEditor=nil) and
RichViewEdit1.PageBreaksBeforeItems[RichViewEdit1.CurItemNo];
// You can edit properties only for item at the caret position.
// We disable this item because otherwise user can think what he will
// edit properties of all selected items.
// More smart programs can determine if there is only one item is selected
// and do not disable this item in this case
mitEditProps.Enabled := not RichViewEdit1.SelectionExists;
end;
{ Edit|Undo------------------------------------------------------------}
procedure TForm1.mitUndoClick(Sender: TObject);
begin
RichViewEdit1.Undo;
end;
{ Edit|Redo -----------------------------------------------------------}
procedure TForm1.mitRedoClick(Sender: TObject);
begin
RichViewEdit1.Redo;
end;
{ Edit|Cut ------------------------------------------------------------}
procedure TForm1.mitCutClick(Sender: TObject);
begin
RichViewEdit1.CutDef;
end;
{ Edit|Copy -----------------------------------------------------------}
procedure TForm1.mitCopyClick(Sender: TObject);
begin
RichViewEdit1.CopyDef;
end;
{ Edit|Paste ----------------------------------------------------------}
procedure TForm1.mitPasteClick(Sender: TObject);
begin
RichViewEdit1.Paste;
end;
{ Edit|Paste As|RTF ---------------------------------------------------}
procedure TForm1.mitPasteAsRTFClick(Sender: TObject);
begin
RichViewEdit1.PasteRTF;
end;
{ Edit|Paste As|Text --------------------------------------------------}
procedure TForm1.mitPasteAsTextClick(Sender: TObject);
begin
RichViewEdit1.PasteText;
end;
{ Edit|Paste As|Unicode Text ------------------------------------------}
procedure TForm1.mitPasteAsUnicodeTextClick(Sender: TObject);
begin
RichViewEdit1.PasteTextW;
end;
{ Edit|Paste As|Bitmap ------------------------------------------------}
procedure TForm1.mitPasteAsBitmapClick(Sender: TObject);
begin
RichViewEdit1.PasteBitmap(False);
end;
{ Edit|Paste As|Metafile ----------------------------------------------}
procedure TForm1.mitPasteAsMetafileClick(Sender: TObject);
begin
RichViewEdit1.PasteMetafile(False);
end;
{ Edit|Paste As|RichView Format ---------------------------------------}
procedure TForm1.mitPasteAsRVFClick(Sender: TObject);
begin
RichViewEdit1.PasteRVF;
end;
{ Edit|Paste As|Ole ---------------------------------------------------}
procedure TForm1.mitPasteAsOleClick(Sender: TObject);
var oc: TOleContainer;
begin
oc := TOleContainer.Create(nil);
if oc.CanPaste then begin
oc.Visible := False;
oc.BorderStyle := bsNone;
oc.Parent := RichViewEdit1;
oc.SizeMode := smAutoSize;
oc.Paste;
RichViewEdit1.InsertControl('', oc,rvvaBaseline);
oc.OnResize := OnOleResize;
oc.OnActivate := OnOleActivate;
oc.OnDeactivate := OnOleDeactivate;
oc.Visible := True;
end
else
oc.Free;
end;
{-----------------------------------------------------------------------}
procedure TForm1.CloseOleContainer;
begin
if ActiveOleContainer<>nil 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 c<table.Rows[r].Count-1 then
table.Cells[r,c].VisibleBorders.Right := False;
end;
table.BestWidth := 400;
RichViewEdit1.InsertText('Third example: width of table = 400 pixels, widths of cells - unspecified.',False);
if RichViewEdit1.InsertItem('', table) then begin
end;
end;
{ Table | Insert Table Example 4 --------------------------------------}
procedure TForm1.mitInsertTable4Click(Sender: TObject);
var table: TRVTableItemInfo;
r,c: Integer;
begin
table := TRVTableItemInfo.CreateEx(3,3, RichViewEdit1.RVData);
table.Color := clNone;
table.BorderStyle := rvtbColor;
table.CellBorderStyle := rvtbColor;
table.BorderWidth := 1;
table.BorderVSpacing := 2;
table.BorderHSpacing := 2;
table.CellBorderWidth := 1;
table.CellPadding := 3;
table.CellVSpacing := 5;
table.CellHSpacing := 5;
table.VRuleWidth := 1;
table.HRuleWidth := 1;
for r := 0 to table.Rows.Count-1 do
for c := 0 to table.Rows[r].Count-1 do begin
table.Cells[r,c].BestWidth := 40;
table.Cells[r,c].Clear;
table.Cells[r,c].AddFmt('%d,%d',[r,c],0,0);
table.Cells[r,c].Color := clWhite;
end;
RichViewEdit1.InsertText('Transparent table with rules',False);
if RichViewEdit1.InsertItem('', table) then begin
end;
end;
{ Table submenu popups ------------------------------------------}
procedure TForm1.mpdTableClick(Sender: TObject);
var item: TCustomRVItemInfo;
table: TRVTableItemInfo;
r,c,cs,rs: Integer;
rve: TCustomRichViewEdit;
Selected, SelectionRectangular: Boolean;
begin
if not RichViewEdit1.GetCurrentItemEx(TRVTableItemInfo, rve, item) then begin
mitRowsAbove.Enabled := False;
mitRowsBelow.Enabled := False;
mitColsLeft.Enabled := False;
mitColsRight.Enabled := False;
mitDelRows.Enabled := False;
mitDelColumns.Enabled := False;
mitMergeCells.Enabled := False;
mitUmRows.Enabled := False;
mitUmCols.Enabled := False;
mitUmRowsAndCols.Enabled := False;
mitSplitVertically.Enabled := False;
mitSplitHorizontally.Enabled := False;
exit;
end;
table := TRVTableItemInfo(item);
Selected := table.GetNormalizedSelectionBounds(True,r,c,cs,rs);
mitRowsAbove.Enabled := Selected;
mitRowsBelow.Enabled := Selected;
mitColsLeft.Enabled := Selected;
mitColsRight.Enabled := Selected;
mitDelRows.Enabled := Selected;
mitDelColumns.Enabled := Selected;
mitMergeCells.Enabled := table.CanMergeSelectedCells(True);
SelectionRectangular := Selected and
(table.CanMergeSelectedCells(True) or
(table.GetEditedCell(r,c)<>nil));
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.
Reference in New Issue View Git Blame Copy Permalink