Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2022年03月22日] [更新 2022年04月11日]　Delphi サンプルプログラム集
   
824_ビットマップ画像と PNG 画像のコピー / 貼り付け
動作確認等 Windows 10 ビルド 19042 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
824_BmpPngClipboard.zip　[10,9 MB]　2022年04月11日版 (EXE 同梱)






ビットマップ画像と PNG 画像のクリップボードへのコピー / 貼り付け


Delphi では次のようなコードでビットマップをクリップボードにコピーしたり，クリップボードから貼り付けることができます．この時，クリップボードには，CR_BITAMP 形式と CF_DIB 形式のピッマップデータが格納されます．CF_BITMAP は，デバイス依存のビットマップ (DDB) です．64 ビットのカラーを扱うビデオボードもありますが，現在の Windows 10 の環境では，CF_BITMAP は，32 ビットのカラーと考えて差支えないでしょう．
CF_DIB はデバイス非依存のビットマップ (DIB) で，TBitmap のテータそのものです． 


  Clipboard.Assign(TBitmap);
  TBitmap.Assign(Clipboard);

アルファチャネルの処理が必要なく，ビット深さの情報も必要がなければ，以下のコードで十分です．
TBitmap..Assign(Clipboard) の TBitmap は CF_BITMAP 形式のデータです．

このコードと同じ手順で，PNG 画像，GIF 画像，JPEG 画像もクリップボードにコピーできます．その場合，PNG 画像，JPEG 画像は，CF_BITMAP 形式のビットマップとしてクリップボードから取得できます．GIF 画像は，CF_GIF形式の画像として取得できます．


リスト1
Clipboard.Assign と Assign(Clipboard) を使用するビットマップのコピーと貼り付け		 
implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

//=============================================================================
//  ビットマップ画像をクリップボードにコピー
//  Clipboard.Assign メソッドを使用
//
//  Images.bmp は 32 bit のアルファチャンネル付きのビットマップ画像ファイル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(ExpandFileName('.\Images.bmp'));
    LBitmap.AlphaFormat := afDefined;
    Image1.Canvas.Draw(0, 0, LBitmap);

    Clipboard.Assign(LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  クリップボードからヒットマップを取得
//  TBitmap.Assign メソッドを使用
//
//  透明色のピクセルは黒になる
//  取得したビットマップのビット深さは常に 32 ビット
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);

  // CF_BITMAP のデータがある場合に処理
  if Clipboard.HasFormat(CF_BITMAP) then begin
    LBitmap := TBitmap.Create;
    try
      LBitmap.Assign(Clipboard);
      Image1.Canvas.Draw(0, 0, LBitmap);
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;

end.


Assign(Clipboard) で，クリップボードから TBitmap のデータを取得した後，HandleType の値を bmDIB にすると，アルファチャネル付き画像として取得できます．

 


//=============================================================================
//  クリップボードからヒットマップを取得
//  TBitmap.Assign メソッドで取得して HandleType を bmDIB にする
//
//  アルファチャンネルを使用しないビットマップの場合
//  AlphaFormat := afDefined を削除する
//  代わりに Transparent := True にすれば透過表示になる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);

  // CF_BITMAP のデータがある場合に処理
  if Clipboard.HasFormat(CF_BITMAP) then begin
    LBitmap := TBitmap.Create;
    try
      LBitmap.Assign(Clipboard);
      LBitmap.HandleType  := bmDIB;
      LBitmap.AlphaFormat := afDefined;
      Image1.Canvas.Draw(0, 0, LBitmap);
    finally
      FreeAndNil(LBitmap);
    end;
  end;
end;


[備考]
DDB (デバイス依存ビットマップ - Device Dependent Bitma) は，Windows のビデオドライバが直接扱うことのできるビットマップです．その内部構造は，ビデオドライバやビデオモードによって異なります。ビットマップのピクセルをプログラムから直接佐操作することはできません．
DIB (デバイス非依存ビットマップ - Device Independent Bitmap) は，ヘッダ部を含めたデータ構造が定義されたビットマップ形式です．
DDB を DIB に変換するには，HandleType プロパティの値を bmDIB にします．PixelFormat プロパティを設定したり，メモリストリームに保存等の操作をすると市自動的に DIB になります．
Delphi の TBitmap は，基本的に DIB を扱います．





01_ビットマップのサイズとビット深さのチェック


ビットマップファイルヘッダにも，ビットマップインフォヘッダにも，そのビットマップがアルファチャンネルを使用しててるかという情報はありません．しかし，ピット深さが 32 ビット以上であるという情報は必要です．また，ビット深さに応じた処理が必要な場合もビット深さの値が必要です．
ビット深ささは，以下のように，ビットマップインフォヘッダ (ビットマップ情報ヘッダ) のメンバからも取得できます．

ビットマップファイルヘッダの部分は 40 バイトの固定ですが，ビットマップファイルインフォヘッダ部はいくつか種類あります．ビットマップのサイズとビット深さを取得するだけであれば，TBitmapInfoHeader と仮定して取得すれば十分です．



図1
実行結果

リスト2
ビットマップのサイズとビット深さのチェック		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

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

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'TplChartBar32.bmp';
end;

//=============================================================================
//  ビットマップ画像のサイズとビット深さをチェックする例
//
//  主なビットマップインフォヘッダには以下の種類がある
//  幅,高さ,ビット深さしか取得する必要がないので TBitmapInfoHeader だけで十分
//    TBitmapInfoHeader
//    TBitmapV4Header
//    TBitmapV5Header
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBmpFilePath   : string;
  LsrcStream     : TMemoryStream;
  LHeadStr       : array[0..1] of AnsiChar;
  LBmpInfoHeader : TBitmapInfoHeader;
  LBmpWidth      : Integer;
  LBmpHeight     : Integer;
  LBmpCount      : Integer;
begin
  Memo1.Lines.Clear;

  LBmpFilePath := ExpandFileName(Trim(Edit1.Text));

  LsrcStream := TMemoryStream.Create;
  try
    LsrcStream.LoadFromFile(LBmpFilePath);

    // ビットマップかどうかのチェック
    LsrcStream.Read(LHeadStr, 2);
    if LHeadStr <> 'BM' then exit;

    LsrcStream.Seek(SizeOf(TBitmapFileHeader), soBeginning);
    LsrcStream.ReadBuffer(LBmpInfoHeader, SizeOf(TBitmapInfoHeader));

    // ビットマップのサイズとビット深さを取得
    LBmpWidth  := LBmpInfoHeader.biWidth;
    LBmpHeight := LBmpInfoHeader.biHeight;
    LBmpCount  := LBmpInfoHeader.biBitCount;

    Memo1.Lines.Add('biWidth  : ' + IntToStr(LBmpWidth));
    Memo1.Lines.Add('biHeight : ' + IntToStr(LBmpHeight));
    Memo1.Lines.Add('bitCount : ' + IntToStr(LBmpCount));
  finally
    FreeAndNil(LsrcStream);
  end;
end;

end.



02_ビット深さを指定したクリップボードへのコピー


CF_DIB にはデバイス非依存のビットマップのデータをセットすることができます．そうすると，クリップボードからデータを取得する際，CF_DIB のデータを取得すればデバイスに依存しないビットマップのデータを取得することが可能になります．以下のコードはその例です．

