unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    NextWindow : HWND;
    procedure WMChangeCBChain(var Message: TWMChangeCBChain); message
      WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Message: TWMDrawClipboard); message
      WM_DRAWCLIPBOARD;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Clipbrd;

{$R *.dfm}

//=============================================================================
//  このフォームをクリップボードビューワとして登録
//  NextWindowは次のクリップボードビューワウィンドウのハンドル
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  NextWindow := SetClipboardViewer(Handle);
end;

//=============================================================================
//  クリップボードビューワとしての登録を解除
//  クリップボード監視のチェインから外す
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipboardChain(Handle, NextWindow);
end;

//=============================================================================
//  クリップボードを空にする
//  単なる動作確認用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.Clear;
end;

//=============================================================================
//  ウィンドウがクリップボードチェインから削除されようとしている時に，チェイン
//  のウィンドウに送られてくるメッセージ
//
//  Remove : チェインから削除されるウィンドウのハンドル
//  Nesxt  : チェインから削除される次のウィンドウのハンドル
//
//  チェイン内の次のウィンドウが削除されようとしている場合は，チェイン内の次の
//  ウィンドウとして，Nextの値を保存する必要がある
//  チェイン内の次のウィンドウが削除されるウィンドウでない場合，チェインの次の
//  ウィンドウにメッセージをSendMessageへ渡さなければならない
//=============================================================================
procedure TForm1.WMChangeCBChain(var Message: TWMChangeCBChain);
begin
  if (Message.Remove = NextWindow) then begin
    NextWindow := Message.Next;
    Message.Result := 0;
  end else begin
    SendMessage(NextWindow, WM_CHANGECBCHAIN, Message.Remove, Message.Next);
  end;
end;

//=============================================================================
//  クリップボード更新フック
//  クリップボードの内容に更新がある時に，クリップボードチェインのウィンドウに
//  送られてくるメッセージ
//  SetClipboradViewer関数で，クリップボードチェインに登録したウィンドウだけが
//  このメッセージを受信できる
//  このメッセージを受信したウィンドウは，クリップボードチェインの次のウィンド
//  ウにこのメッセージを送信し，全てのビューワウィンドウにメッセージが届くよう
//  にしなければならない
//
//  本サンプルでは，アプリ起動時にもこのメッセージを受信
//=============================================================================
procedure TForm1.WMDrawClipboard(var Message: TWMDrawClipboard);
const
  CF_DIBV5 = 17; //Delphi 7以降では不要
