Cette fonction sert à souligner et à mettre en bleu automatiquement toutes les URLs d'un contrôle TRichEdit. Appelez la fonction HighlightURL et passez lui votre contrôle RichEdit en paramètre. La fonction peut être modifiée pour gérer d'autres types de mots clefs.
Dans le ZIP, il y a la fonction et une petite démo.
Source / Exemple :
unit HighlightURL_unit;
interface
uses ComCtrls, Windows, Messages, Graphics;
procedure HighlightURL(const RichEdit : TRichEdit);
implementation
procedure HighlightURL(const RichEdit : TRichEdit);
var sCopy : string;
memoIndex : integer;
s : string;
urlPos : integer;
j : integer;
URL : string;
// Vérifie que le caractère est un caractère d'URL valide.
function isValidChar(const c : char) : boolean;
const validChars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$-_.+!*''(),{}|\^~[]`<>#%|<>;/?:@&=';
begin
result := Pos(c, validChars) <> 0;
end;
begin
s := RichEdit.Lines.Text;
sCopy := Copy(s, 0, length(s));
memoIndex := 0;
RichEdit.Tag := 1;
// Cache le marqueur de sélection avant le traitement
// --> WM_USER + 63 = EM_HIDESELECTION
RichEdit.Perform(Messages.WM_USER + 63, WPARAM(TRUE), LPARAM(FALSE));
// Met tout le texte en noir / non-souligné
RichEdit.SelectAll;
RichEdit.SelAttributes.Color := clBlack;
RichEdit.SelAttributes.Style := [];
// Cherche une URL
urlPos := Pos('http://', sCopy);
while urlPos <> 0 do begin // S'il y a une URL à traiter
// Copie le texte à partir du début de l'URL jusqu'à la fin du texte
sCopy := Copy(sCopy, urlPos, length(sCopy));
memoIndex := memoIndex + urlPos;
// Met le curseur au début de l'URL
RichEdit.SelStart := memoIndex - 1;
j := 1;
URL := '';
// Cherche la fin de l'URL
while isValidChar(sCopy[j]) do begin
URL := URL + sCopy[j];
j := j + 1;
end;
sCopy := copy(sCopy, j, length(sCopy));
memoIndex := memoIndex + j - 2;
// Etend la sélection jusqu'à la fin de l'URL
RichEdit.SelLength := memoIndex - RichEdit.SelStart;
// Met l'URL en bleu et la souligne
RichEdit.SelAttributes.Color := clBlue;
RichEdit.SelAttributes.Style := [fsUnderline];
// Cherche la prochaine URL à traiter
urlPos := Pos('http://', sCopy);
end;
RichEdit.SelStart := 0;
// --> WM_USER + 63 = EM_HIDESELECTION
RichEdit.Perform(Messages.WM_USER + 63, WPARAM(FALSE), LPARAM(FALSE));
RichEdit.Tag := 0;
end;
end.
Conclusion :
Prochainement, une démo complémentaire pour rendre les URL "cliquables" :)
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.