このサンプルでは，指定したビット深さの画像を読み込んでクリップボードにコピーします．そして，そのクリップボードのビットマップデータを取得してディスクに保存します．コピーした時と同じビット深さのビットマップがクリップボードから取得できることが確認できます．

保存したビットマップ画像のビット深さはファイルのプロパティのダイアログでも確認できます．
このサンプルコードでは，32 ビットのアルファチャンネル付きの画像は，アルファ値を保持したままでコピーできます．受け取る側でも，CF_DIB のデータを取得すればアルファチャンネル付きで取得できます．

本サンプルで使用している添付のビットマップ画像は，4 ビット (16 色) の画像から作成しています．したがって， 基本的にビット数による画像の違いはありません．



図2
実行時の画面
  • ラジオボタンを選択
  • [Copy] ボタンをクリック
  • [Paste] ボタンをクリック
図3
[ファイルのプロパティ] ダイアログで確認
  • コピーした時のビット深さと同じになる

リスト3
ビット深さを指定したビットマップのクリップボードへのコピーと貼り付け		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function AddBmpFileHeader(AStream: TMemoryStream): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RadioGroup1.ItemIndex := 0;
end;

//=============================================================================
//  クリップボードにビットマップのデータを DIB としてコピー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LLoadFilePath : string;
  LStream       : TMemoryStream;
  LBitmap       : TBitmap;
  LFormatID     : WORD;
  LData         : THandle;
  LPalette      : HPALETTE;
begin
  Image1.Picture.Assign(nil);
  ListBox1.Items.Clear;

  Clipboard.Open;
  Clipboard.Clear;

  LLoadFilePath := 'Images\' + Trim(RadioGroup1.Items[RadioGroup1.ItemIndex]);

  LStream := TMemoryStream.Create;
  LBitmap := TBitmap.Create;
  try
    // ビットマップ画像ファイルをメモリストリームに読み込む
    LStream.LoadFromFile(LLoadFilePath);
    LStream.Position := 0;
    LBitmap.LoadFromStream(LStream);

    // それをクリップボードにセット
    SetdataToClipboard(CF_DIB, LStream);

    // CF_BITMAP 形式のビットマップを取得できるようにする
    // LFormatID の値は常に CF_BITMAP (VCL のソースコード参照)
    LBitmap.SaveToClipboardFormat(LFormatID, LData, LPalette);
    SetClipboardData(LFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  クリップボードからヒットマップのデータを DIB として取得
//  つまり[貼り付け]の処理
//  それを保存．保存した画像を読み込んで TImage に描画
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSaveFilePath  : string;
  LBmpStream     : TMemoryStream;
  LBmpInfoHeader : TBitmapInfoHeader;
  LBitmap        : TBitmap;
begin
  Image1.Picture.Assign(nil);
  LSaveFilePath := 'Images\DIB_' + Trim(RadioGroup1.Items[RadioGroup1.ItemIndex]);

  // CF_DIB のデータがある場合に処理
  if Clipboard.HasFormat(CF_DIB) then begin

    LBitmap    := TBitmap.Create;
    LBmpStream := TMemoryStream.Create;
    try
      // クリップボードから CF_DIB のデータを取得
      GetDataFromClipboard(CF_DIB, LBmpStream);

      // クリップボードのデータにファイルヘッダがなければ追加
      AddbmpFileHeader(LBmpStream);

      // メモリストリームを保存
      LBmpStream.SaveToFile(LSaveFilePath);

      // 保存したファイルからビットマップ画像を読み込んで表示
      LBitmap.LoadFromFile(LSaveFilePath);
      LBitmap.Transparent := True;
      Image1.Canvas.Draw(0, 0, LBitmap);

      // ビットマップインフォヘッダ部分を読み出す
      LBmpStream.Position := SizeOf(TBitmapFileHeader);
      LBmpStream.Read(LBmpInfoHeader, SizeOf(TBitmapInfoHeader));

      // ビットマップのサイズとビット深さを表示
      ListBox1.Items.Clear;
      ListBox1.Items.Add('Width  : ' + IntToStr(LBmpInfoHeader.biWidth));
      ListBox1.Items.Add('Height : ' + IntToStr(LBmpInfoHeader.biHeight));
      ListBox1.Items.Add('Colors : ' + IntToStr(LBmpInfoHeader.biBitCount) + ' bit');
    finally
      Clipboard.Close;
      FreeAndNil(LBmpStream);
      FreeAndNil(LBitmap);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);

    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードから，指定形式のデータをメモリストリームに格納
//-----------------------------------------------------------------------------
function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;
  AStream.Clear;

  // クリップボードのデータのポインタを取得
  LhGlobale := Clipboard.GetAsHandle(AFmtID);
  LpBuffer  := GlobalLock(LhGlobale);
  try
    // メモリストリームにクリップボードのデータを書き込む
    AStream.WriteBuffer(LpBuffer^, GlobalSize(LhGlobale));
    AStream.Position := 0;
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  メモリストリームにビットマップファイルヘッダの情報を追加
// ウェブブラウザの画像をコピーした場合等はファイルヘッダのデータがない
//-----------------------------------------------------------------------------
function AddBmpFileHeader(AStream: TMemoryStream): Boolean;
var
  LSigChar    : array[0..1] of AnsiChar;
  LFileHeader : TBitmapFileHeader;
  LStream     : TMemoryStream;
begin
  Result := True;

  AStream.Position := 0;
  AStream.Read(LSigChar, SizeOf(LSigChar));
  AStream.Position := 0;
  if LSigChar = 'BM' then Exit;

  Result := False;
  // BM がない場合はファイルヘッダがないので追加する
  LFileHeader.bfType      := $4D42;
  LFileHeader.bfSize      := AStream.Size;
  LFileHeader.bfReserved1 := 0;
  LFileHeader.bfReserved2 := 0;
  LFileHeader.bfOffBits   := SizeOf(TBitmapFileHeader);

  // クリップボードのデータの前にビットマップファイルヘッダ部を追加
  LStream := TMemoryStream.Create;
  try
    LStream.Write(LFileHeader, SizeOf(TBitmapFileHeader));
    LStream.Write(AStream.Memory, AStream.Size);
    LStream.Position := 0;
    AStream.Clear;
    LStream.SaveToStream(AStream);
    AStream.Position := 0;
  finally
    FreeAndNil(LStream);
  end;
end;
end.



03_フォーマット形式を定義して PNG 画像をクリップボードにコピー


Windows の，定義済みのクリップボードのフォーマット形式には，PNG 形式はありません．独自に形式を定義して処理することになります．

ワードやエクセルではフォーマット名に PNG が使われているので，本サンプルもそうしています．他のアプリケーションでは，このフォーマット名で検出しないと，PNG 画像としては取得できません．


図4
[Copy] ボタンをクリック
  • 画像は添付の PNG 画像
  • この画像をコピーする
  • ワードまたはエクセルに PNG 画像として貼り付けできる
図5
[Paste] ボタンをクリック
  • クリップボードから PNG 画像だけを取得
  • ワードやエクセルの PNG 画像も，PNG 画像として取得できる

サンプルの EXE を実行してボタンをクリックするとクリップボードに，メモリストリームに格納した PNG 画像のデータをセットするようになっています．
以下の参考リンクのサンプルプログラムを使用して，クリップボードのフォーマット形式を確認したのが下図です．PNG というフォーマット名が確認できます．