begin
  if not OpenClipboard(Handle) then Exit;

  try
    ListBox1.Items.BeginUpdate;
    ListBox1.Items.Clear;

    //メッセージが発生した日時を表示
    ListBox1.Items.Add(FormatDateTime('yyyy/mm/dd hh:nn:ss', Now));
    ListBox1.Items.Add('');

    //クリップボードが空になった
    if Clipboard.FormatCount = 0 then begin
      ListBox1.Items.Add('Data Empty');
    end else begin
      with ListBox1.Items do begin
        if Clipboard.HasFormat(CF_BITMAP)          then Add('CF_BITMAP');
        if Clipboard.HasFormat(CF_DIB)             then Add('CF_DIB');
        if Clipboard.HasFormat(CF_DIBV5)           then Add('CF_DIBV5');
        if Clipboard.HasFormat(CF_DIF)             then Add('CF_DIF');
        if Clipboard.HasFormat(CF_DSPBITMAP)       then Add('CF_DSPBITMAP');
        if Clipboard.HasFormat(CF_DSPENHMETAFILE)  then Add('CF_DSPENHMETAFILE');
        if Clipboard.HasFormat(CF_DSPMETAFILEPICT) then Add('CF_DSPMETAFILEPICT');
        if Clipboard.HasFormat(CF_DSPTEXT)         then Add('CF_DSPTEXT');
        if Clipboard.HasFormat(CF_ENHMETAFILE)     then Add('CF_ENHMETAFILE');
        if Clipboard.HasFormat(CF_GDIOBJFIRST)     then Add('CF_GDIOBJFIRST');
        if Clipboard.HasFormat(CF_GDIOBJLAST)      then Add('CF_GDIOBJLAST');
        if Clipboard.HasFormat(CF_HDROP)           then Add('CF_HDROP');
        if Clipboard.HasFormat(CF_LOCALE)          then Add('CF_LOCALE');
        if Clipboard.HasFormat(CF_METAFILEPICT)    then Add('CF_METAFILEPICT');
        if Clipboard.HasFormat(CF_OEMTEXT)         then Add('CF_OEMTEXT');
        if Clipboard.HasFormat(CF_OWNERDISPLAY)    then Add('CF_OWNERDISPLAY');
        if Clipboard.HasFormat(CF_PALETTE)         then Add('CF_PALETTE');
        if Clipboard.HasFormat(CF_PENDATA)         then Add('CF_PENDATA');
        if Clipboard.HasFormat(CF_PRIVATEFIRST)    then Add('CF_PRIVATEFIRST');
        if Clipboard.HasFormat(CF_PRIVATELAST)     then Add('CF_PRIVATELAST');
        if Clipboard.HasFormat(CF_RIFF)            then Add('CF_RIFF');
        if Clipboard.HasFormat(CF_SYLK)            then Add('CF_SYLK');
        if Clipboard.HasFormat(CF_TEXT)            then Add('CF_TEXT');
        if Clipboard.HasFormat(CF_TIFF)            then Add('CF_TIFF');
        if Clipboard.HasFormat(CF_UNICODETEXT)     then Add('CF_UNICODETEXT');
        if Clipboard.HasFormat(CF_WAVE)            then Add('CF_WAVE');
      end;
    end;
    ListBox1.Items.EndUpdate;
  finally
    CloseClipboard;
  end;

  //次のクリップボードビューワウィンドウにメッセージを送る
  SendMessage(NextWindow, WM_DRAWCLIPBOARD, 0, 0);
end;

end.

        if Clipboard.HasFormat(CF_TEXT) then S := Clipboard.AsText;

procedure TForm1.WMDrawClipboard(var Message: TWMDrawClipboard);
var
  LhClipboard : THandle;
begin
  ClipBoard.Open;
  if Clipboard.HasFormat(CF_TEXT) then begin
    LhClipboard := Clipboard.GetAsHandle(CF_TEXT);
    try
      Memo1.Text := Clipboard.AsText;
    finally
      GlobalUnlock(LhClipboard);
    end;
  end;
  Clipboard.Close;

  //次のクリップボードビューワウィンドウにメッセージを送る
  SendMessage(NextWindow, WM_DRAWCLIPBOARD, 0, 0);
end;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    RichEdit1: TRichEdit;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    NkClipDetector1: TNkClipDetector;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure NkClipDetector1ClipChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Clipbrd;

{$R *.dfm}

//=============================================================================
//  画像は左上隅から表示するものとする
//  TNkClipDetectorのIgnoreFirstをオブジェクト・インスペクタでFalseにしておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Left := 0;
  Image1.Top  := 0;

  Image1.Transparent := True;
  Image1.AutoSize    := True;

  RichEdit1.ScrollBars := ssBoth;
end;

//=============================================================================
//  [画像の貼り付け]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Assign(Clipboard);
end;

//=============================================================================
//  [テキストの貼り付け]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  //現在のキャレット(カーソル)位置から文字列を挿入
  RichEdit1.SelText := Clipboard.AsText;
end;

//=============================================================================
//  [クリア]ボタン
//  クリップボードのクリア．ついでに表示中の画像とテキストもクリア
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  Clipboard.Clear;
  Image1.Picture.Assign(nil);
  RichEdit1.Lines.Clear;
end;

//=============================================================================
//  TNkClipDetectorのOnClipChangeイベント
//  クリップボードの監視イベント
//
//  Button1は[画像貼り付け]
//  Button2は[テキスト貼り付け]
//  Button3はクリップボードのクリア
//=============================================================================
procedure TForm1.NkClipDetector1ClipChange(Sender: TObject);
begin
  Button1.Enabled := Clipboard.HasFormat(CF_BITMAP) or
                     Clipboard.HasFormat(CF_ENHMETAFILE);
  Button2.Enabled := Clipboard.HasFormat(CF_TEXT);

  Button3.Enabled := Clipboard.FormatCount > 0;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    RichEdit1: TRichEdit;
    Button1: TButton;
    NkClipDetector1: TNkClipDetector;
    procedure Button1Click(Sender: TObject);
    procedure NkClipDetector1ClipChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd,
  ShellAPI,
  ShlObj,
  ActiveX;

