From 6d7862562200fd3363592b1aefebeabdae4374cd Mon Sep 17 00:00:00 2001 From: juha Date: Thu, 17 Dec 2015 13:38:58 +0000 Subject: [PATCH] LCL: HTML Support for TClipboard. Issue #29146, patch from wp. git-svn-id: trunk@50860 - --- lcl/clipbrd.pp | 9 ++++ lcl/include/clipbrd.inc | 107 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 116 insertions(+) diff --git a/lcl/clipbrd.pp b/lcl/clipbrd.pp index a730a38501..35dfa49260 100644 --- a/lcl/clipbrd.pp +++ b/lcl/clipbrd.pp @@ -137,6 +137,7 @@ function CF_Picture: TClipboardFormat; function CF_MetaFilePict: TClipboardFormat; function CF_Object: TClipboardFormat; function CF_Component: TClipboardFormat; +function CF_HTML: TClipboardformat; type TClipboardData = record @@ -162,6 +163,8 @@ type function AssignToGraphic(Dest: TGraphic; FormatID: TClipboardFormat): boolean; //procedure AssignToMetafile(Dest: TMetafile); procedure AssignToPicture(Dest: TPicture); + function DoGetAsHtml(ExtractFragmentOnly: Boolean): String; + function GetAsHtml: String; function GetAsText: string; function GetFormatCount: Integer; function GetFormats(Index: Integer): TClipboardFormat; @@ -170,6 +173,7 @@ type CreateIfNotExists: boolean): integer; procedure InternalOnRequest(const RequestedFormatID: TClipboardFormat; AStream: TStream); + procedure SetAsHtml(const Html: String); procedure SetAsText(const Value: string); function SetBuffer(FormatID: TClipboardFormat; var Buffer; Size: Integer): Boolean; @@ -208,6 +212,7 @@ type procedure SupportedFormats(var AFormatCount: integer; var FormatList: PClipboardFormat); function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; + function GetAsHtmlFragment: String; function HasFormat(FormatID: TClipboardFormat): Boolean; function HasFormatName(const FormatName: string): Boolean; function HasPictureFormat: boolean; @@ -220,6 +225,7 @@ type FormatList: PClipboardFormat): Boolean; procedure SetTextBuf(Buffer: PChar); property AsText: string read GetAsText write SetAsText; + property AsHtml: String read GetAsHtml write SetAsHtml; property ClipboardType: TClipboardType read FClipboardType; property FormatCount: Integer read GetFormatCount; property Formats[Index: Integer]: TClipboardFormat read GetFormats; @@ -241,6 +247,9 @@ function RegisterClipboardFormat(const Format: string): TClipboardFormat; implementation +uses + fasthtmlparser, LazUTF8; + var FClipboards: array[TClipboardType] of TClipboard; diff --git a/lcl/include/clipbrd.inc b/lcl/include/clipbrd.inc index 4801d9f23a..11a0a3bc44 100644 --- a/lcl/include/clipbrd.inc +++ b/lcl/include/clipbrd.inc @@ -14,6 +14,8 @@ The clipboard is able to work with the windows and gtk behaviour/features. } +{$I clipbrd_html.inc} + { TClipboard } constructor TClipboard.Create; @@ -770,3 +772,108 @@ begin end; end; +{ Retrieves html formatted text from the clipboard. If ExtractFragmentOnly is + true then only the relevant html fragment is returned, the rest of the html + string is dropped. This features exists only for Windows. } +function TClipboard.DoGetAsHtml(ExtractFragmentOnly: Boolean): String; +var + stream: TMemoryStream; + bom: TBOM; + US: UnicodeString; +begin + Result := ''; + if (CF_HTML = 0) or not HasFormat(CF_HTML) then + exit; + + stream := TMemoryStream.Create; + try + if not GetFormat(CF_HTML, stream) then + exit; + + stream.Write(#0#0, Length(#0#0)); + + bom := GetBomFromStream(stream); + case Bom of + bomUtf8: + begin + stream.Position := 3; + SetLength(Result, stream.Size - 3); + stream.Read(Result, stream.Size - 3); + //ClipBoard may return a larger stream than the size of the string + //this gets rid of it, since the string will end in a #0 (wide)char + Result := PAnsiChar(Result); + end; + bomUTF16LE: + begin + stream.Position := 2; + SetLength(US, stream.Size - 2); + stream.Read(US[1], stream.Size - 2); + //ClipBoard may return a larger stream than the size of the string + //this gets rid of it, since the string will end in a #0 (wide)char + US := PWideChar(US); + Result := Utf16ToUtf8(US); + end; + bomUtf16BE: + begin + //this may need swapping of WideChars???? + stream.Position := 2; + SetLength(US, stream.Size - 2); + stream.Read(US[1], stream.Size - 2); + //ClipBoard may return a larger stream than the size of the string + //this gets rid of it, since the string will end in a #0 (wide)char + US := PWideChar(US); + Result := Utf16ToUtf8(US); + end; + bomUndefined: + begin + //assume the first byte is part of the string and it is some AnsiString + //CF_HTML returns a string encoded as UTF-8 on Windows + Result := PAnsiChar(Stream.Memory); + end; + end; + + if (Result <> '') then begin + if ExtractFragmentOnly then + Result := ExtractHtmlFragmentFromClipBoardHtml(Result) + {$IFDEF WINDOWS} + else + Result := ExtractHtmlFromClipboardHtml(Result); + {$ENDIF} + end; + + finally + stream.Free; + end; +end; + +function TClipboard.GetAsHtml: String; +begin + Result := DoGetAsHtml(false); +end; + +function TClipboard.GetAsHtmlFragment: String; +begin + Result := DoGetAsHtml(true); +end; + +{ Adds html-formatted text to the clipboard. It must be valid html. + In case of Windows, a specific header is added. } +procedure TClipboard.SetAsHtml(const Html: String); +var + stream: TStream; +begin + if CF_HTML = 0 then + exit; + {$IFDEF WINDOWS} + stream := TStringStream.Create(InsertClipHeader(Html)); + {$ELSE} + stream := TStringStream.Create(Html); + {$ENDIF} + try + stream.Position := 0; + Clipboard.AddFormat(CF_HTML, stream); + finally + stream.Free; + end; +end; +