図6
クリップボード内のフォーマット形式を確認

リスト4
PNG 形式の画像をクリップボードにコピー / 貼り付け		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath : string;
  public
    { Public 宣言 }
  end;

  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.pngimage;

{$R *.dfm}

const
  // これはワードやエクセルが使用しているフォーマット名
  FPngFormatdStr = 'PNG';

var
  FPngFormatID : Cardinal;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFilePath := ExpandFileName('.\Images.png');

  // フォーマット名からフォーマットの ID 値を取得 (値は Windows が決定する)
  FPngFormatID := RegisterClipboardFormat(PChar(FPngFormatdStr));
end;

//=============================================================================
//  クリップボードに PNG 形式で画像をコピー
//  Windows の標準のクリップボードのフォーマットには PNG 形式はない
//  独自のフォーマット名を定義して実行する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream : TMemoryStream;
  LPngImg : TPngImage;
begin
  Image1.Picture.Assign(nil);

  Clipboard.Open;
  Clipboard.Clear;

  LStream := TMemoryStream.Create;
  LPngImg := TPngImage.Create;
  try
    // Png 画像のデータをメモリストリームに格納
    LPngImg.LoadFromFile(FFilePath);
    LPngImg.SaveToStream(LStream);

    Image1.Canvas.Brush.Color := clSilver;
    Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
    Image1.Canvas.Draw(0, 0, LPngImg);

    // クリップボードに格納
    SetDataToClipboard(FPngFormatID, LStream);
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LPngImg);
  end;
end;

//=============================================================================
//  クリップボードから PNG 画像のデータを取得
//  つまり[貼り付け]の処理
//  クリップボードのデータをメモリストリームに格納して TPngImage に読み込む
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LPngImg : TPngImage;
  LStream : TMemoryStream;
begin
  Image1.Picture.Assign(nil);

  // 指定フォーマットのデータがある場合に処理
  if Clipboard.HasFormat(FPngFormatID) then begin
    LPngImg := TPngImage.Create;
    LStream := TMemoryStream.Create;
    try
      // クリップボードから画像データを取得
      GetDataFromClipboard(FPngFormatID, LStream);

      // メモリストリームから画像データを読み込む
      LPngImg.LoadFromStream(LStream);

      Image1.Canvas.Brush.Color := clSilver;
      Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
      Image1.Canvas.Draw(0, 0, LPngImg);
    finally
      Clipboard.Close;
      FreeAndNil(LStream);
      FreeAndNil(LPngImg);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);
    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードから，指定形式のデータをメモリストリームに格納
//-----------------------------------------------------------------------------
function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;
  AStream.Clear;

  // クリップボードのデータのポインタを取得
  LhGlobale := Clipboard.GetAsHandle(AFmtID);
  LpBuffer  := GlobalLock(LhGlobale);
  try
    // メモリストリームにクリップボードのデータを書き込む
    AStream.WriteBuffer(LpBuffer^, GlobalSize(LhGlobale));
    AStream.Position := 0;
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

end.



04_PNG 画像とビットマップ画像の両方をクリップボードへコピー


前項のサンプルでは，PNG 形式の画像だけしかクリップボードにセットしません．
画像関係の多くのアプリケーションでは，クリップボードの CF_BITMAP, CF_DIB 形式からビットマップ画像のデータを取得しますから，これでは不便です．そこで，ビットマップ画像のデータもクリップボードにセットするようにしたのが本サンプルです．

複数の形式のデータをクリップボードへのコピーするには，Clipboard.Assign や Clipboard.SetAsHandle ではなく，SetClipboardData 関数を使用します．
Clipboard.Close は，SetClipboardData 関数で全ての形式のデータをセットしてから実行します．
クリップボードへのコピーと貼り付けの部分に，既に作成した自前の関数を使用しています．

 

    //クリップボードへセット
    Clipboard.SetAsHandle(FPngFormatID, LhGlobale);

    ↓ 

    SetClipboardData(FPngFormatID, LhGlobale);



    // Close は全ての形式のデータを SetClipboardData した後に実行する
    Clipboard.Close;


図7
[Button1] クリックでコピー
  • この PNG 画像をコピーする
  • ワードやエクセルに PNG 画像として貼り付けできる

図8
[Button2] クリックで貼り付け
  • [Button1] クリック直後であれば PNG 画像の取得
  • ワードやエクセルの PNG 画像も，PNG 画像として取得できる

このサンプルでは，クリップボードから CF_DIB のデータも取得するようにしています．下図は，ウェブブラウザで表示している画像を取得した例です．
Clipboard.Assign(TBitma) でコピーしたアルファチャンネル付きのビットマップ画像も，アルファチャンネル付きのビットマップとして取得できます．



図9
CF_DIB 形式のデータを取得
  • ウェブブラウザで表示中の画像の例
  • TBitmap.AlphaFormat := afDefined としている場合

前項のサンプルの時と同じように，クリップボードのフォーマット形式を確認したのが下図です．PNG というフォーマット名に続いて CF_DIB 等のビットマップ形式名が確認できます．
クリップボードからPNG 画像を取得するには，前項のサンプルと同じコードを使用しています．


図10
クリップボード内のフォーマット形式を確認
  • PNG 形式とビットマップ形式の両方がある
  • 順番はクリップボードにセットした順

リスト5
複数のフォーマット形式のデータをクリップボードにコピーする例		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath : string;
  public
    { Public 宣言 }
  end;

  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function AddBmpFileHeader(AStream: TMemoryStream): Boolean;
  function BmpCheckUsedAlpha(ABitmap: TBitmap): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.pngimage;

{$R *.dfm}

const
  // これはワードやエクセルが使用しているフォーマット名
  FPngFormatdStr = 'PNG';
var
  FPngFormatID : Cardinal;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFilePath := ExpandFileName('.\Images.png');

  FPngFormatID := RegisterClipboardFormat(PChar(FPngFormatdStr));
end;

//=============================================================================
//  PNG 画像とビットマップ画像をクリップボードにコピー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream   : TMemoryStream;
  LPngimg   : TPngImage;
  LBitmap   : TBitmap;
  LFormatID : WORD;
  LData     : THandle;
  LPalette  : HPALETTE;
begin
  Image1.Picture.Assign(nil);

  Clipboard.Open;
  Clipboard.Clear;

  LStream := TMemoryStream.Create;
  LPngimg := TPngImage.Create;
  LBitmap := TBitmap.Create;
  try
    LPngimg.LoadFromFile(FFilePath);
    // 透明ピクセルの確認のため TImage.Canvas を塗り潰してから描画
    Image1.Canvas.Brush.Color := clSilver;
    Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
    Image1.Canvas.Draw(0, 0, LPngimg);

    // Png 画像のデータをメモリストリームに格納
    LPngimg.LoadFromFile(FFilePath);
    LPngimg.SaveToStream(LStream);

    //  TPngImage をクリップボードにコピー
    SetDatatoClipboard(FPngFormatID, LStream);

    // TBitmap としてもをクリップボードにコピー
    LBitmap.Assign(LPngimg);
    LStream.Clear;
    LBitmap.SaveToStream(LStream);
    SetDataToClipboard(CF_DIB, LStream);

    // CF_BITMAP 形式のビットマップを取得できるようにする
    // LFormatID の値は常に CF_BITMAP (VCL のソースコード参照)
    LBitmap.SaveToClipboardFormat(LFormatID, LData, LPalette);
    SetClipboardData(LFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LPngimg);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  クリップボードからヒットマップのデータを取得
