VB6やVBAで「長押し」処理を実装する

未だにVB6で作られたシステムを保守している。（保守と言っても、機能追加なども普通にある）
ちなみに私が作ったものではないが、種々の事情により完全に私の管理物であり、5年ほどの間にもはや私が作ったと言っても過言ではないくらいリファクタリングした。

そのシステムで「長押ししたらクリップボードにコピー」という処理を実装しようとして躓いたのでメモ。

何に躓いたかと言うと、MouseDownイベントは押しっぱなしの間ずっと発生し続けているのかと思ったら、どれだけ長押ししようと1回しかイベント発生しないのね、という点。

ネットであれこれ見てもしっくりくるものがなかったので、自作してみた。

Private mouseDownEndTime As Double  'この時間まで押されていたら「長押し」と判断

Private Sub コントロール_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseDown(コントロール)
End Sub

Private Sub コントロール_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseUp(コントロール)
End Sub

'マウスが長押しされた場合に、処理を実行する
Private Sub ctrlMouseDown(ctrl As Control)
    mouseDownEndTime = getTimer() + 1   'この場合は1秒間長押ししたら処理実行
    
    Do Until mouseDownEndTime < getTimer() Or mouseDownEndTime = 0
        DoEvents  'これがないとDo Untilで回っている間のMouseUpを検知しない
    Loop
    
    If mouseDownEndTime > 0 Then  '時間が経過する前にMouseUpしていたらここがゼロなので処理を行わない

        'ここに長押し時に実行したい処理を書く

    End If
    
    mouseDownEndTime = 0
End Sub

Private Function getTimer() As Double
    getTimer = CDbl(Timer)
End Function

Private Sub ctrlMouseUp(ctrl As Control)
    mouseDownEndTime = 0
End Sub

長押し時に実行したい処理がコントロール要素と特に関係ないのであれば、引数としてコントロールを渡さなくても構わない。
私は「コントロール要素の中身をクリップボードにコピーする」という処理を入れたかったので渡しているけど。

ちなみに、VBAにはないけどVB6にはあるコントロールの配列の場合は、MouseDownとMouseUpの書き方が下記のような感じになる。（私が今回使ったのはこっち）

Private Sub コントロール_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseDown(コントロール(Index))
End Sub

Private Sub コントロール_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseUp(コントロール(Index))
End Sub