DSiWin32には次のものがあります。
var
GCF_HTML: UINT;
{:Checks if HTML format is stored on the clipboard.
@since 2008-04-29
@author gabr
}
function DSiIsHtmlFormatOnClipboard: boolean;
begin
Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }
{:Retrieves HTML format from the clipboard. If there is no HTML format on the clipboard,
function returns empty string.
@since 2008-04-29
@author MP002, gabr
}
function DSiGetHtmlFormatFromClipboard: string;
var
hClipData : THandle;
idxEndFragment : integer;
idxStartFragment: integer;
pClipData : PChar;
begin
Result := '';
if DSiIsHtmlFormatOnClipboard then begin
Win32Check(OpenClipboard(0));
try
hClipData := GetClipboardData(GCF_HTML);
if hClipData <> 0 then begin
pClipData := GlobalLock(hClipData);
Win32Check(assigned(pClipData));
try
idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
idxEndFragment := Pos('<!--EndFragment-->', pClipData);
if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
finally GlobalUnlock(hClipData); end;
end;
finally Win32Check(CloseClipboard); end;
end;
end; { DSiGetHtmlFormatFromClipboard }
{:Copies HTML (and, optionally, text) format to the clipboard.
@since 2008-04-29
@author MP002, gabr
}
procedure DSiCopyHtmlFormatToClipboard(const sHtml, sText: string);
function MakeFragment(const sHtml: string): string;
const
CVersion = 'Version:1.0'#13#10;
CStartHTML = 'StartHTML:';
CEndHTML = 'EndHTML:';
CStartFragment = 'StartFragment:';
CEndFragment = 'EndFragment:';
CHTMLIntro = '<sHtml><head><title>HTML clipboard</title></head><body><!--StartFragment-->';
CHTMLExtro = '<!--EndFragment--></body></sHtml>';
CNumberLengthAndCR = 10;
CDescriptionLength = // Let the compiler determine the description length.
Length(CVersion) + Length(CStartHTML) + Length(CEndHTML) +
Length(CStartFragment) + Length(CEndFragment) + 4*CNumberLengthAndCR;
var
description : string;
idxEndFragment : integer;
idxEndHtml : integer;
idxStartFragment: integer;
idxStartHtml : integer;
begin
// The sHtml clipboard format is defined by using byte positions in the entire block
// where sHtml text and fragments start and end. These positions are written in a
// description. Unfortunately the positions depend on the length of the description
// but the description may change with varying positions. To solve this dilemma the
// offsets are converted into fixed length strings which makes it possible to know
// the description length in advance.
idxStartHtml := CDescriptionLength; // position 0 after the description
idxStartFragment := idxStartHtml + Length(CHTMLIntro);
idxEndFragment := idxStartFragment + Length(sHtml);
idxEndHtml := idxEndFragment + Length(CHTMLExtro);
description := CVersion +
SysUtils.Format('%s%.8d', [CStartHTML, idxStartHtml]) + #13#10 +
SysUtils.Format('%s%.8d', [CEndHTML, idxEndHtml]) + #13#10 +
SysUtils.Format('%s%.8d', [CStartFragment, idxStartFragment]) + #13#10 +
SysUtils.Format('%s%.8d', [CEndFragment, idxEndFragment]) + #13#10;
Result := description + CHTMLIntro + sHtml + CHTMLExtro;
end; { MakeFragment }
var
clipFormats: array[0..1] of UINT;
clipStrings: array[0..1] of string;
hClipData : HGLOBAL;
iFormats : integer;
pClipData : PChar;
begin { DSiCopyHtmlFormatToClipboard }
Win32Check(OpenClipBoard(0));
try
//most descriptive first as per api docs
clipStrings[0] := MakeFragment(sHtml);
if sText = '' then
clipStrings[1] := sHtml
else
clipStrings[1] := sText;
clipFormats[0] := GCF_HTML;
clipFormats[1] := CF_TEXT;
Win32Check(EmptyClipBoard);
for iFormats := 0 to High(clipStrings) do begin
if clipStrings[iFormats] = '' then
continue;
hClipData := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(clipStrings[iFormats]) + 1);
Win32Check(hClipData <> 0);
try
pClipData := GlobalLock(hClipData);
Win32Check(assigned(pClipData));
try
Move(PChar(clipStrings[iFormats])^, pClipData^, Length(clipStrings[iFormats]) + 1);
finally GlobalUnlock(hClipData); end;
Win32Check(SetClipboardData(clipFormats[iFormats], hClipData) <> 0);
hClipData := 0;
finally
if hClipData <> 0 then
GlobalFree(hClipData);
end;
end;
finally Win32Check(CloseClipboard); end;
end; { DSiCopyHtmlFormatToClipboard }
initialization
GCF_HTML := RegisterClipboardFormat('HTML Format');
編集: @Edelcom: Delphi 7 では、DSiWin32 を定義する必要があります
_STARTUPINFOW = record
cb: DWORD;
lpReserved: PWideChar;
lpDesktop: PWideChar;
lpTitle: PWideChar;
dwX: DWORD;
dwY: DWORD;
dwXSize: DWORD;
dwYSize: DWORD;
dwXCountChars: DWORD;
dwYCountChars: DWORD;
dwFillAttribute: DWORD;
dwFlags: DWORD;
wShowWindow: Word;
cbReserved2: Word;
lpReserved2: PByte;
hStdInput: THandle;
hStdOutput: THandle;
hStdError: THandle;
end;
TStartupInfoW = _STARTUPINFOW;
PStartupInfoW = ^TStartupInfoW;
これを入れて、新しいバージョンをリリースします。
HTML 形式でクリップボードにコピーする方法の例を次に示します: http://www.swissdelphicenter.ch/torry/showcode.php?id=1391
Delphi 2009 で動作するように、コードを少し変更しました。
// If you've ever tried sticking html into the clipboard using the usual CF_TEXT
// format then you might have been disappointed to discover that wysiwyg html
// editors paste your offering as if it were just text,
// rather than recognising it as html. For that you need the CF_HTML format.
// CF_HTML is entirely text format and uses the transformation format UTF-8.
// It includes a description, a context, and within the context, the fragment.
//
// As you may know one can place multiple items of data onto the clipboard for
// a single clipboard entry, which means that the same data can be pasted in a
// variety of different formats in order to cope with target
// applications of varying sophistocation.
//
// The following example shows how to stick CF_TEXT (and CF_HTML)
// into the clipboard.
function FormatHTMLClipboardHeader(HTMLText: string): string;
const
CrLf = #13#10;
begin
Result := 'Version:0.9' + CrLf;
Result := Result + 'StartHTML:-1' + CrLf;
Result := Result + 'EndHTML:-1' + CrLf;
Result := Result + 'StartFragment:000081' + CrLf;
Result := Result + 'EndFragment:°°°°°°' + CrLf;
Result := Result + HTMLText + CrLf;
Result := StringReplace(Result, '°°°°°°', Format('%.6d', [Length(Result)]), []);
end;
//The second parameter is optional and is put into the clipboard as CF_HTML.
//Function can be used standalone or in conjunction with the VCL clipboard so long as
//you use the USEVCLCLIPBOARD conditional define
//($define USEVCLCLIPBOARD}
//(and clipboard.open, clipboard.close).
//Code from http://www.lorriman.com
procedure CopyHTMLToClipBoard(const str: AnsiString; const htmlStr: AnsiString = '');
var
gMem: HGLOBAL;
lp: PChar;
Strings: array[0..1] of AnsiString;
Formats: array[0..1] of UINT;
i: Integer;
begin
gMem := 0;
{$IFNDEF USEVCLCLIPBOARD}
Win32Check(OpenClipBoard(0));
{$ENDIF}
try
//most descriptive first as per api docs
Strings[0] := FormatHTMLClipboardHeader(htmlStr);
Strings[1] := str;
Formats[0] := RegisterClipboardFormat('HTML Format');
Formats[1] := CF_TEXT;
{$IFNDEF USEVCLCLIPBOARD}
Win32Check(EmptyClipBoard);
{$ENDIF}
for i := 0 to High(Strings) do
begin
if Strings[i] = '' then Continue;
//an extra "1" for the null terminator
gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(Strings[i]) + 1);
{Succeeded, now read the stream contents into the memory the pointer points at}
try
Win32Check(gmem <> 0);
lp := GlobalLock(gMem);
Win32Check(lp <> nil);
CopyMemory(lp, PChar(Strings[i]), Length(Strings[i]) + 1);
finally
GlobalUnlock(gMem);
end;
Win32Check(gmem <> 0);
SetClipboardData(Formats[i], gMEm);
Win32Check(gmem <> 0);
gmem := 0;
end;
finally
{$IFNDEF USEVCLCLIPBOARD}
Win32Check(CloseClipBoard);
{$ENDIF}
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyHTMLToClipBoard('Hello world', 'Hello <b>world</b>');
end;
これを MS Word に貼り付けると、次のように表示されます。
こんにちは世界
Wouter からの受け入れられた回答は良いスタートでしたが、Unicode 文字を処理しません。Unicode (html およびテキスト データ) で動作するようにサンプル コードを変更しました。メモリリークも修正。
function FormatHTMLClipboardHeader(HTMLText: UTF8String): UTF8String;
const
CrLf = #13#10;
begin
Result := 'Version:0.9' + CrLf;
Result := Result + 'StartHTML:-1' + CrLf;
Result := Result + 'EndHTML:-1' + CrLf;
Result := Result + 'StartFragment:000081' + CrLf;
Result := Result + 'EndFragment:°°°°°°' + CrLf;
Result := Result + HTMLText + CrLf;
Result := UTF8String( StringReplace( string(Result), '°°°°°°', Format('%.6d', [Length(Result)]), []) );
end;
//The second parameter is optional and is put into the clipboard as CF_HTML.
procedure CopyHTMLToClipBoard(const str: String; const htmlStr: String = '');
var
gMem : HGLOBAL;
lp : Pointer;
HString : UTF8String;
begin
{$WARN SYMBOL_PLATFORM OFF}
Win32Check(OpenClipBoard(0));
try
Win32Check(EmptyClipBoard);
if ( htmlStr <> '' ) then
begin
// convert to utf8 and add header, which windows html clipboard format requires
HString := FormatHTMLClipboardHeader( UTF8String( htmlStr ) );
//an extra "1" for the null terminator
gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(HString) + 1);
{Succeeded, now read the stream contents into the memory the pointer points at}
try
Win32Check(gmem <> 0);
lp := GlobalLock(gMem);
Win32Check(lp <> nil);
CopyMemory(lp, Pointer( HString ), Length( HString ) + 1);
Win32Check(gmem <> 0);
SetClipboardData( RegisterClipboardFormat( 'HTML Format' ), gMem);
Win32Check(gmem <> 0);
finally
GlobalUnlock(gMem);
GlobalFree(gMem);
end;
end;
// Now just place plain unicode text, double buffer size as it's utf16
gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, ( Length(str) + 1 ) * 2);
{Succeeded, now read the stream contents into the memory the pointer points at}
try
Win32Check(gmem <> 0);
lp := GlobalLock(gMem);
Win32Check(lp <> nil);
CopyMemory(lp, Pointer( str ), ( Length( str ) + 1 ) * 2);
Win32Check(gmem <> 0);
SetClipboardData( CF_UNICODETEXT, gMem);
Win32Check(gmem <> 0);
finally
GlobalUnlock(gMem);
GlobalFree(gMem);
end;
finally
Win32Check(CloseClipBoard);
end;
{$WARN SYMBOL_PLATFORM ON}
end;