From bf92d455f57bc3fe5eac357c433fa45e071377fd Mon Sep 17 00:00:00 2001
From: skalogryz <skalogryz@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Mon, 15 Jun 2015 17:21:30 +0000
Subject: [PATCH] richmemo: extending support for links in win32

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4191 8e941d3f-bd1b-0410-a28a-d453659cc2b4
---
 components/richmemo/richmemo.pas              | 12 ++++++---
 .../richmemo/win32/win32richmemoproc.pas      | 25 ++++++++++++++++++-
 2 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/components/richmemo/richmemo.pas b/components/richmemo/richmemo.pas
index 2c565f651..1dfb690a8 100644
--- a/components/richmemo/richmemo.pas
+++ b/components/richmemo/richmemo.pas
@@ -149,6 +149,7 @@ type
 
   TTextUIParam = record
     features : TTextUIFeatures;
+    linkref  : String;
   end;
 
 type
@@ -235,7 +236,7 @@ type
     procedure SetRangeParaParams(TextStart, TextLength: Integer; ModifyMask: TParaModifyMask;
       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 LoadRichText(Source: TStream): Boolean; virtual;
@@ -895,14 +896,17 @@ begin
   until TextLength<=0;
 end;
 
-procedure TCustomRichMemo.SetLink(TextStart, TextLength: Integer; AIsLink: Boolean);
+procedure TCustomRichMemo.SetLink(TextStart, TextLength: Integer; AIsLink: Boolean; const ALinkRef: String);
 var
   ui : TTextUIParam;
 begin
   if HandleAllocated then begin
     TWSCustomRichMemoClass(WidgetSetClass).GetTextUIParams(Self, TextStart, ui);
-    if AIsLink then Include(ui.features, uiLink)
-    else Exclude(ui.features, uiLink);
+    if AIsLink then begin
+      Include(ui.features, uiLink);
+      ui.linkref:=ALinkRef;
+    end else
+      Exclude(ui.features, uiLink);
     TWSCustomRichMemoClass(WidgetSetClass).SetTextUIParams(Self, TextStart, TextLength, ui);
   end;
 end;
diff --git a/components/richmemo/win32/win32richmemoproc.pas b/components/richmemo/win32/win32richmemoproc.pas
index e6854dc4f..34e959b3d 100644
--- a/components/richmemo/win32/win32richmemoproc.pas
+++ b/components/richmemo/win32/win32richmemoproc.pas
@@ -202,12 +202,17 @@ const
   CP_UNICODE   = 1200;
   HardBreak    = #13;
 
-const
   CFE_PROTECTED = $00000010;
   CFE_LINK      = $00000020;
   CFM_BACKCOLOR = $04000000;
   CFE_AUTOBACKCOLOR = CFM_BACKCOLOR;
 
+  ST_DEFAULT   = $00000000;
+  ST_KEEPUNDO  = $00000001;
+  ST_SELECTION = $00000002;
+  ST_NEWCHARS  = $00000004;
+  ST_UNICODE   = $00000008;
+
 const
   PFNS_PAREN      = $0000;
   PFNS_PARENS     = $0100;
@@ -222,6 +227,11 @@ const
   CFM_RICHMEMO_ATTRS = CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS
                        or CFM_SUBSCRIPT or CFM_SUBSCRIPT or CFM_BACKCOLOR;
 
+type
+  TSetTextEx = packed record
+    flags    : DWORD;
+    codepage : UINT;
+  end;
 
 implementation
 
@@ -432,6 +442,10 @@ class procedure TRichEditManager.SetTextUIStyle(RichEditWnd: Handle; const ui: T
 var
   w   : WPARAM;
   fmt : TCHARFORMAT2;
+{  st  : TSetTextEx;
+  linkrtf : String;
+  txt     : WideString;
+  txtrtf  : String;}
 begin
   if RichEditWnd = 0 then Exit;
 
@@ -441,6 +455,15 @@ begin
   fmt.cbSize := sizeof(fmt);
 
   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;
 
   SendMessage(RichEditWnd, EM_SETCHARFORMAT, w, PtrInt(@fmt));