ボタンが押されたときの反応方法

このQ&Aのポイント
  • Active Basicでゲームプログラムを書いています。ボタンを押したときの反応で、上下左右に画像を動かしたいのですが、ボタンを押すと、いったん静止してから、連打処理(?)のように動きます。やりたいことは、ボタンを押すとすぐに上下左右に一定間隔で画像を動かすことです。
  • Sub MainWnd_KeyDown(KeyCode As Long, flags As Long)のコードを使用しています。
  • ボタンを押すとすぐに上下左右に一定間隔で画像を動かしたいです。どなたかご存知の方がいらっしゃいましたら、ご教授ください。お願いします。
回答を見る
  • ベストアンサー

ボタンが押されたときの反応 Basic

Active Basicでゲームプログラムを書いています。 ボタンを押したときの反応で、上下左右に画像を動かしたいのですが、 ボタンを押すと、いったん静止してから、連打処理(?)のように動きます。 やりたいことは、ボタンを押すとすぐに上下左右に一定間隔で画像を動かすことです。 Sub MainWnd_KeyDown(KeyCode As Long, flags As Long) If KeyCode=37 Then If x<=3 Then Exit Sub End If MyBmpInfo=2 x=x-5 Else If KeyCode=38 Then If y<=0 Then Exit Sub End If MyBmpInfo=1 y=y-5 Else If KeyCode=39 Then If x>=600 Then Exit Sub End If MyBmpInfo=3 x=x+5 Else If KeyCode=40 Then If y>=400 Then Exit Sub End If y=y+5 End If InvalidateRect(hMainWnd,ByVal 0,TRUE) End Sub と書きました。 すみませんが、どなたかご存知の方がいらっしゃいましたら、ご教授ください。 お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.2

 こんばんは。  御礼頂き有難う御座います。  先程、DirectInputとマルチスレッドがでないと無理と回答してしまったのですが(すんません)、標準タイマーとGetkeyboardState()を使用して、安易に実現出来ました。  こんな感じです(SetTimerでタイムアウトを16ミリ秒に設定して確認しました)。 '標準のタイマー Sub MainWnd_Timer(TimerID As DWord) Dim key(256) As Byte GetKeyboardState(key) If key(VK_LEFT) And &h80 Then If x<=3 Then Exit Sub End If BmpInfo=2 x=x-5 End If If key(VK_UP) And &h80 Then If y<=0 Then Exit Sub End If BmpInfo=1 y=y-5 End If If key(VK_RIGHT) And &h80 Then If x>=600 Then Exit Sub End If BmpInfo=3 x=x+5 End If if key(VK_DOWN) And &h80 Then If y>=400 Then Exit Sub End If y=y+5 End If InvalidateRect(hMainWnd, ByVal 0, TRUE) End Sub  

if-so-at
質問者

お礼

修正ありがとうございます! 助かりました!! Threadは、ゲーム作りに必須なようなので、勉強させていただきます! 良い機会もありがとうございました!

その他の回答 (1)

回答No.1

 こんにちは。  流石にリアルタイム入力を処理するとなれば、DirectInput(DirectX関連)などが無いと無理そうです。ですので、現状のコードでは実現不可能な雰囲気です・・・。  http://www.mb.ccnw.ne.jp/garger-studio/gameprog/top2.html  http://itpro.nikkeibp.co.jp/article/MAG/20061122/254532/  GetAsyncKeyState()やGetKeyboardState()と言ったAPIも、先ずは役に立ちません。  スレッドで定期的にDirectInputからキー入力を検出する事になりそうです。  当然ながら排他アクセス等も入ってくる(と思う)ので、データの構造等も考えないといけません。  大体こんな感じに成ると思います。 '構造体 Type ThreadData hThread As HANDLE dwThreadId As DWord cSection As CRITICAL_SECTION bLoop As Boolean End Type 'スレッドで共有するデータは、其のまま書き込んだりするとデータが壊れます '必ず、クリティカルセクションに挟み込んで排他アクセスをします 'グローバル Dim tData As ThreadData 'ウィンドウ作成 Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) ' 'ココら辺で前準備する ' 'クリティカルセクションを作成する InitializeCriticalSection(tData.cSection) tData.bLoop = True 'スレッドの始動 tData.hThread = CreateThread(0, 0, AddressOf(KeyCheck), 0, 0, tData.dwThreadId) End Sub 'ウィンドウ破壊時 Sub MainWnd_Destroy() 'スレッドのループを止める EnterCriticalSection(tData.cSection) tData.bLoop = False LeaveCriticalSection(tData.cSection) WaitForSingleObject(tData.hThread, INFINITE) 'スレッドを消す CloseHandle(tData.hThread) 'クリティカルセクションを消す DeleteCriticalSection(tData.cSection) End Sub '排他してからフラグを取る function IsLoop() As Boolean EnterCriticalSection(tData.cSection) IsLoop = tData.bLoop LeaveCriticalSection(tData.cSection) End Function 'キーチェックスレッド function KeyCheck(lpParameter As VoidPtr) As DWord Dim time As Long While(IsLoop()) 'ココでDirectInputからキー入力を受け取る '取り敢えず時間でも数えておく time = time + 1 SetWindowText(hMainWnd, Str$(time)) Sleep(16) Wend ExitThread(0) KeyCheck = 0 End function  

