喫茶XRAYトップページ

[スレッド全体]
[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;


[10861] Re:ファイルのクリップボードへのコピー返信　削除
2017/2/22 (水) 22:25:05 Mr.XRAY
> ファイルのリストをクリップボードにコピーする参考コードです．
> TClipboard.SetAsHandle で行う場合です．

ハイ．この件は早くも終了 !!
いつも，こうありたいですね．

[10862] Re2:ファイルのクリップボードへのコピー返信　削除
2017/2/22 (水) 22:53:39 taka
▼ 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;
[10863] Re3:ファイルのクリップボードへのコピー返信　削除
2017/2/22 (水) 23:53:41 Mr.XRAY
▼ takaさん

> え、別コードで 切り捨てですか？！ もったいない
>
> Delphi 2005 で実行できるように いじらせてもらいました。
> (10.1も最後に実行してみました)

わわわっ，ゴメンナさい．
ZeosLib とか SQLite は他のバージョンの Delphi でも使いたい人が
いるかと思い，いろいろ確認しておいた方がいいと思いまして．
このコードは，実はメールでの質問の返信用なんです．例によって．

> 変更点
> ・眼に見えない操作なので、クリップボードは呼び出した時点でクリアしました
> ・個数が0の時は、クリップボードにコピーしない
> ・'' は無視
> ・LpDropFilesは、#0で初期化
> ・古いDelphiで構文エラーがでたのでその修正 ByteLength , Move
>
> [エラー] Unit1.pas(56): E2003 未定義の識別子 : 'ByteLength'
> [エラー] Unit1.pas : E2015 この型には指定した演算子は使えません
>
>   SetLength(LFileNameArray, 1);
>   LFileNameArray[0] := Application.ExeName;   //ファイル
>   に置き換えてコピーできるか動作確認しました。

おおっと，初期化しないと... ハハハツ．
ByteLength はしょうがないととして，PByte が...
なるほど，Ptr(Integer ですか．ですよね．
昔は PChar をポインタ代わりに使用するコードが多かったですね．
勉強させて頂きました．いつもスミマせん．


[10864] Re4:ファイルのクリップボードへのコピー返信　削除
2017/2/22 (水) 23:56:56 Mr.XRAY
> わわわっ，ゴメンナさい．
> ZeosLib とか SQLite は他のバージョンの Delphi でも使いたい人が
> いるかと思い，いろいろ確認しておいた方がいいと思いまして．
> このコードは，実はメールでの質問の返信用なんです．例によって．

でも，ここに書いたことによって taka さんに教えて頂いたのでよかった !!
個人あてのメールよりも，コミニュティの場で，というのはこういうことなんですけどね．

これももったいないから，どこかに記事として掲載しようかな...

[10865] Re5:ファイルのクリップボードへのコピー返信　削除
2017/2/23 (木) 00:09:22 Mr.XRAY
> これももったいないから，どこかに記事として掲載しようかな...

ZeosLib 関係は，以下の [備考 4] に勝手に，この喫茶XRAYの記事に
リンクを貼らせていただきました．

http://mrxray.on.coocan.jp/Delphi/plSamples/564_ZeosLib_DelphiBerlin.htm#01

[▼次のスレッド]
INCM/CMT
Cyclamen v3.82