[ツリー表示へ] [ワード検索] [Home]
タイトル ： Re^2: コマンドを長押しすると別の処理をさせる 投稿日 ： 2008/08/10(Sun) 16:28 投稿者 ： 花ちゃん
| ろくでもないコードですが、ちょっと試しに作って見ました。 今回のようにリピート処理が不要な場合はその部分を削除して下さい。 又、下記のような方法でもいいかも CommandButton でダブルクリックを取得する でダブルクリックで処理をする http://www.hanatyan.sakura.ne.jp/vbhlp/cdwclick.htm Option Explicit Private Declare Function timeGetTime Lib "winmm.dll" () As Long Private FrgMouseDown As Boolean Private Sub Command1_MouseDown(Button As Integer, _ Shift As Integer, X As Single, Y As Single) FrgMouseDown = True '1.5秒以上押し続けた場合処理を１回実行する(時間はお好みで） Call GetKeepsPushing(1500, False) '1.5秒以上押し続けた場合処理を何回も繰り返す 'Call GetKeepsPushing(1500, True) End Sub Private Sub Command1_MouseUp(Button As Integer, _ Shift As Integer, X As Single, Y As Single) FrgMouseDown = False ' Me.Cls End Sub Private Sub GetKeepsPushing(ByVal pt As Long, ByVal rp As Boolean) Dim st As Long '約 49.71 日以上連続稼働しているPCは注意して下さい。 st = timeGetTime 'ボタンが押された時の時間 Do While FrgMouseDown 'True の間押されている時間を測定 DoEvents '指定の時間以上押されていたら処理を抜ける If timeGetTime - st > pt Then Exit Do Loop '押されていた時間が指定の時間以内の場合何もしない If timeGetTime - st < pt Then Exit Sub '----------------------------------------------------------------------- 'ボタンが押し続けられた場合の処理 Print "Command ボタンが1.5秒以上押されました。" '----------------------------------------------------------------------- If rp = False Then '１回だけ実行する場合 FrgMouseDown = False Else 'リピート操作が必要な場合(押している間何回も処理を実行する) Call GetKeepsPushing(200, True) End If End Sub |
をクリックするとツリー全体を一括表示します） - コマンドを長押しすると別の処理をさせる - 翔さん 08/08/09-20:58No.12871