paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4071 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2015-03-31 04:14:22 +00:00
parent 3ba32c21e3
commit 792e773443
4 changed files with 231 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
components/richmemo/richmemo.pas
View File

@ -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.

111
components/richmemo/win32/win32richmemo.pas
View File

@ -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

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

@ -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;

19
components/richmemo/wsrichmemo.pas
View File

@ -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