LoginSignup
11
4

More than 3 years have passed since last update.

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

Last updated at Posted at 2021-04-21

はじめに

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 信者なら苦もなく修正してのけるでしょう。 

11
4
0

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
  3. You can use dark theme
What you can do with signing up
11
4