//  つまり[貼り付け]の処理
//  クリップボードのデータをメモリストリームに格納して読み込む
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LStream : TMemoryStream;
  LPngImg : TPngImage;
  LBitmap : TBitmap;
begin
  // 透明ピクセルの確認のため TImage.Canvas を塗り潰す
  Image1.Picture.Assign(nil);
  Image1.Canvas.Brush.Color := clSilver;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);


  LPngImg := TPngImage.Create;
  LBitmap := TBitmap.Create;
  LStream := TMemoryStream.Create;
  try
    // PNG 形式のデータがクリップボードにある場合
    if Clipboard.HasFormat(FPngFormatID) then begin
      GetDataFromClipboard(FPngFormatID, LStream);
      LPngImg.LoadFromStream(LStream);

      Image1.Canvas.Draw(0, 0, LPngImg);
    end else
    // CF_DIB のデータがある場合
    if Clipboard.HasFormat(CF_DIB) then begin
      // クリップボードのデータを取得
      GetDataFromClipboard(CF_DIB, LStream);

      // ファイルヘッダを検査してなければ追加
      AddBmpFileHeader(LStream);
      // メモリストリームからビットマップ画像データを読み込んで表示
      LBitmap.LoadFromStream(LStream);


      if CheckBox1.Checked then begin
        // アルファ値を使用しているか (アルファ値が有効か) をチェック
        if BmpCheckUsedAlpha(LBitmap) then begin
          // AlphaFormat := afDefined にしないと透明ピクセルは黒になる
          LBitmap.AlphaFormat := afDefined;
        end else begin
          // 透過色を透過状態にする
          LBitmap.PixelFormat := pf24bit;
          LBitmap.Transparent := True;
        end;
      end;
      Image1.Canvas.Draw(0, 0, LBitmap);
    end;
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LPngImg);
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);
    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードから，指定形式のデータをメモリストリームに格納
//-----------------------------------------------------------------------------
function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;
  AStream.Clear;

  // クリップボードのデータのポインタを取得
  LhGlobale := Clipboard.GetAsHandle(AFmtID);
  LpBuffer  := GlobalLock(LhGlobale);
  try
    // メモリストリームにクリップボードのデータを書き込む
    AStream.WriteBuffer(LpBuffer^, GlobalSize(LhGlobale));
    AStream.Position := 0;
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  メモリストリームにビットマップファイルヘッダの情報を追加
// ウェブブラウザの画像をコピーした場合等はファイルヘッダのデータがない
//-----------------------------------------------------------------------------
function AddBmpFileHeader(AStream: TMemoryStream): Boolean;
var
  LSigChar    : array[0..1] of AnsiChar;
  LFileHeader : TBitmapFileHeader;
  LStream     : TMemoryStream;
begin
  Result := True;

  AStream.Position := 0;
  AStream.Read(LSigChar, SizeOf(LSigChar));
  AStream.Position := 0;
  if LSigChar = 'BM' then Exit;

  Result := False;
  // BM がない場合はファイルヘッダがないので追加する
  LFileHeader.bfType      := $4D42;
  LFileHeader.bfSize      := AStream.Size;
  LFileHeader.bfReserved1 := 0;
  LFileHeader.bfReserved2 := 0;
  LFileHeader.bfOffBits   := SizeOf(TBitmapFileHeader);

  // クリップボードのデータの前にビットマップファイルヘッダ部を追加
  LStream := TMemoryStream.Create;
  try
    LStream.Write(LFileHeader, SizeOf(TBitmapFileHeader));
    LStream.Write(AStream.Memory, AStream.Size);
    LStream.Position := 0;
    AStream.Clear;
    LStream.SaveToStream(AStream);
    AStream.Position := 0;
  finally
    FreeAndNil(LStream);
  end;
end;

//-----------------------------------------------------------------------------
//  ビットマップのビット深さを取得
//  PixelFormat の値は，PixelFormat を明示的に設定していないと検出不可なので注意
//-----------------------------------------------------------------------------
function BmpCheckBitCount(ABitmap: TBitmap): WORD;
var
  LStream     : TMemoryStream;
  LInfoHeader : TBitmapInfoHeader;
begin
  LStream := TMemoryStream.Create;
  try
    ABitmap.SaveToStream(LStream);
    LStream.Position := SizeOf(TBitmapFileHeader);
    LStream.ReadBuffer(LInfoHeader, SizeOf(TBitmapInfoHeader));
    Result  := LInfoHeader.biBitCount;
  finally
    FreeAndNil(LStream);
  end;
end;

//-----------------------------------------------------------------------------
//  アルファチャンネルを使用しているかをチェック
//  32 ビット未満なら False
//  32 ビットの場合はアルファ値が全て 0 または $FF ならば False
//  32 ビットの TBitmap のデフォルト状態ではアルファ値は全て 0
//  結果が False のビットマップは 24 ビットにした方が無難
//-----------------------------------------------------------------------------
function BmpCheckUsedAlpha(ABitmap: TBitmap): Boolean;
type
  TRGBQuadArray = array [0..MaxInt div SizeOf(TRGBQuad) - 1] of TRGBQuad;
  PRGBQuadArray = ^TRGBQuadArray;
var
  LYPos      : Integer;
  LXPos      : Integer;
  LAlpha     : Byte;
  LScanArray : PRGBQuadArray;
  LCntTotal  : Integer;
  LCntZero   : Integer;
  LCntHexFF  : Integer;
begin
  Result := False;
  if BmpCheckBitCount(ABitmap) < 32 then Exit;

  ABitmap.Canvas.Lock;

  LCntTotal := ABitmap.Width * ABitmap.Height;
  LCntZero  := 0;
  LCntHexFF := 0;

  try
    for LYPos := 0 to ABitmap.Height - 1 do begin
      LScanArray := ABitmap.ScanLine[LYPos];
      for LXPos := 0 to ABitmap.Width - 1 do begin
        LAlpha := LScanArray[LXPos].rgbReserved;
        if LAlpha = $00 then Inc(LCntZero);
        if LAlpha = $FF then Inc(LCntHexFF);
      end;
    end;
    Result := not((LCntTotal = LCntZero) or (LCntTotal = LCntHexFF));
  finally
    ABitmap.Canvas.Unlock;
  end;
end;

end.


上の Button2 クリックには，クリップボードから取得したデータにファイルヘッダ部を追加する処理があります．クリップボードにファイルヘッダがない場合，この処理がないと下図のようなエラーが発生します．
同じアプリ内でコピーと貼り付けを行う場合は，このような処理は必要ありません．
クリップボードにファイルヘッダ部があるのかは，コピー元のアプリの仕様によります．



図11
ビットマップ画像が無効です

クリップボードにコピーする時に，改めて CF_DIB 形式のデータとCF_BITMAP 形式のデータをセットしています．CF_DIB 形式でクリップボードにコピーすると自動的に CF_BITMAP のデータも格納されますが，その場合の CF_BITMAP のデータは，TBitmap.Assign(Clipboard) メソッドでは取得できません．下図のようなエラーが発生します．CF_DIB 形式のデータと CF_BITMAP 形式のデータは，個別に処理する必要があります．


