From 4630073fc9fba5a0f47d8dfb3ec40b82589bd4d8 Mon Sep 17 00:00:00 2001
From: bart <9132501-flyingsheep@users.noreply.gitlab.com>
Date: Sun, 20 Dec 2015 10:53:23 +0000
Subject: [PATCH] LCL: Refactor ClipBoard HTML functions (patch by WP, modified
 by me): - Remove property AsHtml since it was ambigous. It's better to use
 GetAsHtml and set paramters as required. - Add PlainText paramater for
 SetAsHtml method, that also sets the ClipBoards pain text content. - Clear
 the clipboard before adding Html to it, otherwise external applications will
 only ever see the first copy.

git-svn-id: trunk@50953 -
---
 lcl/clipbrd.pp          |  8 +++-----
 lcl/include/clipbrd.inc | 40 ++++++++++++++++++++++++----------------
 2 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/lcl/clipbrd.pp b/lcl/clipbrd.pp
index 35dfa49260..3c166dd214 100644
--- a/lcl/clipbrd.pp
+++ b/lcl/clipbrd.pp
@@ -163,8 +163,6 @@ 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;
@@ -173,7 +171,6 @@ 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;
@@ -198,6 +195,7 @@ type
     function FindPictureFormatID: TClipboardFormat;
     function FindFormatID(const FormatName: string): TClipboardFormat;
     //function GetAsHandle(Format: integer): THandle;
+    function GetAsHtml(ExtractFragmentOnly: Boolean): String;
     function GetComponent(Owner, Parent: TComponent): TComponent;
     procedure GetComponent(var RootComponent: TComponent;
                           OnFindComponentClass: TFindComponentClassEvent;
@@ -212,12 +210,12 @@ 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;
     procedure Open;
     //procedure SetAsHandle(Format: integer; Value: THandle);
+    procedure SetAsHtml(const Html: String; const PlainText: String; {%H-}AddWindowsHeader: Boolean);
     function SetComponent(Component: TComponent): Boolean;
     function SetComponentAsText(Component: TComponent): Boolean;
     function SetFormat(FormatID: TClipboardFormat; Stream: TStream): Boolean;
@@ -225,7 +223,6 @@ 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;
@@ -256,6 +253,7 @@ var
 
 {$I clipbrd.inc}
 
+
 function RegisterClipboardFormat(const Format: string): TClipboardFormat;
 begin
   Result:=ClipboardRegisterFormat(Format);
diff --git a/lcl/include/clipbrd.inc b/lcl/include/clipbrd.inc
index 11a0a3bc44..53ab10843b 100644
--- a/lcl/include/clipbrd.inc
+++ b/lcl/include/clipbrd.inc
@@ -774,8 +774,10 @@ 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;
+  string is dropped. The Office applications in Windows and Linux write the
+  full html code which can be retrieved with ExtractFragmentOnly = false.
+  In case of Windows, the MS header is automatically removed.}
+function TClipboard.GetAsHtml(ExtractFragmentOnly: Boolean): String;
 var
   stream: TMemoryStream;
   bom: TBOM;
@@ -846,32 +848,38 @@ begin
   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);
+{ Adds html-formatted text to the clipboard. The main Office applications in
+  Windows and Linux require a valid and complete html text (i.e. with <html>
+  and <body> tags).
+  In case of Windows, a specific header must be added (AddWindowsHeader = true),
+  otherwise the format will not be recognized by the clipboard. }
+procedure TClipboard.SetAsHtml(const Html: String; const PlainText: String; {%H-}AddWindowsHeader: Boolean);
 var
   stream: TStream;
 begin
   if CF_HTML = 0 then
     exit;
   {$IFDEF WINDOWS}
-  stream := TStringStream.Create(InsertClipHeader(Html));
+  if AddWindowsHeader then
+    stream := TStringStream.Create(InsertClipHeader(Html)) else
+    stream := TStringStream.Create(Html);
   {$ELSE}
   stream := TStringStream.Create(Html);
   {$ENDIF}
   try
+    //Clear the clipboard before adding Html to it,
+    //otherwise external applications will only ever see the first copy.
+    ClipBoard.Clear;
     stream.Position := 0;
     Clipboard.AddFormat(CF_HTML, stream);
+    if (PlainText <> '') then
+    begin
+      stream.Size := 0;
+      stream.Position := 0;
+      stream.WriteAnsiString(PlainText);
+      stream.Position := 0;
+      ClipBoard.AddFormat(CF_TEXT, stream);
+    end;
   finally
     stream.Free;
   end;