tagCANDY CGI VBレスキュー(花ちゃん) - コマンドボタンを長押し(リピート)すると別の処理をさせる(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
コマンドボタンを長押し(リピート)すると別の処理をさせる(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

コマンドボタンを長押し(リピート)すると別の処理をさせる(VB6.0) [No.199の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 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秒以上押し続けた場合処理を1回実行する(時間はお好みで)
   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
      '1回だけ実行する場合
      FrgMouseDown = False
   Else
      'リピート操作が必要な場合(押している間何回も処理を実行する)
      Call GetKeepsPushing(200, True)
   End If
End Sub
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