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

richmemo: win32 trying to parse HYPERLINK for the link action

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7910 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2020-11-30 15:13:28 +00:00
parent 485fd14486
commit 72c74560de
1 changed files with 47 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -180,7 +180,7 @@ type
class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual; class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual;
class function LoadRichText(RichEditWnd: Handle; ASrc: TStream): Boolean; virtual; class function LoadRichText(RichEditWnd: Handle; ASrc: TStream): Boolean; virtual;
class function SaveRichText(RichEditWnd: Handle; ADst: TStream): Boolean; virtual; class function SaveRichText(RichEditWnd: Handle; ADst: TStream; extraflags: Integer = 0): Boolean; virtual;
class procedure SetText(RichEditWnd: Handle; const Text: WideString; TextStart, ReplaceLength: Integer); virtual; class procedure SetText(RichEditWnd: Handle; const Text: WideString; TextStart, ReplaceLength: Integer); virtual;
class function GetTextW(RichEditWnd: Handle; inSelection: Boolean): WideString; virtual; class function GetTextW(RichEditWnd: Handle; inSelection: Boolean): WideString; virtual;
@ -803,14 +803,14 @@ begin
end; end;
end; end;
class function TRichEditManager.SaveRichText(RichEditWnd: Handle; ADst: TStream): Boolean; class function TRichEditManager.SaveRichText(RichEditWnd: Handle; ADst: TStream; extraflags: Integer): Boolean;
var var
cbs : TEditStream_; cbs : TEditStream_;
begin begin
cbs.dwCookie := PDWORD(ADst); cbs.dwCookie := PDWORD(ADst);
cbs.dwError := 0; cbs.dwError := 0;
cbs.pfnCallback := @RTFSaveCallback; cbs.pfnCallback := @RTFSaveCallback;
SendMessage(RichEditWnd, EM_STREAMOUT, SF_RTF, LPARAM(@cbs) ); SendMessage(RichEditWnd, EM_STREAMOUT, SF_RTF or extraFlags, LPARAM(@cbs) );
Result := cbs.dwError = 0; Result := cbs.dwError = 0;
end; end;
@ -1046,8 +1046,51 @@ end;
class function TRichEditManager.LinkNotifyToInfo(RichEditWnd: Handle; class function TRichEditManager.LinkNotifyToInfo(RichEditWnd: Handle;
const LinkNotify: TENLINK; var LinkInfo: TLinkMouseInfo): Boolean; const LinkNotify: TENLINK; var LinkInfo: TLinkMouseInfo): Boolean;
var
gt : GETTEXTEX;
l : integer;
olds, oldl : integer;
st : TStringStream;
evmsk : Integer;
hp : string;
hpi : integer;
hps : integer;
begin begin
Result := false; evmsk := SetEventMask(RichEditWnd, 0);
try
GetSelection(RichEditWnd, olds, oldl);
try
l := LinkNotify.chrg.cpMax - LinkNotify.chrg.cpMin;
SetSelection(RichEditWnd, LinkNotify.chrg.cpMin, l);
st := TStringStream.Create;
hp := '';
try
SaveRichText(RichEditWnd, st, SFF_SELECTION);
hp := st.DataString;
finally
st.Free;
end;
hpi := Pos('HYPERLINK', hp);
if (hpi>0) then begin
inc(hpi, length('HYPERLINK'));
while (hpi <= length(hp)) and not (hp[hpi] in ['"','}']) do inc(hpi);
if (hpi <= length(hp)) and (hp[hpi]='"') then begin
inc(hpi);
hps:=hpi;
while (hpi <= length(hp)) and (hp[hpi] <> '"') do
inc(hpi);
//todo: convert RTF chars into UTF8
LinkInfo.LinkRef := Copy(hp, hps, hpi-hps);
end;
Result := true;
end else
Result :=TRichEditManagerWinXP.LinkNotifyToInfo(RichEditWnd, LinkNotify, LinkInfo);
finally
SetSelection(RichEditWnd, olds, oldl);
end;
finally
SetEventMask(RichEditWnd, evmsk);
end;
end; end;
function WinInsertImageFromFile (const ARichMemo: TCustomRichMemo; APos: Integer; function WinInsertImageFromFile (const ARichMemo: TCustomRichMemo; APos: Integer;