ツールバーボタンのValueプロパティを操作するには?

解決


sato  2003-03-20 19:58:17  No: 77409

ツールバーのボタン制御がうまくできなくて困っています。
ツールバーのボタンをButtonGroupスタイルで何個か作成し、フォームのロード時にその中の1個目のValueプロパティを"tbrPressed"にしています。初期表示では"tbrPressed"に指定したボタンだけが押された状態で表示されます。
その状態でコマンドボタンのクリックされたら、ツールバーの2個目のボタンのValueプロパティを"tbrPressed"に設定するようにしています。2個目のボタンが押された状態にはなるのですが、なぜが1個目のボタンも押された状態で表示されるのです。
しかし、ツールバーのボタンをクリックした後は正常に動作するようになります。

この問題を回避する方法はありませんでしょうか?
よろしくお願いします。


DotL  2003-03-21 05:01:16  No: 77410

オブジェクト.Buttons(1).Value = tbrUnpressed
オブジェクト.Buttons(2).Value = tbrPressed

のようにしていきませんか?

もしくはそのボタングループの個々のスタイルがButtonGroupスタイルに一律していないとか。


DotL  2003-03-22 05:55:16  No: 77411

Toolbar1.Buttons(インデックス).Value = tbrPressed  のかわりに、

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

と宣言して、たとえば

Private Sub Command1_Click()
Dim wPos As WINDOWPLACEMENT, cPos As POINTAPI
wPos.Length = Len(wPos)
GetWindowPlacement hwnd, wPos
ShowCursor 0
GetCursorPos cPos
SetCursorPos wPos.rcNormalPosition.Left + 4 + (Toolbar1.Buttons(2).Left \ 15), wPos.rcNormalPosition.Top + 26 + (Toolbar1.Buttons(2).Top \ 15)
mouse_event 2, 0, 0, 0, 0
mouse_event 4, 0, 0, 0, 0
SetCursorPos cPos.x, cPos.y
ShowCursor 1
End Sub

のようにすればよいと思います。(長くてすみません。)


DotL  2003-03-22 06:33:38  No: 77412

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

を追加して、

Private Sub Command1_Click()
Dim wPos As POINTAPI, cPos As POINTAPI
ShowCursor 0
GetCursorPos cPos
wPos.x = Toolbar1.Buttons(2).Left \ 15 + Toolbar1.Buttons(2).Width \ 15 \ 2
wPos.y = Toolbar1.Buttons(2).Top \ 15 + Toolbar1.Buttons(2).Height \ 15 \ 2
ClientToScreen Form1.hwnd, wPos
SetCursorPos wPos.x, wPos.y
mouse_event 2, 0, 0, 0, 0
mouse_event 4, 0, 0, 0, 0
SetCursorPos cPos.x, cPos.y
ShowCursor 1
End Sub

のようにしたほうがうまくいきます。


sato  2003-03-22 21:39:35  No: 77413

DotLさんありがとうございました。
DotLさんご提案の方法が正当な方法だとは思ったのですが、これだけのことになぜこんなに苦労するのか?という疑問もあり、いろいろ回避策を試してみました。
今回は 一時的にボタンのスタイルを"tbrDefault"にしてValueを"tbrUnpressed"をセットし、再度スタイルを"tbrButtonGroup"戻すということで現象を回避いたしました。
なぜ、このような現象が起きるのかは不明ですが。。。


batchman  2003-03-26 04:23:29  No: 77414

解決された後なので、書いても見てないかもしれませんが、
MSのサポート情報にこの現象の発生原因と回避策が載っていましたので、
URLを貼っておきます。

http://support.microsoft.com/default.aspx?scid=kb;ja;JP189666


※返信する前に利用規約をご確認ください。

※Google reCAPTCHA認証からCloudflare Turnstile認証へ変更しました。






  このエントリーをはてなブックマークに追加