richmemo: add support for links (via textuiparams), added implementation for win32

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4071 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/richmemo/richmemo.pas

@@ -26,7 +26,7 @@ interface
 uses
   Types, Classes, SysUtils
   , LCLType, LCLIntf, Printers
-  , Graphics, StdCtrls, LazUTF8;
+  , Graphics, Controls, StdCtrls, LazUTF8;
 
 type
   TVScriptPos = (vpNormal, vpSubScript, vpSuperScript);
@@ -132,6 +132,25 @@ type
     PrintCanvas: TCanvas;
     CurrentPage: Integer; var AbortPrint: Boolean) of object;
 
+type
+  TLinkAction = (laClick);
+
+  TLinkMouseInfo = record
+    button : TMouseButton;
+  end;
+
+  TLinkActionEvent = procedure (Sender: TObject;
+    ALinkAction: TLinkAction;
+    const info: TLinkMouseInfo;
+    LinkStart, LinkLen: Integer) of object;
+
+  TTextUIFeature = (uiLink);
+  TTextUIFeatures = set of TTextUIFeature;
+
+  TTextUIParam = record
+    features : TTextUIFeatures;
+  end;
+
 type
   TRichMemoObject = class(TObject);
   TCustomRichMemo = class;
@@ -158,6 +177,7 @@ type
     fHideSelection      : Boolean;
     fOnSelectionChange  : TNotifyEvent;
     fOnPrintAction      : TPrintActionEvent;
+    fOnLinkAction       : TLinkActionEvent;
     fZoomFactor         : Double;
   private
     procedure InlineInvalidate(handler: TRichMemoInline);
@@ -179,6 +199,8 @@ type
     procedure DoPrintAction(PrintJobEvent: TPrintAction;
       PrintCanvas: TCanvas;
       CurrentPage: Integer; var AbortPrint: Boolean);
+    procedure DoLinkAction(ALinkAction: TLinkAction; const AMouseInfo: TLinkMouseInfo;
+      LinkStart, LinkEnd: Integer);
 
   public
     constructor Create(AOwner: TComponent); override;
@@ -209,9 +231,12 @@ type
       const FontName: String; FontSize: Integer; FontColor: TColor; AddFontStyle, RemoveFontStyle: TFontStyles); overload;
     procedure SetRangeParams(TextStart, TextLength: Integer; ModifyMask: TTextModifyMask;
       const fnt: TFontParams; AddFontStyle, RemoveFontStyle: TFontStyles); overload;