{$R *.dfm}

//=============================================================================
//  ファイルリストを表示するRichEditの設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.ScrollBars := ssBoth;
end;

//=============================================================================
//  [クリア]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.Clear;
  RichEdit1.Lines.Clear;
end;

//=============================================================================
//  TNkClipDetectorのOnClipChangeイベント
//  クリップボードの監視イベント
//  エクスプローラでファイルを[コピー]したら直ちにそのリストを表示
//=============================================================================
procedure TForm1.NkClipDetector1ClipChange(Sender: TObject);
var
  CF_DROPEFFECT : UINT;
  hMem          : Pointer;
  LdwEffect     : Word;
  LhDrop        : THandle;
  LCount        : Integer;
  LBuff         : array [0..MAX_PATH - 1] of Char;
  i             : Integer;
begin
  RichEdit1.Lines.Clear;
  RichEdit1.Lines.BeginUpdate;


  //---------------------------------------------------------------------------
  //  エクスプローラでの操作種類を検出
  //  コピー，切り取り，移動等の検出が不要ならこの部分は不要
  //---------------------------------------------------------------------------
  LdwEffect     := 0;
  CF_DROPEFFECT := RegisterClipboardFormat(CFSTR_PREFERREDDROPEFFECT);
  if Clipboard.HasFormat(CF_DROPEFFECT) then begin
    LhDrop := Clipboard.GetAsHandle(CF_DROPEFFECT);
    if LhDrop <> 0 then begin
      hMem := Windows.GlobalLock(LhDrop);
      try
        LdwEffect := PWord(hMem)^;
      finally
        GlobalUnlock(LhDrop);
      end;
    end;
    if (LdwEffect and DROPEFFECT_NONE)   > 0 then RichEdit1.Lines.Add('NONE');
    if (LdwEffect and DROPEFFECT_COPY)   > 0 then RichEdit1.Lines.Add('COPY');
    if (LdwEffect and DROPEFFECT_MOVE)   > 0 then RichEdit1.Lines.Add('MOVE');
    if (LdwEffect and DROPEFFECT_LINK)   > 0 then RichEdit1.Lines.Add('LINK');
    if (LdwEffect and DROPEFFECT_SCROLL) > 0 then RichEdit1.Lines.Add('SCROLL');
  end;
  //---------------------------------------------------------------------------


  if Clipboard.HasFormat(CF_HDROP) then begin
    //CF_HDROP内部構造体のハンドルを取得
    LhDrop  := Clipboard.GetAsHandle(CF_HDROP);
    LCount := DragQueryFile(LhDrop, UINT(-1), nil, 0);

    RichEdit1.Lines.Add('コピーファイル数 : ' + IntToStr(LCount));

    for i := 0 to LCount - 1 do begin
      DragQueryFile(LhDrop, i, LBuff, Length(LBuff));
      //ファイル名をリストに追加(フォルダも含まれる)
      RichEdit1.Lines.Add(LBuff);
    end;
  end;

  RichEdit1.Lines.EndUpdate;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses Clipbrd;

{$R *.dfm}

{ TForm1 }

