|
[色の設定]コモンダイアログを改めていじっていたら、何やら妙なものが(笑) ダイアログにボタンを追加するためにウィンドウサイズを引き伸ばしたところ、妙なボタンがあるのを発見した。ボタンの文字は潰れており読み取れない。そこでキャプションを拾ってみると "0(&O)" であった。そのボタンを押してみると、…まあそこそこ変な動きをするのであるが、それはご自身でお確かめください。 さらにウィンドウの高さを伸ばしたせいか、黒三角のつまみを下の方へ移動させたりすると、文言「赤(R):」右側にあるテキストボック上部が欠けてしまう。妙なボタンと言い、良く分からない現象である。 さて本題。今回は以下の拡張を行ってみた。また、前回(といっても10年ほど昔)では出来ていなかった、16箇所ある独自色の設定領域の色を保持するようにもしてみた。
[拡張内容] (7)のCHOOSE_COLOR構造体に関する項目は(2)を実現するためのプログラミングのお話で、(1)〜(6)と比べてちょっと浮いているが結構重要。よそ様は(2)を実現するためにどのような方法を採っているのであろうかと、インターネットを彷徨ったのであるが、そのほとんどは lpCustColors のデータ型をString型としていた。VB5.0より新しい開発用言語だとそれで出来るのであろうか？ それを鑑みると私のやり方はちょっと変わっているのかもしれない。VB5.0のネタだし、まあいっか。 [色の設定]に留まらず他のコモンダイアログを独自に拡張する場合は、そのコモンダイアログに対応する構造体にメンバ lpfnHook にフック関数のポインタを指定し、flags にフック関数を使うことを示す定数を指定すればよい。今回の場合であれば、以下のようになる。CC_ENABLEHOOKがフック関数使用宣言定数である。
With udtCC .lStructSize = Len(udtCC) .hWndOwner = hwnd .hInstance = App.hInstance .lpCustColors = VarPtr(udtRGB(0)) .lpfnHook = GetFunctionAddress(AddressOf CCHookProc) .flags = CC_RGBINIT Or CC_ANYCOLOR Or CC_FULLOPEN Or CC_ENABLEHOOK End With '[色の設定]ダイアログを表示する FuncRet = ChooseColor(udtCC) 後は、lpfnHook に指定したフック関数を実装すればよい。コモンダイアログが初期化された、ボタンが押された、などとことあるごとにイベントがコールバックされるので、狙ったイベントを判定して独自の処理を書けばよい。 '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ' 機 能：色を選択＆取得する ' 引 数：(i)hwnd … ウインドハンドル ' (i)uMsg … ウインドウメッセージ ' (i)wParam … 追加情報１ ' (i)lParam … 追加情報２ ' 返り値：常に0が返る '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Public Function CCHookProc(ByVal hwnd As Long, ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Select Case uMsg 'コモンダイアログが初期化された Case WM_INITDIALOG Dim udtRect As RECT Dim hOKButton As Long 'ウィンドウ表示位置＆サイズを調整 Call GetWindowRect(hwnd, udtRect) With udtRect 'Call MoveWindow(hwnd, .Left, .Top, .Right - .Left, .Bottom - .Top + 60, Abs(CLng(True))) Call MoveWindow(hwnd, .Left + 20, .Top + 20, .Right - .Left, .Bottom - .Top + 60, Abs(CLng(True))) End With 'ボタンを作成する m_hButton = CreateWindowEx(0, "BUTTON", "変なボタンがいる？→", _ WS_CHILD Or WS_VISIBLE Or BS_PUSHBUTTON, _ 300, udtRect.Bottom - udtRect.Top - 5, 200, 30, _ hwnd, ID_MY_BUTTON, App.hInstance, ByVal 0&) Debug.Print "? m_hButton : " & m_hButton 'ウィンドウタイトルを変更 Call SetWindowText(hwnd, "色の設定 - 勝手に拡張版!!" & Chr$(0)) '[OK]ボタンのキャプションを変更 hOKButton = FindWindowEx(hwnd, 0&, vbNullString, "OK" & Chr$(0)) Call SetWindowText(hOKButton, "決定!!" & Chr$(0)) 'コマンドが実行された Case WM_COMMAND Select Case wParam Case ID_OK, ID_CANCEL '[OK][キャンセル]ボタンが押された 'ボタンを破棄する Call DestroyWindow(m_hButton) Case ID_MY_BUTTON '自作ボタン Dim MsgBoxText As String Dim i As Long Const ID_LABEL As Long = &H2D3 Const ID_TEXTBOX As Long = &H2BF For i = 0 To 5 MsgBoxText = MsgBoxText & GetDialogIDValue(hwnd, ID_LABEL + i) MsgBoxText = MsgBoxText & "：" MsgBoxText = MsgBoxText & GetDialogIDValue(hwnd, ID_TEXTBOX + i) MsgBoxText = MsgBoxText & vbCrLf Next i MsgBoxText = MsgBoxText & vbCrLf MsgBoxText = MsgBoxText & "変なボタン：" & GetDialogIDValue(hwnd, &H2C9) Call MsgBox(MsgBoxText, vbOKOnly + vbInformation, "値を取得しました") 'おまけ おまけ おまけ おまけ おまけ 'Dim ObjCaption As String 'Debug.Print "==========================================" 'For i = 0 To 65535 ' ObjCaption = GetDialogIDValue(hwnd, i) ' If Len(ObjCaption) > 0 Then Debug.Print "? &H" & UCase$(Hex$(i)) & " ： " & ObjCaption 'Next i 'Debug.Print "==========================================" Case &H2C9 '変な隠しボタン？ Call MsgBox("隠しボタンが押されました!!") End Select End Select End Function 上記 WM_COMMAND の部分に書いたが、[おまけ]の部分のコメントを外して実行すると [色の設定]コモンダイアログ で使用されている、ラベルやボタンのIDとキャプションが表示される。以下に簡単に一覧でまとめておく。
|
