|
▼ Mr.XRAYさん
> > ファイルのリストをクリップボードにコピーする参考コードです．
> > TClipboard.SetAsHandle で行う場合です．
>
> ハイ．この件は早くも終了 !!
> いつも，こうありたいですね．
え、別コードで 切り捨てですか？！ もったいない
Delphi 2005 で実行できるように いじらせてもらいました。
(10.1も最後に実行してみました)
変更点
・眼に見えない操作なので、クリップボードは呼び出した時点でクリアしました
・個数が0の時は、クリップボードにコピーしない
・'' は無視
・LpDropFilesは、#0で初期化
・古いDelphiで構文エラーがでたのでその修正 ByteLength , Move
[エラー] Unit1.pas(56): E2003 未定義の識別子 : 'ByteLength'
[エラー] Unit1.pas : E2015 この型には指定した演算子は使えません
SetLength(LFileNameArray, 1);
LFileNameArray[0] := Application.ExeName; //ファイル
に置き換えてコピーできるか動作確認しました。
procedure CopyFilesToClipboard(const FileNames: array of string);
var
LFileListText : string;
LValue : string;
LpDropFiles : PDropFiles;
LhGlobal : THandle;
LLen : Integer;
begin
//CF_HDROP形式のファイルのコピーは,ファイル名の末尾に#0を付加
//最後は#0#0とする
LhGlobal := 0;
LFileListText := '';
Clipboard.Clear;
for LValue in FileNames do begin
if (LValue <> '') then begin
LFileListText := LFileListText + LValue + #0;
end
end;
LFileListText := LFileListText + #0;
LLen := {$IFDEF UNICODE}ByteLength{$ELSE}Length{$ENDIF}(LFileListText);
if (LLen = 1) then
Exit;
LhGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + LLen);
if (LhGlobal = 0) then begin
//エラー
end else begin
try
LpDropFiles := GlobalLock(LhGlobal);
if (LpDropFiles = nil) then begin
//エラー
end else begin
try
FillChar(LpDropFiles^, SizeOf(LpDropFiles^), #0);
LpDropFiles^.pFiles := SizeOf(TDropFiles);
{$IFDEF UNICODE}LpDropFiles^.fWide := True;{$ENDIF}
if LFileListText <> '' then begin
{$IF CompilerVersion >= 18.0}
Move(LFileListText[1], (PByte(LpDropFiles) + SizeOf(TDropFiles))^, LLen);
{$ELSE}
Move(LFileListText[1], Ptr(Integer(LpDropFiles) + SizeOf(TDropFiles))^, LLen);
{$IFEND}
end;
finally
GlobalUnlock(LhGlobal);
end;
Clipboard.SetAsHandle(CF_HDROP, LhGlobal);
end;
except
GlobalFree(LhGlobal);
end;
end;
end;
|