Mega Code Archive
How to show better links in a TJvxRichEdit
<![CDATA[
Title: How to show better links in a TJvxRichEdit
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RichEdit, JvRichEd, Shellapi;
type
TForm1 = class(TForm)
JvxRichEdit1: TJvxRichEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure JvxRichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure JvxRichEdit1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
RTF: string;
mword: string;
implementation
{$R *.dfm}
{Wort auf Links pr¨¹fen - Cursor ?ndern}
procedure PruefeWord(RichEdit: TjvxRichEdit; Word1: string);
begin
if Length(word1) 1 then
if word1[1] = ' ' then
Delete(word1, 1, 1);
//Http:// - LInks
if Pos(UpperCase('http://'), UpperCase(Word1)) = 1 then //http:// an der 1 stelle?
begin
if (Pos('.', Word1) 8) then //Ist der . an der stelle 9 oder gr??er
RichEdit.Cursor := crHandPoint;
end
else
begin
//www. - Links
if Pos(UpperCase('www.'), UpperCase(Word1)) = 1 then //www. an der 1 stelle?
begin
if LastDelimiter('.', Word1) Pos('.', Word1) then //Letzter . gr??er als der 1?
RichEdit.Cursor := crHandPoint;
end
else
RichEdit.Cursor := crDefault;
end;
end;
{Wort unterm Cursor ermitteln}
procedure GetWord(Sender: TObject; X, Y: Integer);
var
CIndex, LIndex, Offset, i, j: Integer;
Pt: TPoint;
s: string;
begin
with TjvxRichEdit(Sender) do
begin
Pt := Point(X, Y);
CIndex := Perform(Messages.EM_CHARFROMPOS, 0, Integer(@Pt));
if CIndex 0 then
begin
MWord := '';
Cursor := crDefault;
Exit;
end;
LIndex := Perform(EM_EXLINEFROMCHAR, 0, CIndex);
Offset := CIndex - Perform(EM_LINEINDEX, LIndex, 0);
if Lines.Count - 1 then
begin
MWord := '';
Cursor := crDefault;
Exit;
end;
s := Lines[LIndex];
i := Offset + 1;
while (i 0) and (s[i] ' ') do Dec(i);
j := Offset + 1;
while (j = Length(s)) and (s[j] ' ') do Inc(j);
MWord := Copy(s, i, j - i);
end;
PruefeWord(TjvxRichEdit(Sender), MWord);
end;
{Text ins TRichEdit laden.}
procedure LoadContent(Redit: TJvxRichedit; RTFCode: string);
var
sl: TStringList;
ms: TMemoryStream;
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := RTFCode;
sl.SaveToStream(ms);
ms.Seek(0,0);
if redit nil then
redit.Lines.AddObject(rtfcode, ms);
finally
ms.Free;
end;
finally
sl.Free;
end;
end;
{Text hinzuf¨¹gen - Links makieren}
function AddContent(RichEdit: TjvxRichEdit; Content: string): string;
var
Word: string;
begin
Result := Content;
if not (Content[Length(Content)] = ' ') then //keine Leerstelle zum schluss
Content := Content + ' '; //Leerstelle hinzuf¨¹gen - F¨¹r letztes Wort.
while Pos(' ', Content) 0 do //Leerstelle vorhanden?
begin
Word := Copy(Content, 0, Pos(' ', Content) - 1); //Wort kopieren
//Http:// - Links
if Pos(UpperCase('http://'), UpperCase(Word)) = 1 then //http:// an der 1 stelle?
begin
if (Pos('.', Word) 8) then //Ist der . an der stelle 9 oder gr??er
Result := StringReplace(Result, Word, '\cf1\ul ' + Word +'\cf0\ulnone', [rfIgnoreCase]);
//Link makieren
{\cf1 = 1 Farbe. \cf0 = Normale Farbe "schwarz". \ul
unterstreicht ein Wort/Satz bis wieder \ulnone aufgerufen worden wurde}
end;
//www. - Links
if Pos(UpperCase('www.'), UpperCase(Word)) = 1 then //www. an der 1 stelle?
if LastDelimiter('.', Word) Pos('.', Word) then //Letzter . gr??er als der 1?
Result := StringReplace(Result, Word, '\cf1\ul ' + Word +'\cf0\ulnone', [rfIgnoreCase]);
//Link makieren
Delete(Content, 1, Length(Word) + 1); //Wort aus String l?schen.
end;
LoadContent(RichEdit, Result); //RTF-Code laden.
end;
{RTF-Code erstellen}
procedure SetRTF;
var
C: Longint;
r, g, b: Byte;
begin {Schrift art die sp?ter mit \f0 aufgerufen werden kann.
//Beispiel hinter dem vorletzten - }
{\f1\fnil\fcharset0 Times New Roman;}
//
RTF := '{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fswiss\fprq2\fcharset0 Arial;}}' +
#13#10 +
'{\colortbl ;';
C := ColorToRGB(clblue); //Farbe umwandeln
r := C; //Rot wert auslesen
g := C shr 8; //Gr¨¹n wert
b := C shr 16; //Blau Wert
RTF := RTF + '\red' + IntToStr(r) + '\green' + IntToStr(g) + '\blue' + IntToStr(b) + ';';
//Farbe hinzuf¨¹gen
RTF := RTF + '}' + '\viewkind4\uc1\pard\f0\fs24';
//Font laden Schriftart und Schriftgr??e.
{f0 steht f¨¹r die Schriftart, die oben angegeben wurde. fs24 (font size) die Schriftgr??e}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AddContent(jvxRichEdit1, RTF + ' Delphi Seite: www.swissdelphicenter.ch \par }');
end;
procedure TForm1.JvxRichEdit1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Getword(Sender, x, y);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
setrtf;
end;
procedure TForm1.JvxRichEdit1DblClick(Sender: TObject);
begin
if not (mword = '') then
if mword[1] = ' ' then
Delete(mword, 1, 1);
ShellExecute(Handle, 'open', PChar(Mword), nil, nil, SW_SHOWNORMAL);
end;
end.
]]>