//=============================================================================
//  クリップボードのフォーマットの形式名を取得して表示
//  GetClipBoardFormatName関数を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i       : Integer;
  FmtID   : Integer;
  FmtName : array [0..MAX_PATH-1] of Char;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  for i := 0 to ClipBoard.FormatCount - 1 do begin
    FmtID:= ClipBoard.Formats[i];

    FillChar(FmtName, SizeOf(FmtName), #0);
    if GetClipBoardFormatName(FmtID, FmtName,SizeOf(FmtName)) > 0 then begin
      Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  ' + FmtName);
    end else begin
      case ClipBoard.Formats[i] of
      CF_TEXT:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_TEXT');
      CF_BITMAP:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_BITMAP');
      CF_METAFILEPICT:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_METAFILEPICT');
      CF_SYLK:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_SYLK');
      CF_DIF:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DIF');
      CF_TIFF:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_TIFF');
      CF_OEMTEXT:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_OEMTEXT');
      CF_DIB:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DIB');
      CF_PALETTE:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_PALETTE');
      CF_PENDATA:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_PENDATA');
      CF_RIFF:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_RIFF');
      CF_WAVE:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_WAVE');
      CF_UNICODETEXT:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_UNICODETEXT');
       CF_ENHMETAFILE:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_ENHMETAFILE');
      CF_HDROP:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_HDROP');
      CF_LOCALE:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_LOCALE');
      CF_DIBV5:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DIBV5');
      CF_MAX_XP:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_MAX_XP');
      CF_OWNERDISPLAY:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_OWNERDISPLAY');
      CF_DSPTEXT:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DSPTEXT');
      CF_DSPBITMAP:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DSPBITMAP');
      CF_DSPMETAFILEPICT:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DSPMETAFILEPIC');
      CF_DSPENHMETAFILE:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_DSPENHMETAFILE');
      CF_GDIOBJFIRST:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_GDIOBJFIRST');
      CF_GDIOBJLAST:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_GDIOBJLAST');
      CF_PRIVATEFIRST:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_PRIVATEFIRST');
      CF_PRIVATELAST:
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  CF_PRIVATELAST');
      else
        Memo1.Lines.Add(IntToHex(ClipBoard.Formats[i], 4) + '  UnKown');
      end;
    end;
  end;
  Memo1.Lines.EndUpdate;
end;

end.

procedure TForm1.Button1Click(Sender: TObject);
var
  DataFormat : UINT;
  dataStream : TMemoryStream;
  hBuffer    : THandle;
  pBuffer    : Pointer;
  dwSize     : Cardinal;
begin
  //検出するクリップボードのデータ形式
  DataFormat := CF_BITMAP;

  //その形式だったらクリップボードからdataStreamにデータを格納
  if Clipboard.HasFormat(DataFormat) then begin
    dataStream := TMemoryStream.Create;
    try
      ClipBoard.Open;

      hBuffer := Clipboard.GetAsHandle(DataFormat);
      pBuffer := GlobalLock(hBuffer);
      try
        dwSize := GlobalSize(hBuffer);
        if dwSize > 0 then begin
          dataStream.WriteBuffer(pBuffer^, dwSize);
        end;  
      finally
        GlobalUnlock(hBuffer);
        Clipboard.Close;
      end;
    finally
      FreeAndNil(dataStream);
    end;
  end;
end;

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses Clipbrd, Jpeg, GifImg, PngImage;

{$R *.dfm}

{ TForm1 }

//=============================================================================
//  貼り付け
//  クリップボードから画像を取得
//  このコードは画像の種類を区別しない場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Pict         : TPicture;
  DestFilePath : String;
begin
  if (Clipboard.HasFormat(CF_METAFILEPICT)) or
     (Clipboard.HasFormat(CF_ENHMETAFILE))  or
     (Clipboard.HasFormat(CF_METAFILEPICT)) or
     (Clipboard.HasFormat(CF_BITMAP))       or
     (Clipboard.HasFormat(CF_DIB))          then begin
    Pict := TPicture.Create;
    try
      //クリップボードから画像データのみ取得
      Pict.Assign(Clipboard);

      //TImageに表示してビットマップ画像として保存
      Image1.Picture.Assign(Pict);
      DestFilePath := ExtractFilePath(Application.ExeName) + 'image1.bmp';
      Pict.SaveToFile(DestFilePath);
    finally
      FreeAndNil(Pict);
    end;
  end;
end;

//=============================================================================
//  コピー
//  ディスク上の画像ファイルをクリップボードに格納
//  画像のオブジェクトのコピーは，TPictureの直接操作となる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  Pict        : TPicture;
  SrcFilePath : String;
begin
  SrcFilePath := ExtractFilePath(Application.ExeName) + '501.bmp';

  Pict := TPicture.Create;
  try
    Pict.LoadFromFile(SrcFilePath);
    Clipboard.Assign(Pict);
  finally
    FreeAndNil(Pict);
  end;
end;

//=============================================================================
//  文字列(テキスト)のコピーと貼り付け
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  strText : String;
begin
  strText := 'クリップボード';

  //コピー
  Clipboard.AsText := strText + sLineBreak + 'テスト';
  strText := '';
  Sleep(300);

  //貼り付け
  if (Clipboard.HasFormat(CF_TEXT)) then begin
    strText := Clipboard.AsText;
    MessageBox(Handle, PChar(strText), '情報', MB_ICONINFORMATION);
  end;
end;

end.

procedure TForm1.Button4Click(Sender: TObject);
var
  Bmp : TBitmap;
begin
  if (Clipboard.HasFormat(CF_BITMAP)) then begin
    Bmp := TBitmap.Create;
    try
      Bmp.Handle := Clipboard.GetAsHandle(CF_BITMAP);
      Image1.Picture.Assign(Bmp);
    finally
      FreeAndNil(Bmp);
    end;
  end;
end;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    RichEdit1: TRichEdit;
    Splitter1: TSplitter;
    RichEdit2: TRichEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses RichEdit, Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  リッチテキストファイルの読み込み
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Lines.LoadFromFile(ExtractFilePath(Application.ExeName) + 'RichText.RTF');
end;

//=============================================================================
//  コピー
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  RichEdit1.CopyToClipboard;
end;

//=============================================================================
//  貼り付け
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_OEMTEXT) then begin
    RichEdit2.PasteFromClipboard;
  end;
