//------------------------------------------------------------------------------
// <autogenerated>
// This code was generated by a tool.
// Runtime Version: 1.1.4322.573
//
// Changes to this file may cause incorrect behavior and will be lost if
// the code is regenerated.
// </autogenerated>
//------------------------------------------------------------------------------
unit DP.RichTextEx;
interface
type
RichTextBoxEx =
class(RichTextBox)
public
type
CharFormat2Mask = (Link);
CharFormat2Effect = (_Link, None);
TArrayOfWideChar =
array of WideChar;
[StructLayout(LayoutKind.Sequential)]
CharFormat2 =
class
public
cbSize: Cardinal;
dwMask: CharFormat2Mask;
dwEffects: CharFormat2Effect;
yHeight: Integer;
yOffset: Integer;
crTextColor: Integer;
bCharSet: Byte;
bPitchAndFamily: Byte;
szFaceName: TArrayOfWideChar;
wWeight: System.UInt16;
sSpacing: System.UInt16;
crBackColor: Integer;
lcid: Integer;
dwReserved: Integer;
sStyle: SmallInt;
wKerning: SmallInt;
bUnderlineType: Byte;
bAnimation: Byte;
bRevAuthor: Byte;
bReserved1: Byte;
end;
Message = (User, GetCharFormat, SetCharFormat);
strict private
SCF_SELECTION: Integer;
public
constructor Create;
function get_DetectUrls: Boolean;
reintroduce;
procedure set_DetectUrls(Value: Boolean);
reintroduce;
[DefaultValue(False)]
property DetectUrls: Boolean
read get_DetectUrls
write set_DetectUrls;
strict private
[DllImport('
user32.dll', CharSet=CharSet.Auto)]
class function SendMessage(hWnd: IntPtr; msg:
Message; wParam: IntPtr; lParam: IntPtr): IntPtr;
static;
public
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;
strict private
procedure SetSelectionStyle(mask: CharFormat2Mask; effect: CharFormat2Effect);
function GetSelectionStyle(mask: CharFormat2Mask; effect: CharFormat2Effect): Integer;
end;
implementation
{$AUTOBOX ON}
{$HINTS OFF}
{$WARNINGS OFF}
constructor RichTextBoxEx.Create;
begin
inherited Create;
Self.DetectUrls := False;
end;
function RichTextBoxEx.get_DetectUrls: Boolean;
begin
Result :=
inherited DetectUrls;
end;
procedure RichTextBoxEx.set_DetectUrls(Value: Boolean);
begin
inherited DetectUrls := value;
end;
class function RichTextBoxEx.SendMessage(hWnd: IntPtr; msg:
Message; wParam: IntPtr;
lParam: IntPtr): IntPtr;
begin
end;
procedure RichTextBoxEx.InsertLink(text:
string);
begin
InsertLink(text, Self.SelectionStart);
end;
procedure RichTextBoxEx.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 RichTextBoxEx.InsertLink(text:
string; hyperlink:
string);
begin
InsertLink(text, hyperlink, Self.SelectionStart);
end;
procedure RichTextBoxEx.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 RichTextBoxEx.SetSelectionLink(__link: Boolean);
begin
SetSelectionStyle(CharFormat2Mask.Link, );
end;
function RichTextBoxEx.GetSelectionLink: Integer;
begin
Result := GetSelectionStyle(CharFormat2Mask.Link, CharFormat2Effect.Link);
end;
procedure RichTextBoxEx.SetSelectionStyle(mask: CharFormat2Mask; effect: CharFormat2Effect);
var
lpar: IntPtr;
wpar: IntPtr;
cf: CharFormat2;
begin
cf := CharFormat2.Create;
cf.cbSize := (Cardinal(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);
SendMessage(Self.Handle,
Message.SetCharFormat, wpar, lpar);
Marshal.FreeCoTaskMem(lpar);
end;
function RichTextBoxEx.GetSelectionStyle(mask: CharFormat2Mask; effect: CharFormat2Effect): Integer;
type
TArrayOfArrayOfWideChar =
array of array of WideChar;
var
state: Integer;
lpar: IntPtr;
wpar: IntPtr;
cf: CharFormat2;
begin
cf := CharFormat2.Create;
cf.cbSize := (Cardinal(Marshal.SizeOf(cf)));
cf.szFaceName := New(TArrayOfArrayOfWideChar, 32);
wpar := IntPtr.Create(SCF_SELECTION);
lpar := Marshal.AllocCoTaskMem(Marshal.SizeOf(cf));
Marshal.StructureToPtr(cf, lpar, False);
SendMessage(Self.Handle,
Message.GetCharFormat, wpar, lpar);
cf := (CharFormat2(Marshal.PtrToStructure(lpar, TypeOf(CharFormat2))));
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.