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

RichEdit

开发平台:

Delphi

  1. unit Unit1;
  2. interface
  3. {==============================================================================}
  4. { This demo shows mouse events, not connected with hypertext IDs               }
  5. { - OnRVMouseDown, OnRVMouseUp, OnRVDblClick, OnRVRightClick;                  }
  6. {------------------------------------------------------------------------------}
  7. uses
  8.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9.   ExtCtrls, RVScroll, RichView, RVStyle, StdCtrls,
  10.   CRVFData;
  11. type
  12.   TForm1 = class(TForm)
  13.     RichView1: TRichView;
  14.     panMouseDown: TPanel;
  15.     panMouseUp: TPanel;
  16.     panRightClick: TPanel;
  17.     panDblClick: TPanel;
  18.     RVStyle1: TRVStyle;
  19.     Image1: TImage;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     Label3: TLabel;
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure RichView1RVMouseDown(Sender: TCustomRichView; Button: TMouseButton;
  25.       Shift: TShiftState; ItemNo, X, Y: Integer);
  26.     procedure RichView1RVMouseUp(Sender: TCustomRichView; Button: TMouseButton;
  27.       Shift: TShiftState; ItemNo, X, Y: Integer);
  28.     procedure RichView1RVDblClick(Sender: TCustomRichView; ClickedWord: String;
  29.       Style: Integer);
  30.     procedure RichView1RVRightClick(Sender: TCustomRichView; ClickedWord: String;
  31.       Style, X, Y: Integer);
  32.   private
  33.     { Private declarations }
  34.     function MouseInfo(Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer):String;
  35.   public
  36.     { Public declarations }
  37.   end;
  38. var
  39.   Form1: TForm1;
  40. implementation
  41. {$R *.DFM}
  42. procedure TForm1.FormCreate(Sender: TObject);
  43. var ico: TIcon;
  44. begin
  45.   RichView1.AddNL('More mouse events',1,1);
  46.   RichView1.AddTextNL('There are some more mouse events in RichView'#13+
  47.                       'Left/Right/Double - click in this Window.',0,0,0);
  48.   ico := TIcon.Create;
  49.   ico.Assign(Image1.Picture.Graphic);
  50.   RichView1.AddPictureEx('Notebook image',ico,1, rvvaMiddle);
  51.   RichView1.Add(' - example of image',0);
  52.   RichView1.Format;
  53. end;
  54. function TForm1.MouseInfo(Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer): String;
  55. var ButtonStr, Word: String;
  56.     AItemNo: Integer;
  57.     ARVData: TCustomRVFormattedData;
  58. begin
  59.   ButtonStr := '';
  60.   case Button of
  61.     mbLeft:
  62.       ButtonStr := 'Left button';
  63.     mbRight:
  64.       ButtonStr := 'Right button';
  65.     mbMiddle:
  66.       ButtonStr := 'Middle button';
  67.   end;
  68.   if ItemNo<>-1 then begin
  69.     {
  70.     // this version is available since D4
  71.     Word := RichView1.GetWordAt(X,Y);
  72.     }
  73.     RichView1.GetWordAt(X,Y, ARVData, AItemNo, Word);
  74.     Result := Format('%s at (%d,%d), at item #%d, at word "%s"',
  75.                      [ButtonStr, X,Y, ItemNo, Word]);
  76.     end
  77.   else
  78.     Result := Format('%s at (%d,%d) - no item at this position',
  79.                      [ButtonStr, X,Y]);
  80. end;
  81. procedure TForm1.RichView1RVMouseDown(Sender: TCustomRichView;
  82.   Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
  83. begin
  84.   panMouseDown.Caption := 'MouseDown: '+MouseInfo(Button, Shift, ItemNo, X, Y);
  85. end;
  86. procedure TForm1.RichView1RVMouseUp(Sender: TCustomRichView;
  87.   Button: TMouseButton; Shift: TShiftState; ItemNo, X, Y: Integer);
  88. begin
  89.   panMouseUp.Caption := 'MouseUp: '+MouseInfo(Button, Shift, ItemNo, X, Y);
  90. end;
  91. procedure TForm1.RichView1RVDblClick(Sender: TCustomRichView;
  92.   ClickedWord: String; Style: Integer);
  93. begin
  94.   panDblClick.Caption := Format('DoubleClick: at word="%s", at item having style=%d',
  95.                                   [ClickedWord,Style]);
  96. end;
  97. // This event is obsolete. Use OnRVMouseUp instead
  98. procedure TForm1.RichView1RVRightClick(Sender: TCustomRichView; ClickedWord: String; Style, X, Y: Integer);
  99. begin
  100.   panRightClick.Caption := Format('RightClick: at (%d,%d), at word="%s", at item having style=%d',
  101.                                   [X,Y,ClickedWord,Style]);
  102. end;
  103. end.