end;

//=============================================================================
//  切り取り
//=============================================================================
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  RichEdit1.CutToClipboard;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    RichEdit1: TRichEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  リッチテキストファイルの読み込み
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //リッチテキストを読み込んで表示
  RichEdit1.Lines.LoadFromFile(ExtractFilePath(Application.ExeName) + 'RichText.RTF');

  //クリップボードをクリア
  Clipboard.Clear;
end;

end.

  try
    ClipBoard.Open;
  except
    Exit;
  end;

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;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FNextWindow : HWND;
    procedure WMChangeCBChain(var Message: TWMChangeCBChain); message
      WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Message: TWMDrawClipboard); message
      WM_DRAWCLIPBOARD;
  public
    { Public 宣言 }
    procedure BringToFrontForm(AHandle: HWND);
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

//=============================================================================
//  このフォームをクリップボードビューワとして登録
//  FNextWindow は次のクリップボードビューワウィンドウのハンドル
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FNextWindow := SetClipboardViewer(Handle);
end;

//=============================================================================
//  クリップボードビューワとしての登録を解除
//  クリップボード監視のチェインから外す
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipboardChain(Handle, FNextWindow);
end;

//=============================================================================
//  クリップボードを空にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.Clear;
end;

//=============================================================================
//  取得した内容をクリアする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

//=============================================================================
//  ウィンドウがクリップボードチェインから削除される時に送られてくるメッセージ
//=============================================================================
procedure TForm1.WMChangeCBChain(var Message: TWMChangeCBChain);
begin
  if (Message.Remove = FNextWindow) then begin
    FNextWindow := Message.Next;
    Message.Result := 0;
  end else begin
    SendMessage(FNextWindow, WM_CHANGECBCHAIN, Message.Remove, Message.Next);
  end;
end;

//=============================================================================
//  クリップボード更新フック
//  クリップボードの内容に更新がある時に送られてくるメッセージ
//  CF_TEXT の時にテキストをクリップボードから自動的に取得
//
//  本サンプルでは，アプリ起動時にもこのメッセージを受信
//=============================================================================
procedure TForm1.WMDrawClipboard(var Message: TWMDrawClipboard);
var
  LhClipbrd : THandle;
begin
  // Microsoft Edge, Google Chrome の URL をコピーした時の対応策
  // クリップボードが開けないエラーが発生する
  try
    ClipBoard.Open;
  except
    Exit;
  end;

  if Clipboard.HasFormat(CF_TEXT) then begin
    LhClipbrd := Clipboard.GetAsHandle(CF_TEXT);
    try
      Memo1.Lines.Add(Clipboard.AsText);
    finally
      GlobalUnlock(LhClipbrd);
    end;
  end;
  Clipboard.Close;

  //次のクリップボードビューワウィンドウにメッセージを送る
  SendMessage(FNextWindow, WM_DRAWCLIPBOARD, 0, 0);

  BringToFrontForm(Handle);
