ツールバーのボタン制御がうまくできなくて困っています。
ツールバーのボタンをButtonGroupスタイルで何個か作成し、フォームのロード時にその中の1個目のValueプロパティを"tbrPressed"にしています。初期表示では"tbrPressed"に指定したボタンだけが押された状態で表示されます。
その状態でコマンドボタンのクリックされたら、ツールバーの2個目のボタンのValueプロパティを"tbrPressed"に設定するようにしています。2個目のボタンが押された状態にはなるのですが、なぜが1個目のボタンも押された状態で表示されるのです。
しかし、ツールバーのボタンをクリックした後は正常に動作するようになります。
この問題を回避する方法はありませんでしょうか?
よろしくお願いします。
オブジェクト.Buttons(1).Value = tbrUnpressed
オブジェクト.Buttons(2).Value = tbrPressed
のようにしていきませんか?
もしくはそのボタングループの個々のスタイルがButtonGroupスタイルに一律していないとか。
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
のようにすればよいと思います。(長くてすみません。)
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
のようにしたほうがうまくいきます。
DotLさんありがとうございました。
DotLさんご提案の方法が正当な方法だとは思ったのですが、これだけのことになぜこんなに苦労するのか?という疑問もあり、いろいろ回避策を試してみました。
今回は 一時的にボタンのスタイルを"tbrDefault"にしてValueを"tbrUnpressed"をセットし、再度スタイルを"tbrButtonGroup"戻すということで現象を回避いたしました。
なぜ、このような現象が起きるのかは不明ですが。。。
解決された後なので、書いても見てないかもしれませんが、
MSのサポート情報にこの現象の発生原因と回避策が載っていましたので、
URLを貼っておきます。
http://support.microsoft.com/default.aspx?scid=kb;ja;JP189666
ツイート | ![]() |