- 日時： 2009/12/26 16:50
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[その他コントロール][イベント][] *
* キーワード：ボタン,コマンド,リピート,押し続ける,押しっぱなし,CommandButton *
***********************************************************************************
タイトル ： コマンドを長押しすると別の処理をさせる
記 事 No ： 12871
投 稿 日 ： 2008/08/09(Sat) 20:58
元質問者 ： 翔さん
コマンドボタンを押しっぱなし（長押し）すると別の処理が出来るようにしたいのです。
-----------------------------------------------------------------------------------
記事No ： 12873
投稿日 ： 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
|
コマンドボタンを長押し(リピート)すると別の処理をさせる(VB6.0)