喫茶XRAY [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;