-    procedure SetRangeParaParams(TextStart, TextLength: INteger; ModifyMask: TParaModifyMask;
+    procedure SetRangeParaParams(TextStart, TextLength: Integer; ModifyMask: TParaModifyMask;
       const ParaMetric: TParaMetric);
 
+    procedure SetLink(TextStart, TextLength: Integer; AIsLink: Boolean); virtual;
+    function isLink(TextStart: Integer): Boolean; virtual;
+
     function LoadRichText(Source: TStream): Boolean; virtual;
     function SaveRichText(Dest: TStream): Boolean; virtual;
 
@@ -228,6 +253,7 @@ type
     property OnSelectionChange: TNotifyEvent read fOnSelectionChange write fOnSelectionChange;
     property ZoomFactor: Double read GetZoomFactor write SetZoomFactor;
     property OnPrintAction: TPrintActionEvent read fOnPrintAction write fOnPrintAction;
+    property OnLinkAction: TLinkActionEvent read fOnLinkAction write fOnLinkAction;
   end;
   
   { TRichMemo }
@@ -314,6 +340,7 @@ procedure InitTabStopList(var tabs: TTabStopList); overload;
 procedure InitTabStopList(var tabs: TTabStopList; const TabStopsPt: array of double); overload;
 procedure InitPrintParams(var prm: TPrintParams);
 
+procedure InitTextUIParams(var prm: TTextUIParam);
 
 var
   RTFLoadStream : function (AMemo: TCustomRichMemo; Source: TStream): Boolean = nil;
@@ -322,7 +349,7 @@ var
 implementation
 
 uses
-  RichMemoFactory, WSRichMemo;
+  {%H-}RichMemoFactory, WSRichMemo;
 
 procedure InitFontParams(var p: TFontParams);
 begin
@@ -462,6 +489,11 @@ begin
   FillChar(prm, sizeof(prm), 0);
 end;
 
+procedure InitTextUIParams(var prm: TTextUIParam);
+begin
+  FillChar(prm, sizeof(prm), 0);
+end;
+
 { TRichMemoInline }
 
 procedure TRichMemoInline.Draw(Canvas: TCanvas; const ASize: TSize);
@@ -559,10 +591,14 @@ procedure TCustomRichMemo.DoPrintAction(PrintJobEvent: TPrintAction;
   PrintCanvas: TCanvas; CurrentPage: Integer; var AbortPrint: Boolean);
 begin
   if Assigned(OnPrintAction) then
-    try
+    OnPrintAction(Self, PrintJobEvent, PrintCanvas, CurrentPAge, AbortPrint);
-      OnPrintAction(Self, PrintJobEvent, PrintCanvas, CurrentPAge, AbortPrint);
+end;
-    except
+
-    end;
+procedure TCustomRichMemo.DoLinkAction(ALinkAction: TLinkAction; const AMouseInfo: TLinkMouseInfo; LinkStart,
+  LinkEnd: Integer);
+begin
+  if Assigned(OnLinkAction) then
+    OnLinkAction(Self, ALinkAction, AMouseInfo, LinkStart, LinkEnd);
 end;
 
 procedure TCustomRichMemo.InlineInvalidate(handler: TRichMemoInline);
@@ -821,7 +857,7 @@ begin
   end;
 end;
 
-procedure TCustomRichMemo.SetRangeParaParams(TextStart, TextLength: INteger;
+procedure TCustomRichMemo.SetRangeParaParams(TextStart, TextLength: Integer;
   ModifyMask: TParaModifyMask; const ParaMetric: TParaMetric);
 var
   ln: Integer;
@@ -846,6 +882,26 @@ begin
   until TextLength<=0;
 end;
 
+procedure TCustomRichMemo.SetLink(TextStart, TextLength: Integer; AIsLink: Boolean);
+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);
+    TWSCustomRichMemoClass(WidgetSetClass).SetTextUIParams(Self, TextStart, TextLength, ui);
+  end;
+end;
+
+function TCustomRichMemo.isLink(TextStart: Integer): Boolean;
+var
+  ui : TTextUIParam;
+begin
+  Result:=HandleAllocated and TWSCustomRichMemoClass(WidgetSetClass).GetTextUIParams(Self, TextStart, ui);
+  if Result then Result:=uiLink in ui.features;
+end;
+
 function TCustomRichMemo.LoadRichText(Source: TStream): Boolean;
 begin
   Result:=false;
@@ -932,8 +988,6 @@ begin
 end;
 
 function TCustomRichMemo.Print(const params: TPrintParams): Integer;
-var
-  printed: Integer;
 begin
   Result:=0;
   if not Assigned(Printer) then Exit;
@@ -957,6 +1011,5 @@ begin
     Result:=false;
 end;
 
-
 end.
 

components/richmemo/win32/win32richmemo.pas

@@ -82,6 +82,12 @@ type
       const Params: TIntFontParams); override;
     class procedure SetHideSelection(const ACustomEdit: TCustomEdit; AHideSelection: Boolean); override;      
     class function GetStyleRange(const AWinControl: TWinControl; TextStart: Integer; var RangeStart, RangeLen: Integer): Boolean; override;
+
+    class procedure SetTextUIParams(const AWinControl: TWinControl; TextStart, TextLen: Integer;
+      const ui: TTextUIParam); override;
+    class function GetTextUIParams(const AWinControl: TWinControl; TextStart: Integer;
+      var ui: TTextUIParam): Boolean; override;
+
     class function LoadRichText(const AWinControl: TWinControl; Source: TStream): Boolean; override;
     class function SaveRichText(const AWinControl: TWinControl; Dst: TStream): Boolean; override;
 
@@ -194,23 +200,56 @@ begin
   end;
 end;
 
+type
+ PENLINK = ^TENLINK;
+
 function RichEditNotifyProc(const AWinControl: TWinControl; Window: HWnd;
       Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam;
       var MsgResult: Windows.LResult; var WinProcess: Boolean): Boolean;
 var
-  sch : PSELCHANGE;
+  lnk : PENLINK;
+  hdr : PNMHDR;
+  mb  : TMouseButton;
+  mmsg : UINT;
+  isClick : Boolean;
+  minfo   : TLinkMouseInfo;
 begin
   Result:=false; // we need to catch just notifications,
     // any other message should be handled in a "Default" manner
     // So, default result is false;
+  hdr:=PNMHDR(LParam);
   case Msg of
     WM_NOTIFY: begin
