paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 10:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Refactor ClipBoard HTML functions (patch by WP, modified by me):

Browse Source 
- 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 -
This commit is contained in:
bart 2015-12-20 10:53:23 +00:00
parent 4477d86b14
commit 4630073fc9
2 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/clipbrd.pp
View File

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

40
lcl/include/clipbrd.inc
View File

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