From 792e773443447e00f766353962d6ee5301948de5 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Tue, 31 Mar 2015 04:14:22 +0000 Subject: [PATCH] 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 | 75 ++++++++++-- components/richmemo/win32/win32richmemo.pas | 111 ++++++++++++++++-- .../richmemo/win32/win32richmemoproc.pas | 47 +++++++- components/richmemo/wsrichmemo.pas | 19 ++- 4 files changed, 231 insertions(+), 21 deletions(-) diff --git a/components/richmemo/richmemo.pas b/components/richmemo/richmemo.pas index c6aa5b7ca..3f99465db 100644 --- a/components/richmemo/richmemo.pas +++ b/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); - except - end; + OnPrintAction(Self, PrintJobEvent, PrintCanvas, CurrentPAge, AbortPrint); +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. diff --git a/components/richmemo/win32/win32richmemo.pas b/components/richmemo/win32/win32richmemo.pas index f01762a22..f36aa1174 100644 --- a/components/richmemo/win32/win32richmemo.pas +++ b/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); - if sch^.nmhdr.code=EN_SELCHANGE then - begin - if Assigned(AWinControl) and (AWinControl is TCustomRichMemo) then - TIntCustomRichMemo(AWinControl).DoSelectionChange; - Result:=true; + case hdr^.code of + EN_SELCHANGE: + begin + if Assigned(AWinControl) and (AWinControl is TCustomRichMemo) then + TIntCustomRichMemo(AWinControl).DoSelectionChange; + 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 diff --git a/components/richmemo/win32/win32richmemoproc.pas b/components/richmemo/win32/win32richmemoproc.pas index 7b65c5768..5ba61afbe 100644 --- a/components/richmemo/win32/win32richmemoproc.pas +++ b/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; diff --git a/components/richmemo/wsrichmemo.pas b/components/richmemo/wsrichmemo.pas index b72c9f9d6..6ee2737e2 100644 --- a/components/richmemo/wsrichmemo.pas +++ b/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