pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richmemo: extending support for links in win32

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4191 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2015-06-15 17:21:30 +00:00
parent 51cb7240d2
commit bf92d455f5
2 changed files with 32 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
components/richmemo/richmemo.pas
View File

@ -149,6 +149,7 @@ type
TTextUIParam = record TTextUIParam = record
features : TTextUIFeatures; features : TTextUIFeatures;
linkref : String;
end; end;
type type
@ -235,7 +236,7 @@ type
procedure SetRangeParaParams(TextStart, TextLength: Integer; ModifyMask: TParaModifyMask; procedure SetRangeParaParams(TextStart, TextLength: Integer; ModifyMask: TParaModifyMask;
const ParaMetric: TParaMetric); const ParaMetric: TParaMetric);
procedure SetLink(TextStart, TextLength: Integer; AIsLink: Boolean); virtual; procedure SetLink(TextStart, TextLength: Integer; AIsLink: Boolean; const ALinkRef: String = ''); virtual;
function isLink(TextStart: Integer): Boolean; virtual; function isLink(TextStart: Integer): Boolean; virtual;
function LoadRichText(Source: TStream): Boolean; virtual; function LoadRichText(Source: TStream): Boolean; virtual;
@ -895,14 +896,17 @@ begin
until TextLength<=0; until TextLength<=0;
end; end;
procedure TCustomRichMemo.SetLink(TextStart, TextLength: Integer; AIsLink: Boolean); procedure TCustomRichMemo.SetLink(TextStart, TextLength: Integer; AIsLink: Boolean; const ALinkRef: String);
var var
ui : TTextUIParam; ui : TTextUIParam;
begin begin
if HandleAllocated then begin if HandleAllocated then begin
TWSCustomRichMemoClass(WidgetSetClass).GetTextUIParams(Self, TextStart, ui); TWSCustomRichMemoClass(WidgetSetClass).GetTextUIParams(Self, TextStart, ui);
if AIsLink then Include(ui.features, uiLink) if AIsLink then begin
else Exclude(ui.features, uiLink); Include(ui.features, uiLink);
ui.linkref:=ALinkRef;
end else
Exclude(ui.features, uiLink);
TWSCustomRichMemoClass(WidgetSetClass).SetTextUIParams(Self, TextStart, TextLength, ui); TWSCustomRichMemoClass(WidgetSetClass).SetTextUIParams(Self, TextStart, TextLength, ui);
end; end;
end; end;

25
components/richmemo/win32/win32richmemoproc.pas
View File

@ -202,12 +202,17 @@ const
CP_UNICODE = 1200; CP_UNICODE = 1200;
HardBreak = #13; HardBreak = #13;
const
CFE_PROTECTED = $00000010; CFE_PROTECTED = $00000010;
CFE_LINK = $00000020; CFE_LINK = $00000020;
CFM_BACKCOLOR = $04000000; CFM_BACKCOLOR = $04000000;
CFE_AUTOBACKCOLOR = CFM_BACKCOLOR; CFE_AUTOBACKCOLOR = CFM_BACKCOLOR;
ST_DEFAULT = $00000000;
ST_KEEPUNDO = $00000001;
ST_SELECTION = $00000002;
ST_NEWCHARS = $00000004;
ST_UNICODE = $00000008;
const const
PFNS_PAREN = $0000; PFNS_PAREN = $0000;
PFNS_PARENS = $0100; PFNS_PARENS = $0100;
@ -222,6 +227,11 @@ const
CFM_RICHMEMO_ATTRS = CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS CFM_RICHMEMO_ATTRS = CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS
or CFM_SUBSCRIPT or CFM_SUBSCRIPT or CFM_BACKCOLOR; or CFM_SUBSCRIPT or CFM_SUBSCRIPT or CFM_BACKCOLOR;
type
TSetTextEx = packed record
flags : DWORD;
codepage : UINT;
end;
implementation implementation
@ -432,6 +442,10 @@ class procedure TRichEditManager.SetTextUIStyle(RichEditWnd: Handle; const ui: T
var var
w : WPARAM; w : WPARAM;
fmt : TCHARFORMAT2; fmt : TCHARFORMAT2;
{ st : TSetTextEx;
linkrtf : String;
txt : WideString;
txtrtf : String;}
begin begin
if RichEditWnd = 0 then Exit; if RichEditWnd = 0 then Exit;
@ -441,6 +455,15 @@ begin
fmt.cbSize := sizeof(fmt); fmt.cbSize := sizeof(fmt);
fmt.dwMask := CFM_LINK; fmt.dwMask := CFM_LINK;
(* txt := GetTextW(RichEditWnd, true);
st.codepage:=CP_ACP;
st.flags:=ST_SELECTION;
txtrtf:=txt;
writeln('txtrtf = ', txtrtf);
linkrtf:=Format('{\rtf1{\field{\*\fldinst{ HYPERLINK "%s"}}{\fldrslt{%s}}}}',
[ui.linkref, txtrtf]);
SendMessage(RichEditWnd, EM_SETTEXTEX, WPARAM(@st), LParam(@linkrtf[1])); *)
if uiLink in ui.features then fmt.dwEffects := fmt.dwEffects or CFE_LINK; if uiLink in ui.features then fmt.dwEffects := fmt.dwEffects or CFE_LINK;
SendMessage(RichEditWnd, EM_SETCHARFORMAT, w, PtrInt(@fmt)); SendMessage(RichEditWnd, EM_SETCHARFORMAT, w, PtrInt(@fmt));