-      sch:=PSELCHANGE(LPARAM);
+      case hdr^.code of
-      if sch^.nmhdr.code=EN_SELCHANGE then
+        EN_SELCHANGE:
-      begin
+          begin
-        if Assigned(AWinControl) and (AWinControl is TCustomRichMemo) then
+            if Assigned(AWinControl) and (AWinControl is TCustomRichMemo) then
-          TIntCustomRichMemo(AWinControl).DoSelectionChange;
+              TIntCustomRichMemo(AWinControl).DoSelectionChange;
-        Result:=true;
+            Result:=true;
+          end;
+        EN_LINK:
+          begin
+            lnk:=PENLINK(LPARAM);
+            if Assigned(AWinControl) and (AWinControl is TCustomRichMemo) then begin
+              isClick:=true;
+              mmsg:=lnk^.msg;
+              mb:=mbLeft;
+              case mmsg of
+                WM_LBUTTONUP: mb:=mbLeft;
+                WM_RBUTTONUP: mb:=mbRight;
+                WM_MBUTTONUP: mb:=mbMiddle;
+              else
+                isClick:=false;
+              end;
+              if isClick then begin
+                FillChar(minfo, sizeof(minfo), 0);
+                minfo.button:=mb;
+                TIntCustomRichMemo(AWinControl).DoLinkAction(laClick, minfo, lnk^.chrg.cpMin, lnk^.chrg.cpMax-lnk^.chrg.cpMin);
+              end;
+
+            end;
+            Result:=true;
+          end;
       end;
     end;
   end;
@@ -460,7 +499,7 @@ begin
   FinishCreateWindow(AWinControl, Params, false);
 
   eventmask := SendMessage(AWinControl.Handle, EM_GETEVENTMASK, 0, 0);
-  eventmask := eventmask or ENM_SELCHANGE;
+  eventmask := eventmask or ENM_SELCHANGE or ENM_LINK;
   SendMessage(AWinControl.Handle, EM_SETEVENTMASK, 0, eventmask);
 
   // memo is not a transparent control -> no need for parentpainting
@@ -573,6 +612,62 @@ begin
   RichEditManager.SetEventMask(AWinControl.Handle, eventmask);
 end;
 
+class procedure TWin32WSCustomRichMemo.SetTextUIParams(const AWinControl: TWinControl; TextStart, TextLen: Integer;
+      const ui: TTextUIParam);
+var
+  OrigStart : Integer;
+  OrigLen   : Integer;
+  NeedLock  : Boolean;
+  eventmask : Integer;
+begin
+  if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
+
+  eventmask := RichEditManager.SetEventMask(AWinControl.Handle, 0);
+  RichEditManager.GetSelection(AWinControl.Handle, OrigStart, OrigLen);
+
+  NeedLock := (OrigStart <> TextStart) or (OrigLen <> TextLen);
+  if NeedLock then begin
+    LockRedraw( TCustomRichMemo(AWinControl), AWinControl.Handle);
+    RichEditManager.SetSelection(AWinControl.Handle, TextStart, TextLen);
+    RichEditManager.SetTextUIStyle(AWinControl.Handle, ui);
+    RichEditManager.SetSelection(AWinControl.Handle, OrigStart, OrigLen);
+    UnlockRedraw( TCustomRichMemo(AWinControl), AWinControl.Handle);
+  end else
+    RichEditManager.SetTextUIStyle(AWinControl.Handle, ui);
+
+  RichEditManager.SetEventMask(AWinControl.Handle, eventmask);
+end;
+
+class function TWin32WSCustomRichMemo.GetTextUIParams(const AWinControl: TWinControl; TextStart: Integer;
+  var ui: TTextUIParam): Boolean;
+var
+  OrigStart : Integer;
+  OrigLen   : Integer;
+  NeedLock  : Boolean;
+  eventmask : Integer;
+begin
+  if not Assigned(RichEditManager) or not Assigned(AWinControl) then begin
+    Result:=false;
+    Exit;
+  end;
+
+  eventmask := RichEditManager.SetEventMask(AWinControl.Handle, 0);
+  RichEditManager.GetSelection(AWinControl.Handle, OrigStart, OrigLen);
+
+  NeedLock := (OrigStart <> TextStart);
+  if NeedLock then begin
+    LockRedraw( TCustomRichMemo(AWinControl), AWinControl.Handle);
+    RichEditManager.SetSelection(AWinControl.Handle, TextStart, 1);
+    RichEditManager.GetTextUIStyle(AWinControl.Handle, ui);
+    RichEditManager.SetSelection(AWinControl.Handle, OrigStart, OrigLen);
+    UnlockRedraw( TCustomRichMemo(AWinControl), AWinControl.Handle);
+  end else
+    RichEditManager.GetTextUIStyle(AWinControl.Handle, ui);
+
+  RichEditManager.SetEventMask(AWinControl.Handle, eventmask);
+  Result:=true;
+end;
+
 class function TWin32WSCustomRichMemo.LoadRichText(
   const AWinControl: TWinControl; Source: TStream): Boolean;  
 begin

components/richmemo/win32/win32richmemoproc.pas

@@ -165,7 +165,10 @@ type
     class function GetTextLength(RichEditWnd: Handle): Integer;
     class function SetSelectedTextStyle(RichEditWnd: Handle; Params: TIntFontParams): Boolean; virtual;
     class function GetSelectedTextStyle(RichEditWnd: Handle; var Params: TIntFontParams): Boolean; virtual;