end;

//-----------------------------------------------------------------------------
//  指定フォームを強制的に最前面に表示する関数
//  この手続きを実行するウィンドウがアクティブでない場合用
//
//  AHandle : 前面に表示するフォームのハンドル (メインフォーム以外も可)
//  SPI_GETFOREGROUNDLOCKTIMEOUT, SPI_SETFOREGROUNDLOCKTIMEOUT はデバック時無効
//-----------------------------------------------------------------------------
procedure TForm1.BringToFrontForm(AHandle: HWND);
var
  LhForeWnd     : HWND;
  LTimeOut      : DWORD;
  LThreadForeID : Cardinal;
  LThreadSelfID : Cardinal;
begin
  // 現在の最前面のウィンドウハンドルを取得
  // 少しタイムラグがないとウィンドウハンドルが取得できないことがある
  LhForeWnd := 0;
  while True do begin
    LhForeWnd := GetForegroundWindow;
    if LhForeWnd <> 0 then Break;
    Application.ProcessMessages;
    Sleep(10);
  end;
  // 現在の最前面ウィンドウのプロセスIDの値を取得
  LThreadForeID := GetWindowThreadProcessId(LhForeWnd);
  // 前面表示するウィンドウのプロセスのスレッドIDの値を取得
  // LThreadSelfID := GetWindowThreadProcessId(AHandle); でもOK (値は違う)
  LThreadSelfID := GetCurrentThreadId;
  try
    // スレッドのアタッチ
    AttachThreadInput(LThreadSelfID, LThreadForeID, True);
    // タスクバーの点滅時間の設定値を取得 (フォアグランドにするまでの時間)
    // デフォルト値は非常に大きな値.通常は前面に表示しないで点滅するだけ
    SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @LTimeOut, 0);

    // タスクバーの点滅時間の設定
    // 点滅時間を 0 にして直ちに最前面に表示するようにする
    SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, nil, 0);

    // 最小化されているときは元に戻す
    if IsIconic(AHandle) then begin
      SendMessage(AHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
    end;
    // 最前面に表示する
    SetForegroundWindow(AHandle);
  finally
    // タスクバーの点滅時間の設定を元に戻す
    SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(LTimeOut), 0);
    // 終了したらアタッチを切り離す
    AttachThreadInput(LThreadSelfID, LThreadForeID, False);
  end;
end;

end.

//=============================================================================
//  クリップボード更新フック
//  クリップボードの内容に更新がある時に送られてくるメッセージ
//  CF_TEXT の時にテキストをクリップボードから自動的に取得
//
//  一定時間内に受信したメッセージを無視する例
//=============================================================================
procedure TForm1.WMDrawClipboard(var Message: TWMDrawClipboard);
{$WRITEABLECONST ON}
const
  LGetTime : Cardinal = 0;
{$WRITEABLECONST OFF}
var
  LhClipbrd   : THandle;
  LTimeSpane  : Cardinal;
begin
  LTimeSpane := timeGetTime - LGetTime;
  if LTimeSpane < 100 then Exit;

  // Microsoft Edge, Google Chrome の URL をコピーした時の対応策
  // クリップボードが開けないエラーが発生する
  try
    ClipBoard.Open;
  except
    Exit;
  end;
  LGetTime := timeGetTime;


  if Clipboard.HasFormat(CF_TEXT) then begin
    LhClipbrd := Clipboard.GetAsHandle(CF_TEXT);
    try
      Memo1.Lines.Add(Clipboard.AsText);
    finally
      GlobalUnlock(LhClipbrd);
    end;
  end;
  Clipboard.Close;

  //次のクリップボードビューワウィンドウにメッセージを送る
  SendMessage(FNextWindow, WM_DRAWCLIPBOARD, 0, 0);

  BringToFrontForm(Handle);
end;