[ 825_TClipboard.SetAsHandle を使用したファイルのコピー ]

Delphi Programming / Object Pascal

[掲載 2017年02月24日] [更新 2018年02月21日]　Delphi サンプルプログラム集

825_TClipboard.SetAsHandle を使用したファイルのコピー
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro 他

825_FilesCooyToClipboard.zip　[1,109 KB]　2018年02月21日版 (EXE 同梱)

01_TClipboard.SetAsHandle を使用したファイルのコピー
02_TClipboard.SetAsHandle を使用した文字列のコピー

01_TClipboard.SetAsHandle を使用したファイルのコピー

文字列，テキストや画像は，TClipboard.Assign を使用すればクリップボードにコピーできますが，エクスプローラのようなファイルのコピーは TClipboard.Assign ではできません．
コンテキストメニューコンポーネントのように，シェルの機能を使用するとファイルのコピーが可能ですが，次のように，TClipboard.SetAsHandle を使用してもコピーできます．
Delphi 6 以降で使用可能なコードにしてみました．

[備考 1]
当サイトで提供しているコンテキストメニューコンポーネントを使用する場合は，コンテキストメニューを表示しないで [コピー] コマンドを実行します．コンテキストメニューコンポーネントを使用すると，コピー，貼り付け，切り取り等の操作も可能です．操作対象となるフォルダ名やファイル名は，Files プロパティにセットします．

ドラッグ・アンド・ドロップの記事にもコンポーネントを使用する例ですが，ファイルのコピーのサンプルコードがあります．

[備考 2]
本サンプルでは，文字列の格納に動的な文字列配列を使用していますが，このような場合，当サイトのほとんどのサンプルでは TStringList を使用しています．
「動的な配列を関数の引数として使うには」という質問を見かけたので使ってみただけです．

	図1 設計時画面
	図2 本サンプルでの操作対象のフォルダとファイル [DDD] フォルダと AA1.txt ファイルコピーすると，エクスプローラで任意の場所に貼り付けできる

リスト1
TClipboard.SetAsHandle を使用したファイルのコピー

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  ShlObj,
  ClipBrd;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  引数の文字列配列(ファイル名のリスト)のファイルをクリップボードに送る
//  クリップボードの形式はCF_HDROP
//
//  usesにShlObj,ClipBrdが必要
//-----------------------------------------------------------------------------
procedure CopyFilesToClipboard(const FileNames: array of string);
var
  LFileListText : string;
  LuFlags       : Cardinal;
  LpDropFiles   : PDropFiles;
  LhGlobal      : THandle;
  LLen          : Integer;
  i             : Integer;
begin
  Clipboard.Open;
  Clipboard.Clear;

  //CF_HDROP形式のファイルのコピーは,ファイル名の末尾に#0を付加
  //最後は#0#0とする
  LFileListText := '';
  for i := 0 to Length(FileNames) - 1 do begin
    if Trim(FileNames[i]) <> '' then begin
      LFileListText := LFileListText + FileNames[i] + #0;
    end;
  end;
  LFileListText := LFileListText + #0;

  {$IFDEF UNICODE}
  LLen := ByteLength(LFileListText);
  {$ELSE}
  LLen := Length(LFileListText);
  {$ENDIF}
  if Length(Trim(LFileListText)) = 0 then exit;

  LuFlags  := GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT;
  LhGlobal := GlobalAlloc(LuFlags, 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(TDropFiles), #0);
          LpDropFiles^.pFiles := SizeOf(TDropFiles);
          {$IFDEF UNICODE}
          LpDropFiles^.fWide  := True;
          {$ENDIF}

         {$IF CompilerVersion >= 20.0}
          Move(LFileListText[1],
               (PByte(LpDropFiles) + SizeOf(TDropFiles))^,
               LLen);
          {$ELSE}
            //このコードは{$IF CompilerVersion >= 20.0}でも動作する
           Move(LFileListText[1],
                PByte(Integer(LpDropFiles) + SizeOf(TDropFiles))^,
                LLen);
          {$IFEND}
        finally
          GlobalUnlock(LhGlobal);
        end;
        Clipboard.SetAsHandle(CF_HDROP, LhGlobal);
        Clipboard.Close;
      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;

end.

Delphi XE の場合，TClipboard.SetAsHandle は以下のように Windows API の SetClipboardData 関数でクリップボードにデータを送っています．
同様に，TClipboard.Assign も，最終的には SetClipboardData 関数を使用してクリップボードにデータを送っています．

procedure TClipboard.SetAsHandle(Format: Word; Value: THandle);
begin
  Open;
  try
    Adding;
    SetClipboardData(Format, Value);
  finally
    Close;
  end;
end;

02_TClipboard.SetAsHandle を使用した文字列のコピー

TClipboard.SetAsHandle を使用してクリップボードに文字列をセットする際は注意が必要です．
Delphi 2009 以降の Delphi の String 型はユニコード文字列です．クリップボードのフォーマットとして CF_UNICODETEXT を使用して．バッファの領域として確保するバイト数にも注意します．
CF_TEXT で文字列をコピーする時は，文字列の型を AnsiString 型にします．

リスト2
TClipboard.SetAsHandle を使用した文字列のコピー
CF_TEXT は AnsiString 型の文字列用．ユニコードな文字列には CF_UNICODETEXT を使用する

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button3: TButton;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd;

{$R *.dfm}

//=============================================================================
//  TClipboard.AsTextはユニコード文字列を処理してくれる
//  ClipboardはTClipboardのインスタンス
//  usesにClipbrdを追加すると自動で生成される
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText : string;
begin
  LText := '日本語 ABC';

  Clipboard.Clear;
  Clipboard.AsText := LText;
end;

//=============================================================================
//  CF_TEXTはAnsiString用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LhGlobale : HGLOBAL;
  LPChar    : PAnsiChar;
  LText     : Ansistring;
begin
  LText := '日本語 ABC' + #0;

  Clipboard.Open;
  Clipboard.Clear;

  LhGlobale := GlobalAlloc(GHND, Length(LText));
  LPChar    := GlobalLock(LhGlobale);
  StrPCopy(LPChar, LText);

  GlobalUnlock(LhGlobale);
  Clipboard.SetAsHandle(CF_TEXT, LhGlobale);
  GlobalFree(LhGlobale);

  Clipboard.Close;
end;

//=============================================================================
//  ユニコードな文字列にはCF_UNICODETEXTを使用する
//  クリップボードにセットするバイト数に注意
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LhGlobale : HGLOBAL;
  LPChar    : PChar;
  LText     : string;
begin
  LText := '日本語 ABC' + #0;

  Clipboard.Open;
  Clipboard.Clear;

  //以下のようにByteLengthも使用可能
  //LhGlobale := GlobalAlloc(GHND, ByteLength(LText));
  LhGlobale := GlobalAlloc(GHND, Length(LText) * SizeOf(Char));
  LPChar    := GlobalLock(LhGlobale);
  StrPCopy(LPChar, LText);

  GlobalUnlock(LhGlobale);
  Clipboard.SetAsHandle(CF_UNICODETEXT, LhGlobale);
  GlobalFree(LhGlobale);

  Clipboard.Close;
end;

end.