-    class function GetStyleRange(RichEditWnd: Handle; TextStart: Integer; var RangeStart, RangeLen: Integer): Boolean; virtual; 
+    class procedure SetTextUIStyle(RichEditWnd: Handle; const ui: TTextUIParam); virtual;
+    class function GetTextUIStyle(RichEditWnd: Handle; var ui: TTextUIParam): Boolean; virtual;
+
+    class function GetStyleRange(RichEditWnd: Handle; TextStart: Integer; var RangeStart, RangeLen: Integer): Boolean; virtual;
     class procedure GetSelection(RichEditWnd: Handle; var TextStart, TextLen: Integer); virtual;      
     class procedure SetSelection(RichEditWnd: Handle; TextStart, TextLen: Integer); virtual;      
     class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual;
@@ -193,6 +196,8 @@ const
   HardBreak  = #13;
 
 const
+  CFE_PROTECTED = $00000010;
+  CFE_LINK      = $00000020;
   CFM_BACKCOLOR = $04000000;
   CFE_AUTOBACKCOLOR = CFM_BACKCOLOR;
 
@@ -384,6 +389,46 @@ begin
   Result := true;  
 end;
 
+class procedure TRichEditManager.SetTextUIStyle(RichEditWnd: Handle; const ui: TTextUIParam);
+var
+  w   : WPARAM;
+  fmt : TCHARFORMAT2;
+begin
+  if RichEditWnd = 0 then Exit;
+
+  w := SCF_SELECTION;
+
+  FillChar(fmt, sizeof(fmt), 0);
+  fmt.cbSize := sizeof(fmt);
+
+  fmt.dwMask := CFM_LINK;
+  if uiLink in ui.features then fmt.dwEffects := fmt.dwEffects or CFE_LINK;
+
+  SendMessage(RichEditWnd, EM_SETCHARFORMAT, w, PtrInt(@fmt));
+end;
+
+class function TRichEditManager.GetTextUIStyle(RichEditWnd: Handle; var ui: TTextUIParam): Boolean;
+var
+  w   : WPARAM;
+  fmt : TCHARFORMAT2;
+begin
+  Result:=false;
+  if RichEditWnd = 0 then Exit;
+
+  w := SCF_SELECTION;
+
+  FillChar(fmt, sizeof(fmt), 0);
+  fmt.cbSize := sizeof(fmt);
+
+  fmt.dwMask := CFM_LINK;
+
+  SendMessage(RichEditWnd, EM_GETCHARFORMAT, w, PtrInt(@fmt));
+  InitTextUIParams(ui);
+  if fmt.dwEffects and CFE_LINK > 0 then
+    Include(ui.features, uiLink);
+  Result:=true;
+end;
+
 type
   richedit_gettextlengthex = packed record
     flags     : DWORD;

components/richmemo/wsrichmemo.pas

@@ -26,7 +26,7 @@ interface
 uses
   Types, Classes, SysUtils,
   LCLType,
-  Graphics, Controls, StdCtrls, Printers,
+  Graphics, Controls, Printers,
   WSStdCtrls, RichMemo;
 
 type
@@ -78,6 +78,11 @@ type
     class function GetParaTabs(const AWinControl: TWinControl; TextStart: integer;
       var AStopList: TTabStopList): Boolean; virtual;
 
+    class procedure SetTextUIParams(const AWinControl: TWinControl; TextStart, TextLen: Integer;
+      const ui: TTextUIParam); virtual;
+    class function GetTextUIParams(const AWinControl: TWinControl; TextStart: Integer;
+      var ui: TTextUIParam): Boolean; virtual;
+
     class procedure InDelText(const AWinControl: TWinControl; const TextUTF8: String; DstStart, DstLen: Integer); virtual;
     //class procedure SetHideSelection(const ACustomEdit: TCustomEdit; AHideSelection: Boolean); override;
     class function LoadRichText(const AWinControl: TWinControl; Source: TStream): Boolean; virtual;
@@ -202,6 +207,18 @@ begin
   Result:=False;
 end;
 
+class procedure TWSCustomRichMemo.SetTextUIParams(const AWinControl: TWinControl;
+  TextStart, TextLen: Integer; const ui: TTextUIParam);
+begin
+
+end;
+
+class function TWSCustomRichMemo.GetTextUIParams(const AWinControl: TWinControl;
+  TextStart: Integer; var ui: TTextUIParam): Boolean;
+begin
+  Result:=false;
+end;
+
 class procedure TWSCustomRichMemo.InDelText(const AWinControl: TWinControl; const TextUTF8: String; DstStart, DstLen: Integer); 
 begin