▼ Mr.XRAYさん
恐ろしや、あっという間に１ヶ月たちました。
> これは，あくまでも，エクセル側で [貼り付け] 操作をした時に，
> 書式も反映させるためです．
マスターの例では書かれているとおりで、形式が TEXT のため
LibreOffice では正しく表示できませんでした。
EXCEL はなんと HTML ヘッダが無くても表示してしまいます。
HTMLフォーマットにするため色々なところからパクって修正したソースを
貼り付けておきます。
想定した使用例は StringGrid の内容をクリップボードに貼り付けます。
なお LibreOffice で実行するとタイトル行にゴミが付きます。
これは LibreOffice のバグ？と思います。
あとクリップボードの確認には「クリップ見え窓」というソフトを利用させて
いただきました。作者の方に感謝します。
http://www.officedaytime.com/clipmm/
注意：
変数名に「日本語」が入っているため XE2 以上でないとコンパイルできません。
unit Unit7;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, EditGrid, Vcl.Buttons,
Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Clipbrd, Vcl.DBGrids;
type
TClipboardAccess = class( TClipboard )
end;
procedure Cs_StrCellClipHtmlCopy( ArgGrid : TStringGrid; ArgRowEnd : Integer = (-1); ArgCkCol : Integer = (-1) );
implementation
//////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////
// http://stackoverflow.com/questions/22617990/how-to-create-picture-and-html-formats-all-together-on-the-clipboard
//-----------------------------------------------------------------------
// HTML形式の ClipBord コピー用ヘッダ作成
//-----------------------------------------------------------------------
procedure Cs_StrCellClipHtmlCopy( ArgGrid : TStringGrid; ArgRowEnd : Integer = (-1); ArgCkCol : Integer = (-1) );
const
CnsHtmlFrom : String = ( // HTML開始
'<html>'
);
CnsHtmlTo : String = ( // HTML終了
'</html>'
);
CnsHeadFrom : String = ( // ヘッダ開始
'<THEAD>'
);
CnsEtc : String = ( // おまじない
'<!--StartFragment-->'
+ ' <table border="1">'
);
CnsHeadTo : String = ( // ヘッダ終了
'</THEAD>'
);
CnsBodyFrom : String = ( // 明細部、ボディ開始
'<BODY>'
);
CnsBodyTo : String = ( // 明細部、ボディ終了
'</BODY>'
) ;
CnsTableFrom : String = ( // 表＝テーブル、開始
'<tr>'
);
CnsTableTo : String = ( // 表＝テーブル、終了
'</tr>'
);
CnsCellLeft : String = ( // セル、文字横位置、左寄せ
'<td align="left">'
);
CnsCellCenter : String = ( // セル、文字横位置、中央
'<td align="center">'
);
CnsCellRight : String = ( // セル、文字横位置、右寄せ
'<td align="right">'
);
CnsCellTo : String = ( // セル、指定終了
'</td>'
);
CnsCellFontRedFrom : String = ( // セル、Font色＝赤
'<font color="#ff0000">'
);
CnsCellFontRedTo : String = ( // セル、Font指定終了
'</font>'
);
function FormatHTMLClipboardHeader( ArgHTMLText : UTF8String ): AnsiString;
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 + ArgHTMLText + CrLf;
Result := StringReplace( Result, '°°°°°°', Format('%.6d', [ Length( Result ) ]), [] );
end;
var
CF_HTML: UINT;
SwtFind : Boolean;
WHtmlStr : UTF8String;
WCurrency : Currency;
WCol, WRow, WSize, WCount : Integer;
WStr, WStrWk, WHeadStr, W文字位置 : String;
begin
if ( ArgGrid is TCustomGrid ) = False then exit;
CF_HTML := RegisterClipboardFormat( 'HTML Format' );
//-------------------------------------
// ClipBord へ渡すデータ作成開始
//-------------------------------------
WStr := '';
WStr := WStr + CnsHtmlFrom; // HTML開始
//-------------------------------------
// ClipBord へ渡すデータ、ヘッダ
//-------------------------------------
WStr := WStr + CnsHeadFrom; // ヘッダ開始
WStr := WStr + CnsEtc; // おまじない
for WRow := 0 to ( ArgGrid.FixedRows - 1 ) do
begin
WStr := WStr + CnsTableFrom; // 表＝テーブル、開始
for WCol := 0 to ( ArgGrid.ColCount - 1 ) do
begin
W文字位置 := CnsCellLeft;
if WCol = 1 then
W文字位置 := CnsCellCenter
else if WCol = 2 then
W文字位置 := CnsCellRight;
WStr := WStr + W文字位置 + UTF8String( ArgGrid.Cells[ WCol, WRow ] ) + CnsCellTo; // セル、指定終了
end;
WStr := WStr + CnsTableTo; // 表＝テーブル、終了
end;
WStr := WStr + CnsHeadTo; // ヘッダ終了
//---------------------------------------
// ClipBord へ渡すデータ、ボディ(明細)部
//---------------------------------------
if ArgGrid.ColCount <= ArgCkCol then // 列値 <> NULL 確認だが、確認する列が実際の列数より大きい
ArgCkCol := (-1);
WCount := 0;
WStr := WStr + CnsBodyFrom; // 明細部、ボディ開始
for WRow := ArgGrid.FixedRows to ( ArgGrid.RowCount - 1 ) do
begin
if 0 <= ArgCkCol then // 列値 <> NULL 確認
begin
if ArgGrid.Cells[ ArgCkCol, WRow ] = '' then
continue;
end;
if 0 < ArgRowEnd then
begin
Inc( WCount );
if ArgRowEnd < WCount then break;
end
else if ArgRowEnd = (-1) then // 全列空白はSKIP
begin
SwtFind := False;
for WCol := ArgGrid.FixedCols to ( ArgGrid.ColCount - 1 ) do
if ArgGrid.Cells[ WCol, WRow ] <> '' then
begin
SwtFind := True;
break;
end;
if SwtFind = False then continue;
Inc( WCount );
end;
WStr := WStr + CnsTableFrom; // 表＝テーブル、開始
for WCol := 0 to ( ArgGrid.ColCount - 1 ) do
begin
W文字位置 := CnsCellLeft;
if ( ArgGrid is TEditGrid ) = True then
begin
if WCol = 1 then
W文字位置 := CnsCellCenter
else if WCol = 2 then
W文字位置 := CnsCellRight;
{///////////////// TDBGrid の場合はこんな感じで文字表示位置を確認
if TDBGrid( ArgGrid ).Fields[ WCol ].Alignment = taCenter then
W文字位置 := CnsCellCenter
else if TDBGrid( ArgGrid ).Fields[ WCol ].Alignment = taRightJustify then
W文字位置 := CnsCellRight;
/////}
end;
WStrWk := ArgGrid.Cells[ WCol, WRow ];
if W文字位置 = CnsCellRight then // 右詰＝マイナス数値の場合は赤色にする。
begin
WCurrency := StrToIntDef( WStrWk, 0 ); // ←整数以外 , . などがあると駄目
if WCurrency < 0 then
WStrWk := CnsCellFontRedFrom + WStrWk + CnsCellFontRedTo; // セル、Font指定
end;
WStr := WStr + W文字位置 + UTF8String( WStrWk ) + CnsCellTo; // セル、指定終了
end;
WStr := WStr + CnsTableTo; // 表＝テーブル、終了
end;
WStr := WStr + CnsBodyTo; // 明細部、ボディ終了
WStr := WStr + CnsHtmlTo; // HTML終了
Clipboard.Open;
try
WHtmlStr := FormatHTMLClipboardHeader( WStr );
WSize := Length( AnsiString( WHtmlStr ) );
TClipboardAccess( Clipboard).SetBuffer( CF_HTML, PAnsiChar( WHtmlStr )^, WSize + 1);
TClipboardAccess( Clipboard).SetBuffer( CF_TEXT, PAnsiChar( WHtmlStr )^, WSize + 1);
finally
Clipboard.Close;
end;
end;
end.
|