LoginSignup
3

More than 1 year has passed since last update.

posted at

updated at

Delphi と最近の Windows のクリップボード事情

はじめに

Delphi で作られた古いプログラムを Windows 10 で動かしている時、クリップボードの機能を使うと "クリップボードが開けません" 的なエラーを拝むことがあります。

このプログラムを作った Windows XP 当時ではエラーが出た覚えがなく、そもそも頻繁にエラーが出るようだったら当時デバッグしているハズですので、変わったのは周囲の環境という事になります。

古い EXE は [互換性] タブで Windows XP (Service Pack 2) 辺りに設定しておけば、クリップボードの問題は出にくくなると思います。
image.png
が、なんだかモヤっとしますよね。

原因

おおまかな原因としては

  • クリップボードの処理方法が Windows Vista 以降で変わった (多分)。
  • Microsoft Office のクリップボード (履歴) が悪さしている。

こんな所じゃないかと思います。

検証

クリップボードを握った状態 は、Excel で 20x200 くらいのデータを作り、〔Ctrl〕+〔A〕, 〔Ctrl〕+〔C〕 すると作り出せます 1
image.png
Excel で 〔Ctrl〕+〔A〕, 〔Ctrl〕+〔C〕 した直後に、目的の EXE でクリップボードにデータを格納します。Delphi で書かれたこんなコードだと、

procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.AsText := 'abc';
end;

ボタンを押した時にエラーになります。結構長い時間、クリップボードがロックされている事が解ります。
image.png
「俺が作ったプログラムではエラーが出なかった!」って安心する前に、目的の EXE でデータを本当にクリップボードに格納したかを確認してみましょう。Excel のデータが格納されていませんか?それはエラーを握りつぶしてるだけですよ?

イロイロ調べてみましたが、根本的な解決方法としては、やっぱり 誰かが握っているクリップボードを離すまでリトライするしかないんじゃないかと思います。「昔の EXE を開いている時はなるべく Excel を起動しないでおく」 なんて、現実的な解決方法ではありませんしね。

コード

Delphi でエラーになるのは ClipBoard.Open() した時か、ClipBoard.AsText := でテキストをクリップボードに格納した時です。

次のコードは ClipBoard.Open() / Close() メソッドと ClipBoard.AsText プロパティの代替関数です。Delphi 10.4 Sydney 用のコードなので、それよりも前の Delphi では多少の修正が必要となります 2

interface

uses
  ..., Vcl.Clipbrd;

function OpenClipboard(RetryCnt: Cardinal = 10): Boolean;
procedure CloseClipboard;
function SetClipboardText(const s: string; RetryCnt: Cardinal = 10): Boolean;

implementation

function OpenClipboard(RetryCnt: Cardinal): Boolean;
begin
  while RetryCnt > 0 do
    begin
      var BreakFlg := True;
      try
        Clipboard.Open;
      except
        on E: EClipboardException do
          begin
            Dec(RetryCnt);
            BreakFlg := False;
          end;
      end;
      if BreakFlg then
        Break;
      Sleep(250);
    end;
  result := RetryCnt <> 0;
end;

procedure CloseClipboard;
begin
  Clipboard.Close;
end;

function SetClipboardText(const s: string; RetryCnt: Cardinal): Boolean;
begin
  while RetryCnt > 0 do
    begin
      var BreakFlg := True;
      try
        Clipboard.AsText := s;
      except
        on E: EClipboardException do
          begin
            Dec(RetryCnt);
            BreakFlg := False;
          end;
      end;
      if BreakFlg then
        Break;
      Sleep(250);
    end;
  result := RetryCnt <> 0;
end;

OpenClipboard()SetClipboardText() はリトライ回数を超えた場合に False を返します。リトライ回数はデフォルトで 10 回に指定されているので、大抵は次のように置き換えるだけです。

//Clipboard.AsText := 'Hello, World.';
  SetClipboardText('Hello, World.');

もっと細かく制御したい場合には次のように記述します。

  if not SetClipboardText('Hello, World.', 15) then
    begin
      // リトライ回数を超えた場合のエラー処理
    end;

おわりに

新しく作るアプリケーションでクリップボードを扱う際にはリトライも考慮したほうがいいかもですね、というお話でした。

なお、ClipBoard.AsText プロパティは Setter (SetAsText) の中で Open / Close を行っているので、

  Clipboard.Open;
  try
    Clipboard.AsText := 'Hello, World.';
  finally
    Clipboard.Close;
  end;

なんてやる必要はありません。

See also:


  1. 検証用プログラム書いてもいいんですけど、Office が握るのを確認するにはこれがいいかと。 

  2. よく訓練された Delphi 信者なら苦もなく修正してのけるでしょう。 

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
What you can do with signing up
3