Qiita Teams that are logged in
You are not logged in to any team

Log in to Qiita Team
Community
OrganizationEventAdvent CalendarQiitadon (β)
Service
Qiita JobsQiita ZineQiita Blog
3
Help us understand the problem. What are the problem?

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

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
3
Help us understand the problem. What are the problem?