unit URichBoxHyperlink;
interface
uses
System.Drawing, System.Collections, System.ComponentModel, System.Windows.Forms,
System.Runtime.InteropServices;
type
TArrayOfWideChar =
array of WideChar;
[StructLayout(LayoutKind.Sequential)]
CHARFORMAT2_STRUCT =
class
public
cbSize: UInt32;
dwMask: UInt32;
dwEffects: UInt32;
yHeight: Int32;
yOffset: Int32;
crTextColor: Int32;
bCharSet: Byte;
bPitchAndFamily: Byte;
szFaceName: TArrayOfWideChar;
wWeight: UInt16;
sSpacing: UInt16;
crBackColor: Integer;
lcid: Integer;
dwReserved: Integer;
sStyle: Int16;
wKerning: Int16;
bUnderlineType: Byte;
bAnimation: Byte;
bRevAuthor: Byte;
bReserved1: Byte;
end;
type
RichTextBoxHyperlink =
class(System.Windows.Forms.RichTextBox)
strict private
Components: System.ComponentModel.Container;
WM_USER: Integer;
EM_GETCHARFORMAT: Integer;
EM_SETCHARFORMAT: Integer;
SCF_SELECTION: Integer;
SCF_WORD: Integer;
SCF_ALL: Integer;
CFE_BOLD: UInt32;
CFE_ITALIC: UInt32;
CFE_UNDERLINE: UInt32;
CFE_STRIKEOUT: UInt32;
CFE_PROTECTED: UInt32;
CFE_LINK: UInt32;
CFE_AUTOCOLOR: UInt32;
CFE_SUBSCRIPT: UInt32;
CFE_SUPERSCRIPT: UInt32;
CFM_SMALLCAPS: Integer;
CFM_ALLCAPS: Integer;
CFM_HIDDEN: Integer;
CFM_OUTLINE: Integer;
CFM_SHADOW: Integer;
CFM_EMBOSS: Integer;
CFM_IMPRINT: Integer;
CFM_DISABLED: Integer;
CFM_REVISED: Integer;
CFM_BACKCOLOR: Integer;
CFM_LCID: Integer;
CFM_UNDERLINETYPE: Integer;
CFM_WEIGHT: Integer;
CFM_SPACING: Integer;
CFM_KERNING: Integer;
CFM_STYLE: Integer;
CFM_ANIMATION: Integer;
CFM_REVAUTHOR: Integer;
CFM_BOLD: UInt32;
CFM_ITALIC: UInt32;
CFM_UNDERLINE: UInt32;
CFM_STRIKEOUT: UInt32;
CFM_PROTECTED: UInt32;
CFM_LINK: UInt32;
CFM_SIZE: UInt32;
CFM_COLOR: UInt32;
CFM_FACE: UInt32;
CFM_OFFSET: UInt32;
CFM_CHARSET: UInt32;
CFM_SUBSCRIPT: UInt32;
CFM_SUPERSCRIPT: UInt32;
CFU_UNDERLINENONE: Byte;
CFU_UNDERLINE: Byte;
CFU_UNDERLINEWORD: Byte;
CFU_UNDERLINEDOUBLE: Byte;
CFU_UNDERLINEDOTTED: Byte;
CFU_UNDERLINEDASH: Byte;
CFU_UNDERLINEDASHDOT: Byte;
CFU_UNDERLINEDASHDOTDOT: Byte;
CFU_UNDERLINEWAVE: Byte;
CFU_UNDERLINETHICK: Byte;
CFU_UNDERLINEHAIRLINE: Byte;
[DllImport('
user32.dll', CharSet=CharSet.Auto)]
class function SendMessage(hWnd: IntPtr; msg: Integer; wParam: IntPtr; lParam: IntPtr): IntPtr;
static;
procedure SetSelectionStyle(mask: UInt32; effect: UInt32);
function GetSelectionStyle(mask: UInt32; effect: UInt32): Integer;
procedure InitializeComponent;
strict protected
/// <summary>
/// Ressourcen nach der Verwendung bereinigen
/// </summary>
procedure Dispose(Disposing: Boolean);
override;
public
constructor Create;
overload;
constructor Create(Container: System.ComponentModel.IContainer);
overload;
function get_DetectUrls: Boolean;
reintroduce;
procedure set_DetectUrls(Value: Boolean);
reintroduce;
[DefaultValue(False)]
property DetectUrls: Boolean
read get_DetectUrls
write set_DetectUrls;
procedure InsertLink(text:
string);
overload;
procedure InsertLink(text:
string; position: Integer);
overload;
procedure InsertLink(text:
string; hyperlink:
string);
overload;
procedure InsertLink(text:
string; hyperlink:
string; position: Integer);
overload;
procedure SetSelectionLink(link: Boolean);
function GetSelectionLink: Integer;
end;
implementation
uses
System.Globalization;
{$AUTOBOX ON}
procedure RichTextBoxHyperlink.InitializeComponent;
begin
Self.Components := System.ComponentModel.Container.Create;
end;
{$HINTS OFF}
{$WARNINGS OFF}
constructor RichTextBoxHyperlink.Create;
begin
inherited Create;
Self.DetectUrls := False;
end;
constructor RichTextBoxHyperlink.Create(Container: System.ComponentModel.IContainer);
begin
inherited Create;
//
// Erforderlich für die Unterstützung des Windows Forms-Designers
//
Container.Add(Self);
InitializeComponent;
//
// TODO: Fügen Sie nach dem Aufruf von InitializeComponent Konstruktorcode hinzu.
//
end;
procedure RichTextBoxHyperlink.Dispose(Disposing: Boolean);
begin
if Disposing
then
begin
if Components <>
nil then
Components.Dispose();
end;
inherited Dispose(Disposing);
end;
function RichTextBoxHyperlink.get_DetectUrls: Boolean;
begin
Result :=
inherited DetectUrls;
end;
procedure RichTextBoxHyperlink.set_DetectUrls(Value: Boolean);
begin
inherited DetectUrls := value;
end;
class function RichTextBoxHyperlink.SendMessage(hWnd: IntPtr; msg: Integer; wParam: IntPtr;
lParam: IntPtr): IntPtr;
begin
end;
procedure RichTextBoxHyperlink.InsertLink(text:
string);
begin
InsertLink(text, Self.SelectionStart);
end;
procedure RichTextBoxHyperlink.InsertLink(text:
string; position: Integer);
begin
if ((position < 0)
or (position > Self.Text.Length))
then
raise ArgumentOutOfRangeException.Create('
position');
Self.SelectionStart := position;
Self.SelectedText := text;
Self.Select(position, text.Length);
Self.SetSelectionLink(True);
Self.Select((position + text.Length), 0);
end;
procedure RichTextBoxHyperlink.InsertLink(text:
string; hyperlink:
string);
begin
InsertLink(text, hyperlink, Self.SelectionStart);
end;
procedure RichTextBoxHyperlink.InsertLink(text:
string; hyperlink:
string; position: Integer);
begin
if ((position < 0)
or (position > Self.Text.Length))
then
raise ArgumentOutOfRangeException.Create('
position');
Self.SelectionStart := position;
Self.SelectedRtf := (((('
{\rtf1\ansi ' + text) + '
\v #') + hyperlink) + '
\v0}');
Self.Select(position, ((text.Length + hyperlink.Length) + 1));
Self.SetSelectionLink(True);
Self.Select((((position + text.Length) + hyperlink.Length) + 1), 0);
end;
procedure RichTextBoxHyperlink.SetSelectionLink(link: Boolean);
begin
if link
then begin
CFE_Link := 0;
SetSelectionStyle(CFM_LINK, CFE_Link);
end;
end;
function RichTextBoxHyperlink.GetSelectionLink: Integer;
begin
Result := GetSelectionStyle(CFM_LINK, CFE_LINK);
end;
procedure RichTextBoxHyperlink.SetSelectionStyle(mask: UInt32; effect: UInt32);
var
res: IntPtr;
lpar: IntPtr;
wpar: IntPtr;
cf: CHARFORMAT2_STRUCT;
begin
cf := CHARFORMAT2_STRUCT.Create;
cf.cbSize := (UInt32(Marshal.SizeOf(cf)));
cf.dwMask := mask;
cf.dwEffects := effect;
wpar := IntPtr.Create(SCF_SELECTION);
lpar := Marshal.AllocCoTaskMem(Marshal.SizeOf(cf));
Marshal.StructureToPtr(cf, lpar, False);
res := SendMessage(Self.Handle, EM_SETCHARFORMAT, wpar, lpar);
Marshal.FreeCoTaskMem(lpar);
end;
function RichTextBoxHyperlink.GetSelectionStyle(mask: UInt32; effect: UInt32): Integer;
var
state: Integer;
res: IntPtr;
lpar: IntPtr;
wpar: IntPtr;
cf: CHARFORMAT2_STRUCT;
begin
cf := CHARFORMAT2_STRUCT.Create;
cf.cbSize := (UInt32(Marshal.SizeOf(cf)));
cf.szFaceName := New(TArrayOfWideChar, 32);
wpar := IntPtr.Create(SCF_SELECTION);
lpar := Marshal.AllocCoTaskMem(Marshal.SizeOf(cf));
Marshal.StructureToPtr(cf, lpar, False);
res := SendMessage(Self.Handle, EM_GETCHARFORMAT, wpar, lpar);
cf := (CHARFORMAT2_STRUCT(Marshal.PtrToStructure(lpar, TypeOf(CHARFORMAT2_STRUCT))));
if ((cf.dwMask
and mask) = mask)
then
if ((cf.dwEffects
and effect) = effect)
then
state := 1
else
state := 0
else
state := -1;
Marshal.FreeCoTaskMem(lpar);
Result := state;
end;
end.