図12
サポートされていないクリップボード形式です

[備考]
クリップボードの形式が CF_DIBV5 のビットマップは，ピッマップインフォヘッダ (ビットマップ情報ヘッダ の構造体が BITMAPV5HEADER (Delphi では TBitmapV5Header レコード型) のビットマップです．このビットマップは，ビットマップ・バージョン 5 とも言われていました．Windows 98 で採用されましたが，現在の Windows では使われていません．




05_TPngImage.SaveToClipboardFormat メソッドを使用するコピー


Delphi には，TBitmap.SaveToClipboardFormat, TBitmap.LoadFromClipboardFormat 等，クリップボードへのコピー，クリップボードからのデータ取得用のメソッドが実装されています．

TPNGImage にも同じメソッドがあります．下に示すコードは，それらのメソッドを使用する例ですが，透明 / 半透明の情報は失われます．
TBitmap.SaveToClipboardFormat メソッドも，CF_BITMAP 形式でのコピーとなります．アルファチャンネルの情報を保持したままでクリップボードにデータをセットすることはできません．




図13
コピー元の PNG 画像

図14
貼り付け

リスト6
TPngImage.SaveToClipboardFormat メソッドを使用したクリップボードへのコピー
CF_BITMAP 形式でのコピーとなり，アルファチャンネルの情報は失われる		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath : string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.imaging.pngImage;

{$R *.dfm}

var
  FFormatID : WORD;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFilePath := ExpandFileName('.\Images.png');
  FFormatID := CF_BITMAP;
end;

//=============================================================================
//  クリップボードに PNG 画像をコピー
//  Windows の標準のクリップボードのフォーマットには PNG 形式はない
//  アルファチャネルの情報は失われる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPngimg  : TPngImage;
  LData    : THandle;
  LPalette : HPALETTE;
begin
  Clipboard.Open;
  Clipboard.Clear;

  LPngimg := TPngImage.Create;
  try
    // Png 画像を読み込む
    LPngimg.LoadFromFile(FFilePath);

    // PNG 画像を TImage に描画
    // 透明ピクセルの確認のため TImage.Canvas を塗り潰してから描画
    Image1.Canvas.Brush.Color := clSilver;
    Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
    Image1.Canvas.Draw(0, 0, LPngImg);

    // クリップボードにコピーするために必要なデータを取得
    // FFormatID の戻り値は CF_BITMAP
    LPngimg.SaveToClipboardFormat(FFormatID, LData, LPalette);
    // クリップボードへセット
    Clipboard.SetAsHandle(FFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LPngimg);
  end;
end;

//=============================================================================
//  クリップボードから PNG 画像のデータを取得
//  FFormatID を CF_BITMAP にしても結果は同じ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LPngImage : TPngImage;
  LData    : THandle;
begin
  Image1.Picture.Assign(nil);

  if Clipboard.HasFormat(FFormatID) then begin
    LPngImage := TPngImage.Create;
    try
      // クリップボードのデータのポインタを取得
      LData := Clipboard.GetAsHandle(FFormatID);

      // クリップボードのデータを TPngImaage のデータとして取得
      LPngImage.LoadFromClipboardFormat(FFormatID, LData, 0);

      // PNG 画像を TImage に描画
      // 透明ピクセルの確認のため TImage.Canvas を塗り潰してから描画
      Image1.Canvas.Brush.Color := clSilver;
      Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
      Image1.Canvas.Draw(0, 0, LPngImage);
    finally
      Clipboard.Close;
      FreeAndNil(LPngImage);
    end;
  end;
end;

end.



06_GIF 画像をクリップボードへコピー


GIF 画像のクリップボードのフォーマット形式は CF_GIF です．今回作成した自前の関数も使用できますが，TGIFImage には，TBitmap と同じように，クリップボード入出力用の SaveToClipboardFormat メソッドと .LoadFromClipboardForma メソッドがあります．それらのメソッドを使用する例です．

このサンプルでは，CF_BITMAP 形式の画像としても取得できるようにしています．CF_BITMAP で取得したビットマップのビット深さは，常に 32 ビットです．


図15
[Copy] ボタンをクリック
  • 画像は添付の GIF 画像
  • この画像をコピーする
  • TGifImage.Transparent の値を False にして表示している
図16
[Paste] ボタンをクリック
  • クリップボードから GIF 画像だけを取得

リスト7
GIF 画像をクリップボードへコピー / 貼り付け		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath : string;
  public
    { Public 宣言 }
  end;

  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.GIFImg;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFilePath := ExpandFileName('.\Images.gif');
end;

//=============================================================================
//  クリップボードに GIF 画像をコピー
//  SaveToClipboardFormat と Clipboard.SetAsHandle を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream   : TMemoryStream;
  LGifImg   : TGIFImage;
  LFormatID : WORD;
  LData     : THandle;
  LPalette  : HPALETTE;
begin
  Image1.Picture.Assign(nil);

  Clipboard.Open;
  Clipboard.Clear;

  LStream := TMemoryStream.Create;
  LGifImg := TGIFImage.Create;
  try
    // GIF 画像ファイルをメモリストリームに読み込む
    LGifImg.LoadFromFile(FFilePath);

    LGifImg.Transparent := False;
    Image1.Canvas.Draw(0, 0, LGifImg);

    // クリップボードにセット
    // LFormatID の値は常に CF_GIF (VCL のソースコード参照)
    LGifImg.SaveToClipboardFormat(LFormatID, LData, LPalette);
    Clipboard.SetAsHandle(LFormatID, LData);


    // CF_DIB 形式のビットマップを取得できるようにする
    LGifImg.Bitmap.PixelFormat := pf8bit;
    LGifImg.Bitmap.SaveToStream(LStream);
    SetDataToClipboard(CF_DIB, LStream);

    // CF_BITMAP 形式のビットマップを取得できるようにする
    // LFormatID の値は常に CF_BITMAP (VCL のソースコード参照)
    LGifImg.Bitmap.SaveToClipboardFormat(LFormatID, LData, LPalette);
    SetClipboardData(LFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LGifImg);
    FreeAndNil(LStream);
  end;
end;

//=============================================================================
//  クリップボードから GIF 画像のデータを取得
//   Clipboard.GetAsHandle と LoadFromClipboardFormat を使用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGifImg : TGIFImage;
  LData    : THandle;
begin
  Image1.Picture.Assign(nil);

  if Clipboard.HasFormat(CF_GIF) then begin
    LGifImg := TGIFImage.Create;
    try
      // クリップボードのデータのポインタを取得
      LData := Clipboard.GetAsHandle(CF_GIF);
      // クリップボードのデータを TGifImaage のデータとして取得
      LGifImg.LoadFromClipboardFormat(CF_GIF, LData, 0);

      Image1.Canvas.Draw(0, 0, LGifImg);
    finally
      Clipboard.Close;
      FreeAndNil(LGifImg);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);

    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

end.


GIF 画像は，本ページの最初で述べたように，以下のコードでもクリップボードにコピー / 貼り付けできます．ただし，クリップボードに格納されるのは CF_GIF 形式のデータだけです．

 


implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.GifImg;

{$R *.dfm}

