Suite du tuto sur les RichEdit. Cet exemple montre comment faire pour détecter une URL sous le curseur. Pour détecter un autre type de mot clef, il suffit de changer la fonction IsValidChar(). Cf. le zip pour un exemple d'utilisation !
Source / Exemple :
function isValidChar(const c : char) : boolean;
const validChars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$-_.+!*''(),{}|\^~[]`<>#%|<>;/?:@&=';
begin
result := Pos(c, validChars) <> 0;
end;
function GetURLUnderCursor(const RichEdit : TRichEdit) : string;
var
iWordStart, iWordEnd,
iCharIndex, iLineIndex, iCharOffset: Integer;
Pt: TPoint;
mouse : TMouse;
begin
Result := '';
mouse := TMouse.Create();
Pt := mouse.CursorPos;
Pt := RichEdit.ScreenToClient(Pt);
// Récupère le caractère sous le curseur
// (La fonction retourne -1 si elle échoue)
iCharIndex := SendMessage(RichEdit.Handle, Messages.EM_CHARFROMPOS, 0, Integer(@Pt));
if iCharIndex >= 0 then begin
// Si le caractère est valide, on teste les caractères adjacents pour
// savoir si le mot sous le curseur est une URL
if isValidChar(RichEdit.Text[iCharIndex]) then begin
// Récupère l'index de la ligne
iLineIndex := RichEdit.Perform(EM_EXLINEFROMCHAR, 0, LPARAM(iCharIndex));
// Récupère la position du caractère depuis le début de la ligne
iCharOffset := iCharIndex - RichEdit.Perform(Messages.EM_LINEINDEX, WPARAM(iLineIndex), 0);
// Récupère le mot sous le curseur
if length(RichEdit.Lines[iLineIndex]) > 0 then begin
// La partie gauche du mot
iWordStart := iCharOffset + 1;
while iWordStart > 0 do begin
if isValidChar(RichEdit.Lines[iLineIndex][iWordStart]) then
iWordStart := iWordStart - 1
else
break;
end;
// La partie droite
iWordEnd := iCharOffset + 1;
while iWordEnd < length(RichEdit.Lines[iLineIndex]) do begin
if isValidChar(RichEdit.Lines[iLineIndex][iWordEnd]) then
iWordEnd := iWordEnd + 1
else
break;
end;
// On copie le mot dans Result
Result := Copy(RichEdit.Lines[iLineIndex], iWordStart + 1, iWordEnd - iWordStart);
end;
// Si le mot n'est pas une URL, on retourne une chaîne vide
if pos('http://', Result) <> 1 then Result := '';
end;
end;
end;
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.