クリップボード監視によるラジオボタンの切り替えにて (ID:38047)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

RadioGroupが配置してあり、このラジオボタンの切り替えを、
クリップボード監視により行なおうとしています。

クリップボード監視による切り替えには成功したのですが、
フォームをアクティブにすると、なぜか選択が元に戻ってしまいます。

何が原因なのか、わかる方がいらしたら、どうか教えて下さい。
よろしくお願いします。

以下、再現手順です。
1.新規作成し、RadioGroupをフォームに貼り付け、Itemsにアイテムを２個追加。
2.下記のコードをそっくりそのまま貼り付け。
3.実行し、ひとまず２個目のラジオボタンを選択。
4.メモ帳を起動して文字を入力し、その文字をクリップボードに記憶。
  するとラジオボタンの選択が切り替わる。
5.ところが、このソフトを選択してアクティブにすると選択が元に戻ってしまう。
  (メモ帳がアクティブだったのをこのソフトをアクティブにする)

//---------------------------------------------------------------------
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RadioGroup1: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }

FClipNextHandle: HWND;
    procedure WMDrawClipboard(var Msg: TWMDrawClipboard);
        message WM_DRAWCLIPBOARD;
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain);
        message WM_CHANGECBCHAIN;

public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMDrawClipboard(var Msg: TWMDrawClipboard);
//クリップボード更新フック
//更新された後に流れてくる。
//アプリが立ち上がった瞬間も流れる
begin
  inherited;
//------------------------------
    //ShowMessage('クリップボード更新された');
    if Length(Clipboard.AsText) > 0 then
    begin
      RadioGroup1.ItemIndex := 0;
    end
    else
    begin
      RadioGroup1.ItemIndex := 1;
    end;
//------------------------------
  if FClipNextHandle<>0 then
    SendMessage(FClipNextHandle,WM_DRAWCLIPBOARD, 0, 0);
end;
procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);
begin
  if Msg.Remove = FClipNextHandle then
    FClipNextHandle := Msg.Next;
  if FClipNextHandle <> 0 then
    SendMessage(FClipNextHandle, WM_CHANGECBCHAIN, Msg.Remove,Msg.Next);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ChangeClipboardChain(Handle, FClipNextHandle);
end;
procedure TForm1.FormCreate(Sender: TObject);
    procedure ClipboardSetHandle;
    begin
      FClipNextHandle := SetClipboardViewer(Form1.Handle);
      if FClipNextHandle = 0 then
        if GetLastError <> 0 then
        begin
          //ShowMessage('クリップボードのフックに失敗');
        end;
    end;
begin
  ClipboardSetHandle;
end;
end.
//---------------------------------------------------------------------

←解決時は質問者本人がここをチェックしてください。

戻る