//=============================================================================
//  GIF 画像をクリップボードにコピー
//  Clipboard.Assign を使用する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGifImg : TGIFImage;
begin
  Image1.Picture.Assign(nil);

  LGifImg := TGIFImage.Create;
  try
    LGifImg.LoadFromFile(ExpandFileName('.\Images.gif'));
    Clipboard.Assign(LGifImg);
    LGifImg.Transparent := False;
    Image1.Canvas.Draw(0, 0, LGifImg);
  finally
    FreeAndNil(LGifImg);
  end;
end;

//=============================================================================
//  クリップボードから GIF 画像のデータを取得
//  TGIFImage.Assign を使用する例
//  上のコードでは，クリップボートのデータは CF_GIF だけ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGifImg : TGIFImage;
begin
  Image1.Picture.Assign(nil);

  // CF_GIF のデータがある場合に処理
  if Clipboard.HasFormat(CF_GIF) then begin
    LGifImg := TGIFImage.Create;
    try
　    LGifImg.Assign(Clipboard);
      Image1.Canvas.Draw(0, 0, LGifImg);
    finally
      FreeAndNil(LGifImg);
    end;
  end;
end;



07_JPEG 画像をクリップボードへコピー


Windows の，定義済みのクリップボードのフォーマット形式には，JPEG 形式はありません．PNG 画像のサンプルと同じように，独自に形式を定義して処理することになります．

ワードやエクセルではフォーマット名に JFIF が使われているので，本サンプルもそうしています．他のアプリケーションでは，このフォーマット名で検出しないと，JPEG 画像ししては取得できません．そのような機能を実装していないアプリでも，CF_DIB 形式と CF_BITMAP 形式の画像としては取得できるようにしています．CF_BITMAP で取得したビットマップのビット深さは，常に 32 ビットです．

添付の JPEG 画像のビット深さは 24 ビットです．TJPEGImage.PixelFormat プロパティの値を jf8Bit (256 色) にしても，クリップボードには 24 ビットのデータとして格納されます．


図17
[Copy] ボタンをクリック
  • 画像は添付の JPEG 画像
  • この画像をコピーする
  • ワードやエクセルに JPEG 画像として貼り付けできる
図18
[Paste] ボタンをクリック
  • クリップボードから JPEG 画像だけを取得
  • ワードやエクセルの JPEG 画像も，JPEG 画像として取得できる

リスト8
JPEG 画像をクリップボードへコピー / 貼り付け		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath : string;
  public
    { Public 宣言 }
  end;

  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.imaging.Jpeg;

{$R *.dfm}

const
  // これはワードやエクセルが使用しているフォーマット名
  FJpgFormatdStr = 'JFIF';
var
  FJpgFormatID : Cardinal;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFilePath := ExpandFileName('Images.jpg');

  // フォーマット名からフォーマットの ID 値を取得 (値は Windows が決定する)
  FJpgFormatID := RegisterClipboardFormat(PChar(FJpgFormatdStr));
end;

//=============================================================================
//  クリップボードに PNG 形式で画像をコピー
//  Windows の標準のクリップボードのフォーマットには JPEG 形式はない
//  独自のフォーマット名を定義して実行する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream   : TMemoryStream;
  LJpgimg   : TJPEGImage;
  LBitmap   : TBitmap;
  LFormatID : WORD;
  LData     : THandle;
  LPalette  : HPALETTE;
begin
  Image1.Picture.Assign(nil);

  Clipboard.Open;
  Clipboard.Clear;

  LStream := TMemoryStream.Create;
  LJpgimg := TJPEGImage.Create;
  LBitmap := TBitmap.Create;
  try
    // Jpeg 画像のデータをメモリストリームに格納
    LJpgimg.LoadFromFile(FFilePath);
    LJpgimg.SaveToStream(LStream);

    Image1.Canvas.Draw(0, 0, LJpgimg);

    // クリップボードに格納
    SetDataToClipboard(FJpgFormatID, LStream);


    LBitmap.Assign(LJpgimg);
    // CF_DIB 形式のビットマップを取得できるようにする
    LStream.Clear;
    LBitmap.SaveToStream(LStream);
    SetDataToClipboard(CF_DIB, LStream);

    // CF_BITMAP 形式のビットマップを取得できるようにする
    // LFormatID の値は常に CF_BITMAP (VCL のソースコード参照)
    LBitmap.SaveToClipboardFormat(LFormatID, LData, LPalette);
    SetClipboardData(LFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LJpgimg);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  クリップボードから JPEG 画像のデータを取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJpgImg : TJPEGImage;
  LStream : TMemoryStream;
begin
  Image1.Picture.Assign(nil);

  // 指定フォーマットのデータがある場合に処理
  if Clipboard.HasFormat(FJpgFormatID) then begin
    LJpgImg := TJPEGImage.Create;
    LStream := TMemoryStream.Create;
    try
      // クリップボードから画像データを取得
      GetDataFromClipboard(FJpgFormatID, LStream);

      // メモリストリームから画像データを読み込む
      LJpgImg.LoadFromStream(LStream);

      Image1.Canvas.Draw(0, 0, LJpgImg);
    finally
      Clipboard.Close;  
      FreeAndNil(LStream);
      FreeAndNil(LJpgImg);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);
    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードから，指定形式のデータをメモリストリームに格納
//-----------------------------------------------------------------------------
function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;
  AStream.Clear;

  // クリップボードのデータのポインタを取得
  LhGlobale := Clipboard.GetAsHandle(AFmtID);
  LpBuffer  := GlobalLock(LhGlobale);
  try
    // メモリストリームにクリップボードのデータを書き込む
    AStream.WriteBuffer(LpBuffer^, GlobalSize(LhGlobale));
    AStream.Position := 0;
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

end.



08_ICON 画像をクリップボードへコピー


ICON 画像のクリップボードへのコピーと取得のサンプルです．
拡張子が .ico のアイコン画像も，定義済みのフォーマット形式がありまん．独自に定義することになります．このサンプルでは ICON としました．
他のアプリケーションでは，このフォーマット名で検出しないと，ICONG 画像しして取得できません．そのような機能を実装していないアプリでも，CF_DIB または CF_BITMAP 形式の画像として取得できるようにしています．このサンプルで使用している ICON 画像のビット深さは，32 ビットです．


[備考]
Delphi の TIcon には，クリップボード入出力の機能は実装されていません．


図19
[Copy] ボタンをクリック
  • 画像は添付のアイコン画像
  • この画像をコピーする
図20
[Paste] ボタンをクリック
  • クリップボードからアイコン画像だけを取得

このサンプルでは，コピーした画像を CF_DIB または CF_BITMAP 形式の画像として取得できるようにしています．
下図は，これまでのサンプルで取得して貼り付けた結果です．


図21
本ページの最初のサンプルで取得した結果
  • 透過ピクセルが黒になっている
図22
[PNG 画像とビットマップ画像・・・] のサンプルで取得した結果
  • アルファ値が有効な状態での取得になる
  • TBitmap.AlphaFormat := afDefined にした場合

マイクロソフトでは，256 x 256 以上のアイコン画像として PNG 形式を使用することを推奨しています．
ワードやエクセルに，拡張子が .ico の画像を挿入すると，PNG 画像として扱われます．それらの画像をクリップボードにコピーすると，PNG 画像と，アルファチャンネル付きのビットマップ画像もクリップボードに格納されます．


リスト9
ICON 画像をクリップボードへコピー / 貼り付け		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath : string;
  public
    { Public 宣言 }
  end;

  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
  function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

