| [10859] ファイルのクリップボードへのコピー | 返信 削除 |
| 2017/2/22 (水) 17:25:13 Mr.XRAY |
|
ZeosLib と宇宙人が一段落ついたので次です． ファイルのリストをクリップボードにコピーする参考コードです． TClipboard.SetAsHandle で行う場合です． 関数にしてみました． implementation uses ShlObj, ClipBrd; {$R *.dfm} //----------------------------------------------------------------------------- // 引数の文字列配列(ファイル名のリスト)をクリップボードに送る // クリップボードの形式はCF_HDROP // // 動作確認は Windows 7 U64(SP1) + Delphi XE(UP1) Pro // usesにShlObj,ClipBrdが必要 //----------------------------------------------------------------------------- procedure CopyFilesToClipboard(const FileNames: array of string); var LFileListText : string; LValue : string; LpDropFiles : PDropFiles; LhGlobal : THandle; LLen : Integer; begin //CF_HDROP形式のファイルのコピーは,ファイル名の末尾に#0を付加 //最後は#0#0とする LFileListText := ''; for LValue in FileNames do begin LFileListText := LFileListText + LValue + #0; end; LFileListText := LFileListText + #0; LLen := ByteLength(LFileListText); 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 LpDropFiles^.pFiles := SizeOf(TDropFiles); LpDropFiles^.fWide := True; if LFileListText <> '' then begin Move(LFileListText[1], (PByte(LpDropFiles) + SizeOf(TDropFiles))^, LLen); end; finally GlobalUnlock(LhGlobal); end; Clipboard.SetAsHandle(CF_HDROP, LhGlobal); end; except GlobalFree(LhGlobal); end; end; end; //============================================================================= // コピーするファイル名のセット // 文字列配列は他にもいろいろあるので適当に //============================================================================= procedure TForm1.Button1Click(Sender: TObject); var LFileNameArray : array of string; begin SetLength(LFileNameArray, 2); //ファイル名のチェックはなし //ファイルが1つでも存在しないとファイルを誤認識してコピーしない LFileNameArray[0] := ExpandFileName('..\CCC\DDD'); //フォルダ LFileNameArray[1] := ExpandFileName('..\CCC\AA1.txt'); //ファイル CopyFilesToClipboard(LFileNameArray); end; //============================================================================= // クリップボードを空にする //============================================================================= procedure TForm1.Button2Click(Sender: TObject); begin Clipboard.Clear; end;  |