ボタンをポチッ

ユーザーフォームのコントロールに用意されているコマンドボタンが、どうしても好きになれないという方のために。オリジナルのボタンを作ってみました。クリックするとちょっと反応することと、マウスが上に行くとカーソルの形が変わる、というのがミソです。

まず、ボタン用に作った Picture を貼り込んだ Image コントロールをふたつ用意してユーザーフォームに貼り付けます。UpImage と DownImage がそれで、同じ大きさで影の位置を反対にしてあります。UpImage が正常な状態の図柄で、DownImage はボタンが押された一瞬表示される図柄です。DownImage は UpImage からちょっとだけずらした位置に置きます。

このユーザーフォーム（ここでは、ControlButtonForm としてあります）のコードに以下を書き込みます。短いコードですので、行間をお読みください。

Private Const waitTime = 100    'ポチ時間(msec)
'----- Form Activate
Private Sub UserForm_Activate()
      slideButton = False
      'カーソルの設定
      UpImage.MousePointer = fmMousePointerCustom
      UpImage.MouseIcon = LoadPicture("C:\Windows\Cursors\aero_link_il.cur")  (*1)
End Sub
'----- UpImage でマウスが押された
Private Sub UpImage_MouseDown(ByVal Button As Integer, _
        ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      slideButton = True
      ButtonChick    (*2)
      Application.Wait [now()] + waitTime / 86400000
      slideButton = False
      'ここでボタンがクリックされた際の実行関数を記載
      '---------------------------
End Sub
'----- UpImage / DownImage の切替
Private Property Let slideButton(sw)
      UpImage.Visible = Not sw
      DownImage.Visible = sw
End Property

以上で完成。ControlButtonForm.Show とすれば、フォームが表示されます。ボタンをクリックした時に実行する本体のルーチンは、どこかに書いておいて、UpImage_MouseDown() の最後で呼ぶようにしてください。

ボタン画像をクリックすると、「ポチッ」という音とともにこんな動作を行います。
わかりやすいように、ちょっと誇張したので、あまり上品ではありませんが、ポチ時間とふたつの Image のずらし距離を調整すれば、もう少しおとなしくなります。

なお、(*1) の MouseIcon は、….cur のファイルを読み込んだので、カーソルが黒くなってしまいました。本当は、新たに ….ico の画像ファイルを作成してそれを読み込む必要があるのですが、面倒なのでここではさぼってしまいました。挑戦される方は、健闘を祈ります。
(*2) の ButtonChick は、別のところで作った音出し関数です。ポチッと音を出すを参照してください。