const
  FIconFormatdStr = 'ICON';
var
  FIconFormatID : Cardinal;


//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFilePath := ExpandFileName('128_32bit.ico');

  // フォーマット名からフォーマットの ID 値を取得 (値は Windows が決定する)
  FIconFormatID := RegisterClipboardFormat(PChar(FIconFormatdStr));
end;

//=============================================================================
//  クリップボードに TIcon の画像をコピー
//  Windows の標準のクリップボードのフォーマットには TIcon に相当する形式はない
//  独自のフォーマット名を定義して実行する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream 　: TMemoryStream;
  LIcon   　: TIcon;
  LBitmap 　: TBitmap;
  LFormatID : WORD;
  LData     : THandle;
  LPalette  : HPALETTE;
begin
  Image1.Picture.Assign(nil);

  Clipboard.Open;
  Clipboard.Clear;

  LStream := TMemoryStream.Create;
  LIcon   := TIcon.Create;
  LBitmap := TBitmap.Create;

  try
    // アイコン画像のデータをメモリストリームに格納
    LIcon.LoadFromFile(FFilePath);
    LIcon.SaveToStream(LStream);

    // 透過状態確認のため TImage.Canvas を塗り潰してから描画
    Image1.Canvas.Brush.Color := clSilver;
    Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
    Image1.Canvas.Draw(0, 0, LIcon);
    Image1.Canvas.Draw(0, 0, LIcon);

    // クリップボードに独自形式のデータを格納
    SetDataToClipboard(FIconFormatID, LStream);

    // CF_DIB 形式のビットマップを取得できるようにする
    LBitmap.Assign(LIcon);
    LStream.Clear;
    LBitmap.SaveToStream(LStream);
    SetDataToClipboard(CF_DIB, LStream);

    // CF_BITMAP 形式のビットマップを取得できるようにする
    LBitmap.SaveToClipboardFormat(LFormatID, LData, LPalette);
    SetClipboardData(LFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LIcon);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  クリップボードから TIcon 画像のデータを取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LIcon      : TIcon;
  LIcoStream : TMemoryStream;
begin
  Image1.Picture.Assign(nil);

  // 指定フォーマットのデータがある場合に処理
  if Clipboard.HasFormat(FIconFormatID) then begin
    LIcon      := TIcon.Create;
    LIcoStream := TMemoryStream.Create;
    try
      // クリップボードから指定フォーマットのデータを取得
      GetDataFromClipboard(FIconFormatID, LIcoStream);

      // メモリストリームから画像データを読み込む
      LIcon.LoadFromStream(LIcoStream);

      // 透過状態確認のため TImage.Canvas を塗り潰してから描画
      Image1.Canvas.Brush.Color := clSilver;
      Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
      Image1.Canvas.Draw(0, 0, LIcon);
    finally
      Clipboard.Close;
      FreeAndNil(LIcoStream);
      FreeAndNil(LIcon);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);

    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードから，指定形式のデータをメモリストリームに格納
//-----------------------------------------------------------------------------
function GetDataFromClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;
  AStream.Clear;

  // クリップボードのデータのポインタを取得
  LhGlobale := Clipboard.GetAsHandle(AFmtID);
  LpBuffer  := GlobalLock(LhGlobale);
  try
    // メモリストリームにクリップボードのデータを書き込む
    AStream.WriteBuffer(LpBuffer^, GlobalSize(LhGlobale));
    AStream.Position := 0;
  finally
    GlobalUnlock(LhGlobale);
  end;
end;

end.


ICON 画像は，32 ビットのアルファチャンネル付きの TBitmap，あるいは TPngImage 画像に変換して扱う方が確実と言えます．
アルファチャンネル付きの 32 ビットの TBitmap 画像には，以下のコードで変換できます．以下のコードでは，TPngImage 画像に正常に変換できません．アルファ値の情報が失われてしまいます．以下の記事のサンプルコードを参考にしてくだささい．


図23
下にす示すコードを使用して変換した結果
  • 左から順番に
    元のアイコン画像ビットマップ画像
    PNG 画像

リスト10
ICON 画像を TBitmap 画像と TPngImage 画像に変換		 
implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.pngimage;

{$R *.dfm}

//=============================================================================
//  ICON 画像を ビットマップと PNG 画像に変換
//  テストに使用しているのは 32ビットの ICON 画像
//  TBitmap は 32 ビットで透明 / 半透明の情報が保持される
//  TPngImage は 24 ビットになる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

procedure TImageFillRectColor(AImage: TImage; AColor: TColor);
begin
  AImage.Picture.Assign(nil);

  AImage.Canvas.Brush.Color := AColor;
  AImage.Canvas.FillRect(Image1.Canvas.ClipRect);
end;

var
  LFileName : string;
  LIcon     : TIcon;
  LBitamp   : TBitmap;
  LPngImg   : TPngImage;
begin
  TImageFillRectColor(Image1, clSilver);
  TImageFillRectColor(Image2, clSilver);
  TImageFillRectColor(Image3, clSilver);
  if Edit1.Text = '' then exit;

  LFileName := Edit1.Text;

  LIcon   := TIcon.Create;
  LBitamp := TBitmap.Create;
  LPngImg := TPngImage.Create;
  try
    LIcon.LoadFromFile(LFileName);

    Image1.Canvas.Draw(0, 0, LIcon);

    LBitamp.Assign(LIcon);
    LBitamp.SaveToFile(ChangeFileExt(LFileName, '.bmp'));
    Image2.Canvas.Draw(0, 0, LBitamp);

    LPngImg.Assign(LBitamp);
    LPngImg.SaveToFile(ChangeFileExt(LFileName, '.png'));
    Image3.Canvas.Draw(0, 0, LPngImg);
  finally
    FreeAndNil(LIcon);
    FreeAndNil(LBitamp);
    FreeAndNil(LPngImg);
  end;
end;


TKIcon を使用すると，透明 / 半透明ピクセルの情報を保持したまま PNG 画像に変換できます．
TKIcon は， 908_ExtractIcon.zip に同梱している kcontrols_1.7.zip 書庫内にあります．


図24
TKIcon を使用して画像形式を変換
  • 左から順番に
    元の ICON 画像
    ピッマップ画像
    PNG 画像

リスト11
TKIcon を使用して，TIcon 画像を TBitmap 画像と TPngImage 画像に変換		 
implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.pngimage,
  KIcon;

{$R *.dfm}

//=============================================================================
//  TKIcon を使用して ICON 画像を ビットマップと PNG 画像に変換
//  TKIcon は 256 x 256 以上の icon 画像を扱える
//  元の ICON のビット数に関係なく，BMP, PNG 共に 32 ビットの画像となる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

procedure TImageFillRectColor(AImage: TImage; AColor: TColor);
begin
  AImage.Picture.Assign(nil);

  AImage.Canvas.Brush.Color := AColor;
  AImage.Canvas.FillRect(Image1.Canvas.ClipRect);
end;

var
  LFileName : string;
  LKIcon    : TKIcon;
  LBitamp   : TBitmap;
  LPngImg   : TPngImage;