if-so-at
質問者

お礼

ご回答ありがとうございます! ・・・スレッドは、まだ勉強していないので、未知の領域で、全然分かりません・・・ 頑張って勉強します。

関連するQ&A

  • ActiveBasic 再描写処理が読み出されても、描写していた物を削除しない方法

    ActiveBasic4.23.00を使ってプログラムを書いています。 例えば、次のようなコードがあったとします。 'グローバル Dim DragFlag As Long Dim hDC As HDC '此処まで Sub MainWnd_Destroy() ReleaseDC(hMainWnd,hDC) test_DestroyObjects() PostQuitMessage(0) End Sub Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) hDC = GetDC(hMainWnd) End Sub Sub MainWnd_LButtonDown(flags As Long, x As Integer, y As Integer) DragFlag = 1 MoveToEx(hDC,x,y,ByVal NULL) End Sub Sub MainWnd_MouseMove(flags As Long, x As Integer, y As Integer) If DragFlag = 0 Then Exit Sub LineTo(hDC,x,y) End Sub Sub MainWnd_LButtonUp(flags As Long, x As Integer, y As Integer) DragFlag = 0 End Sub (ABWiki様を参考にさせていただきました。) これで、簡単なお絵かきが出来ますが、再描写(例えば、ウインドウの大きさを変えるなど)をするとすべて消えてしまいます。 これを、描いた線を消さずに再描写することは出来ないのでしょうか。 すみませんがご教授ください。

  • Active Basic 再描写処理

    最近デバイスコンテキストを何とか理解してきたので、実験的に『上から物体が振ってくるのを避ける』というゲームを作ってみようと思い作り始めました。 『←』が押されれば、棒人間を左に、『→』が押されれば、棒人間を右に移動させる処理と、ランダムで●が上から落ちてくるという処理をタイマーを使ってやってみました。(スレッドとかはまだ勉強していないので) 一応完成はしたのですが、棒人間を動かすと、どうしても●がちらつきます。 この場合は、どういう風に処理をすればいいのでしょうか? プログラムはこう書きました。 グローバル変数 Dim hBmp01 As HWND Dim hBmp02 As HWND Dim hBmp03 As HWND Dim hBmp04 As HWND Dim hMemDC As HDC Dim BmpInfo As Long Dim hBomDC As HWND Dim Bomxy As RECT Dim x As Long Dim y As Long Dim bx As Long Dim by As Long Dim n As Long '---------------------------------------------------- 省略 '----------------------------------------------------- Sub MainWnd_Destroy() DeleteObject(hBmp01) DeleteObject(hBmp02) DeleteObject(hBmp03) DeleteObject(hBmp04) YokeGame_DestroyObjects() PostQuitMessage(0) End Sub Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT) SetWindowText(hMainWnd,"画像描写テスト ~爆弾的なものを避けるゲーム~") hBmp01 = LoadImage(0,".\画像\人\普通.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) hBmp02 = LoadImage(0,".\画像\人\右.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) hBmp03 = LoadImage(0,".\画像\人\左.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) hBmp04 = LoadImage(0,".\画像\爆弾\ボム.bmp",IMAGE_BITMAP,0,0,LR_LOADFROMFILE) GetWindowRect(hBmp04,Bomxy) If hBmp01=0 or hBmp02=0 or hBmp03=0 or hBmp04=0 Then MessageBox(hMainWnd,Ex"画像の読み込みに失敗しました\r\n強制終了します。","Error",MB_OK or MB_ICONHAND) DeleteObject(hBmp01) DeleteObject(hBmp02) DeleteObject(hBmp03) DeleteObject(hBmp04) SendMessage(hMainWnd,WM_CLOSE,0,0) End If x=290 y=275 BmpInfo=1 bx = 320 by = 0 SetTimer(hMainWnd,0,300,0) End Sub Sub Kettei() Dim ok As Long by=0 Do Randomize bx = Fix(Rnd()*100) If bx>0 and 630>bx Then ok=TRUE End If Loop Until ok=TRUE End Sub Sub MainWnd_Paint(hDC As HDC) hMemDC = CreateCompatibleDC(hDC) hBomDC = CreateCompatibleDC(hDC) If BmpInfo = 1 Then SelectObject(hMemDC,hBmp01) Else If BmpInfo = 2 Then SelectObject(hMemDC,hBmp02) Else If BmpInfo = 3 Then SelectObject(hMemDC,hBmp03) End If BitBlt(hDC,x,y,40,50,hMemDC,0,0,SRCCOPY) Sleep(30) SelectObject(hMemDC,hBmp01) BitBlt(hDC,x,y,40,50,hMemDC,0,0,SRCCOPY) Sleep(30) SelectObject(hBomDC,hBmp04) BitBlt(hDC,bx,by,9,9,hBomDC,0,0,SRCCOPY) DeleteDC(hMemDC) DeleteDC(hBomDC) BmpInfo = 1 End Sub Sub MainWnd_KeyDown(KeyCode As Long, flags As Long) If KeyCode = 37 Then If x<=0 Then x=0 Exit Sub End If x = x - 10 BmpInfo=3 End If If KeyCode = 39 Then If x>=600 Then x = 600 Exit Sub End If x = x + 10 BmpInfo=2 End If InvalidateRect(hMainWnd,ByVal 0,TRUE) End Sub Sub MainWnd_Timer(TimerID As DWord) If TimerID = 0 Then by = by + 10 InvalidateRect(hMainWnd,Byval 0,TRUE) If by >=360 Then Kettei() End If End If End Sub っと、このようになりました。(一応動きます) strictには、チェックを入れていません。 バージョンは、4.23.00を使っています。 それと、InvalidateRect関数なのですが、 InvalidateRect(hMainWnd,Byval 0,TRUE) の、二つ目のパラメータ(?)部分に、全体を再描写させるときに何故『Byval 0』と表記するのでしょうか? ヘルプには、NULL を指定すると、クライアント領域全体が更新領域に設定されますと書かれていますが、NULLを指定すると無効な識別となります。 すみませんが、分かる方がいらっしゃいましたら、ご教授をお願いします。

  • Active Basic 枠無しウインドウをマウスで移動させる

    枠なしのウインドウ(スタイル:ポップアップ/枠無し)を、 ドラッグで任意の場所に移動させたいのですが、知識が足りません。 一応抵抗はしてみたのですが、あっけなく弾き飛ばされました。 'グローバル Dim LClickFlag As Long Sub MainWnd_LButtonDown(flags As Long, x As Integer, y As Integer) LClickFlag=TRUE End Sub Sub MainWnd_LButtonUp(flags As Long, x As Integer, y As Integer) LClickFlag=FALSE End Sub Sub MainWnd_MouseMove(flags As Long, x As Integer, y As Integer) If LClickFlag=TRUE Then SetWindowPos(hMainWnd,NULL,x,y,0,0,SWP_NOSIZE) End If End Sub 動きはしますが、ちょこちょこちょこちょこ動いて、移動させたい場所に移動できません。 すみませんが、どのようにやれば良いかのご教授をお願いします。 それと、ずっと参考にしていた、Active Basicの非公式WIKI様(http://www.2chab.net/pukiwiki/index.php?ActiveBasic%20Wiki-TopPage)は、もう復活しないのでしょうか。 こちらも知っていらっしゃる方がいらっしゃいましたら、ご教授をお願いします。

  • ▲ExcelのVBA▼困っています

    何度もVBAで質問させてもらい助けてもらっています。 懲りずにまた質問ですが… 下のプログラムは"●"が跳ね返るものなのですが… ●の後を■と▲が追うようなプログラムにするには なにを追加すればいいのでしょうか…?; どなたか教えて下さい;;お願いします;; Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim maru As String, yoko As String, tate As String Sub 描画() Cells(X, Y).Value = maru End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() maru = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub

  • 2010 excel マクロ 記号の変化

    エラー発生で強制終了になってしまいます。2007年のexcelで作成したものですが、2010だと強制終了になってしまいます。 内容は□をダブルクリックすると■になるように作っています。 記述は2003年からのマクロ記述なので、変化が必要なのでしょうか? Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'セルをダブルクリックすると、・→○→△→×→・と変更する。 Dim S1 As String Dim S2 As String Dim S01 As String Dim S02 As String Dim S03 As String Dim S04 As String S1 = "□" S2 = "■" S01 = "・" S02 = "○" S03 = "△" S04 = "×" On Error GoTo ERR_12 sCheckXY S1, S2 sCheckX1234 S01, S02, S03, S04 sChangeXY S1, S2 Exit Sub ERR_12: End End Sub Sub sChangeXY(X As String, Y As String) '選択セルに□があれば■に変える Dim Str0 As String 'str1の左端 Dim Str1 As String 'strの右側更新 Dim Str2 As String 'strの左側更新 Dim Str20 As String 'strの左側一部保存 Dim L As Long Dim M As Long Dim N As Long Str1 = ActiveCell.Text L = Len(Str1) Debug.Print L If L = 0 Then End End If For N = 1 To L Debug.Print Str2 Str0 = Left(Str1, 1) If Str0 = X Or N = L Then If Str20 <> "" Then If N = L Then Str20 = Str20 + Str0 End If If MsgBox(Str20 & "  はチェックしますか?", vbYesNo, "選択肢") = vbYes Then Str2 = Str2 + Replace(Str20, X, Y) Str20 = Str0 Else Str2 = Str2 + Replace(Str20, Y, X) Str20 = Str0 End If Else Str20 = Str0 End If Else Str20 = Str20 + Str0 End If Str1 = Right(Str1, L - N) Next N ActiveCell.Value = Str2 End Sub Sub sCheckXY(X As String, Y As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X Then ActiveCell.Value = Y End ElseIf ActiveCell.Text = Y Then ActiveCell.Value = X End End If End Sub Sub sCheckX1234(X1 As String, X2 As String, X3 As String, X4 As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X1 Then ActiveCell.Value = X2 End ElseIf ActiveCell.Text = X2 Then ActiveCell.Value = X3 End ElseIf ActiveCell.Text = X3 Then ActiveCell.Value = X4 End ElseIf ActiveCell.Text = X4 Then ActiveCell.Value = X1 End End If End Sub

  • ※VBA配列

    http://oshiete1.goo.ne.jp/qa5196795.htmlで 質問させてもらった者です。質問不足だったため 質問の内容を追加したかったのですが、追加の方法がわからず またこちらで質問させていただきました Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim X1 As Integer, Y1 As Integer Dim X2 As Integer, Y2 As Integer Dim maru As String, yoko As String, tate As String Dim sankaku As String, shikaku As String Sub 描画() Cells(Y2, X2).Value = shikaku Cells(Y1, X1).Value = sankaku Cells(Y, X).Value = maru End Sub Sub 削除() Cells(Y2, X2).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() X2 = X1 Y2 = Y1 X1 = X Y1 = Y If yoko = "右" Then X = X + 1 Else X = X - 1 End If If X = 30 Then yoko = "左" ElseIf X = 1 Then yoko = "右" End If If tate = "上" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 20 Then tate = "下" ElseIf Y = 1 Then tate = "上" End If End Sub Sub main() maru = "●" sankaku = "▲" shikaku = "■" X = 1 Y = 1 X1 = 1 Y1 = 1 X2 = 1 Y2 = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub a~tの文字が、上記のような動きをする プログラムを作成するにはどのように配列を活かせばいいですか? 配列がよくわかっておらず勉強したのですが…使えずにいます;;

  • Excel VBA ・・・教えてください

    何度も質問させて頂いてます。すみません、 下記のプログラムはこの場で教えて頂いたプログラムで、 実行すると●の後を▲や■が追いかける動きをします。 下記のプログラムをある程度使用して 1~20の数字が順々で追いかけっこする プログラムを作成するにはどのようにすればいいのでしょうか… できればプログラムは長めにならず 20の数字から簡単に増やすことのできるような そんなプログラムが作成したいです… どなたかアドバイスお持ちの方 教えて下さいお願いします... Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim X1 As Integer, Y1 As Integer Dim X2 As Integer, Y2 As Integer Dim maru As String, yoko As String, tate As String Dim sankaku As String, shikaku As String Sub 描画() Cells(Y2, X2).Value = shikaku Cells(Y1, X1).Value = sankaku Cells(Y, X).Value = maru End Sub Sub 削除() Cells(Y2, X2).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() X2 = X1 Y2 = Y1 X1 = X Y1 = Y If yoko = "右" Then X = X + 1 Else X = X - 1 End If If X = 30 Then yoko = "左" ElseIf X = 1 Then yoko = "右" End If If tate = "上" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 20 Then tate = "下" ElseIf Y = 1 Then tate = "上" End If End Sub Sub main() maru = "●" sankaku = "▲" shikaku = "■" X = 1 Y = 1 X1 = 1 Y1 = 1 X2 = 1 Y2 = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub

  • vb コンボボックスのイベントについて

    こんばんわ。 コンボボックスで、 指定の値をマウス操作でクリックしたときと、 キーボードの上下で、移動後returnを押したときだけ、 MsgBox "処理実行" を実行したいです。 keystateを使ってみたのですが、前の情報が残っているのかうまくいきません。keystateの情報をクリアさせるか、シンプルに上記を動作させる何かよい方法はありますでしょうか。 Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Dim flg1 As Boolean Private Sub form_load() Combo1.AddItem (11) Combo1.AddItem (22) Combo1.AddItem (33) Combo1.AddItem (44) End Sub Private Sub Combo1_Keyup(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then 'return flg1 = True Call Combo1_click End If End Sub Private Sub Combo1_click() If (GetKeyState(&H26) <> 0) Or (GetKeyState(&H28) <> 0) Then ' ↑↓ If flg1 = False Then Exit Sub End If End If MsgBox "処理実行" flg1 = False End Sub

  • VBAでフォームにおけるコマンドが実行されません。

    なんどもすいません。二列目に、二桁の整数の足し算を出題することができるたし算の作問プログラムと、続いて三列目に、足し算の解答をして、それの正誤を確かめるプログラムを、それぞれフォームで”問題”、”採点”とした時、一回フォームのウィンドウを閉じてしまうと”採点”のコマンドを押しても、うまく実行されません。 im Ans() As Long Dim n As Variant Private Sub monndai_Click() Dim x As Long, y As Long Columns("B:F").Clear n = InputBox("問題数は?") If Not IsNumeric(n) Then Exit Sub If n <= 0 Then Exit Sub ReDim Ans(n) As Long For i = 1 To n Randomize x = Int(Rnd * 100) Randomize y = Int(Rnd * 100) Ans(i) = x + y Cells(i, 2) = "(" & i & ") " & x & " + " & y & " = " Next i End Sub Private Sub saiten_Click() t = 0 Dim i As Long For i = 1 To n If Cells(i, 3) = Ans(i) Then Cells(i, 4) = "○": t = t + 1 Else Cells(i, 4) = "×": End If Next i tokutenn = "貴方の正答率は" & Int(t / n) & "%です" End Sub (注)tokutennはフォームのテキストボックスのオブジェクト名です。

  • REALbasicについて質問です。

    今日プログラミングをはじめた超初心者です。 全然わからないので教えていただきたいのですが Sub Action () dim x as string dim y as integer x = editField1.text y = val(x) if y = 0 then msgbox "ゼロだよん。" else msgbox "ゼロじゃないよん。" end if End Sub というプログラムを実行してみたのですがeditField1のところがおかしいらしく動いてくれません。どのようにしたらよろしいでしょうか?

専門家に質問してみよう