About HyperLink

Hard to simplify in a sentence.
Here is my problem:

I have a database, for example:
viva
forever
love

Then, I type in TRichEdit:
I love you forever.

This is what I want:
when I move my mouse on word "love" or "forever",
the mouse pointer changes to crHandPoint.

So, how to do that?
I hope you can understand my point.
Sorry for the incovenience, since English is not natural
language in my country...

Like usual, waiting for help from any expert...



stinger_60284Asked:
Who is Participating?
 
erajojConnect With a Mentor Commented:
Hi,
Here's a simple way to do it.
It works on both TRichEdit and TMemo:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Slask1: TRichEdit;
    Richedit1: TMemo;
    procedure Slask1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    m_ValidToken: TStringList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Slask1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const
  VALIDCHAR = [ '0'..'9', 'A'..'Z' ];
var
  sText, sToken: string;
  iPos, iStartPos, iLength : Integer;
  POINTL : TPoint;
  Lines  : TStrings;
begin
  if ( Sender is TRichEdit ) then begin
    POINTL := Point( X, Y );
    iPos  := SendMessage( TRichEdit( Sender ).Handle, EM_CHARFROMPOS, 0, Integer( @POINTL ) );
  end else if ( Sender is TMemo )
  then iPos := SendMessage( TMemo( Sender ).Handle, EM_CHARFROMPOS, 0, MakeLParam( X, Y ) )
  else begin
    ( Sender as TControl ).Cursor := crIBeam; // restore cursor
    Exit; // no need to continue
  end;
  sText := TCustomMemo( Sender ).Text;

  if ( iPos = -1 ) then // no char hit
  begin
    ( Sender as TControl ).Cursor := crIBeam; // restore cursor
    Exit; // no need to continue
  end;

  iStartPos := LOWORD( iPos ) + 1; // string offset +1
  iLength   := 1;
  if not ( UpCase( sText[ iStartPos ] ) in VALIDCHAR ) then // no valid char hit
  begin
    ( Sender as TControl ).Cursor := crIBeam; // restore cursor
    Exit; // no need to continue
  end;

  while ( iStartPos > 0 ) and ( UpCase( sText[ iStartPos ] ) in VALIDCHAR ) do Dec( iStartPos ); Inc( iStartPos );
  while ( iStartPos + iLength < Length( sText ) ) and ( UpCase( sText[ iStartPos + iLength ] ) in VALIDCHAR ) do Inc( iLength );

  sToken  := Copy( sText, iStartPos, iLength );
  if ( m_ValidToken.Find( sToken, iPos ) )
  then ( Sender as TControl ).Cursor := crHandPoint
  else ( Sender as TControl ).Cursor := crIBeam;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  m_ValidToken := TStringList.Create;
  with m_ValidToken do begin
    Sorted := True; // enable fast binary search
    Add( 'Love' );
    Add( 'Forever' );
  end;
end;

end.

/// John
0
 
gysbert1Commented:
A few thoughts, might help ...

1) Hook into the MouseMove event of the control and check do all your processing here ...
2) Create a list with all the items in the database that you regularly update (how often will the dabase change ?)
3) If no method exixts to find text at a certain location you will have to calculate it (bummer) using the font attributes and the position in the control...
4) You know how easy it is to change the cursor so I do not have to go into that !

0
 
gysbert1Commented:
That looks exactly right !

I would accept it ... (Definate A  ;^)
0
 
erajojCommented:
Well, hold your horses, try it out first. I haven't tested it yet....

/// John
0
 
stinger_60284Author Commented:
Okay John, I believe in gysbert1.
Btw, if there's a mistake, i'll ask you...
:)

Thanks for your kindness!!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.