begin
  TImageFillRectColor(Image1, clSilver);
  TImageFillRectColor(Image2, clSilver);
  TImageFillRectColor(Image3, clSilver);
  if Edit1.Text = '' then exit;

  LFileName := Edit1.Text;

  LKIcon  := TKIcon.Create;
  LBitamp := TBitmap.Create;
  LPngImg := TPngImage.Create;
  try
    LKIcon.LoadFromFile(LFileName);

    if LKIcon.IconCount = 1 then begin
      Image1.Canvas.Draw(0, 0, LKIcon);

      LKIcon.CopyToBitmap(0, LBitamp);
      LBitamp.SaveToFile(ChangeFileExt(LFileName, '.bmp'));
      if LKIcon.IconData[0].Bpp = 32 then begin
        LBitamp.AlphaFormat := afDefined;
      end else begin
        LBitamp.Transparent := True;
      end;
      Image2.Canvas.Draw(0, 0, LBitamp);

      LKIcon.CopyToPng(0, LPngImg);
      LPngImg.SaveToFile(ChangeFileExt(LFileName, '.png'));
      Image3.Canvas.Draw(0, 0, LPngImg);
    end;
  finally
    FreeAndNil(LKIcon);
    FreeAndNil(LBitamp);
    FreeAndNil(LPngImg);
  end;
end;



09_TPicture の画像をクリップボードへコピー


TPicture の画像のクリップボードへのコピーと取得のサンプルです．
TImage には TImage.Pictur4 プロパティがありますから，TImage に描画している画像も，このようなコードでクリップボードにコピーできることになります．
TIcon 画像はクリップボードをサポートしていないので，この方法では，クリップボードへのコピーはできません．クリップボードのフォーマット形式がない PNG 画像，JPEGImage 画像は，TBitmap の画像としてコピーされます．画像のアルファ値の情報，あるいは透明 / 半透明の情報は失われます．


図25
[Copy] ボタンをクリック
  • TPicture の画像は GIF 画像
  • それをクリップボードにコピー
図26
[Paste] ボタンをクリック
  • クリップボードの TPicture オブジェクトを取得

リスト12
TPicture の画像をクリップボードへコピー / 貼り付け		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

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

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.GIFImg;

{$R *.dfm}

//=============================================================================
//  TPicture の画像をクリップボードにコピー
//  TGifImage の画像の例
 //
 //  クリップボートのフォーマット形式がない PNG, JPEG 等は TBitmap となる
 //  アルファ値の情報，透明 / 半透明の情報は失われる
 //  TIcon はクリップボードをサポートしていなので不可
 //
 //  TImage には TImage.Picture プロパティがあるので TImage の画像もコピー可能
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LPicture  : TPicture;
begin
  Image1.Picture.Assign(nil);
  Image1.Canvas.Brush.Color := clSilver;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);


  LPicture := TPicture.Create;
  try
    LPicture.LoadFromFile('images.gif');

    Clipboard.Assign(LPicture);

    if LPicture.Graphic is TGIFImage then begin
      // TBitmap であれば TPicture.Bitmap プロパティがある
      (LPicture.Graphic as TGIFImage).Transparent := CheckBox1.Checked;
    end;
    Image1.Canvas.Draw(0, 0, LPicture.Graphic);
  finally
    FreeAndNil(LPicture);
  end;
end;

//=============================================================================
//  TPicture の画像をクリップボードから取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LPicture : TPicture;
begin
  Image1.Picture.Assign(nil);
  Image1.Canvas.Brush.Color := clSilver;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);


  if Clipboard.HasFormat(CF_PICTURE) then begin
    LPicture := TPicture.Create;
    try
      LPicture.Assign(Clipboard);

      if LPicture.Graphic is TGIFImage then begin
        // TBitmap であれば TPicture.Bitmap プロパティがある
        (LPicture.Graphic as TGIFImage).Transparent := CheckBox1.Checked;
      end;
      Image1.Canvas.Draw(0, 0, LPicture.Graphic);
    finally
      FreeAndNil(LPicture);
    end;
  end;
end;

end.


TCF_PICTURE は，Delphi / C++Builder 特有の形式です．Windows のクリップボードの標準フォーマットにはありません．TClipBoard.Formats でも検出できるのは実際にコピーした画像形式だけです．CF_PICTUREW は，Delphi / C++Builder が内部的に使用する形式です．
他のアプリケーションからも，CF_IDB, CF_BITMAP 形式のビットマップ画像として取得できるようにしておくと便利と言えます．

リスト13
TPicture の画像と CF_DIB, CF_BITMAP 形式のデータもクリップボードへコピー		 
  function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  Vcl.Imaging.GIFImg,
  Vcl.Imaging.jpeg,
  Vcl.Imaging.pngimage;

{$R *.dfm}

//=============================================================================
//  PNG 画像とビットマップ画像をクリップボードにコピー
//  CF_DIB, CF_BITMAP 形式のデータもコピー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilepath : string;
  LStream   : TMemoryStream;
  LPicture  : TPicture;
  LBitmap   : TBitmap;
  LFormatID : WORD;
  LData     : THandle;
  LPalette  : HPALETTE;
begin
  // TIcon の画像の場合
  // LFilepath := ExpandFileName('.\128_32bit.ico');
  LFilepath := ExpandFileName('.\Images.bmp');

  Image1.Picture.Assign(nil);

  Clipboard.Open;
  Clipboard.Clear;

  LStream := TMemoryStream.Create;
  LPicture := TPicture.Create;
  LBitmap := TBitmap.Create;
  try
    LPicture.LoadFromFile(LFilePath);

    // 透明ピクセルの確認のため TImage.Canvas を塗り潰してから描画
    Image1.Canvas.Brush.Color := clSilver;
    Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
    Image1.Canvas.Draw(0, 0, LPicture.Graphic);


    // TPicture の画像をクリップボードにコピー
    if not (LPicture.Graphic is TIcon) then begin
      LPicture.SaveToClipboardFormat(LFormatID, LData, LPalette);
      SetClipboardData(LFormatID, LData);
    end;

    // CF_DIB 形式のビットマップを取得できるようにする
    LBitmap.Assign(LPicture.Graphic);
    if LPicture.Graphic is TGIFImage then begin
      LBitmap.PixelFormat := pf8bit;
    end;
    LStream.Clear;
    LBitmap.SaveToStream(LStream);
    SetDataToClipboard(CF_DIB, LStream);

    // CF_BITMAP 形式のビットマップを取得できるようにする
    // LFormatID の値は常に CF_BITMAP (VCL のソースコード参照)
    LBitmap.SaveToClipboardFormat(LFormatID, LData, LPalette);
    SetClipboardData(LFormatID, LData);
  finally
    Clipboard.Close;
    FreeAndNil(LStream);
    FreeAndNil(LPicture);
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  クリップボードへメモリストリームのデータを，指定形式でセット
//  SetClipboardData 関数を使用
//-----------------------------------------------------------------------------
function SetDataToClipboard(AFmtID: WORD; AStream: TMemoryStream): Boolean;
var
  LhGlobale : HGLOBAL;
  LpBuffer  : Pointer;
begin
  Result := True;

  // クリップボードのデータ格納領域を確保してそのポインタを取得
  LhGlobale := GlobalAlloc(GHND, AStream.Size);
  LpBuffer   := GlobalLock(LhGlobale);
  try
    AStream.Position := 0;
    AStream.ReadBuffer(LpBuffer^, AStream.Size);
    // クリップボードへセット
    SetClipboardData(AFmtID, LhGlobale);
  finally
    GlobalUnlock(LhGlobale);
  end;
end;