Unit1.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:5k
源码类别:

RichEdit

开发平台:

Delphi

  1. {==============================================================================}
  2. {
  3.   This demo shows how to implement listbox-like selection using hypertext.
  4.   Property settings:
  5.   - rvoTagsArePChars is included in rv.Options
  6.   - rvoAllowSelection is excluded from rv.Options
  7.   - rv.TabNavigation = rvtnNone
  8.   - rv.Style = RVStyle1
  9.   - 3 text styles are created in RVStyle.TextStyles
  10.     TextStyles[0] - normal text
  11.     TextStyles[1] - hypertext
  12.     TextStyles[2] - hypertext with background
  13.   NOTE: This demo is a bit overcomplicated.
  14.     If you do not use tables (TRVTableItemInfo), you do not need to
  15.     work with RVData variables (because documents without tables
  16.     have only one RVData - rv.RVData)
  17.   NOTE2: phonebook can be saved (rv.SaveRVFFromFile)
  18.     and loaded (rv.LoadRVFFromFile). In order to load bullets (images with phones),
  19.     process OnRVFImageListNeeded.
  20. }
  21. {==============================================================================}
  22. unit Unit1;
  23. interface
  24. uses
  25.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  26.   Dialogs, StdCtrls, RVScroll, RichView, RVStyle, ImgList, CRVFData;
  27. type
  28.   TForm1 = class(TForm)
  29.     ImageList1: TImageList;
  30.     RVStyle1: TRVStyle;
  31.     rv: TRichView;
  32.     Button1: TButton;
  33.     Button2: TButton;
  34.     Button3: TButton;
  35.     Label1: TLabel;
  36.     Label2: TLabel;
  37.     Edit1: TEdit;
  38.     procedure FormCreate(Sender: TObject);
  39.     procedure rvJump(Sender: TObject; id: Integer);
  40.     procedure Button1Click(Sender: TObject);
  41.     procedure Button2Click(Sender: TObject);
  42.     procedure Button3Click(Sender: TObject);
  43.   private
  44.     { Private declarations }
  45.     FSelectedRVData: TCustomRVFormattedData;
  46.     FSelectedItemNo: Integer;
  47.     function MakeTag(s: String): Integer;
  48.     function GetTagStr(tag: Integer): String;
  49.     procedure Select(RVData: TCustomRVFormattedData; ItemNo: Integer);
  50.   public
  51.     { Public declarations }
  52.   end;
  53. var
  54.   Form1: TForm1;
  55. implementation
  56. uses Unit2;
  57. {$R *.dfm}
  58. { TForm1 }
  59. const
  60.   TEXTSTYLE_NOTMALTEXT = 0;
  61.   TEXTSTYLE_JUMP = 1;
  62.   TEXTSTYLE_SELECTED = 2;
  63. function TForm1.MakeTag(s: String): Integer;
  64. begin
  65.   Result := Integer(StrNew(PChar(s)));
  66. end;
  67. function TForm1.GetTagStr(tag: Integer): String;
  68. var i: Integer;
  69. begin
  70.   // reverse function
  71.   Result := PChar(tag);
  72.   for i := 1 to Length(Result) do
  73.     if Result[i]=#1 then
  74.       Result[i] := ' ';
  75. end;
  76. procedure TForm1.FormCreate(Sender: TObject);
  77. begin
  78.   rv.AddNL('Telephone directory:',0,0);
  79.   rv.AddBulletEx('',0, ImageList1, 0);
  80.   rv.AddTag('Kim Lumber',TEXTSTYLE_JUMP, MakeTag('123-4567'));
  81.   rv.AddBulletEx('',0, ImageList1, 0);
  82.   rv.AddTag('Phil Forest',TEXTSTYLE_JUMP, MakeTag('234-5678'));
  83.   rv.AddBulletEx('',0, ImageList1, 0);
  84.   rv.AddTag('Woody Young',TEXTSTYLE_JUMP, MakeTag('345-6789'));
  85.   rv.Format;
  86. end;
  87. procedure TForm1.Select(RVData: TCustomRVFormattedData; ItemNo: Integer);
  88. begin
  89.   if (FSelectedRVData<>nil) and (FSelectedRVData=RVData) and
  90.      (FSelectedItemNo=ItemNo) then begin
  91.     Button2.Click;
  92.     exit;
  93.   end;
  94.   if FSelectedRVData<>nil then
  95.     FSelectedRVData.GetItem(FSelectedItemNo).StyleNo := TEXTSTYLE_JUMP;
  96.   if RVData<>nil then begin
  97.     Edit1.Text := GetTagStr(RVData.GetItemTag(ItemNo));
  98.     RVData.GetItem(ItemNo).StyleNo := TEXTSTYLE_SELECTED;
  99.   end;
  100.   FSelectedRVData := RVData;
  101.   FSelectedItemNo := ItemNo;
  102.   rv.Refresh;
  103.   {
  104.    In this demo, two text styles (TEXTSTYLE_SELECTED and TEXTSTYLE_JUMP)
  105.    have difference only in colors.
  106.    But if they had different font name/size/style, or different jump flag,
  107.    Refresh would be not enough - change this line to rv.Format;
  108.   }
  109. end;
  110. {------------------------------------------------------------------------------}
  111. procedure TForm1.rvJump(Sender: TObject; id: Integer);
  112. var RVData: TCustomRVFormattedData;
  113.     ItemNo: Integer;
  114. begin
  115.   rv.GetJumpPointLocation(id, RVData, ItemNo);
  116.   Select(RVData, ItemNo);
  117. end;
  118. {------------------------------------------------------------------------------}
  119. procedure TForm1.Button1Click(Sender: TObject);
  120. begin
  121.   Form2.Edit1.Text := '';
  122.   Form2.Edit2.Text := '';
  123.   if Form2.ShowModal=mrOk then begin
  124.     rv.AddBulletEx('',0, ImageList1, 0);
  125.     rv.AddTag(Form2.Edit1.Text ,TEXTSTYLE_JUMP, MakeTag(Form2.Edit2.Text));
  126.     rv.FormatTail;
  127.     Select(rv.RVData, rv.ItemCount-1);
  128.   end;
  129. end;
  130. procedure TForm1.Button2Click(Sender: TObject);
  131. begin
  132.   if FSelectedRVData=nil then begin
  133.     Beep;
  134.     exit;
  135.   end;
  136.   Form2.Edit1.Text := FSelectedRVData.GetItemTextA(FSelectedItemNo);
  137.   Form2.Edit2.Text := GetTagStr(FSelectedRVData.GetItemTag(FSelectedItemNo));
  138.   if Form2.ShowModal=mrOk then begin
  139.     FSelectedRVData.SetItemTextA(FSelectedItemNo, Form2.Edit1.Text);
  140.     FSelectedRVData.SetItemTag(FSelectedItemNo, MakeTag(Form2.Edit2.Text));
  141.     rv.Format;
  142.     Edit1.Text := Form2.Edit2.Text;
  143.   end;
  144. end;
  145. procedure TForm1.Button3Click(Sender: TObject);
  146. var RVData: TCustomRVFormattedData;
  147.     ItemNo: Integer;
  148. begin
  149.   if FSelectedRVData=nil then begin
  150.     Beep;
  151.     exit;
  152.   end;
  153.   RVData := FSelectedRVData;
  154.   ItemNo := FSelectedItemNo;
  155.   Select(nil, -1);
  156.   RVData.DeleteItems(ItemNo-1, 2); // deleting two items: image and text
  157.   rv.Format;
  158.   Edit1.Text := '';
  159. end;
  160. end.