コンボボックスで指定した 音色で、キーボード上をマウ スカーソルを動かす事に依 り、音を鳴らす事が出来る。
猶、音を鳴らさない様に、マ ウスカーソルをキーボード 上を移動させるには、マウス ボタンを押し下げた状態で、
移動させる。
一般的に、実用プログラムに比較するとゲームプログラムは、高度なテクニックを要求される事が多い。
此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を 目的として居る。
制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。
此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。
キーボード
VB 2005 ○55
□ アプリケーション画面のデザイン（標準コントロールの利用）
□ プログラムの動作原理（イベント駆動型のプログラム）
□ プログラムの構成要素（オブジェクトとプロパティ）
□ 値の代入（変数、オブジェクトのプロパティ）
□ グラフィックスの利用（Graphicsオブジェクト）
□ 条件に応じた処理（If文の利用）
□ 自動的に行われる処理（タイマーの利用）
今回の課題項目
コントロールの種類 プロパティ プロパティの設定値
フォーム Name MML
FormBorderStyle FixedSingle
MaximizeBox False
StartPosition CenterScreen
Text 音階を鳴らす♪
ピクチャボックス Name picKeyboard
Image keyboard.gif
Size 631, 200
ボタン１ Name btnOpen
Font Times New Roman、１６、太字
Text OPEN
ボタン２ Name btnClose
Font Times New Roman、１６、太字
Text CLOSE
コンボボックス Name cboTone
Font Times New Roman、１２、標準
トラックバー Name barVolume
LargeChange 10
Maximum 127
Value 70
オ オブ ブジ ジェ ェク クト ト・ ・プ プロ ロパ パテ ティ ィ一 一覧 覧
ボタン１ コンボボックス
ピクチャボックス
ボタン２
トラックバー
Imports System.IO
Public Class MML
' API関数の宣言
< System.Runtime.InteropServices.DllImport( _
"winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midiOutOpen( _
ByRef hMidiOut As Integer, _ ByVal uDeviceID As Integer, _ ByVal dwCallback As Integer, _ ByVal dwInstance As Integer, _
ByVal dwFlags As Integer ) As Integer End Function
< System.Runtime.InteropServices.DllImport( _
"winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midiOutShortMsg( _
ByVal hMidiOut As Integer, _
ByVal dwMsg As Integer ) As Integer End Function
< System.Runtime.InteropServices.DllImport( _
"winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midiOutClose( _
ByVal hMidiOut As Integer ) As Integer End Function
< System.Runtime.InteropServices.DllImport( _
"winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midiOutGetNumDevs( ) As Integer
End Function
' フォームクラスレベルでグローバルな変数の宣言
Private HDL As Integer ' MIDIのハンドル Private Tone( 127 ) As String ' 音色
Private Pos( 35 ) As Rectangle ' 鍵盤の位置 Private ToneNo( 35 ) As String ' 音階番号
Private Cmd As String = "" ' 命令コード保存用 Private Num As Integer = 255
Private Flg As Boolean = False
プロ プ ログ グラ ラム ムリ リス スト ト
' フォームが読み込まれた時の処理
Private Sub MML_Load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load
' MIDIデバイスが有るか何うかの判定
If midiOutGetNumDevs( ) = 0 Then
MessageBox.Show( "御使用の環境では、MIDI音源を使用出来ません。" ) Exit Sub
Else
MessageBox.Show( "御使用の環境で、MIDI音源が使用出来ます。" ) End If
' 音色の読込
Dim Sr As StreamReader = New StreamReader( "tone.txt" ) Dim S, D( ) As String
For I As Integer = 0 To 127 S = Sr.ReadLine( )
D = S.Split( "," ) Tone( I ) = D( 0 )
cboTone.Items.Add( D( 1 )) Next
Sr.Close( )
' 鍵盤位置の読込
Sr = New StreamReader( "position.txt" ) For I As Integer = 0 To 35
S = Sr.ReadLine( ) D = S.Split( "," )
Pos( I ) = New Rectangle( Integer.Parse( D( 0 )), Integer.Parse( D( 1 )), _ Integer.Parse( D( 2 )), Integer.Parse( D( 3 )))
ToneNo( I ) = D( 4 ) Next
Sr.Close( ) Sr.Dispose( ) End Sub
' ボタン（OPEN）がクリックされた時の処理
Private Sub btnOpen_Click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnOpen.Click
Dim Ret As Integer
' ハンドルの取得（Handleにハンドルが入る）
Ret = midiOutOpen( HDL, -1, 0, 0, 0 )
' コントロールの有効化
btnClose.Enabled = True: cboTone.Enabled = True: picKeyboard.Enabled = True
' ボタン（CLOSER）がクリックされた時の処理
Private Sub btnClose_Click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnClose.Click
' クローズ
midiOutClose( HDL )
' コントロールの無効化
btnClose.Enabled = False: cboTone.Enabled = False: picKeyboard.Enabled = False End Sub
' コンボボックス（TONE）の選択項目が変化した時の処理
Private Sub cboTone_SelectedIndexChanged( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles cboTone.SelectedIndexChanged
Dim Ret As Integer Dim S As String
S = Tone( cboTone.SelectedIndex ) & "C0"
' 音色を変える
Ret = midiOutShortMsg( HDL, System.Convert.ToInt32( S, 16 )) End Sub
' ピクチャボックス（KEYBOARD）でマウスカーソルが移動した時の処理
Private Sub picKeyboard_MouseMove( ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picKeyboard.MouseMove
If Flg Then Exit Sub
Dim P As Point = New Point( e.X, e.Y ) Dim N As Integer = 0
Dim S As String = ""
' 鍵盤位置の取得
For I As Integer = 0 To 35
If Pos( I ).Contains( P ) Then N = I: Exit For Next
If Not N = Num Then If Not Cmd = "" Then ' 音を止める
S = Cmd & "80"
midiOutShortMsg( HDL, System.Convert.ToInt32( S, 16 )) End If
' 命令コードの生成
Cmd = ( barVolume.Value.ToString( ) & ToneNo( N )) S = Cmd & "90"
' 音を出す
midiOutShortMsg( HDL, System.Convert.ToInt32( S, 16 )) Num = N
End If End Sub
' ピクチャボックス（KEYBOARD）からマウスカーソルが退去した時の処理
Private Sub picKeyboard_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles picKeyboard.MouseLeave
If Not Cmd = "" Then ' 音を止める
Dim S As String = Cmd & "80"
midiOutShortMsg( HDL, System.Convert.ToInt32( S, 16 )) Cmd = "" : Num = 0
End If End Sub
' ピクチャボックス（KEYBOARD）でマウスボタンが押し下げられた時の処理
Private Sub picKeyboard_MouseDown( ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picKeyboard.MouseDown
Flg = True End Sub
' ピクチャボックス（KEYBOARD）でマウスボタンが離された時の処理
Private Sub picKeyboard_MouseUp( ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picKeyboard.MouseUp
Flg = False End Sub End Class
プログラムの概要
連鎖型落下ゲーム『フルーツ、ポン！』
で有る。
縦か横に同じ図柄のパネルを３個以上 並べて消して行く。消去された処には上 からパネルがスライドダウンして来る。
猶、移動させるパネルをクリックし、次 いで、移動先のパネルをクリックすると ２枚のパネルが入れ替わる。
一般的に、実用プログラムに比較すると ゲームプログラムは、高度なテクニック を要求される事が多い。
此処では、ゲームプログラムを作成する 事に依り、楽しみ乍ら、プログラムの制 作手順を習得する事を目的として居る。
制作手順としては、実際の作業過程に従
い、段階的に機能を追加する方法を採用して居る。
此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。
フルーツ ポン！
VB 2005 ○56
□ アプリケーション画面のデザイン（標準コントロールの利用）
□ プログラムの動作原理（イベント駆動型のプログラム）
□ プログラムの構成要素（オブジェクトとプロパティ）
□ 値の代入（変数、オブジェクトのプロパティ）
□ グラフィックスの利用（Graphicsオブジェクト）
□ 条件に応じた処理（If文の利用）
□ 自動的に行われる処理（タイマーの利用）
今回の課題項目
コントロールの種類 プロパティ プロパティの設定値 フォーム Name fruits
FormBorderStyle FixedSingle
MaximizeBox False
StartPosition CenterScreen
Text Fruits Pon （尾立作品のリメイク）
ピクチャボックス１ Name picScore
Image score.gif
Size 49, 314
ピクチャボックス２ Name picG
BackColor White
BorderStyle FixedSingle
Size 290, 354
ピクチャボックス３ Name picTime
BorderStyle Fixed3D
Size 16, 354
ラベル１ Name lblTotalCaption
Font ＭＳ 明朝、１２、太字
Text 合計
オ オブ ブジ ジェ ェク クト ト・ ・プ プロ ロパ パテ ティ ィ一 一覧 覧
ボタン１
ピクチャボックス１
ボタン２ ピクチャボックス２
ラベル１ ラベル２
ラベル４ ラベル３
ピクチャボックス３
コントロールの種類 プロパティ プロパティの設定値 ラベル２ Name lblGcnt
AutoSize False
BackColor White
Font ＭＳ 明朝、１２、太字
Size 80, 16
Text 0
TextAlign MiddleRight
ラベル３ Name lblMes
AutoSize False
BackColor 192, 255, 255
BorderStyle FixedSingle
Font HG創英角ﾎﾟｯﾌﾟ体、１６、太字
ForeColor Red
Size 250, 90
Text 開始ボタンクリックで
ゲームスタート！
TextAlign MiddleCenter
ラベル４ Name lblExplain
AutoSize False
Font ＭＳ 明朝、１０、太字
Size 489, 36
Text ルールは簡単です。隣り合う２個のパネルを入
れ替えて、縦か横に３個以上揃えましょう。右 側のメーターが一杯に成る迄に幾つ消せるか な！！
ボタン１ Name btnStart
Font ＭＳ 明朝、１２、太字
Text 開始
ボタン２ Name btnFinish
Font ＭＳ 明朝、１２、太字
Text 終了
此のプログラムは、以前、ノアに居られた尾立先生が製作された物を、リメイクした 物です。従来のプログラムでは、正確なタイマー処理を行うのに、API関数が使用さ れて居ましたが、今回は、.NET Frameworkの機能で有るSystem.Timers名前空間
の Timer オブジェクトを使用しました。完全な別スレッドで処理が行われる為、正
確なタイマー処理が行えます。但し、フォームのコントロールを操作するには、デリ ゲート機能を使用する必要が有ります。少し難しいかも知れませんが、役に立つ知識 に成る筈です。少しコードが長いですが、其の分、楽しいです。
Public Class fruits
Private Const ENP As Integer = 20 Private Const INS As Integer = 21
Private Map( 9, 7 ) As Integer
Private Map1( 9, 7 ), Map2( 9, 7 ), Map3( 19, 7 ) As Integer Private Fcnt( 7 ), Tcnt, Ecnt As Integer
Private Px1, Py1, Px2, Py2 As Integer Private Sx, Sy, Ex, Ey As Integer Private FirstFlg, EndFlg As Boolean Private Cstop, Sact, Gact As Boolean
Private lblFcnt( 7 ) As Label Private Bm As Bitmap Private Gr, Gt As Graphics
Private Rn As Random = New Random( )
Private Tm As System.Timers.Timer = New System.Timers.Timer( )
Delegate Sub TimerDelegate( )
' フォームが読み込まれた時の処理
Private Sub fruits_Load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load
' 得点表示用ラベルの生成
Dim T As Integer = picScore.Top + 16 For I As Integer = 0 To 7
lblFcnt( I ) = New Label With lblFcnt( I )
.Size = New Size( 80, 16 )
.Location = New Point( 103, I * 40 + T ) .BackColor = Color.White
.Font = New Font( "ＭＳ 明朝", 12, FontStyle.Bold, GraphicsUnit.Point ) .TextAlign = ContentAlignment.MiddleRight
End With
Me.Controls.Add( lblFcnt( I )) Next
' 画像の読込
Bm = New Bitmap( "fruits.gif" )
' Graphicsオブジェクトのインスタンス生成
With picG
.Image = New Bitmap( .Width, .Height ) Gr = Graphics.FromImage( .Image )
プロ プ ログ グラ ラム ムリ リス スト ト
With picTime
.Image = New Bitmap( .Width, .Height ) Gt = Graphics.FromImage( .Image ) End With
' タイマーの設定
AddHandler Tm.Elapsed, _
New System.Timers.ElapsedEventHandler( AddressOf TimerProc ) Tm.Interval = 500
Tm.AutoReset = True End Sub
' フォームが閉じられ様とした時の処理
Private Sub fruits_FormClosing( ByVal sender As Object, _
ByVal e As System.Windows.Forms.FormClosingEventArgs ) Handles Me.FormClosing
Gr.Dispose( ) Application.Exit( ) End Sub
' ボタン（開始）がクリックされた時の処理
Private Sub btnStart_Click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnStart.Click
Dim I, X, Y, N As Integer Dim R As Rectangle
Gact = True : EndFlg = False : Cstop = False Sx = 0 : Sy = 349 : Ex = 13 : Ey = 349
Ecnt = 0
Gt.Clear( Color.White ) : picTime.Refresh( ) Gr.Clear( Color.White )
For Y = 0 To 9 For X = 0 To 7 Do
N = Rn.Next( 0, 8 )
Loop Until PutChk( N, Y, X )
R = New Rectangle( 0, N * 32, 32, 32 )
Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) Map( Y, X ) = N
Next Next
picG.Refresh( ) For I = 0 To 7
Fcnt( I ) = 0 : lblFcnt( I ).Text = Fcnt( I ).ToString( ) Next
Tcnt = 0 : lblGcnt.Text = Tcnt.ToString( )
FirstFlg = False : lblMes.Visible = False : Tm.Enabled = True End Sub
' ボタン（終了）がクリックされた時の処理
Private Sub btnFinish_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnFinish.Click
Me.Close( ) End Sub
' ピクチャボックスでマウスボタンが押し下げられた時の処理
Private Sub picG_MouseDown( ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picG.MouseDown
Dim X As Integer = e.X Dim Y As Integer = e.Y Dim C As Integer Dim R As Rectangle
If X >= 16 And X <= 271 And Y >= 16 And Y <= 335 And _ EndFlg = False And Gact = True Then
X = X - 16 : Y = Y - 16 If FirstFlg = False Then
Py1 = Int( Y / 32 ) : Px1 = Int( X / 32 ) If Map( Py1, Px1 ) <= 7 Then FirstFlg = True
R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 )
Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) picG.Refresh( )
Else
Cstop = True : Ecnt = 0
Select Case Map( Py1, Px1 ) Case 8
Call ChrDel( Py1, Px1, 1 ): Call MoveProc( ): Call SetProc( ) Case 9
Call ChrDel( Py1, Px1, 2 ): Call MoveProc( ): Call SetProc( ) Case 10
Call Del3Line( Py1, Px1 ): Call MoveProc( ): Call SetProc( ) Case 11
Call ChrDel( Py1, Px1, 3 ): Call MoveProc( ): Call SetProc( ) Case 12
Call ChrChange( Py1, Px1 ) Case 13
Call Vsort( Py1, Px1 ) End Select
While MatchChk( ) = True
Application.DoEvents( ) : System.Threading.Thread.Sleep( 200 ) Call EraseProc( ): Call MoveProc( ): Call SetProc( )
End While Cstop = False
If NoMoreMove( ) = True And Sact = False Then While NoMoreMove( ) = True
Call ReInitialize( ) End While
End If End If Else
Py2 = Int( Y / 32 ) : Px2 = Int( X / 32 ) If Py1 = Py2 And Px1 = Px2 Then FirstFlg = False
R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 )
Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) picG.Refresh( )
End If
If ( Py1 = Py2 And ( Px1 = Px2 + 1 Or Px1 = Px2 – 1 )) Or _ ( Px1 = Px2 And ( Py1 = Py2 + 1 Or Py1 = Py2 - 1 )) Then
C = Map( Py1, Px1 ): Map( Py1, Px1 ) = Map( Py2, Px2 ): Map( Py2, Px2 ) = C If MatchChk( ) = True Then
C = Map( Py1, Px1 ): Map( Py1, Px1 ) = Map( Py2, Px2 ): Map( Py2, Px2 ) = C Call TwoFlip( True )
R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 )
Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 )
Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16, R, GraphicsUnit.Pixel) picG.Refresh( )
FirstFlg = False
C = Map( Py1, Px1 ): Map( Py1, Px1 ) = Map( Py2, Px2 ): Map( Py2, Px2 ) = C Do
Application.DoEvents( ) : System.Threading.Thread.Sleep( 200 ) Call EraseProc( ): Call MoveProc( ): Call SetProc( )
Loop While MatchChk( ) = True
If NoMoreMove( ) = True And Sact = False Then While NoMoreMove( ) = True
Call ReInitialize( ) End While
End If Else
C = Map( Py1, Px1 )
Map( Py1, Px1 ) = Map( Py2, Px2 ) Map( Py2, Px2 ) = C
Call TwoFlip( False ) FirstFlg = False End If
End If End If End If End Sub
'=======================
' ジェネラルプロシージャ
'=======================
' タイマー処理を行うジェネラルプロシージャ
Private Sub TimerProc( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) If Gact = True Then
Invoke( New TimerDelegate( AddressOf DrawTimer )) Sy -= 1: Ey -= 1
If Sy <= -1 Then Tm.Enabled = False EndFlg = True
Invoke( New TimerDelegate( AddressOf ShowGameOver )) Gact = False
End If End If End Sub
' 経過時間を表示するジェネラルプロシージャ（デリゲート用）
Private Sub DrawTimer( )
Gt.DrawLine( Pens.Magenta, Sx, Sy, Ex, Ey ) picTime.Refresh( )
End Sub
' 遊戯終了を表示するジェネラルプロシージャ（デリゲート用）
Private Sub ShowGameOver( ) lblMes.BackColor = Color.Yellow lblMes.Text = "Game Over"
lblMes.Visible = True End Sub
' 最初から３個並ぶのを検証するジェネラルプロシージャ
Private Function PutChk( ByVal N As Integer, ByVal Y As Integer, ByVal X As Integer ) _ As Boolean
If X > 1 Then
If N = Map( Y, X – 1 ) And N = Map( Y, X - 2 ) Then Return False
End If End If
If Y > 1 Then
If N = Map( Y - 1, X ) And N = Map( Y - 2, X ) Then Return False
End If End If Return True End Function