紛らわしい神経衰弱 VB 2005 17 プログラムの概要 子供でも出来るカードゲーム 神経衰弱 です 画面上の 開始 ボタンをクリックすると ゲームが開始する カードを 2 枚クリックして 何回で総てを揃えられるかを競う 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -1-
オブジェクト プロパティ一覧 ピクチャボックス 22 個 piccard00 piccard01 piccard02 piccard03 piccard04 piccard05 piccard06 piccard07 piccard08 piccard09 piccard10 piccard11 piccard12 piccard13 piccard14 piccard15 piccard16 piccard17 piccard18 piccard19 piccard20 piccard21 ボタン ラベル 1 ラベル 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name breakdown FormBorderStyle FixedSingle Size 880, 848 StartPosition CenterScreen 紛らわしい神経衰弱 ピクチャボックス1~22 Name piccard00~piccard21 Image back.gif Size 140, 200 ラベル1 Name lblmes Red MS 明朝, 14 太字 ForeColor White 空白 Align MiddleCenter ラベル2 Name lbltotal MS 明朝, 14 太字 回数 :00 回 ボタン Name btnstart 開始 -2-
プログラムリスト Public Class breakdown Private N( ) As String = _ { " おそ松 ", " 一松 ", " カラ松 ", " チョロ松 ", " トド松 ", " 十四松 ", _ " ハタ坊 ", " チビ太 ", " イヤミ ", " トト子 ", " デカパン "} Private B( 11 ) As Bitmap Private C( 21 ), Opn( 1 ), Cnt, Obt As Integer Private P( 21 ) As PictureBox ' ピクチャボックス ( カード ) がクリックされた時の処理 Private Sub CardClick( ByVal sender As System.Object, ByVal e As System.EventArgs ) If btnstart.enabled Then Exit Sub Dim S As PictureBox = DirectCast( sender, PictureBox ) Dim I As Integer = Val( S.Name.Substring( 7, 2 )) If Cnt = 0 Then Opn( 0 ) = I : Cnt = 1 Else If I = Opn( 0 ) Then Exit Sub Else Opn( 1 ) = I : Cnt = 2 P( I ).Image = B( C( I )) : lblmes. = N( C( I )) : Application.DoEvents( ) If Cnt = 2 Then lbltotal. = " 回数 :" & (Val(lblTotal..Substring(3, 2)) + 1).ToString("00") & " 回 " System.Threading.Thread.Sleep( 2000 ) If C( Opn( 0 )) = C( Opn( 1 )) Then P( Opn( 0 )).Visible = False : P( Opn( 1 )).Visible = False Obt += 1 : If Obt = 11 Then btnstart.enabled = True Else P( Opn( 0 )).Image = B( 11 ) : P( Opn( 1 )).Image = B( 11 ) Cnt = 0 ' フォームが読み込まれた時の処理 Private Sub breakdown_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load 1 コード記述画面を表示して左記のコードを入力する 2 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する ' 画像の読込 For I As Integer = 0 To 10 B( I ) = New Bitmap( "char" & I.ToString( "00" ) & ".gif" ) Next B( 11 ) = New Bitmap( "back.gif" ) ' コントロールの配列化とイベントハンドラの追加 For I As Integer = 0 To 21 P( I ) = Me.Controls( "piccard" & I.ToString( "00" )) AddHandler P( I ).Click, AddressOf CardClick Next Randomize( ) 3 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する -3-
' ボタン ( 開始 ) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click Dim I, W, R1, R2 As Integer ' カードの初期化 For I = 0 To 20 Step 2 C( I ) = I 2 : C( I + 1 ) = I 2 Next ' カードのシャッフル For I = 1 To 100 R1 = Int( Rnd( ) * 22 ) : R2 = Int( Rnd( ) * 22 ) W = C( R1 ) : C( R1 ) = C( R2 ) : C( R2 ) = W Next 4 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する ' カードの表示 For I = 0 To 21 P( I ).Image = B( 11 ) : P( I ).Visible = True Next lbltotal. = " 回数 :00 回 " Cnt = 0 : Obt = 0 : btnstart.enabled = False End Class -4-
ビンゴ VB 2005 18 プログラムの概要 パーティや地蔵盆で良く行われるゲーム ビンゴ です 76 枚用と 100 枚用の 2 種類を選択する事が出来ます 遊び方は 特に説明する必要は無いでせう ビンゴカードを印刷する機能を備えた拡張版も用意してますので 参考に仕て下さい 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -5-
オブジェクト プロパティ一覧 ピクチャボックス ラベル ボタン グループボックス タイマー ラジオボタン 1 ラジオボタン 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name bingo Black FormBorderStyle FixedSingle Size 1034, 682 StartPosition CenterScreen BINGO ピクチャボックス Name picbingo Image bingo.gif Location 784, 12 Size 222, 142 ラベル Name lblhit White MS ゴシック 120 太字 Location 780, 166 Size 230, 182 空白 Align MiddleCenter ボタン Name btnstart Silver Times New Roman 18 太字 Location 780, 372 Size 232, 123 START タイマー Name tmrgo ラジオボタン1 Name rad75 ラジオボタン2 Name rad99-6-
プログラムリスト Public Class bingo Private Num( 99 ) As Integer Private Cnt As Integer Private Lmt As Integer Private Pre As Integer Private lblnumber( 99 ) As Label 1 コード記述画面を表示して左記のコードを入力する ' ゲームを初期化するジェネラルプロシージャ Private Sub GameInit( ) Dim I, R1, R2, W As Integer ' 前出番号の初期化 Pre = -1 ' 番号の初期化 For I = 0 To 99 Num( I ) = I : lblnumber( I ).ForeColor = Color.White Next I ' シャッフル For I = 1 To 200 R1 = Int( Rnd( ) * Lmt ) : R2 = Int( Rnd( ) * Lmt ) W = Num( R1 ) : Num( R1 ) = Num( R2 ) : Num( R2 ) = W Next I 2 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する ' フォームが読み込まれた時の処理 Private Sub bingo_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' 画面の初期化 For I As Integer = 0 To 99 lblnumber( I ) = New Label( ) With lblnumber( I ).Size = New Size( 70, 45 ).Location = New Point(( I Mod 10) * 72 + 26, ( I 10 ) * 62 + 22 ). = Color.Black.ForeColor = Color.White.Align = ContentAlignment.MiddleRight. = New ( "MS ゴシック ", 36.0!, Style.Bold ). = I.ToString( ).Visible = True Me.Controls.Add( lblnumber( I )) End With Next ' ゲームの初期化 Randomize( ) : Lmt = 100 : Call GameInit( ) 画面に 1 桁しか表示され ない環境では フォントの サイズを小さくする (30.0 位 ) 3 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する -7-
' ラジオボタン ( 範囲 ) の選択状態が変化した時の処理 Private Sub RadioButtonCheckedChanged( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles rad75.checkedchanged If sender Is rad75 Then Lmt = 76 Else Lmt = 100 Call GameInit( ) 4 デザイン画面でラジオボタン 1 をダブルクリックして コード画面を表示し 左記のコードを入力する ' ボタン ( スタート ) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As Object, ByVal e As System.EventArgs ) _ Handles btnstart.click If btnstart. = "START" Then Cnt = 0 tmrgo.interval = 100 tmrgo.enabled = True Else Call GameInit( ) btnstart. = "START" 5 デザイン画面でボタンをダブルクリックして コード画面を表示し 左記のコードを入力する ' タイマーが一定間隔で行う処理 Private Sub tmrgo_tick( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles tmrgo.tick Dim R, N, I As Integer R = Int( Rnd( ) * Lmt ) N = Num( R ) If Not Pre < 0 Then lblnumber( Pre ).ForeColor = Color.White lblnumber( N ).ForeColor = Color.Red Pre = N : Cnt = Cnt + 1 If Cnt > 14 Then tmrgo.interval += 100 6 デザイン画面でタイマーをダブルクリックして コード画面を表示し 左記のコードを入力する If Cnt > 19 Then tmrgo.enabled = False lblhit. = N.ToString( ) Pre = -1 : Lmt -= 1 If Lmt < 1 Then btnstart. = "RESET" Else For I = R To ( Lmt - 1 ) Num( I ) = Num( I + 1 ) Next I End Class -8-
パクリス VB 2005 19 プログラムの概要 謂わずと知れた落ち物ゲーム テトリス の超簡易版 パクリス です 画面上の スタート ボタンをクリックすると 画面右側の領域で 上からブロックが落ちて来ます 左右の矢印キーでブロックを左右に移動させて色が揃う様に落下させます 下向きの矢印キーで一気に落下させる事も出来ます 此のゲームでは ブロックを回転させたり 連鎖消去する事は出来ないが 落ちゲー の基本が解ると思う 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -9-
オブジェクト プロパティ一覧 ピクチャボックス 1 ピクチャボックス 2 ラベル 1 ラベル 2 ボタン タイマー コントロールの種類 プロパティ プロパティの設定値 フォーム Name pacris パクリス - テトリスのパクリ ピクチャボックス1 Name piclogo Image pacris.jpg Size 320, 122 ピクチャボックス2 Name picscreen Black Size 300, 300 ラベル1 Name lblmes Red BorderStyle Fixed3D HG 創英角ホ ッフ 体 22 太字 GAME OVER Align MiddleCenter ラベル2 Name lblscr Blue HG 創英角ホ ッフ 体 18 太字 ForeColor White 0 Align MiddleRight ボタン Name btnstart START タイマー Name tmrmove Interval 500-10-
プログラムリスト 1 Public Class pacris Private G As Graphics Private M( 9, 9 ), BX, BY, Scr As Integer Private B( ) As Brush = { Brushes.Black, Brushes.White, _ Brushes.Yellow, Brushes.Cyan, Brushes.Green, Brushes.DeepPink } コード記述画面を表示して左記のコードを入力する ' フォームが読み込まれた時の処理 Private Sub pacris_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load With picscreen.image = New Bitmap(.Width,.Height ) G = Graphics.FromImage(.Image ) End With ' ボタン (START) がクリックされた時の処理 Private Sub btnstart_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnstart.click btnstart.enabled = False : lblmes.visible = False For I As Integer = 0 To 9 For J As Integer = 0 To 9 M( I, J ) = 0 Next Next Scr = 0 : lblscr. = Scr.ToString( ) Call StartPos( ) tmrmove.enabled = True 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する 3 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する ' スタート位置を表示するジェネラルプロシージャ Private Sub StartPos( ) BX = Int( Rnd( ) * 10 ) : BY = 0 M(BY, BX) = Int(Rnd( ) * 5 + 1 ) Call DrawScreen( ) ' 画面を書き換えるジェネラルプロシージャ Private Sub DrawScreen( ) For I As Integer = 0 To 9 For J As Integer = 0 To 9 G.FillRectangle( B( M( I, J )), J * 30, I * 30, 30, 30 ) Next Next picscreen.refresh( ) 4 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する ' ブロックを消去するジェネラルプロシージャ Private Sub DelBlock( ) Dim P As Integer = 0 If BX > 0 AndAlso M( BY, BX - 1 ) = M( BY, BX ) Then M( BY, BX - 1 ) = 0 : P += 1 If BX < 9 AndAlso M( BY, BX + 1 ) = M( BY, BX ) Then -11-
M( BY, BX + 1 ) = 0 : P += 1 If BY < 9 AndAlso M( BY + 1, BX ) = M( BY, BX ) Then M( BY + 1, BX ) = 0 : P += 1 If P > 0 Then M( BY, BX ) = 0 : Call DrawScreen( ) Scr += ( 2 ^ ( P - 1 )) : lblscr. = Scr.ToString( ) If Scr > 0 And ( Scr Mod 10 = 0 ) Then If tmrmove.interval > 100 Then tmrmove.interval = 500 - ( Scr 10 ) * 100 ' タイマーが一定間隔で行う処理 Private Sub tmrmove_tick(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles tmrmove.tick If BY > 8 OrElse M( BY + 1, BX ) > 0 Then tmrmove.enabled = False Call DelBlock( ) If M( BY, BX ) > 0 And BY = 0 Then lblmes.visible = True Else Call StartPos( ) : tmrmove.enabled = True Else M( BY + 1, BX ) = M( BY, BX ) : M( BY, BX ) = 0 : BY += 1 Call DrawScreen( ) ' キーが開放された時の処理 Private Sub pacris_keyup(byval sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp Select Case e.keycode Case Keys.Left If BX > 0 AndAlso M( BY, BX - 1 ) = 0 Then M( BY, BX - 1 ) = M( BY, BX ) : M( BY, BX ) = 0 : BX -= 1 Call DrawScreen( ) Case Keys.Right If BX < 9 AndAlso M( BY, BX + 1 ) = 0 Then M( BY, BX + 1 ) = M( BY, BX ) : M( BY, BX ) = 0 : BX += 1 Call DrawScreen( ) Case Keys.Down tmrmove.enabled = False Do Until BY > 8 OrElse M( BY + 1, BX ) > 0 M( BY + 1, BX ) = M( BY, BX ) : M( BY, BX ) = 0 : BY += 1 Call DrawScreen( ) System.Threading.Thread.Sleep( 50 ) Loop Call DelBlock( ) : Call StartPos( ) : tmrmove.enabled = True End Select End Class -12-6 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する 7 フォームのイベント一覧より KeyUp イベントをダブルクリックして 左記のコードを入力する
烏賊と蛸のボクシング VB 2005 20 プログラムの概要 烏賊と蛸を戦わすゲーム ボクシング です 画面上の スタート ボタンをクリックする ( 又は エンターキーを押す ) と ゲームが開始する プレーヤーは烏賊で 左右の矢印キーで前進 後進し スペースキーでパンチを放つ 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -13-
オブジェクト プロパティ一覧 ラベル 1 ラベル 2 ラベル 3 パネル プログレスバー 1 プログレスバー 2 ボタン タイマー コントロールの種類 プロパティ プロパティの設定値 フォーム Name boxing FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen 烏賊と蛸のボクシング ラベル1 Name lblmes1 MS 明朝, 14 太字 只今 ラベル2 Name lblscore MS 明朝, 14 太字 0 Align MiddleRight ラベル3 Name lblmes2 MS 明朝, 14 太字 勝抜き中です! パネル Name pnlring White Size 400, 100 プログレスバー 1 Name prgoctopus プログレスバー 2 Name prgsquid ボタン Name btnstart スタート タイマー Name tmrgame Interval 50-14-
プログラムリスト 1 Public Class boxing Private Img( 1, 1 ) As Bitmap Private G As Graphics Private Ps, Po, Cnt, Xs, Xo, Q As Integer コード記述画面を表示して左記のコードを入力する ' フォームが読み込まれた時の処理 Private Sub boxing_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load Img( 0, 0 ) = New Bitmap( "ika1.gif" ) Img( 0, 1 ) = New Bitmap( "ika2.gif" ) Img( 1, 0 ) = New Bitmap( "tako1.gif" ) Img( 1, 1 ) = New Bitmap( "tako2.gif" ) With pnlring.backgroundimage = New Bitmap (.Width,.Height ) G = Graphics.FromImage(.BackgroundImage ) End With Randomize( ) 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する ' キャラクタを表示するジェネラルプロシージャ Private Sub CharDisp( ByVal W As Integer ) G.Clear( Color.White ) G.DrawImage( Img( 0, Q ), Xs, 30 ) G.DrawImage( Img( 1, W ), Xo, 30 ) pnlring.refresh( ) ' ゲームを初期化するジェネラルプロシージャ Private Sub GameInit( ) Po = 160 + Cnt * 20 prgoctopus.maximum = Po : prgoctopus.value = Po Ps = 200 prgsquid.maximum = Ps : prgsquid.value = Ps Xo = 40 : Xs = 300 : Call CharDisp( 0 ) : Q = 0 3 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する ' ボタン ( スタート ) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click Cnt = 0 : lblscore. = CStr( Cnt ) Call GameInit( ) Me.KeyPreview = True btnstart.enabled = False tmrgame.enabled = True 4 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する -15-
' キーが押された時の処理 Private Sub boxing_keydown( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyDown Select Case e.keycode Case Keys.Left If Xs > 36 Then Xs = Xs - 2 ' 烏賊の X 座標 Case Keys.Right If Xs < 340 Then Xs = Xs + 2 ' 烏賊の X 座標 Case Keys.Space If Q = 0 Then Q = 1 ' パンチフラグ End Select 5 フォームのイベント一覧より KeyDown イベントをダブルクリックして 左記のコードを入力する ' タイマーが一定間隔で自動的に行う処理 Private Sub tmrgame_tick( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles tmrgame.tick Dim W As Integer = 0 Select Case Int( Rnd( ) * 5 ) Case 0 : W = 1 Case 1, 2 : If Xo > 0 Then Xo -= 2 ' 蛸の X 座標 Case 3, 4 : If Xo < 364 Then Xo += 2 ' 蛸の X 座標 End Select Call CharDisp( W ) Dim D As Integer = Xs - Xo If D > 10 And D < 36 Then If Q = 1 And W = 0 Then Po = Po - 10 : If Po < 0 Then Po = 0 prgoctopus.value = Po ElseIf Q = 0 And W = 1 Then Ps = Ps - 10 : If Ps < 0 Then Ps = 0 prgsquid.value = Ps ElseIf Q = 1 And W = 1 Then Po = Po - 5 : If Po < 0 Then Po = 0 prgoctopus.value = Po Ps = Ps - 5 : If Ps < 0 Then Ps = 0 prgsquid.value = Ps If Po = 0 Then Cnt = Cnt + 1 : lblscore. = CStr( Cnt ) ' 勝抜き人数 Call GameInit( ) Exit Sub ElseIf Ps = 0 Then tmrgame.enabled = False btnstart.enabled = True MsgBox( "KO 負け!", MsgBoxStyle.Exclamation, " 結果 " ) Q = 0 End Class 6 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する -16-
ビーチバレー VB 2005 21 プログラムの概要 烏賊と蛸が夕日を背に対戦する対戦型アクションゲーム ビーチバレー です 画面上の スタート ボタンをクリックする ( 又は エンターキーを押す ) と ゲームが開始する 10 点先取で勝ちで有る 夫々れのプレーヤーは 画面に表示されたキー操作で烏賊や蛸を操る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -17-
オブジェクト プロパティ一覧 ラベル 2 ラベル 1 パネル ピクチャボックス 3 ピクチャボックス 1 ピクチャボックス 2 ピクチャボックス 4 ピクチャボックス 5 ボタン タイマー コンボボックス コントロールの種類 プロパティ プロパティの設定値 フォーム Name volleyball Navy BackGroundImage back.gif FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen ビーチバレー パネル Name pnlground Transparent Location 16, 14 Size 512, 426 ラベル1 Name lblscore0 Transparent MS 明朝, 14 太字 ForeColor White 0-18-
コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblscore1 Transparent MS 明朝, 14 太字 ForeColor White 0 Align MiddleRight ピクチャボックス1 Name picshadow Transparent Image shadow.gif ピクチャボックス2 Name picoctopus Transparent Image tako1.gif ピクチャボックス3 Name picturtle Transparent Image kame1.gif ピクチャボックス4 Name picball Transparent Image ball.gif ピクチャボックス5 Name picsquid Transparent Image ika1.gif ボタン Name btnstart Cyan HG 創英角ホ ッフ 体 12 太字 スタート コンボボックス Name cbolevel Cyan MS 明朝 10 標準 Items 初級中級上級 タイマー Name tmrgame Interval 50-19-
プログラムリスト Public Class volleyball Private X1 As Integer ' 烏賊のX 座標 Private Y1 As Integer ' 烏賊のY 座標 Private X2 As Integer ' 蛸のX 座標 Private Y2 As Integer ' 蛸のY 座標 Private KA As Integer ' 亀のX 座標 Private X As Integer ' ボールのX 座標 Private Y As Integer ' ボールのY 座標 Private XP As Integer ' ボールの横移動量 Private YP As Integer ' ボールの縦移動量 Private K1 As Integer ' 烏賊のジャンプフラグ Private P1 As Integer ' 烏賊のジャンプカウント Private Q1 As Integer ' 烏賊のアタックフラグ Private S1 As Integer ' 烏賊の得点 Private K2 As Integer ' 蛸のジャンプフラグ Private P2 As Integer ' 蛸のジャンプカウント Private Q2 As Integer ' 蛸のアタックフラグ Private S2 As Integer ' 蛸の得点 Private LV As Integer ' レベル Private Squid( 1 ) As Bitmap Private Octopus( 1 ) As Bitmap Private Turtle( 1 ) As Bitmap 1 コード記述画面を表示して左記のコードを入力する 2 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する ' ゲームを初期化するジェネラルプロシージャ Private Sub GameInit () X1 = 464 : Y1 = 296 : K1 = 0 : P1 = 0 : picsquid.location = New Point( X1, Y1 ) X2 = 16 : Y2 = 296 : K2 = 0 : P2 = 0 : picoctopus.location = New Point( X2, Y2 ) KA = 576 : picturtle.location = New Point( KA - 64, 250 ) X = 448 : Y = 248 : picball.location = New Point( X, Y ) XP = 0 : YP = 12 S1 = 0 : lblscore0. = S1.ToString( ) S2 = 0 : lblscore1. = S2.ToString( ) ' フォームが読み込まれた時の処理 Private Sub volleyball_load( ByVal sender As Object, ByVal e As System.EventArgs ) _ Handles Me.Load For I As Integer = 0 To 1 Squid( I ) = New Bitmap( "ika" & ( I + 1 ).ToString( ) & ".gif" ) Octopus( I ) = New Bitmap( "tako" & ( I + 1 ).ToString( ) & ".gif" ) Turtle( I ) = New Bitmap( "kame" & ( I + 1 ).ToString( ) & ".gif" ) Next cbolevel.selectedindex = 0 : LV = 1 Call GameInit( ) ' ボタン ( スタート ) がクリックされた時の処理 Private Sub btnstart_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnstart.click Call GameInit( ) btnstart.enabled = False : cbolevel.enabled = False Me.KeyPreview = True : tmrgame.enabled = True -20-3 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する 4 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する
' コンボボックス ( レベル ) がクリックされた時の処理 Private Sub cbolevel_selectedindexchanged( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles cbolevel.selectedindexchanged LV = cbolevel.selectedindex + 1 tmrgame.interval = 50 * ( 3 / LV ) ' キーが押された時の処理 Private Sub volleyball_keydown( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyDown Select Case e.keycode Case Keys.I If K1 = 0 Then K1 = 1 : P1 = 30 Case Keys.J X1 = X1 + ( X1 > 256 ) * 2 Case Keys.L X1 = X1 - ( X1 < 480 ) * 2 Case Keys.K Q1 = 5 If ( Math.Abs( X1 X ) < 32 ) And ( Math.Abs( Y1 Y ) < 32 ) Then XP = -( X1 X ) / 1.5 * ( 1 - K1 ) - 32 * K1 YP = 30-25 * K1 Case Keys.W If K2 = 0 Then K2 = 1 : P2 = 30 Case Keys.A X2 = X2 + ( X2 > 0 ) * 2 Case Keys.D X2 = X2 - ( X2 < 224 ) * 2 Case Keys.S Q2 = 5 If ( Math.Abs( X2 - X ) < 32 ) And ( Math.Abs( Y2 Y ) < 32 ) Then XP = -( X2 - X ) / 1.5 * ( 1 - K2 ) - 32 * K2 YP = 30-25 * K2 End Select ' タイマーが一定間隔で自動的に行う処理 Private Sub tmrgame_tick( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles tmrgame.tick ' 亀の処理 KA = KA - 1 : If KA < 0 Then KA = 576 picturtle.image = Turtle( KA Mod 2 ) picturtle.left = KA - 64 ' 烏賊の処理 If K1 = 1 Then Y1 = Y1 - P1 : P1 = P1-2 : If P1 < -30 Then K1 = 0 If Q1 > 0 Then Q1 = Q1-1 picsquid.image = Squid( Math.Sign( Q1 )) picsquid.location = New Point( X1, Y1 ) ' 蛸の処理 If K2 = 1 Then Y2 = Y2 - P2 : P2 = P2-2 : If P2 < -30 Then K2 = 0 If Q2 > 0 Then Q2 = Q2-1 picoctopus.image = Octopus( Math.Sign( Q2 )) -21-5 デザイン画面で コンボボックスをダブルクリックして コード画面を表示し 左記のコードを入力する 6 フォームのイベント一覧より KeyDown イベントをダブルクリックして 左記のコードを入力する 7 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する
picoctopus.location = New Point( X2, Y2 ) ' ボールの処理 X = X + XP : Y = Y - YP - 2 : If YP > -24 Then YP = YP - 2 picball.location = New Point( X, Y ) picshadow.location = New Point( X, 308 ) If Y > 300 Then If X < 256 Then S1 = S1 + 1 : lblscore0. = S1.ToString( ) : X = 32 If S1 > 9 Then tmrgame.enabled = False MsgBox( " 烏賊の勝ち!", MsgBoxStyle.Information, " 試合終了 " ) btnstart.enabled = True : cbolevel.enabled = True Exit Sub Else S2 = S2 + 1 : lblscore1. = S2.ToString( ) : X = 448 If S2 > 9 Then tmrgame.enabled = False MsgBox( " 蛸の勝ち!", MsgBoxStyle.Information, " 試合終了 " ) btnstart.enabled = True : cbolevel.enabled = True Exit Sub Y = 296 X1 = 464 : Y1 = 296 : X2 = 16 : Y2 = 296 K1 = 0 : P1 = 0 : K2 = 0 : P2 = 0 XP = 0 : YP = 12 ElseIf X < 0 Or X > 479 Then XP = XP * ( -1 ) End Class -22-
バイオリズム VB 2005 22 プログラムの概要 体のリズムを知る バイオリズム プログラムで有る 体のリズムは 身体 感情 知性の 3 種のリズムから出来て居て 此等は一定の周期で 高調期と低調期を繰り返す 此等のリズムは 一定の周期で繰り返されるので 明日や更に先の自分のコンディションを前以て知る事が出来る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -23-
オブジェクト プロパティ一覧 ラベル 1 上段 : ラベル 2 3 4 5 下段 : ラベル 6 7 8 パネル 適宜作成 上段 : テキストボックス 1 下段 : テキストボックス 2 上段 : コンボボックス 1 3 下段 : コンボボックス 2 ボタン 1 ボタン 2 ピクチャボックス コントロールの種類 プロパティ プロパティの設定値 フォーム Name biorhythm FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen バイオリズム ラベル1 Name lbltitle HG 創英角ホ ッフ 体 24 標準 バイオリズムプログラム ラベル2 Name lblbirthday MS 明朝 12 太字 誕生日西暦 ラベル3 Name lblyearb MS 明朝 12 太字 年 ラベル4 Name lblmonthb MS 明朝 12 太字 月 ラベル5 Name lbldayb MS 明朝 12 太字 日 -24-
コントロールの種類 プロパティ プロパティの設定値 ラベル6 Name lbltarget MS 明朝 12 太字 表示月西暦 ラベル7 Name lblyeart MS 明朝 12 太字 年 ラベル8 Name lblmontht MS 明朝 12 太字 月 テキストボックス1 Name txtyearb MS 明朝 12 太字 自分の誕生年 Align Right テキストボックス2 Name txtyeart MS 明朝 12 太字 空白 Align Right コンボボックス1 Name cbomonthb MS 明朝 12 太字 Items 1~12 自分の誕生月 コンボボックス2 Name cbomontht MS 明朝 12 太字 Items 1~12 空白 コンボボックス3 Name cbodayb MS 明朝 12 太字 Items 1~31 自分の誕生日 ボタン1 Name btnstart MS 明朝 11 太字 表示 ボタン2 Name btnfinish MS 明朝 11 太字 終了 ピクチャボックス Name picdisp Black Size 621, 211 パネル Name pnlexplain 適宜作成 肉体面は赤感情面は緑 知性面は青 -25-
プログラムリスト Public Class biorhythm Private Const PI As Single = 3.14159 / 180 Private WI(2) As Integer Private CL(2) As Color Private TMD As Integer Private BM As Bitmap Private GR As Graphics ' 表示画面を初期化するジェネラルサブプロシージャ Private Sub BaseScreen( ) Dim I, X, Y, M As Integer Dim S As DateTime Dim H As Single 1 コード記述画面を表示して左記のコードを入力する 2 ' 表示月の日数の設定 Y = Val( txtyeart. ) M = Val( cbomontht. ) S = New DateTime( Y, M, 1 ) TMD = DateTime.DaysInMonth( Y, M ) ' グラフ枠の描画 H = 620 / TMD GR.Clear( Color.Black ) GR.DrawRectangle( Pens.White, 0, 0, 620, 210 ) For I = 1 To TMD X = ( I - 1 ) * H GR.DrawLine( Pens.White, X, 0, X, 210 ) GR.DrawString( I.ToString( "00" ), Me., Brushes.White, X + 5, 1 ) Next GR.DrawLine( Pens.White, 0, 10, 620, 10 ) GR.DrawLine( Pens.White, 0, 110, 620, 110 ) picdisp.refresh( ) ' フォームが読み込まれた時の処理 Private Sub biorhythm_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' Graphics オブジェクトの生成 With picdisp BM = New Bitmap(.Width,.Height ).Image = BM GR = Graphics.FromImage(.Image ) End With ' 画面の表示 txtyeart. = DateTime.Now.ToString( "yyyy" ) cbomontht.selectedindex = DateTime.Now.Month - 1 Call BaseScreen( ) ' 周期と描色の設定 WI( 0 ) = 23 : WI( 1 ) = 28 : WI( 2 ) = 33 CL( 0 ) = Color.Red : CL( 1 ) = Color.Green : CL( 2 ) = Color.Blue 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する 3 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する -26-
' ボタン ( 表示 ) がクリックされた時の処理 Private Sub btnstart_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnstart.click Dim WS( 2 ), DN, I, J As Integer Dim ST, PX, PY As Single ' 入力の検証と変数への代入 Dim Y1 As Integer = Val( txtyearb. ) : If Y1 = 0 Then Exit Sub Dim M1 As Integer = Val( cbomonthb. ) : If M1 = 0 Then Exit Sub Dim D1 As Integer = Val( cbodayb. ) : If D1 = 0 Then Exit Sub Dim Y2 As Integer = Val( txtyeart. ) : If Y2 = 0 Then Exit Sub Dim M2 As Integer = Val( cbomontht. ) : If M2 = 0 Then Exit Sub ' グラフ枠の描画 Call BaseScreen( ) ' 誕生日から表示月の朔日迄の日数の算出 Dim SD As DateTime = New DateTime( Y1, M1, D1 ) Dim ED As DateTime = New DateTime( Y2, M2, 1 ) DN = ( ED - SD ).Days 4 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する ' 位相の算出 (0: 肉体面 -Physical 1: 感情面 -Sensitivity 2: 知性面 -Intellectual) For I = 0 To 2 : WS( I ) = DN Mod WI( I ) : Next ' バイオリズムの描画 For I = 0 To 2 ST = ( 620 * ( WI( I ) / TMD )) / 360 PX = ( 620 / TMD ) * WS(I) - ST * 360 For J = -360 To 720 PY = 110 - Math.Sin( J * PI ) * 90 If ( PX > 1 And PX < 619 ) And ( PY > 1 And PY < 209 ) Then BM.SetPixel( PX, PY, CL( I )) If System.Convert.ToInt32( PY ) = 110 Then GR.FillEllipse( New SolidBrush( CL( I )), PX - 3, PY - 3, 7, 7 ) PX = PX + ST Next Next picdisp.refresh( ) ' ボタン ( 終了 ) がクリックされた時の処理 Private Sub btnfinish_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnfinish.click Me.Dispose( ) End End Class 5 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する -27-
ポップ君の山登り VB 2005 23 プログラムの概要 面クリア型のパズルゲーム ポップ君の山登り で有る 画面右欄に表示されるキー操作 ( 押すキーと移動先の関係を示す ) に従い ポップ君を山の頂上に導く事が出来れば 面クリアで有る 但し 1 段下には降りる事が出来るが 2 段下には降りる事は出来ない 亦 岩は 1 個なら押す事が出来るが 引っ張る事は出来ない 全 33 面が用意されて居る 面データを解析し 新しい面作成に挑戦して欲しい 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -28-
オブジェクト プロパティ一覧 ラベル 1 ラベル 2 パネル ボタン 1 ピクチャボックス 1 ピクチャボックス2 ピクチャボックス3 ピクチャボックス4 ピクチャボックス5 ラベル3 ラベル4 ラベル5 ラベル6 ボタン2 ピクチャボックス 6 コントロールの種類 プロパティ プロパティの設定値 フォーム Name climbing Black FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen ポップ君の山登り パネル Name pnlback BackgroundImage sky.gif Size 644, 416 ピクチャボックス1 Name picsheet Transparent Size 644, 416 ピクチャボックス2 Name picpop Transparent Image left.gif Size 28, 32 ラベル1 Name lblclear Transparent MS 明朝 20 太字 ForeColor Red クリア!! ラベル2 Name lbltitle Transparent MS 明朝 14 太字 ForeColor White ポップ君の山登り -29-
コントロールの種類 プロパティ プロパティの設定値 ラベル3 Name lblsheet AutoSize False Transparent MS 明朝 14 太字 ForeColor White Size 161, 19 第 1 面 Align MiddleCenter ラベル4 Name lblkeyoperation Transparent MS 明朝 14 太字 ForeColor White キー操作 ラベル5 Name lblexplain AutoSize False Transparent MS 明朝 18 太字 ForeColor White 図の様に記述する ラベル6 Name lblescape Transparent MS 明朝 9 太字 ForeColor White ESCキーで遣り直し ピクチャボックス3 Name picleft Transparent Image left.gif Size 28, 32 ピクチャボックス4 Name picright Transparent Image right.gif Size 28, 32 ピクチャボックス5 Name picmountain Transparent Image mountain.gif Size 28, 32 ピクチャボックス6 Name picrock Transparent Image rock.gif Size 28, 32 ボタン1 Name BtnTest テスト Visible False ボタン2 Name btnnext 次へ -30-
プログラムリスト Public Class climbing Private Const MAX As Integer = 33 Private Sdata( MAX - 1 ) As String ' 面データ Private BD( 22, 13 ) As Integer ' 仮想画面 Private Mcnt As Integer ' 山の数 Private Rcnt As Integer ' 岩の数 Private PX As Integer ' ポップ君のX 座標 Private PY As Integer ' ポップ君のY 座標 Private Sheet As Integer ' 面番号 Private Pt As String ' 起動パス Private G As Graphics 1 コード記述画面を表示して左記のコードを入力する ' フォームが読み込まれた時の処理 Private Sub climbing_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load Dim F As String Dim I As Integer ' データパスの設定 Pt = Application.StartupPath : If Not Pt.EndsWith( " " ) Then Pt &= " " ' 面データの読込 F = Pt & "climbing.dat" FileOpen( 1, F, OpenMode.Input ) For I = 0 To ( MAX - 1 ) Sdata( I ) = LineInput( 1 ) Next I FileClose( 1 ) ' 仮想画面の初期設定 For I = 0 To 22 : BD( I, 0 ) = 2 : BD( I, 13 ) = 2 : Next I For I = 1 To 12 : BD( 0, I ) = 2 : BD( 22, I ) = 2 : Next I Mcnt = 0 : Rcnt = 0 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する ' Graphics オブジェクトの生成 With picsheet.image = New Bitmap(.Width,.Height ) G = Graphics.FromImage(.Image ) End With ' 第 1 面の表示 Sheet = 1 : Call DispSheet( ) ' 画面表示テスト Private Sub btntest_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btntest.click Sheet += 1 : If Sheet > 33 Then Sheet = 1 Call DispSheet( ) -31-3 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する
' フォーム上でキー入力が為された時の処理 Private Sub climbing_keyup( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyUp Dim X, Y, I, B As Integer Dim F, S As String Dim R As Boolean ' キー入力の判定 Select Case e.keycode Case Keys.D1, Keys.NumPad1 If Not BD( PX - 1, PY ) = 2 Then If BD( PX - 1, PY ) = 1 Then If Not BD( PX - 1, PY - 1 ) = 1 Then If BD( PX - 2, PY ) = 0 Then X = PX - 1 : Y = PY : Call DelRock( X, Y ) BD( PX - 1, PY ) = 0 : BD( PX - 2, PY ) = 1 X = X - 1 : G.DrawImage( picrock.image, X * 28, Y * 32 ) picsheet.refresh( ) PX = PX - 1 : Call DispPop( 0 ) Do While BD( X, Y + 1 ) = 0 Call DelRock( X, Y ): BD( X, Y ) = 0 : BD( X, Y + 1 ) = 1 Y = Y + 1 : G.DrawImage( picrock.image, X * 28, Y * 32 ) picsheet.refresh( ) Loop Else If BD( PX - 1, PY + 1 ) > 0 Then PX = PX - 1 : Call DispPop( 0 ) Else If BD( PX - 1, PY + 2 ) > 0 Then PX = PX - 1 : PY = PY + 1 : Call DispPop( 0 ) Case Keys.D2, Keys.NumPad2 If Not BD( PX + 1, PY ) = 2 Then If BD( PX + 1, PY ) = 1 Then If Not BD( PX + 1, PY - 1 ) = 1 Then If BD( PX + 2, PY ) = 0 Then X = PX + 1 : Y = PY : Call DelRock( X, Y ) BD( PX + 1, PY ) = 0 : BD( PX + 2, PY ) = 1 X = X + 1 : G.DrawImage( picrock.image, X * 28, Y * 32 ) picsheet.refresh( ) PX = PX + 1 : Call DispPop( 1 ) Do While BD( X, Y + 1 ) = 0 Call DelRock( X, Y ): BD( X, Y ) = 0 : BD( X, Y + 1 ) = 1 Y = Y + 1 : G.DrawImage( picrock.image, X * 28, Y * 32 ) picsheet.refresh( ) Loop Else If BD( PX + 1, PY + 1 ) > 0 Then PX = PX + 1 : Call DispPop( 1 ) Else -32-4 フォームのイベント一覧より KeyUp イベントをダブルクリックして 左記のコードを入力する
If BD( PX + 1, PY + 2 ) > 0 Then PX = PX + 1 : PY = PY + 1 : Call DispPop( 1 ) Case Keys.D4, Keys.NumPad4 If BD( PX, PY 1 ) = 0 Then If BD( PX - 1, PY ) > 0 Then If BD( PX - 1, PY - 1 ) = 0 Then PX = PX - 1 : PY = PY - 1 : Call DispPop( 0 ) Case Keys.D5, Keys.NumPad5 If BD( PX, PY - 1 ) = 0 Then If BD( PX + 1, PY ) > 0 Then If BD( PX + 1, PY 1 ) = 0 Then PX = PX + 1 : PY = PY - 1 : Call DispPop( 1 ) Case Keys.D7, Keys.NumPad7 If BD( PX, PY 2 ) = 0 Then If BD( PX, PY 1 ) = 0 Then If BD( PX - 1, PY - 1 ) > 0 Then If BD( PX - 1, PY - 2 ) = 0 Then PX = PX - 1 : PY = PY - 2 : Call DispPop( 0 ) Case Keys.D8, Keys.NumPad8 If BD( PX, PY - 2 ) = 0 Then If BD( PX, PY - 1 ) = 0 Then If BD( PX + 1, PY - 1 ) > 0 Then If BD( PX + 1, PY - 2 ) = 0 Then PX = PX + 1 : PY = PY - 2 : Call DispPop( 1 ) Case Keys.Escape: Call DispSheet( ) Case Keys.T: btntest.visible = True End Select ' 面クリアの判定 If PY = 1 Then lblclear. = " クリア!!" For I = 1 To 3 lblclear.visible = True : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) lblclear.visible = False : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Next I If Sheet < MAX Then btnnext.enabled = True -33-
' ボタン ( 次へ ) がクリックされた時の処理 Private Sub btnnext_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnnext.click btnnext.enabled = False: Sheet += 1 : If Sheet > MAX Then Exit Sub Call DispSheet( ) ' 面を表示するジェネラルプロシージャ Private Sub DispSheet( ) Dim D( ) As String Dim I, J, C, X, Y As Integer ' 面番号の表示 lblsheet. = StrConv( " 第 " & CStr( Sheet ) & " 面 ", VbStrConv.Wide ) ' 仮想画面の初期化 For I = 1 To 21 : For J = 2 To 11 : BD( I, J ) = 0 : Next J : Next I If Sheet > 27 Then For I = 1 To 21 : BD( I, 12 ) = 0 : Next I Else For I = 1 To 21 : BD( I, 12 ) = 2 : Next I ' 面データの設定 D = Split( Sdata( Sheet - 1 ), "." ) ' 山の設定と表示 Mcnt = D( 0 ) : C = 1 : G.Clear( Color.Transparent ) For I = 1 To Mcnt X = D( C ) : Y = D( C + 1 ) : BD( X, Y ) = 2 : C += 2 G.DrawImage( picmountain.image, X * 28, Y * 32 ) Next I If Sheet < 28 Then For I = 1 To 21: G.DrawImage(picMountain.Image, I * 28, 12 * 32): Next ' 岩の設定と表示 Rcnt = D( C ) : C += 1 For I = 1 To Rcnt X = D( C ) : Y = D( C + 1 ) : BD( X, Y ) = 1 : C += 2 G.DrawImage( picrock.image, X * 28, Y * 32 ) Next I picsheet.refresh( ) ' ポップ君の設定と表示 PX = D( C ) : PY = D( C + 1 ) : Call DispPop( 0 ) ' ポップ君を表示するジェネラルプロシージャ Private Sub DispPop( ByRef N As Integer ) picpop.location = New Point( PX * 28, PY * 32 ) If N = 0 Then picpop.image = picleft.image Else picpop.image = picright.image ' 岩を消去するジェネラルプロシージャ Private Sub DelRock( ByVal X As Integer, ByVal Y As Integer ) G.Clip = New Region( New Rectangle( X * 28, Y * 32, 28, 32 )) G.Clear( Color.Transparent ) 8 6に同じ G.Clip = New Region( New Rectangle( 0, 0, 644, 416 )) End Class -34-5 3 に同じ 6 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する 7 6 に同じ
バウンドゴルフ VB 2005 24 プログラムの概要 枠に当たるとボールが跳ね返るゴルフゲーム バウンドゴルフ です メニューバーの ゲーム から スタート をクリックするか F5 キーを押すと ゲームがスタートする ボールが表示されると 左右の矢印キーを用いて ボールを飛ばす方向を決め スペースを押す ボールを打つ力を加減するゲージが表示されるので 適当な強さに成ればスペースを押す 池 ( 水色 ) に落ちたり カラスにボールを奪われると 持ち球が減る 猶 ゲームの難易度を 易しい に設定すると グリーン ( 黄色 ) にボールが乗ると グリーンが拡大表示されて パッティングが容易に成る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -35-
オブジェクト プロパティ一覧 メニュー ラベル 1 ピクチャボックス 1~5 ラベル 2 グループボックス 1 ラベル 3 グループボックス 2 ラベル 5 パネル グループボックス 3 ラベル 6 ラベル 4 グループボックス 4 ラベル 7 ピクチャボックス 9 ピクチャボックス 10 ピクチャボックス 6 ピクチャボックス 7 ピクチャボックス 8 タイマー 1 タイマー 2 タイマー 3 コントロールの種類 プロパティ プロパティの設定値 フォーム Name golf FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Size 490, 440 バウンドゴルフ グループボックス1 Name grptitle 空白 ラベル1 Name lbltitle MS 明朝 18 太字 バウンドゴルフ ラベル2 Name lblhole MS 明朝 16 太字 1 ラベル3 Name lblmes MS 明朝 12 太字 番ホール -36-
コントロールの種類 プロパティ プロパティの設定値 ピクチャボックス1~5 Name picrest0 ~ picrest4 Image ball.gif Size 16, 16 Visible False パネル Name pnlgd Fuchsia Size 350, 318 ピクチャボックス6 Name piccrow Transparent Image crow0.gif Size 32, 16 ピクチャボックス7 Name picdir Transparent Image arrow0.gif Size 16, 16 ピクチャボックス8 Name picball Transparent Image ball.gif Size 16, 16 ラベル4 Name lblmessage AutoSize False MS 明朝 14 太字 Size 290, 21 空白 Align MiddleCenter ピクチャボックス9 Name picpower White BorderStyle FixedSingle Size 15, 318 ピクチャボックス10 Name piccharactor White Image aya.jpg Size 81, 185 SizeMode Zoom グループボックス2 Name grpscore MS 明朝 8 太字 スコア ラベル5 Name lblscore AutoSize False MS 明朝 10 太字 Size 57, 13 Align 空白 MiddleRight グループボックス3 Name grppat MS 明朝 8 太字 パット数 -37-
コントロールの種類 プロパティ プロパティの設定値 ラベル6 Name lblpat AutoSize False MS 明朝 10 太字 Size 57, 13 Align 空白 MiddleRight グループボックス4 Name grpper MS 明朝 8 太字 パー数 ラベル7 Name lblper AutoSize False MS 明朝 10 太字 Size 57, 13 Align 空白 MiddleRight タイマー 1 Name tmrcrow Interval 100 タイマー 2 Name tmrpow Interval 50 タイマー 3 Name tmrdir Interval 100 メニューストリップ Name mnugolf Items Name mnufile mnugame mnuhelp ファイル (&F) ゲーム (&G) ヘルプ (&H) Name DropDownItems ShortcutKeys mnufile mnufilefinish Ctrl+Q 終了 (&X) mnugame mnugamestart F5 スタート (&S) mnugameline mnugamelebel 難易度 (&L) mnuhelp mnuhelpindex Ctrl+H 目次 (&C) mnuhelpline mnuhelpversion バージョン情報 (&V) Name DropDownItems ShortcutKeys mnugamelebel mnugameleveleasy Ctrl+E 易しい (&E) mnugameleveldifficult Ctrl+D 難しい (&D) メニューバーの作成 メニューバーを作成するには 先ず ツールボックス ( メニューとツールバーのカテゴリ ) で MenuStrip コントロールをダブルクリックして フォームに追加する 猶 オブジェクト名は プロパティ欄で設定する事が出来る -38-
プログラムリスト Public Class golf ' 領域を塗り潰す API 関数の宣言 Private Declare Function ExtFloodFill Lib "gdi32" ( _ ByVal hdc As Integer, _ ByVal X As Integer, ByVal Y As Integer, _ ByVal crcolor As Integer, ByVal wfilltype As Integer _ ) As Integer Private Const FLOODFILLBORDER As Short = 0 Private Const FLOODFILLSURFACE As Short = 1 ' フォームレベルでグローバルな変数の宣言 Private PT As String Private ND As Short Private G As Graphics Private B As Bitmap Private ImgD( 7 ) As Bitmap Private ImgC( 1 ) As Bitmap Private Gp As Graphics Private HL As Integer Private SC As Integer Private BO As Integer Private PU As Integer Private PA As Integer Private HX As Integer Private HY As Integer Private CX As Integer Private CY As Integer Private SX As Integer Private SY As Integer Private DR As Integer Private FX As Integer Private FY As Integer Private KF As Integer Private PW As Integer Private DF As Integer ' ホール番号 ' スコア ' ボール数 ' パット数 ' パー数 ' ホールX 座標 ' ホールY 座標 ' カラスX 座標 ' カラスY 座標 ' ボールX 座標 ' ボールY 座標 ' 飛行方向 ' 横飛行方向 ' 縦飛行方向 ' キーフラグ ' パワー ' 難易度 1 コード記述画面を表示して左記のコードを入力する ' メニュー ( レベル - 難しい ) がクリックされた時の処理 Public Sub mnugameleveldifficult_click( ByVal eventsender As System.Object, _ ByVal eventargs As System.EventArgs ) Handles mnugameleveldifficult.click DF = 1 mnugameleveleasy.checked = False mnugameleveldifficult.checked = True ' メニュー ( レベル- 易しい ) がクリックされた時の処理 Public Sub mnugameleveleasy_click( ByVal eventsender As System.Object, _ ByVal eventargs As System.EventArgs ) Handles mnugameleveleasy.click DF = 0 mnugameleveleasy.checked = True mnugameleveldifficult.checked = False -39-2 デザイン画面で メニュー項目をダブルクリックして コード画面を表示し 左記のコードを入力する 3 デザイン画面で メニュー項目をダブルクリックして コード画面を表示し 左記のコードを入力する
' フォームが読み込まれた時の処理 Private Sub golf_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load PT = Application.StartupPath : If Not PT.EndsWith( " " ) Then PT &= " " For I As Integer = 0 To 7 ImgD( I ) = New Bitmap( "arrow" & I.ToString( ) & ".gif" ) Next For I As Integer = 0 To 1 ImgC( I ) = New Bitmap( "crow" & I.ToString( ) & ".gif" ) Next With pnlgd B = New Bitmap(.Width,.Height ).BackgroundImage = B G = Graphics.FromImage(.BackgroundImage ) End With With picpower.image = New Bitmap(.Width,.Height ) Gp = Graphics.FromImage(.Image ) End With Call FormInit( ) ' フォームの閉じるがクリックされた時の処理 Private Sub golf_formclosing( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs ) Handles Me.FormClosing Call mnufilefinish_click( mnufilefinish, New System.EventArgs( )) ' キー入力が為された時の処理 Private Sub golf_keydown( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyDown Dim K As Integer = e.keycode ' 方向決定の場合 If KF = 1 Then If DF = 0 Then If K = Keys.Space Then KF = -1 ElseIf K = Keys.Right Then DR = DR + 1 : If DR > 7 Then DR = 0 Call DispDir( ) ElseIf K = Keys.Left Then DR = DR - 1 : If DR < 0 Then DR = 7 Call DispDir( ) Else If K = Keys.Space Then tmrdir.enabled = False: KF = -1 ' パワー決定の場合 ElseIf KF = 2 Then If K = Keys.Space Then tmrpow.enabled = False: KF = -1-40- 4 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する 5 フォームのイベント一覧より FormClosing イベントをダブルクリックして 左記のコードを入力する 6 フォームのイベント一覧より KeyDown イベントをダブルクリックして 左記のコードを入力する
' メニュー ( 終了 ) がクリックされた時の処理 Private Sub mnufilefinish_click( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles mnufilefinish.click If tmrdir.enabled = True Then tmrdir.enabled = False If tmrpow.enabled = True Then tmrpow.enabled = False If tmrdir.enabled = True Then tmrdir.enabled = False Application.Exit( ) ' メニュー ( スタート ) がクリックされた時の処理 Private Sub mnugamestart_click( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles mnugamestart.click 7 デザイン画面で メニュー項目をダブルクリックして コード画面を表示し 左記のコードを入力する Call VarInit( ) lbltitle.visible = False lblhole.visible = True lblmes.visible = True For I As Integer = 0 To 4 Me.grpTitle.Controls( "picrest" & I.ToString( )).Visible = True Next I lblmessage.visible = False Do Until HL > 9 Call GameLoop( ) If tmrcrow.enabled = True Then tmrcrow.enabled = False piccrow.visible = False picball.visible = False Loop Call DispBall( ) If BO > 0 Then lblmessage. = " ホールアウト " Else lblmessage. = " ボールが無く成りました!" lblmessage.visible = True 8 デザイン画面で メニュー項目をダブルクリックして コード画面を表示し 左記のコードを入力する ' タイマ ( カラス ) が一定間隔で自動的に行う処理 Private Sub tmrcrow_tick( ByVal eventsender As System.Object, _ ByVal eventargs As System.EventArgs ) Handles tmrcrow.tick Static CF As Integer CX = CX - 2 : If CX < -16 Then CX = 480 piccrow.image = ImgC( CF ) piccrow.location = New Point( CX, CY ) CF = CF Xor 1 9 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する ' タイマ ( 方向決定 ) が一定間隔で自動的に行う処理 Private Sub tmrdir_tick( ByVal eventsender As System.Object, _ ByVal eventargs As System.EventArgs ) Handles tmrdir.tick Call DispDir( ) DR = DR + 1 : If DR > 7 Then DR = 0 10 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する -41-
' タイマ ( パワー決定 ) が一定間隔で自動的に行う処理 Private Sub tmrpow_tick( ByVal eventsender As System.Object, _ ByVal eventargs As System.EventArgs ) Handles tmrpow.tick Gp.FillRectangle( Brushes.Red, 0, CInt( 318 - ( 318 / 200 ) * PW ), 15, 318 ) picpower.refresh( ) PW = PW + 10 : If PW > 200 Then PW = 0 : Gp.Clear( Color.White ) '======================= ' ジェネラルプロシージャ '======================= ' 画面を初期化するジェネラルプロシージャ Private Sub FormInit( ) ' グランドの描画 G.Clear( Color.Fuchsia ) G.FillRectangle( Brushes.White, 4, 4, 342, 310 ) G.FillRectangle( Brushes.DarkGreen, 8, 8, 334, 302 ) pnlgd.refresh( ) ' 難易度の設定 DF = 0 mnugameleveleasy.checked = True mnugameleveldifficult.checked = False ' 打撃方向を表示するジェネラルプロシージャ Private Sub DispDir( ) Dim X As Integer Dim Y As Integer Select Case DR Case 0, 4 FX = 0 : X = SX Case 1, 2, 3 FX = 1 : X = SX + 16 Case 5, 6, 7 FX = -1 : X = SX - 16 End Select Select Case DR Case 0, 1, 7 FY = -1 : Y = SY - 16 Case 2, 6 FY = 0 : Y = SY Case 3, 4, 5 FY = 1 : Y = SY + 16 End Select picdir.image = ImgD( DR ) picdir.location = New Point( X, Y ) ' 変数を初期化するジェネラルプロシージャ Private Sub VarInit( ) ' 変数の初期化 HL = 1 SC = 0 : Call DispScore( ) BO = 5 : Call DispBall( ) PU = 0 : Call DispPat( ) -42-11 デザイン画面で メニュー項目をダブルクリックして コード画面を表示し 左記のコードを入力する 12 此れ以降は 総てジェネラルプロシージャなので コード記述画面を表示して左記のコードを入力する
' 得点を表示するジェネラルプロシージャ Private Sub DispScore( ) Dim S As String If SC = 0 Then S = "±" ElseIf SC > 0 Then S = "+" Else S = "-" lblscore. = S & StrConv( CStr( System.Math.Abs( SC )), VbStrConv.Wide ) ' パット数を表示するジェネラルプロシージャ Private Sub DispPat( ) lblpat. = StrConv( CStr( PU ), VbStrConv.Wide ) ' パー数を表示するジェネラルプロシージャ Private Sub DispPer( ) lblper. = StrConv( CStr( PA ), VbStrConv.Wide ) ' ホール番号を表示するジェネラルプロシージャ Private Sub DispHole( ) lblhole. = StrConv( CStr( HL ), VbStrConv.Wide ) For I As Integer = 1 To 3 lblhole.forecolor = Color.Red : System.Threading.Thread.Sleep( 300 ) lblhole.forecolor = Color.Black : System.Threading.Thread.Sleep( 300 ) Next I ' 残りボールを表示するジェネラルプロシージャ Private Sub DispBall( ) For I As Integer = 0 To 4 Me.grpTitle.Controls( "picrest" & I.ToString( )).Visible = False Next I For I As Integer = 0 To ( BO - 1 ) Me.grpTitle.Controls( "picrest" & I.ToString( )).Visible = True Next I ' グランドを表示するジェネラルプロシージャ Private Sub DispGround( ) Dim F As String Dim D( ) As Byte Dim Z As Single Dim Q As Color Dim C, A, X, Y, R, I, J, W, H As Integer F = PT & "hole" & HL.ToString( "00" ) & ".bin" ReDim D( FileLen( F ) - 1 ) FileOpen( 1, F, OpenMode.Binary ) FileGet( 1, D ) FileClose( 1 ) G.FillRectangle( Brushes.DarkGreen, 8, 8, 334, 302 ) -43-
PA = D( 0 ) : Call DispPer( ) SX = D( 1 ) : SX = SX * 2-144 SY = D( 2 ) : SY = SY * 2-48 CY = D( 3 ) : CY *= 2 A = 1 For I = ( SY - 4 ) To ( SY + 18 ) For J = ( SX - 12 ) To ( SX + 26 ) Step 2 B.SetPixel( J + A, I, Color.LightBlue ) Next J A = A Xor 1 Next I C = 4 Do A = D( C ) : C += 1 If A = 0 Then Exit Do If A = 10 Then X = D( C ) : HX = X * 16-144 : C += 1 Y = D( C ) : HY = Y * 16-48 : C += 1 G.FillEllipse( Brushes.Yellow, HX - 16, HY - 16, 32, 32 ) G.FillEllipse( Brushes.Black, HX - 3, HY - 3, 7, 7 ) Else Select Case A Case 2 : Q = Color.FromArgb( 255, 0, 255, 0 ) ' Green Case 6 : Q = Color.FromArgb( 255, 139, 0, 0 ) ' DarkRed Case 7 : Q = Color.FromArgb( 255, 0, 255, 255 ) ' Cyan Case 14 : Q = Color.FromArgb( 255, 128, 128, 128 ) ' Gray End Select X = D( C ) : X = X * 16-144 : C += 1 Y = D( C ) : Y = Y * 16-48 : C += 1 R = D( C ) : R *= 4 : C += 1 Z = D( C ) : C += 1 : If Z > 10 Then Z /= 100 If Z < 1 Then W = R : H = R * Z Else W = R * ( 1 / Z ) : H = R G.FillEllipse( New SolidBrush( Q ), CInt( X - W / 2 ), CInt( Y - H / 2 ), W, H ) Loop pnlgd.refresh( ) ' ゲームのメインループのジェネラルプロシージャ Private Sub GameLoop( ) Dim BX As Integer ' ボールX 座標 ( 初期位置 ) Dim BY As Integer ' ボールY 座標 ( 初期位置 ) Dim KX As Integer ' ボールX 座標 ( ショット位置 ) Dim KY As Integer ' ボールY 座標 ( ショット位置 ) Dim SS As Integer ' ボール速度 Dim I, J As Integer ' ループ用 Dim C As Color ' 判定用 ( 色で判定 ) Call DispGround( ) Call DispHole( ) CX = 480 : BX = SX : BY = SY : PU = 0 : Call DispPat( ) piccrow.location = New Point( CX, CY ) : piccrow.visible = True : tmrcrow.enabled = True picball.location = New Point( SX, SY ) : picball.visible = True -44-
Do picdir.location = New Point( SX, SY - 16 ) : picdir.visible = True ' 方向の決定 KF = 1 : Me.KeyPreview = True DR = 0 : Call DispDir( ) : If DF = 1 Then tmrdir.enabled = True Do Until KF < 0 : Application.DoEvents( ) : Loop Me.KeyPreview = False Call DispDir( ) ' パワーの決定 KF = 2 : Me.KeyPreview = True PW = 0 : tmrpow.enabled = True Do Until KF < 0 : Application.DoEvents( ) : Loop Me.KeyPreview = False Gp.FillRectangle( Brushes.Red, 0, CInt( 318 - ( 318 / 200 ) * PW ), 15, 318 ) picpower.refresh( ) picdir.visible = False PU = PU + 1 : Call DispPat( ) ' ボールの移動 SS = PW : KX = SX : KY = SY For I = 1 To PW SX = SX + FX * 2 : If SX < 8 Or SX > 325 Then FX = FX * (-1) SY = SY + FY * 2 : If SY < 8 Or SY > 293 Then FY = FY * (-1) picball.location = New Point( SX, SY ) : Application.DoEvents( ) ' 判定 If ( Math.Abs( SX - CX ) < 8 ) And ( Math.Abs( SY - CY )) < 8 Then tmrcrow.enabled = False SX = CX - 16 : SY = CY : picball.location = New Point( SX, SY ) piccrow.image = ImgC( 1 ) For J = CX To -16 Step -4 SX = J - 16 : picball.location = New Point( SX, SY ) CX = J : piccrow.location = New Point( CX, CY ) Application.DoEvents( ) System.Threading.Thread.Sleep( 50 ) Next J BO = BO - 1 : If BO = 0 Then BO = -1 : HL = 10 : Exit Sub Cal l DispBall( ) SX = BX : SY = BY : CX = 480 piccrow.location = New Point( CX, CY ) : tmrcrow.enabled = True picball.location = New Point( SX, SY ) Exit For Else C = B.GetPixel( SX + 8, SY + 8 ) Select Case C Case Color.FromArgb( 255, 0, 0, 0 ), Color.Black ' ホール If SS < 50 Then If PU = 1 Then lblmessage. = " ホールインワン!!" Else lblmessage. = " カップイン!" lblmessage.visible = True System.Threading.Thread.Sleep( 1000 ) Select Case ( PU - PA ) Case Is < -3: lblmessage. = " 嘘だろ!!" Case -3: lblmessage. = " アルバトロス " Case -2: lblmessage. = " イーグル " Case -1: lblmessage. = " バーディ " Case 0: lblmessage. = " パー " -45-
Case 1: lblmessage. = " ボギー " Case 2: lblmessage. = " ダブルボギー " Case 3: lblmessage. = " トリプルボギー " Case Else: lblmessage. = " 何んだ コリャ!!" End Select Application.DoEvents( ) System.Threading.Thread.Sleep( 2000 ) lblmessage.visible = False SC = SC + ( PU - PA ) : Call DispScore( ) HL = HL + 1 Exit Sub Case Color.FromArgb( 255, 255, 255, 0 ), Color.Yellow ' グリーン If ( SS < 50 ) And ( DF = 0 ) Then G.FillRectangle( Brushes.LightGreen, 4, 4, 342, 310 ) G.FillEllipse( Brushes.Black, 164, 148, 20, 20 ) SX = (( SX + 8 ) - HX ) * 8 + 174 : SY = (( SY + 8 ) - HY ) * 8 + 158 picball.location = New Point( SX, SY ) pnlgd.refresh( ) Exit For Case Color.FromArgb( 255, 139, 0, 0 ), Color.DarkRed ' 林 If SS < 70 Then SX = SX + ( Int( Rnd( ) * 3 ) - 1 ) * 6 : FX = Int( Rnd( ) * 3 ) - 1 If SX < 8 Then SX = 8 : FX = 1 If SX > 325 Then SX = 325 : FX = -1 SY = SY + ( Int( Rnd( ) * 3 ) - 1 ) * 6 : FY = Int( Rnd( ) * 3 ) - 1 If SY < 8 Then SY = 8 : FY = 1 If SY > 325 Then SY = 325 : FY = -1 picball.location = New Point( SX, SY ) Case Color.FromArgb( 255, 128, 128, 128 ), Color.Gray ' バンカー If SS < 80 Then lblmessage. = " バンカー!" : lblmessage.visible = True Application.DoEvents() System.Threading.Thread.Sleep( 2000 ) lblmessage.visible = False Exit For Case Color.FromArgb( 255, 0, 255, 255 ), Color.Cyan ' 池 If SS < 60 Then lblmessage. = " 池に落ちた!" : lblmessage.visible = True Application.DoEvents( ) System.Threading.Thread.Sleep( 2000 ) lblmessage.visible = False BO = BO - 1 : If BO = 0 Then BO = -1 : HL = 10 : Exit Sub Call DispBall( ) SX = KX : SY = KY : picball.location = New Point( SX, SY ) Exit For End Select SS -= 1 System.Threading.Thread.Sleep( 30 ) Next I Loop End Class -46-
三目並べ VB 2005 25 プログラムの概要 非常に単純なコンピュータ対戦型のボードゲーム 三目並べ です 画面上の 開始 をクリックすると 先手後手を決める画面が表示されるので 停止 をクリックする 後は 手番の時に桝目をクリックして 縦 横 斜めの孰れかに三目並べれば勝ちで有る 先手は 絶対に負けない一手が有り 非常に単純なゲームで有るが 五目並べや立体三目並べの原型と成るゲームで有る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -47-
オブジェクト プロパティ一覧 パネル ピクチャボックス ラベル ボタン 2 ボタン 1 タイマー コントロールの種類 プロパティ プロパティの設定値 フォーム Name three Green FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen 3 目並べ ピクチャボックス Name picboard Size 181, 181 ボタン1 Name btnstart Lime MS 明朝 12 太字 開始 パネル Name pnlturn 192, 255, 255( 薄水色 ) MS 明朝 12 太字 ForeColor White ボタン2 Name btnstop Cyan( 水色 ) MS 明朝 12 太字 停止 タイマー Name tmrturn Enabled False Interval 100-48-
プログラムリスト Public Class three ' フォームクラスレベルでグローバルな変数の宣言 Private G As Graphics Private F As Boolean = False Private C, T, X( 8 ), W( 8 ) As Integer 1 コード記述画面を表示して左記のコードを入力する ' フォームが読み込まれた時の処理 Private Sub three_load( ByVal sender As Object, ByVal e As System.EventArgs ) _ Handles Me.Load ' 描画の為の Graphics オブジェクトの生成 With picboard.image = New Bitmap(.Width,.Height ) G = Graphics.FromImage(.Image ) End With Call GameInit( ) ' ボタン ( 開始 ) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As Object, ByVal e As System.EventArgs ) _ Handles btnstart.click pnlturn.visible = True tmrturn.enabled = True ' タイマー ( 順番決定 ) が一定間隔で自動的に行う処理 Private Sub tmrturn_tick(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles tmrturn.tick Static N As Integer = 0 If N Mod 2 = 0 Then lblturn. = " 先手 " : T = 0 Else lblturn. = " 後手 " : T = 1 N += 1 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する 3 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する 4 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する ' ボタン ( 停止 ) がクリックされた時の処理 Private Sub btnstop_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnstop.click tmrturn.enabled = False System.Threading.Thread.Sleep( 1000 ) pnlturn.visible = False Call GameInit( ) F = True : C = 0 If T = 1 Then Call Computer( ) 5 デザイン画面で ボタンをダブルクリックして コード画面を表示し 左記のコードを入力する -49-
' ピクチャボックス ( 盤 ) でマウスをクリックした時の処理 Private Sub picboard_mouseup( ByVal sender As Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picboard.mouseup Dim K As Integer = ( e.x 60 ) + ( e.y 60 ) * 3 If Not F Then Exit Sub If Not Math.Abs( X( K )) = 1 Then 6 ピクチャボックスを選択し イベント画面に切り替え MouseUp の項目をダブルクリックして 左記のコードを入力する G.FillRectangle( Brushes.Red, ( K Mod 3 ) * 60 + 1, ( K 3 ) * 60 + 1, 59, 59 ) picboard.refresh( ) X( K ) = 1 : C += 1 : Call Judge( ) If F Then Call Computer( ) ' ゲームを初期化する自作メソッド Private Sub GameInit( ) G.Clear( Color.White ) For I As Integer = 0 To 180 Step 60 G.DrawLine( Pens.Black, I, 0, I, 180 ) G.DrawLine( Pens.Black, 0, I, 180, I ) Next picboard.refresh( ) For I As Integer = 0 To 8 : X( I ) = 0 : W( I ) = 0 : Next 7 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する ' 勝敗を判定する自作メソッド Private Sub Judge( ) Dim J As Integer = 0 If X( 0 ) + X( 1 ) + X( 2 ) = 3 Then J = 1 If X( 3 ) + X( 4 ) + X( 5 ) = 3 Then J = 1 If X( 6 ) + X( 7 ) + X( 8 ) = 3 Then J = 1 If X( 0 ) + X( 3 ) + X( 6 ) = 3 Then J = 1 If X( 1 ) + X( 4 ) + X( 7 ) = 3 Then J = 1 If X( 2 ) + X( 5 ) + X( 8 ) = 3 Then J = 1 If X( 0 ) + X( 4 ) + X( 8 ) = 3 Then J = 1 If X( 2 ) + X( 4 ) + X( 6 ) = 3 Then J = 1 If X( 0 ) + X( 1 ) + X( 2 ) = -3 Then J = 2 If X( 3 ) + X( 4 ) + X( 5 ) = -3 Then J = 2 If X( 6 ) + X( 7 ) + X( 8 ) = -3 Then J = 2 If X( 0 ) + X( 3 ) + X( 6 ) = -3 Then J = 2 If X( 1 ) + X( 4 ) + X( 7 ) = -3 Then J = 2 If X( 2 ) + X( 5 ) + X( 8 ) = -3 Then J = 2 If X( 0 ) + X( 4 ) + X( 8 ) = -3 Then J = 2 If X( 2 ) + X( 4 ) + X( 6 ) = -3 Then J = 2 8 上記 7 に引き続き コード記述画面を表示して 左記のコードを記述する If J = 1 Then MsgBox( " 貴方の勝ち!", MsgBoxStyle.Information, " 三目並べ " ) ElseIf J = 2 Then MsgBox( " 電脳の勝ち!", MsgBoxStyle.Information, " 三目並べ " ) ElseIf C = 9 Then MsgBox( " 引き分け " ) : J = 3 If J > 0 Then F = False -50-
' コンピュータの思考ルーチンと成る自作メソッド Private Sub Computer( ) Dim K As Integer = -1 If Not Math.Abs( X( 0 )) = 1 Then If Math.Abs( X( 1 ) + X( 2 )) = 2 Then K = 0 If Math.Abs( X( 3 ) + X( 6 )) = 2 Then K = 0 If Math.Abs( X( 4 ) + X( 8 )) = 2 Then K = 0 If Not Math.Abs( X( 1 )) = 1 Then If Math.Abs( X( 0 ) + X( 2 )) = 2 Then K = 1 If Math.Abs( X( 4 ) + X( 7 )) = 2 Then K = 1 If Not Math.Abs( X( 2 )) = 1 Then 9 If Math.Abs( X( 0 ) + X( 1 )) = 2 Then K = 2 If Math.Abs( X( 5 ) + X( 8 )) = 2 Then K = 2 If Math.Abs( X( 4 ) + X( 6 )) = 2 Then K = 2 上記 8に引き続 If Not Math.Abs( X( 3 )) = 1 Then き コード記述画 If Math.Abs( X( 4 ) + X( 5 )) = 2 Then K = 3 面を表示して 左 If Math.Abs( X( 0 ) + X( 6 )) = 2 Then K = 3 記のコードを記 述する If Not Math.Abs( X( 4 )) = 1 Then If Math.Abs( X( 3 ) + X( 5 )) = 2 Then K = 4 If Math.Abs( X( 1 ) + X( 7 )) = 2 Then K = 4 If Math.Abs( X( 0 ) + X( 8 )) = 2 Then K = 4 If Math.Abs( X( 2 ) + X( 6 )) = 2 Then K = 4 If Not Math.Abs( X( 5 )) = 1 Then If Math.Abs( X( 3 ) + X( 4 )) = 2 Then K = 5 If Math.Abs( X( 2 ) + X( 8 )) = 2 Then K = 5 If Not Math.Abs( X( 6 )) = 1 Then If Math.Abs( X( 7 ) + X( 8 )) = 2 Then K = 6 If Math.Abs( X( 0 ) + X( 3 )) = 2 Then K = 6 If Math.Abs( X( 2 ) + X( 4 )) = 2 Then K = 6 If Not Math.Abs( X( 7 )) = 1 Then If Math.Abs( X( 6 ) + X( 8 )) = 2 Then K = 7 If Math.Abs( X( 1 ) + X( 4 )) = 2 Then K = 7 If Not Math.Abs( X( 8 )) = 1 Then If Math.Abs( X( 6 ) + X( 7 )) = 2 Then K = 8 If Math.Abs( X( 2 ) + X( 5 )) = 2 Then K = 8 If Math.Abs( X( 0 ) + X( 4 )) = 2 Then K = 8 If K < 0 Then Dim N As Integer = 0 For I As Integer = 0 To 8 If X( I ) = 0 Then W( N ) = I : N += 1 Next K = W( Int( Rnd( ) * N )) G.FillRectangle( Brushes.Blue, ( K Mod 3 ) * 60 + 1, ( K 3 ) * 60 + 1, 59, 59 ) picboard.refresh( ) X( K ) = -1 : C += 1 : Call Judge( ) End Class -51-
じゃんけんロック VB 2005 26 プログラムの概要 面クリア型のパズルゲーム じゃんけんロック で有る 上下左右の矢印キーで 対応する方向にキャラクタを移動させる 但し 四角の固定ロックには移動する事は出来ない 荷物とじゃんけんロックは 押して移動する事が出来るが 引っ張る事は出来ない 亦 じゃんけんロックは ジャンケンの規則に従い 消去する事が出来る 例えばグーの岩をチョキの岩に押し付けると チョキの岩は消滅する 荷物を家に送り届ければ 面クリアで有る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -52-
オブジェクト プロパティ一覧 ラベル 1 ピクチャボックス 1~10 ボタン 6 ラベル 2 パネル 1 グループボックス 1 パネル 2 コンボボックス ボタン 1 ボタン 2 グループボックス 2 ボタン 4 グループボックス 3 ボタン 3 ボタン 5 コントロールの種類 プロパティ プロパティの設定値 フォーム Name JankenRock Green MS 明朝 9 標準 FormBorderStyle FixedSingle KeyPreview True MaximizeBox False StartPosition CenterScreen ジャンケンロック ラベル1 Name lblnumber AutoSize False Transparent MS 明朝 16 標準 ForeColor White 第 1 面 Align MiddleCenter パネル1 Name pnlground 0, 192, 0 Size 384, 384-53-
コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblclear AutoSize False Transparent MS 明朝 20 太字 ForeColor 255, 255, 192 クリア!! Align MiddleCenter パネル2 Name pnlselect Black Visible False グループボックス1 Name grpselect MS 明朝 10 太字 ForeColor White クリア面 コンボボックス Name cboselect ボタン1 Name btnok MS 明朝 11 太字 決定 ボタン2 Name btncancel MS 明朝 11 太字 キャンセル グループボックス2 Name grpoperation ForeColor White 操作 ボタン3 Name btnreplay Enabled False 再生 ボタン4 Name btnnext Enabled False 次へ グループボックス3 Name grpachieve ForeColor White 実績 ボタン5 Name btnselect クリア面の選択 ボタン6 Name btntest テスト Visible False ピクチャボックス1~10 Name picbase0 ~ picbase9 Transparent Image 上図の通り Size 32, 32 作成した後 フォームのサイズを変更して見えなくする -54-
プログラムリスト Public Class JankenRock Friend Const MAX As Integer = 59 1 Private BD( 58, 11 ) As String Private ST( 11, 11 ) As String Private NS As Integer Private CX As Integer Private CY As Integer Private DP As String Private G As Graphics ' 面データ ' ステージデータ ' 面番号 ' X 座標 ' Y 座標 ' データパス コード記述画面を表示して左記のコードを入力する Private KeyRec( 1000 ) As Integer ' キー入力記録 Private Kcnt As Integer ' キー入力数 Private ReplayMode As Boolean ' 再生モードフラグ Private Num( MAX - 1 ) As Integer ' フォームが読み込まれた時の処理 Private Sub JankenRock_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load Dim I As Integer Dim J As Integer Dim F As String ' 面データファイル名の設定 DP = Application.StartupPath : If Not DP.EndsWith( " " ) Then DP &= " " F = DP & "JankenRock.dat" ' 面データの読込 FileOpen( 1, F, OpenMode.Input ) For I = 0 To 58 For J = 0 To 11 Input( 1, BD( I, J )) Next J Next I FileClose( 1 ) ' Graphics オブジェクトの生成 With pnlground.backgroundimage = New Bitmap(.Width,.Height ) G = Graphics.FromImage(.BackgroundImage ) End With 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する ' 着目面番号の初期化 NS = 0 ' 第 1 面の表示 Call DispSheet( ) -55-
' フォーム上でキー入力が為された時の処理 Private Sub JankenRock_KeyUp( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyUp ' キー入力の記録 If ReplayMode = False Then KeyRec( Kcnt ) = e.keycode: Kcnt += 1 ' 入力キーに依る処理分岐 Call KeyOperation( e.keycode ) 3 フォームを選択し イベント画面に切り替え KeyUp の項目をダブルクリックして 左記のコードを入力する ' ボタン ( 次へ ) がクリックされた時の処理 Private Sub btnnext_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnnext.click btnnext.enabled = False btnreplay.enabled = False NS = NS + 1 Call DispSheet( ): pnlground.focus( ) 4 デザイン画面のボタン btnnext をダブルクリックして コード画面を表示し 左記のコードを入力する ' ボタン ( 再生 ) がクリックされた時の処理 Private Sub btnreplay_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnreplay.click Dim I, K As Integer K = Kcnt : Call DispSheet( ) : Kcnt = K ReplayMode = True For I = 0 To ( Kcnt - 1 ) Call KeyOperation( KeyRec( I )) System.Threading.Thread.Sleep( 500 ) Next I 5 デザイン画面のボタン btnreplay をダブルクリックして コード画面を表示し 左記のコードを入力する ReplayMode = False: pnlground.focus( ) ' ボタン ( クリア面の選択 ) がクリックされた時の処理 Private Sub btnselect_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnselect.click Dim F As String Dim I, C As Integer C = 0 cboselect.items.clear( ) For I = 1 To MAX F = DP & I.ToString( "00" ) & ".dat" If Not Dir( F ) = "" Then cboselect.items.add( " 第 " & StrConv( I.ToString( ), vbwide ) & " 面 " ) Num( C ) = I : C += 1 Next I pnlselect.visible = True -56-6 デザイン画面のボタン btnselect をダブルクリックして コード画面を表示し 左記のコードを入力する
' ボタン ( 決定 ) がクリックされた時の処理 Private Sub btnok_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnok.click Dim F As String Dim I, K, C As Integer If Not cboselect.selectedindex < 0 Then NS = Num( cboselect.selectedindex ) - 1 F = DP & Num( cboselect.selectedindex ).ToString( "00" ) & ".dat" FileOpen( 1, F, OpenMode.Input ) Input( 1, Kcnt ) For I = 0 To ( Kcnt - 1 ) Input( 1, KeyRec( I )) Next I FileClose( 1 ) K = Kcnt : Call DispSheet( ) : Kcnt = K If NS < MAX Then btnnext.enabled = True btnreplay.enabled = True pnlground.focus( ) pnlselect.visible = False ' ボタン ( キャンセル ) がクリックされた時の処理 Private Sub btncancel_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btncancel.click pnlselect.visible = False ' 画面を表示するジェネラルプロシージャ Private Sub DispSheet( ) Dim I, J As Integer 7 デザイン画面のボタン btnok をダブルクリックして コード画面を表示し 左記のコードを入力する 8 デザイン画面のボタン btncancel をダブルクリックして コード画面を表示し 左記のコードを入力する ' キー入力数と再生フラグの初期化 Kcnt = 0: ReplayMode = False 9 ' 画面の表示 G.Clear( pnlground. ) 上記 1と同様に コード記述画面を表示して For I = 0 To 11 左記のコードを記述する 以下同様 For J = 0 To 11 ST( J, I ) = System.Convert.ToInt32( BD( NS, I ).Substring( J, 1 )) Select Case ST( J, I ) Case 1: G.DrawImage( picbase4.image, J * 32, I * 32 ) Case 2: G.DrawImage( picbase5.image, J * 32, I * 32 ) Case 3: G.DrawImage( picbase6.image, J * 32, I * 32 ) Case 4: G.DrawImage( picbase7.image, J * 32, I * 32 ) Case 5: G.DrawImage( picbase8.image, J * 32, I * 32 ) Case 6: G.DrawImage( picbase9.image, J * 32, I * 32 ) Case 7: G.DrawImage( picbase0.image, J * 32, I * 32 ): CX = J : CY = I End Select Next J Next I pnlground.refresh( ) lblnumber. = " 第 " & StrConv(( NS + 1 ).ToString( ), VbStrConv.Wide ) & " 面 " -57-
' キー入力を処理するジェネラルプロシージャ Private Sub KeyOperation( ByVal K As Keys ) Select Case K Case Keys.Down: Call MoveChar( CX, CY + 1, CX, CY + 2, 0 ) Case Keys.Up: Call MoveChar( CX, CY - 1, CX, CY - 2, 1 ) Case Keys.Left: Call MoveChar( CX - 1, CY, CX - 2, CY, 2 ) Case Keys.Right: Call MoveChar( CX + 1, CY, CX + 2, CY, 3 ) Case Keys.Escape: Call DispSheet( ) Case Keys.T: btnnext.visible = True End Select ' キャラクタを移動するジェネラルプロシージャ Private Sub MoveChar( ByVal X1 As Integer, ByVal Y1 As Integer, _ ByVal X2 As Integer, ByVal Y2 As Integer, ByVal N As Integer ) Dim I, B As Integer Dim F, S As String Dim R As Boolean Dim P As PictureBox = Me.Controls( "picbase" & N.ToString( )) Select Case ST( X1, Y1 ) ' 移動先が固定岩か家の場合 Case 1, 6 Exit Sub ' 移動先が空白の場合 Case 0 G.FillRectangle( New SolidBrush( pnlground. ), CX * 32, CY * 32, 32, 32 ) ST( CX, CY ) = 0 : CX = X1 : CY = Y1 : ST( CX, CY ) = 7 G.DrawImage( P.Image, CX * 32, CY * 32 ) ' 移動先がグーの場合 Case 2 If ST( X2, Y2 ) = 0 Or ST( X2, Y2 ) = 3 Then G.FillRectangle( New SolidBrush( pnlground. ), CX * 32, CY * 32, 32, 32 ) G.FillRectangle( New SolidBrush( pnlground. ), X1 * 32, Y1 * 32, 32, 32 ) ST( CX, CY ) = 0 : ST( X2, Y2 ) = ST( X1, Y1 ) : CX = X1 : CY = Y1 : ST( CX, CY ) = 7 G.DrawImage( picbase5.image, X2 * 32, Y2 * 32 ) G.DrawImage( P.Image, CX * 32, CY * 32 ) ' 移動先がチョキの場合 Case 3 If ST( X2, Y2 ) = 0 Or ST( X2, Y2 ) = 4 Then G.FillRectangle( New SolidBrush( pnlground. ), CX * 32, CY * 32, 32, 32 ) G.FillRectangle( New SolidBrush( pnlground. ), X1 * 32, Y1 * 32, 32, 32 ) ST( CX, CY ) = 0 : ST( X2, Y2 ) = ST( X1, Y1 ) : CX = X1 : CY = Y1 : ST( CX, CY ) = 7 G.DrawImage( picbase6.image, X2 * 32, Y2 * 32 ) G.DrawImage( P.Image, CX * 32, CY * 32 ) ' 移動先がパーの場合 Case 4 If ST( X2, Y2 ) = 0 Or ST( X2, Y2 ) = 2 Then G.FillRectangle( New SolidBrush( pnlground. ), CX * 32, CY * 32, 32, 32 ) G.FillRectangle( New SolidBrush( pnlground. ), X1 * 32, Y1 * 32, 32, 32 ) ST( CX, CY ) = 0 : ST( X2, Y2 ) = ST( X1, Y1 ) : CX = X1 : CY = Y1 : ST( CX, CY ) = 7 G.DrawImage( picbase7.image, X2 * 32, Y2 * 32 ) G.DrawImage( P.Image, CX * 32, CY * 32 ) -58-
' 移動先が荷物の場合 Case 5 If ST( X2, Y2 ) = 6 Then G.FillRectangle( New SolidBrush( pnlground. ), CX * 32, CY * 32, 32, 32 ) G.FillRectangle( New SolidBrush( pnlground. ), X1 * 32, Y1 * 32, 32, 32 ) ST( CX, CY ) = 0 : CX = X1 : CY = Y1 : ST( CX, CY ) = 7 G.DrawImage( P.Image, CX * 32, CY * 32 ) ' クリアのブリンク表示 lblclear. = " クリア!!" For I = 1 To 3 lblclear.visible = True : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) lblclear.visible = False : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Next I ' 最短手数の判定 R = True F = DP & ( NS + 1 ).ToString( "00" ) & ".dat" If Not Dir( F ) = "" Then FileOpen( 1, F, OpenMode.Input ) Input( 1, B ) FileClose( 1 ) If Not B > Kcnt Then R = False ' 最短手数の場合の処理 ( 記録の保存と表示 ) If R Then S = CStr( Kcnt ) For I = 0 To ( Kcnt - 1 ) S &= ( "," & KeyRec( I ).ToString( )) Next I FileOpen( 1, F, OpenMode.Output ) PrintLine( 1, S ) FileClose( 1 ) lblclear. = " 最短手数達成!" For I = 1 To 3 lblclear.visible = True : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) lblclear.visible = False : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Next I If NS < MAX Then btnnext.enabled = True btnreplay.enabled = True ElseIf ST( X2, Y2 ) = 0 Then G.FillRectangle( New SolidBrush( pnlground. ), CX * 32, CY * 32, 32, 32 ) G.FillRectangle( New SolidBrush( pnlground. ), X1 * 32, Y1 * 32, 32, 32 ) ST( CX, CY ) = 0 : ST( X2, Y2 ) = ST( X1, Y1 ) : CX = X1 : CY = Y1 : ST( CX, CY ) = 7 G.DrawImage( picbase8.image, X2 * 32, Y2 * 32 ) G.DrawImage( P.Image, CX * 32, CY * 32 ) End Select pnlground.refresh( ) -59-
' 画面表示テスト Private Sub btntest_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btntest.click NS = NS + 1 : If NS >= MAX Then NS = 0 Call DispSheet( ) pnlground.focus( ) End Class 10 デザイン画面のボタン btntest をダブルクリックして コード画面を表示し 左記のコードを入力する -60-
ドラゴンの城 VB 2005 27 プログラムの概要 オーソドックスな RPG ゲーム ドラゴンの城 で有る 上下左右の矢印キーで 対応する方向にキャラクタを移動させる 但し 山の方向には移動する事は出来ない 幾多の敵と闘う事で 体力と経験値を高め ドラゴンの城に行き ドラゴンを倒すとクリアで有る 体力が無く成ると ゲームオーバーと成り プログラムは終了する 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -61-
オブジェクト プロパティ一覧 ピクチャボックス 1 ラベル 1 ラベル 2 ラベル 5 ラベル 6 ラベル 3 ラベル 7 ラベル 4 ラベル 8 ラベル 9 ラベル 10 ラベル 11 ラベル 12 ピクチャボックス 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name DragonCastle Black FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen ドラゴンの城 ピクチャボックス1 Name picmap Lime Size 288, 224 ラベル1 Name lblitem1 MS 明朝 16 標準 ForeColor White 体力 ラベル2 Name lblitem2 MS 明朝 16 標準 ForeColor White 攻撃力 -62-
コントロールの種類 プロパティ プロパティの設定値 ラベル3 Name lblclear MS 明朝 16 太字 ForeColor White 経験値 ラベル4 Name lblitem3 MS 明朝 16 太字 ForeColor White 所持金 ラベル5~8 Name ラベル5:lblHP ラベル6:lblSTR ラベル7:lblEXP ラベル8:lblGOLD AutoSize False MS 明朝 16 太字 ForeColor White Align MiddleRight ラベル9 Name lblmes MS 明朝 14 太字 ForeColor Red 空白 Align MiddleLeft ラベル10 Name lblenemyname MS 明朝 14 太字 ForeColor Red 空白 Align MiddleLeft ラベル11 Name lblenemystr MS 明朝 14 太字 ForeColor Red 空白 Align MiddleRight ラベル12 Name lblkey MS 明朝 14 太字 ForeColor 255, 255, 128 SPC: 戦闘 ESC: 逃亡 Align MiddleCenter ピクチャボックス2 Name picenemy Black Size 142, 106 SizeMode Zoom 上図では ラベルは グループボックスの中に入れて居る 此の様な 飾り は 各自の判断で 適宜 付けて欲しい 猶 上図では グループボックスの プロパティを 空白 に仕て居る -63-
プログラムリスト Public Class DragonCastle Private HP, ST, DF, EP, GD As Integer Private EB, EN, EM As Integer Private ES As String Private MapX, MapY, ManX, ManY As Integer Private Map( 34, 28 ) As Integer Private Battle, Dragon As Boolean 1 コード記述画面を表示して左記のコードを入力する Private Bm( 5 ), Be( 10 ) As Bitmap Private Gr As Graphics Private Rn As Random = New Random( ) ' フォームが読み込まれた時の処理 Private Sub DragonCastle_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load HP = 200 : ST = 100 : DF = 20 : EP = 1 : GD = 0 MapX = 4 : MapY = 4 : ManX = 8 : ManY = 7 FileOpen( 1, "dragon_map.txt", OpenMode.Input ) For I As Integer = 0 To 28 For J As Integer = 0 To 34 Input( 1, Map( J, I )) Next Next FileClose( 1 ) Bm( 0 ) = New Bitmap( "dragon_pat1.gif" ) Bm( 1 ) = New Bitmap( "dragon_pat2.gif" ) Bm( 2 ) = New Bitmap( "dragon_pat3.gif" ) Bm( 3 ) = New Bitmap( "dragon_pat4.gif" ) Bm( 4 ) = New Bitmap( "dragon_pat5.gif" ) Bm( 5 ) = New Bitmap( "dragon_pat6.gif" ) Be( 0 ) = New Bitmap( "dragon_ene0.gif" ) Be( 1 ) = New Bitmap( "dragon_ene1.gif" ) Be( 2 ) = New Bitmap( "dragon_ene2.gif" ) Be( 3 ) = New Bitmap( "dragon_ene3.gif" ) Be( 4 ) = New Bitmap( "dragon_ene4.gif" ) Be( 5 ) = New Bitmap( "dragon_ene5.gif" ) Be( 6 ) = New Bitmap( "dragon_ene6.gif" ) Be( 7 ) = New Bitmap( "dragon_ene7.gif" ) Be( 8 ) = New Bitmap( "dragon_ene8.gif" ) Be( 9 ) = New Bitmap( "dragon_ene9.gif" ) Be( 10 ) = New Bitmap( "dragon_enea.gif" ) データファイルは 事前に 実行ファイルと同じフォルダに格納して置く 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する 各画像ファイルは 事前に 実行ファイルと同じフォルダに格納して置く -64-
With picmap.image = New Bitmap(.Width,.Height ) Gr = Graphics.FromImage(.Image ) End With Call DrawMap( ) : Call DrawMan( ) : Call DispState( ) Battle = False : Dragon = False 3 ' マップを表示するジェネラルプロシージャ Private Sub DrawMap( ) Dim N As Integer = 0 上記 1と同様に コード記述画面を表示して For I As Integer = 0 To 6 左記のコードを記述する 以下同様 For J As Integer = 0 To 8 If Map( MapX + J, MapY + I ) < 6 Then Gr.DrawImage( Bm( Map( MapX + J, MapY + I )), J * 32, I * 32 ) Next Next picmap.refresh( ) ' 勇者を表示するジェネラルプロシージャ Private Sub DrawMan( ) Gr.DrawImage( Bm( 0 ), 128, 96 ) picmap.refresh( ) ' 勇者の状態を表示するジェネラルプロシージャ Private Sub DispState( ) lblhp. = HP.ToString( ) lblstr. = ST.ToString( ) lblexp. = EP.ToString( ) lblgold. = GD.ToString( ) 4 上記 3 に同じ ' メッセージを消去するジェネラルプロシージャ Private Sub DelMes( ByVal T As Integer ) If T > 0 Then System.Threading.Thread.Sleep( T ) lblmes. = "" lblenemyname. = "" lblenemystr. = "" lblkey.visible = False picenemy.visible = False 5 上記 3 に同じ -65-
' キー入力が為された時の処理 Private Sub DragonCastle_KeyUp( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyUp Dim N, Q, C, T, V As Integer Dim F As Boolean = False If Not Battle Then ' 勇者の移動 Select Case e.keycode Case Keys.Left N = Map( ManX - 1, ManY ) If Not N = 2 Then ManX -= 1 : MapX -= 1 : Call DrawMap( ) : Call DrawMan( ) : F = True Case Keys.Right N = Map( ManX + 1, ManY ) If Not N = 2 Then ManX += 1 : MapX += 1 : Call DrawMap( ) : Call DrawMan( ) : F = True Case Keys.Up N = Map( ManX, ManY - 1 ) If Not N = 2 Then ManY -= 1 : MapY -= 1 : Call DrawMap( ) : Call DrawMan( ) : F = True Case Keys.Down N = Map( ManX, ManY + 1 ) If Not N = 2 Then ManY += 1 : MapY += 1 : Call DrawMap( ) : Call DrawMan( ) : F = True Case Keys.End HP *= 2 : ST *= 2 : DF *= 2 : EP *= 2 : GD *= 2 Call DispState( ) End Select ' 移動した場合の処理 If F Then ' 体力減尐 ( 森と池 ) Select Case N Case 3: HP -= 471 / (ST / 5) + 7 Case 4: HP -= 471 / (ST / 10) + 10 End Select ' 体力増加 ( 病院?) If ( ManX = 5 And ManY = 5 ) Or ( ManX = 26 And ManY = 19 ) Then If Not HP = 3000 Then HP += GD : GD = 0 If HP > 3000 Then HP = 3000-66- 6 フォームを選択し イベント画面に切り替え KeyUp の項目をダブルクリックして 左記のコードを入力する
Call DispState( ) If HP <= 0 Then MessageBox.Show( " 死亡 " ) Application.Exit( ) ' 敵出現 If ManX = 14 And ManY = 23 Then ' ドラゴン出現 lblmes. = " ドラゴンが居る!!!" : Application.DoEvents( ) lblenemyname. = " ドラゴン " : lblenemystr. = "????" picenemy.image = Be( 10 ) : picenemy.visible = True lblkey.visible = True : Battle = True : Dragon = True Else If Rn.Next( 1, 3 ) = 2 Then lblmes. = " 敵が現れた!!" Select Case Map( ManX, ManY ) Case 1 : Q = 0 Case 3 : Q = 3 Case 4 : Q = 6 End Select C = Rn.Next( 3 ) + Q Select Case C Case 0 : ES = " シルフ " : EB = 150 : EN = 100 : EM = 10 Case 1 : ES = " アデプト " : EB = 200 : EN = 120 : EM = 12 Case 2 : ES = " ウィザード " : EB = 250 : EN = 145 : EM = 14 Case 3 : ES = " ヴァヴァーン " : EB = 300 : EN = 170 : EM = 16 Case 4 : ES = " ナーレット " : EB = 350 : EN = 195 : EM = 20 Case 5 : ES = " カーティケイヤ " : EB = 400 : EN = 224 : EM = 21 Case 6 : ES = " キメラ " : EB = 450 : EN = 230 : EM = 22 Case 7 : ES = " ハーピー " : EB = 550 : EN = 257 : EM = 23 Case 8 : ES = " マスターロード " : EB = 700 : EN = 293 : EM = 24 Case 9 : ES = " アキンドナイト " : EB = 900 : EN = 332 : EM = 30 End Select lblenemyname. = ES : lblenemystr. = EB.ToString( ) picenemy.image = Be( C ) : picenemy.visible = True lblkey.visible = True : Battle = True Else ' 戦闘 Select Case e.keycode Case Keys.Space If Not Dragon Then lblmes. = " アタック!!!" : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) T = ST + DF : V = EN + EM If T > V Then -67-
' 勝利 lblmes. = ES & " を倒した!" GD += ( EB / 5 ) If Not ST > EN Then EP += ( EM * 4-2000 / ST ) If EP >= ST * 3 Then ST += ( EN / 10 + 10 ) : DF += 5 Else ' 敵の攻撃 lblmes. = " 敗北した " : Application.DoEvents( ) HP -= ( EM * 22 5 ) If HP <= 0 Then MessageBox.Show( " 死亡 " ) Application.Exit( ) Call DispState( ) Else If ST >= 373 And HP >= 2556 Then lblmes. = " ドラゴンを倒した!!!" : Application.DoEvents( ) MessageBox.Show( " おめでとう!" ) Application.Exit( ) Else lblmes. = " 未だ未だドラゴンは倒せん!" : Application.DoEvents( ) MapX = 4 : MapY = 4 : ManX = 8 : ManY = 7 Call DrawMap( ) : Call DrawMan( ) Dragon = False Battle = False Application.DoEvents( ) : Call DelMes( 1000 ) Case Keys.Escape If Rn.Next( 4 ) = 0 Then lblmes. = " 敵の襲撃!!!" : Application.DoEvents( ) HP -= ( EB / ( ST - 80 )) If HP <= 0 Then MessageBox.Show( " 死亡 " ) Application.Exit( ) Call DispState( ) Else lblmes. = " 逃げ切れた " : Application.DoEvents( ) Battle = False : Call DelMes( 1000 ) End Select End Class -68-
ジャスト 10 VB 2005 28 プログラムの概要 貴方の体内時計の正確さを試すゲーム ジャスト 10 で有る スタートボタンをクリックして 10 秒経過したと思えばストップボタンをクリックする 丁度 10 秒に成る様に調整して下さい 呉々も イカボン の動きに惑わされない様に 注意して下さい 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -69-
オブジェクト プロパティ一覧 ラベル 1 ラベル 2 ピクチャボックス タイマー ボタン 1 ボタン 2 tmrconfuse コントロールの種類 プロパティ プロパティの設定値 フォーム Name just10 MS 明朝 9 標準 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen ジャスト10 ピクチャボックス Name picchar Image ikabon1.gif Size 169, 276 ラベル1 2 Name lbltime lblmes Blue Red MS 明朝 12 標準 ForeColor White 空白 Align MiddleCenter タイマー Name tmrconfuse INterval 500 ボタン1 2 Name btnstart btnstop MS 明朝 12 標準 START STOP -70-
プログラムリスト Public Class just10 Private Sw As Stopwatch = New Stopwatch( ) Private Rn As Random = New Random( ) Private Ch( 1 ) As Bitmap Private Ct As Boolean ' フォームが読み込まれた時の処理 Private Sub just10_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load Ch( 0 ) = New Bitmap( "ikabon1.gif" ) Ch( 1 ) = New Bitmap( "ikabon2.gif" ) ' ボタン (START) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click 1 コード記述画面を表示して左記のコードを入力する 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する Sw.Reset( ) : Sw.Start( ) btnstart.enabled = False btnstop.enabled = True lbltime. = "" : lblmes. = "" Ct = True tmrconfuse.enabled = True 3 デザイン画面のボタン btnstart をダブルクリックして コード画面を表示し 左記のコードを入力する ' ボタン (STOP) がクリックされた時の処理 Private Sub btnstop_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstop.click Sw.Stop( ) : tmrconfuse.enabled = False Dim T As Single = Sw.ElapsedMilliseconds / 1000 lbltime. = T.ToString( "#0.00" ) If T = 10 Then lblmes. = " 素晴らしい!!!" ElseIf 9.5 < T And T < 10.5 Then lblmes. = " 惜しい!!!" Else lblmes. = " 練習しよう!!!" btnstop.enabled = False btnstart.enabled = True 4 デザイン画面のボタン btnstart をダブルクリックして コード画面を表示し 左記のコードを入力する -71-
' タイマーが一定間隔で行う処理 Private Sub tmrconfuse_tick(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles tmrconfuse.tick If Ct Then picchar.image = Ch( 1 ) Else picchar.image = Ch( 0 ) Ct = Not Ct tmrconfuse.interval = 1000 + ( Rn.Next( -300, 300 )) End Class 5 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する -72-
対戦チェッカー VB 2005 29 プログラムの概要 人間対人間の対戦型のボードゲーム チェッカー で有る 青が先手で 赤が後手で有る 手番の人間は 先ず 動かす駒をクリックし 次に 移動する場所をクリックする 飛び越して取る事の出来る駒が有る場合は 必ず取らなければ成らない 勿論 ルール違反の移動先をクリックした場合は 無効で 警告が表示される 相手の駒を総て取れば勝ちで有る メッセージボックスが表示されるので 続けてゲームを行う事も出来る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -73-
オブジェクト プロパティ一覧 ピクチャボックス1 ラベル1 ピクチャボックス2 ラベル 2 ラベル 3 ラベル 4 ピクチャボックス 3 ボタン コントロールの種類 プロパティ プロパティの設定値 フォーム Name checker FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen チェッカー ピクチャボックス1 Name picblue Transparent Image picblue.gif Size 37, 37 ピクチャボックス2 Name picred Transparent Image picred.gif Size 37, 37 ラベル1 Name lbltitle HG 創英角ホ ッフ 体 26 太字 対戦チェッカー -74-
コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblscr2 AutoSize False Blue MS 明朝 16 標準 ForeColor White 0 Align MiddleRight ラベル3 Name lblscr3 AutoSize False Red MS 明朝 12 標準 0 Align MiddleRight ラベル4 Name lblmessage AutoSize False White MS 明朝 12 標準 ForeColor White 0 Align MiddleCenter ピクチャボックス3 Name picboard White BorderStyle FixedSingle Size 322, 322 ボタン Name BtnFinish MS 明朝 12 標準 終了 -75-
プログラムリスト Public Class checker ' フォームクラスレベルでグローバルな変数の宣言 Private KP( 7, 7 ) As Integer ' 盤データ ( 保存用 ) Private BD( 7, 7 ) As Integer ' 盤データ ( 競技用 ) Private UN( 1 ) As Integer ' 判定用 Private VN( 1 ) As Integer ' 判定用 Private SC( 3 ) As Integer ' 得点 (2: 青 3: 赤 ) Private XD( 8 ) As Integer ' 判定用 Private YD( 8 ) As Integer ' 判定用 Private DP( 1, 3, 4 ) As Integer ' 判定用 Private V1( 1, 3, 48 ) As Integer ' 判定用 Private V2( 1, 3, 48 ) As Integer ' 判定用 Private BA As Integer ' 手番 (2: 青 3: 赤 ) Private TN As Integer ' 互先 (2: 先手 3: 後手 ) Private CX As Integer ' 着目 X 座標 ( 盤面升目 ) Private CY As Integer ' 着目 Y 座標 ( 盤面升目 ) Private PX As Integer ' 駒位置 X 座標 ( 盤面升目 ) Private PY As Integer ' 駒位置 Y 座標 ( 盤面升目 ) Private FX As Integer ' 移動先 X 座標 ( 盤面升目 ) Private FY As Integer ' 移動先 Y 座標 ( 盤面升目 ) Private PC As Boolean ' 駒位置指定フラグ Private NM As Boolean ' 連続移動フラグ Private OK As Boolean ' 規則違反判定フラグ Private TB As Boolean ' 敵駒取得フラグ Private ED As Boolean ' 終了フラグ Private KM As Boolean ' 王駒昇格フラグ Private PR As String ' メッセージ Private G As Graphics 1 コード記述画面を表示して左記のコードを入力する ' フォームが読み込まれた時の処理 Private Sub checker_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' Graphics オブジェクトの生成 With picboard.image = New Bitmap(.Width,.Height ) G = Graphics.FromImage(.Image ) End With ' 盤面データの設定 Call DataSet( ) ' 盤面の初期化 Call GameInit( ) Call TurnDisp( ) Call BoardInit( 0 ) 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する -76-
' 盤面でマウスボタンをクリックした時の処理 Private Sub picboard_mouseup( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picboard.mouseup If TN = BA Then ' 駒の枠線を消去する G.DrawRectangle( Pens.White, CX * 40, CY * 40, 40, 40 ) picboard.refresh( ) ' 着目座標を求める CX = e.x 40 : CY = e.y 40 ' 一巡の処理を行う Call Turn( ) ' ボタン ( 終了 ) がクリックされた時の処理 Private Sub cmdfinish_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles cmdfinish.click Me.Dispose( ) End ' 盤面データを設定するジェネラルサブプロシージャ Private Sub DataSet( ) ' サブプロシージャレベルでローカルの変数 Dim I, J As Integer 5 上記 1と同様に コー ' 盤面データを設定するド記述画面を表示し For I = 0 To 7 て 左記のコードを記 For J = 0 To 7 述する 以下同様 Select Case J Case 0, 2 If I Mod 2 = 0 Then KP( I, J ) = 4 Else KP( I, J ) = 2 Case 1 If I Mod 2 = 0 Then KP( I, J ) = 2 Else KP( I, J ) = 4 Case 3 If I Mod 2 = 0 Then KP( I, J ) = 1 Else KP( I, J ) = 4 Case 4 最後迄 If I Mod 2 = 0 Then KP( I, J ) = 4 Else KP( I, J ) = 1 Case 5, 7 If I Mod 2 = 0 Then KP( I, J ) = 3 Else KP( I, J ) = 4 Case 6 If I Mod 2 = 0 Then KP( I, J ) = 4 Else KP( I, J ) = 3 End Select Next J Next I -77-
XD( 1 ) = 0 : YD( 1 ) = -2 XD( 2 ) = 1 : YD( 2 ) = -1 XD( 3 ) = 2 : YD( 3 ) = 0 XD( 4 ) = 1 : YD( 4 ) = 1 XD( 5 ) = 0 : YD( 5 ) = 2 XD( 6 ) = -1 : YD( 6 ) = 1 XD( 7 ) = -2 : YD( 7 ) = 0 XD( 8 ) = -1 : YD( 8 ) = -1 DP( 0, 2, 1 ) = 4 : DP( 0, 2, 2 ) = 6 : DP( 0, 2, 3 ) = 2 : DP( 0, 2, 4 ) = 8 DP( 0, 3, 1 ) = 2 : DP( 0, 3, 2 ) = 8 : DP( 0, 3, 3 ) = 4 : DP( 0, 3, 4 ) = 6 DP( 1, 2, 1 ) = 2 : DP( 1, 2, 2 ) = 8 : DP( 1, 2, 3 ) = 4 : DP( 1, 2, 4 ) = 6 DP( 1, 3, 1 ) = 6 : DP( 1, 3, 2 ) = 4 : DP( 1, 3, 3 ) = 8 : DP( 1, 3, 4 ) = 2 ' ゲームを初期化するジェネラルサブプロシージャ Private Sub GameInit( ) TN = 2 : BA = 2 : CX = 1 : CY = 0 PC = False : NM = False : ED = False UN( 1 ) = 0 : SC( 2 ) = 0 : SC( 3 ) = 0 lblscr2. = "0" lblscr3. = "0" ' 手番を表示するジェネラルサブプロシージャ Private Sub TurnDisp( ) If BA = 2 Then lblmessage. = Color.Blue lblmessage.forecolor = Color.White lblmessage. = " 青の番 " Else lblmessage. = Color.Red lblmessage.forecolor = Color.White lblmessage. = " 赤の番 " ' 盤面を初期化するジェネラルサブプロシージャ Private Sub BoardInit( ByVal F As Integer ) Dim I, J As Integer Dim A As PictureBox Dim B As PictureBox If F = 0 Then A = picblue : B = picred Else A = picred : B = picblue -78-
For I = 0 To 7 For J = 0 To 7 Select Case KP( I, J ) Case 1 G.FillRectangle( Brushes.White, I * 40, J * 40, 40, 40 ) Case 2 G.DrawImage( A.Image, I * 40 + 1, J * 40 + 2 ) Case 3 G.DrawImage( B.Image, I * 40 + 1, J * 40 + 2 ) Case 4 G.FillRectangle( Brushes.Black, I * 40, J * 40, 40, 40 ) End Select BD( I, J ) = KP( I, J ) Next J Next I picboard.refresh( ) ' 一巡の処理を行うジェネラルサブプロシージャ Private Sub Turn( ) ' 移動する駒を指定する If ( BD( CX, CY ) And 7 ) = BA And NM = False Then G.DrawRectangle( Pens.Red, CX * 40, CY * 40, 40, 40 ) picboard.refresh( ) PX = CX : PY = CY : PC = True ' 移動先を指定する If PC = True Then If BD( CX, CY ) = 1 Then FX = CX : FY = CY ' 移動先を検証する If JudgeDestination( PX, PY, FX, FY, 0 ) Then Exit Sub Call MovePiece( ) ' 駒を移動する Call JudgeKing( ) ' キングに昇格したか判定する Call TakePiece( ) ' 駒を取り上げる ' 連続して跳べるか判定する If JumpMore( ) Then Exit Sub ' 終了したか判定する Call JudgeEnd( ) If ED = True Then If BA = 2 Then PR = " 青 " Else PR = " 赤 " lblmessage. = PR & " の勝ちです!!" If MsgBox(" もう一度?", vbyesno + vbquestion, " 対戦ゲーム ") = MsgBoxResult.Yes Then Call GameInit() Call TurnDisp() Call BoardInit(0) Else BA = BA Xor 1 : PC = False : Call TurnDisp() : TN = TN Xor 1-79-
' 移動先を検証するジェネラルサブプロシージャ Public Function JudgeDestination( ByVal X1 As Integer, ByVal Y1 As Integer, _ ByVal X2 As Integer, ByVal Y2 As Integer, ByVal F As Integer ) As Boolean Dim XX As Integer Dim YY As Integer Dim NG As Boolean OK = False : TB = False XX = Math.Abs( X2 - X1 ) : YY = Math.Abs( Y2 - Y1 ) If ( XX = 0 Or XX = 1 ) And ( YY = 0 Or YY = 1 ) Then If BD( X1, Y1 ) <> ( BD( X1, Y1 ) And 7 ) Then OK = True ElseIf ( BA = 2 ) And ( Y2 - Y1 = 1 ) Then OK = True ElseIf ( BA = 3 ) And ( Y2 - Y1 = -1 ) Then OK = True ElseIf ( XX = 0 Or XX = 2 ) And ( YY = 0 Or YY = 2 ) Then XX = X1 + ( X2 X1 ) / 2 : YY = Y1 + ( Y2 - Y1 ) / 2 If ( BD( XX, YY ) And 7) = ( BA Xor 1) Then If BD( X1, Y1 ) <> ( BD( X1, Y1 ) And 7 ) Then OK = True : TB = True ElseIf ( BA = 2 ) And ( Y2 - Y1 = 2 ) Then OK = True : TB = True ElseIf ( BA = 3 ) And ( Y2 - Y1 = -2 ) Then OK = True : TB = True If F = 1 Then Return OK Else NG = False If ( NM = True ) And ( TB = False ) Then NG = True : PR = " 駒を取らなければ成りません!" ElseIf ( UN( 1 ) > 0 ) And ( OK = True ) And ( TB = False ) Then NG = True : PR = " 駒を取らなければ成りません!" ElseIf OK = False Then NG = True : PR = " ルール違反です!" If NG = True Then PC = False lblmessage. = PR If NM = True Then PC = True Else G.DrawRectangle( Pens.White, PX * 40, PY * 40, 40, 40 ) picboard.refresh( ) Return NG End Function -80-
' 駒を移動させるジェネラルサブプロシージャ Public Sub MovePiece( ) G.FillRectangle( Brushes.White, PX * 40, PY * 40, 40, 40 ) If BA = 2 Then G.DrawImage( picblue.image, FX * 40 + 1, FY * 40 + 2 ) Else G.DrawImage( picred.image, FX * 40 + 1, FY * 40 + 2 ) picboard.refresh( ) BD( FX, FY ) = BD( PX, PY ) : BD( PX, PY ) = 1 ' キングに昇格したか判定するジェネラルサブプロシージャ Public Sub JudgeKing( ) KM = False If ( BA = 2 And FY > 6 ) Or ( BA = 3 And FY < 1 ) Then If ( BD( FX, FY ) And 8 ) = 0 Then BD( FX, FY ) = BD( FX, FY ) Or 8: KM = True : NM = False ' 駒を取り上げるジェネラルサブプロシージャ Public Sub TakePiece( ) Dim XX, YY As Integer If TB = True Then XX = PX + ( FX PX ) / 2 : YY = PY + ( FY - PY ) / 2 G.FillRectangle( Brushes.White, XX * 40, YY * 40, 40, 40 ): picboard.refresh( ) BD( XX, YY ) = 1 : SC( BA ) += 1 Me.Controls( "lblscr" & BA.ToString( )). = SC( BA ) ' 連続して跳べるか判定するジェネラルサブプロシージャ Public Function JumpMore( ) As Boolean Dim XT, YT, I As Integer NM = False If Not (( TB = False ) Or ( KM = True )) Then For I = 2 To 8 Step 2 XT = FX + XD( I ) * 2 : YT = FY + YD( I ) * 2 If ( XT >= 0 And XT <= 7 ) And ( YT >= 0 And YT <= 7 ) Then If BD( XT, YT ) = 1 Then If JudgeDestination( FX, FY, XT, YT, 1 ) Then Exit For Next I -81-
If OK = True Then NM = True : PC = True PX = FX : PY = FY G.DrawRectangle( Pens.Red, CX * 40, CY * 40, 40, 40 ) lblmessage. = " 続けて跳ぶ事が出来ます!" Return OK End Function ' 終了したか判定するジェネラルサブプロシージャ Public Sub JudgeEnd() Dim I, J, K As Integer If SC( BA ) >= 12 Then ED = True Else BA = BA Xor 1 : Call Judge2( ) : BA = BA Xor 1 If VN( 0 ) = 0 And VN( 1 ) = 0 Then ED = True Else For I = 0 To 1 UN( I ) = VN( I ) For J = 1 To VN( I ) For K = 0 To 3 V2( I, K, J ) = V1( I, K, J ) Next K Next J Next I ' 終了を判定するジェネラルサブプロシージャ Public Sub Judge2() Dim CS As Integer Dim CE As Integer Dim CC As Integer Dim W1 As Integer Dim W2 As Integer Dim W3 As Integer Dim I As Integer Dim J As Integer Dim K As Integer Dim X As Integer Dim Y As Integer -82-
VN( 0 ) = 0 : VN( 1 ) = 0 CS = 0 : CE = 7 : CC = 1 : If BA = 2 Then CS = 7 : CE = 0 : CC = -1 For I = CS To CE Step CC If I Mod 2 = 0 Then W1 = 1 Else W1 = 0 For J = ( W1 ) To ( W1 + 6 ) Step 2 If ( BD( J, I ) And 7 ) = BA Then If ( BD( J, I ) And 8 ) = 8 Then W2 = 4 : W3 = 1 Else W2 = 2 : W3 = 0 For K = 1 To W2 X = J + XD( DP( W3, BA, K )) : Y = I + YD( DP( W3, BA, K )) If ( X >= 0 And X <= 7 ) And ( Y >= 0 And Y <= 7 ) Then If Not ( BD( X, Y ) = 0 Or BD( X, Y ) = 4 ) Then If BD( X, Y ) = 1 Then VN( 0 ) = VN( 0 ) + 1 V1( 0, 0, VN( 0 )) = J : V1( 0, 1, VN( 0 )) = I V1( 0, 2, VN( 0 )) = X : V1( 0, 3, VN( 0 )) = Y ElseIf ( BD( X, Y ) And 7 ) <> BA Then X = X + XD( DP( W3, BA, K )) : Y = Y + YD( DP( W3, BA, K )) If ( X >= 0 And X <= 7 ) And ( Y >= 0 And Y <= 7 ) Then If BD( X, Y ) = 1 Then VN( 1 ) = VN( 1 ) + 1 V1( 1, 0, VN( 1 )) = J : V1( 1, 1, VN( 1 )) = I V1( 1, 2, VN( 1 )) = X : V1( 1, 3, VN( 1 )) = Y Next K Next J Next I End Class -83-
重力空間 VB 2005 30 プログラムの概要 頭脳と反射神経を試すアクションパズルゲーム 重力空間 で有る スタートボタンをクリックして 矢印キーで コングを扉の処に導けば 面クリアで有る コングは 或る高さから落ちると 暫く動けなく成る 10 秒毎に 重力方向が変化するので 惑わされない様に 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -84-
オブジェクト プロパティ一覧 ラベル 2 グループボックス 1 ラベル 3 ラベル 4 ラベル 1 ラベル 5 パネル ラベル 6 グループボックス 2 ラベル 8 ピクチャボックス ラベル 7 グループボックス 3 ラベル 10 ラベル 9 ボタン 1 タイマー ボタン 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmplayer MS 明朝 9 標準 FormBorderStyle FixedSingle Icon donkey.ico MaximizeBox False StartPosition CenterScreen GRAVITY ZONE - 重力空間 ラベル1 Name lblboard AutoSize False White BorderStyle FixedSingle Location 7, 8 Size 593, 593 空白 パネル Name pnlboard Black Location 15, 16 Size 576, 576-85-
コントロールの種類 プロパティ プロパティの設定値 ピクチャボックス Name pickong Transparent Image donkey2.gif Size 48, 48 ラベル2 Name lblsheetno AutoSize false MS 明朝 18 標準 第 1 面 Align MiddleCenter グループボックス1 Name grahiscore 最短所要時間 ラベル3 Name lblhiscore MS 明朝 14 標準 0 Align MiddleRight ラベル4 Name lblsecond0 MS 明朝 14 標準 秒 Align MiddleLeft ラベル5 Name lblchampion White MS 明朝 14 標準 空白 Align MiddleCenter ラベル6 Name lbldate White MS 明朝 14 標準 空白 Align MiddleCenter グループボックス2 Name grascore 経過時間 ラベル7 Name lblscore MS 明朝 14 標準 0 Align MiddleRight ラベル8 Name lblsecond1 MS 明朝 14 標準 秒 Align MiddleLeft グループボックス3 Name gratotal 所要時間 ラベル9 Name lbltotal MS 明朝 14 標準 0 Align MiddleRight -86-
ラベル10 Name lblsecond2 MS 明朝 14 標準 秒 Align MiddleLeft ボタン1 Name btnplay MS 明朝 12 標準 プレイ ボタン2 Name btnfinish MS 明朝 12 標準 終了 タイマー Name tmrtime Interval 100 追加フォーム ラベル 1 ラベル 3 ラベル 2 ラベル 4 ラベル 5 グループボックス テキストボックス ボタン コントロールの種類 プロパティ プロパティの設定値 フォーム Name frminfo Black MS 明朝 9 標準 FormBorderStyle FixedSingle Icon donkey.ico MaximizeBox False StartPosition CenterScreen GRAVITY ZONE - 結果 -87-
コントロールの種類 プロパティ プロパティの設定値 ラベル1 Name lblmes0 MS 明朝 18 標準 ForeColor Red 全シートをクリアしました! ラベル2 Name lblmes1 MS 明朝 18 標準 ForeColor White 所要時間は ラベル3 Name lblscore White MS 明朝 18 標準 空白 ラベル4 Name lblmes2 MS 明朝 18 標準 ForeColor White 秒です グループボックス Name grprecord ForeColor White 記録更新 ラベル5 Name lblrecord MS 明朝 18 標準 ForeColor White 記録は更新されませんでした テキストボックス Name txtname MS 明朝 12 標準 ボタン Name btnreturn MS 明朝 12 標準 戻る フォームの追加は プロジェクト メニューから Windows フォームの追加 を選択する ファイル名には info.vb と付けて 追加 ボタンをクリックする 猶 フォームの Name プロパティは 既定で info と成るが 此れでは都合が悪いので frminfo と変更する -88-
プログラムリスト Public Class frmplayer Private Const MAX As Integer = 100-1 Private Structure INFO Dim DirG As Integer Dim PosX As Integer Dim PosY As Integer End Structure Private SD As String ' 起動パス Private BI( MAX ) As INFO ' 基本情報 ( 重力方向 コング座標 ) Private BD( MAX, 11, 11 ) As Integer ' 仮想画面 Private SG( 11, 11 ) As Integer ' 仮想画面 ( プレイ用 ) Private WK( 11, 11 ) As Integer ' 仮想画面 ( 作業用 ) Private ST As Integer ' ステージ番号 (0 スタート ) Private Kc As Integer ' コングの画像番号 Private Px As Integer ' コングの X 座標 ( プレイ用 ) Private Py As Integer ' コングの Y 座標 ( プレイ用 ) Private Gd As Integer ' 重力の方向 (0: 下 1: 左 2: 上 3: 右 ) Private Pd As Integer ' 変更前の重力の方向 (0: 下 1: 左 2: 上 3: 右 ) Private SheetMax As Integer ' ステージ数 Private PlayFlag As Boolean ' プレイフラグ (True: プレイ中 False: 編集中 ) Private TotalTime As Integer ' 所要時間 Private RecordDate As String ' ハイスコア達成日時 Private PlayerName As String ' プレーヤー名 Private HiScore As Integer ' ハイスコア Private TP( 6 ) As PictureBox Private GT( 6 ) As Graphics Private DK( 9 ) As Bitmap Private PT( 5 ) As Bitmap Private SW As New System.Diagnostics.Stopwatch Private G As Graphics ' プロパティの設定 Public Property Player( ) As String Get Player = PlayerName End Get Set( ByVal Value As String ) PlayerName = Value End Set End Property 1 コード記述画面を表示して左記のコードを入力する -89-
' フォームが読み込まれた時の処理 Private Sub player_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load Dim H, I, J As Integer Dim F, S As String SD = Application.StartupPath : If Not SD.EndsWith( " " ) Then SD &= " " F = SD & "gravity.dat" FileOpen( 1, F, OpenMode.Input ) Input( 1, SheetMax ) For H = 0 To SheetMax Input( 1, BI( H ).DirG ) Input( 1, BI( H ).PosX ) Input( 1, BI( H ).PosY ) For I = 0 To 11 For J = 0 To 11 Input( 1, BD( H, J, I )) Next J Next I Next H FileClose( 1 ) 2 フォーム上のコントロールを配置して居ない処をダブルクリックして コード画面を表示し 左記のコードを入力する F = SD & "gravity.rec" FileOpen( 1, F, OpenMode.Input ) Input( 1, RecordDate ): Input( 1, PlayerName ): Input( 1, HiScore ) FileClose( 1 ) lbldate. = RecordDate lblchampion. = PlayerName lblhiscore. = HiScore.ToString( ) For I = 0 To 6 TP( I ) = New PictureBox( ) With TP( I ).Size = New Size( 48, 48 ).Image = New Bitmap( 48, 48 ) GT( I ) = Graphics.FromImage(.Image ) End With Next For I = 0 To 9 S = "donkey" & I.ToString( ) & ".gif" DK( I ) = New Bitmap( S ) Next For I = 0 To 5 S = "parts" & I.ToString( ) & ".gif" PT( I ) = New Bitmap( S ) Next With pnlboard.backgroundimage = New Bitmap(.Width,.Height ) G = Graphics.FromImage(.BackgroundImage ) End With TotalTime = 0 : ST = 0 : Randomize( ) -90-
' ボタン ( プレイ ) がクリックされた時の処理 Private Sub btnplay_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnplay.click Kc = 2 Gd = BI( ST ).DirG Px = BI( ST ).PosX Py = BI( ST ).PosY For I As Integer = 0 To 11 For J As Integer = 0 To 11 SG( I, J ) = BD( ST, I, J ) WK( I, J ) = BD( ST, I, J ) Next J Next I Call ChangeImage( ) Call DispSheet( ) btnplay.enabled = False PlayFlag = True Me.KeyPreview = True SW.Reset( ) : SW.Start( ) tmrtime.enabled = True ' タイマー ( 経過時間表示用 ) が一定間隔で行う処理 Private Sub tmrtime_tick( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles tmrtime.tick Dim T As Integer Static K As Integer T = SW.ElapsedMilliseconds / 1000 lblscore. = T.ToString( ) If ( Not T = K ) And ( T > 0 ) And ( T Mod 10 = 0 ) Then Pd = Gd Gd = Int( Rnd( ) * 4 ) Call ChangeImage( ) Call ChangeSheet( ) K = T 3 デザイン画面のボタン btnstart をダブルクリックして コード画面を表示し 左記のコードを入力する 4 デザイン画面で タイマーをダブルクリックして コード画面を表示し 左記のコードを入力する ' フォーム上でキー入力が為された時の処理 ( プレイ用 ) Private Sub player_keyup( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyUp Dim K As Keys = e.keycode Dim Dx, Dy, Nx, Ny As Integer 5 フォームを選択し イベント画面に切り替え KeyUp の項目をダブルクリックし If PlayFlag = False Then Exit Sub て 左記のコードを入力する -91-
Select Case K Case Keys.Left, Keys.Right If K = Keys.Left Then Select Case Gd Case 0 : Dx = -1 : Dy = 0 Case 1 : Dx = 0 : Dy = -1 Case 2 : Dx = 1 : Dy = 0 Case 3 : Dx = 0 : Dy = 1 End Select Else Select Case Gd Case 0 : Dx = 1 : Dy = 0 Case 1 : Dx = 0 : Dy = 1 Case 2 : Dx = -1 : Dy = 0 Case 3 : Dx = 0 : Dy = -1 End Select Nx = Px + Dx : Ny = Py + Dy If Nx < 0 Or Nx > 11 Then Exit Sub If Ny < 0 Or Ny > 11 Then Exit Sub Select Case SG( Nx, Ny ) Case 0 If K = Keys.Left Then Kc = 0 Else Kc = 1 Call ChangeKong( ) : pickong.refresh( ) Px = Nx : Py = Ny pickong.location = New Point( Px * 48, Py * 48 ) ' 落下処理 Call DropDown( ) Case 2, 3 If Kc = 6 Then Kc = 7 Else Kc = 6 Call ChangeKong( ) : pickong.refresh( ) Px = Nx : Py = Ny pickong.location = New Point( Px * 48, Py * 48 ) Case 4 ' 面クリア処理 Call ClearSheet( Nx, Ny ) End Select Case Keys.Up Select Case Gd Case 0 : Dx = 0 : Dy = -1 Case 1 : Dx = 1 : Dy = 0 Case 2 : Dx = 0 : Dy = 1 Case 3 : Dx = -1 : Dy = 0 End Select Nx = Px + Dx : Ny = Py + Dy If Nx < 0 Or Nx > 11 Then Exit Sub If Ny < 0 Or Ny > 11 Then Exit Sub -92-
Select Case SG( Nx, Ny ) Case 0 Select Case SG( Px, Py ) Case 2, 3 Kc = 3: Call ChangeKong( ) : pickong.refresh( ) Px = Nx : Py = Ny: pickong.location = New Point( Px * 48, Py * 48 ) End Select Case 2, 3 If Kc = 6 Then Kc = 7 Else Kc = 6 Call ChangeKong( ) : pickong.refresh( ) Px = Nx : Py = Ny: pickong.location = New Point( Px * 48, Py * 48 ) Case 4 ' 面クリア処理 Call ClearSheet( Nx, Ny ) End Select Case Keys.Down Select Case Gd Case 0 : Dx = 0 : Dy = 1 Case 1 : Dx = -1 : Dy = 0 Case 2 : Dx = 0 : Dy = -1 Case 3 : Dx = 1 : Dy = 0 End Select Nx = Px + Dx : Ny = Py + Dy If Nx < 0 Or Nx > 11 Then Exit Sub If Ny < 0 Or Ny > 11 Then Exit Sub Select Case SG( Nx, Ny ) Case 0 Select Case SG( Px, Py ) Case 2, 3 Kc = 2: Call ChangeKong( ) : pickong.refresh( ) Px = Nx : Py = Ny: pickong.location = New Point( Px * 48, Py * 48 ) ' 落下処理 Call DropDown( ) End Select Case 2, 3 If Kc = 6 Then Kc = 7 Else Kc = 6 Call ChangeKong( ) : pickong.refresh( ) Px = Nx : Py = Ny: pickong.location = New Point( Px * 48, Py * 48 ) Case 4 ' 面クリア処理 Call ClearSheet( Nx, Ny ) End Select Case Keys.Escape Kc = 2: Call ChangeKong( ) : pickong.refresh( ) Px = BI( ST ).PosX : Py = BI( ST ).PosY pickong.location = New Point( Px * 48, Py * 48 ) End Select -93-
' ボタン ( 終了 ) がクリックされた時の処理 Private Sub btnfinish_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnfinish.click Application.Exit( ) 6 デザイン画面のボタン btnstart をダブルクリックして コード画面を表示し 左記のコードを入力する '============================ ' 以下ジェネラルプロシージャ '============================ 7 上記 1 と同様に コード記述画面を表示して 左記のコードを記述する 以下同様 ' 重力方向に依りパーツ画像を変更するジェネラルプロシージャ Private Sub ChangeImage( ) For I As Integer = 0 To 5 GT( I ).Clear( Color.Black ): GT( I ).DrawImage( PT( I ), 0, 0 ) For J As Integer = 1 To Gd TP( I ).Image.RotateFlip( RotateFlipType.Rotate90FlipNone ) Next Next Call ChangeKong( ) ' 重力方向に依りコング画像を変更するジェネラルプロシージャ Private Sub ChangeKong( ) GT( 6 ).Clear( Color.Black ): GT( 6 ).Clear( Color.Transparent ) GT( 6 ).DrawImage( DK( Kc ), 0, 0 ) For I As Integer = 1 To Gd TP( 6 ).Image.RotateFlip( RotateFlipType.Rotate90FlipNone ) Next ' プレイ画面にシートを表示するジェネラルプロシージャ Private Sub DispSheet( ) lblsheetno. = " 第 " & StrConv(( ST + 1 ).ToString( ), VbStrConv.Wide ) & " 面 " G.Clear( Color.Black ): pickong.visible = False For I As Integer = 0 To 11 For J As Integer = 0 To 11 If SG( J, I ) > 0 Then G.DrawImage( TP( SG( J, I )).Image, J * 48, I * 48 ) Next Next pnlboard.refresh( ) pickong.image = TP( 6 ).Image pickong.location = New Point( Px * 48, Py * 48 ) pickong.visible = True -94-
' 重力方向に依り仮想画面を変更するジェネラルプロシージャ Private Sub ChangeSheet( ) Dim I, J, X, Y, W As Integer ' コングを一旦重力方向 0 の状態に変換 Select Case Pd Case 0 Case 1: W = Px: Px = Py: Py = 11 - W Case 2: Px = 11 Px: Py = 11 - Py Case 3: W = Px: Px = 11 Py: Py = W End Select ' 指定重力方向の状態に変換 Select Case Gd Case 0 For I = 0 To 11 For J = 0 To 11 SG( I, J ) = WK( I, J ) Next J Next I Case 1 Y = 0 For I = 0 To 11 X = 0 For J = 11 To 0 Step -1 SG( X, Y ) = WK( I, J ): X += 1 Next J Y += 1 Next I W = Px: Px = 11 Py: Py = W Case 2 Y = 0 For I = 11 To 0 Step -1 X = 0 For J = 11 To 0 Step -1 SG( X, Y ) = WK( J, I ): X += 1 Next J Y += 1 Next I Px = 11 Px: Py = 11 - Py Case 3 Y = 0 For I = 11 To 0 Step -1 X = 0 For J = 0 To 11 SG( X, Y ) = WK( I, J ): X += 1 Next J Y += 1 Next I W = Px: Px = Py: Py = 11 - W End Select ' 新シートの表示 Call DispSheet( ) -95-
' 落下処理を行うジェネラルプロシージャ Private Sub DropDown( ) Dim Bx, By, Tx, Ty, Cnt, I As Integer Select Case Gd Case 0 : Bx = 0 : By = 1 Case 1 : Bx = -1 : By = 0 Case 2 : Bx = 0 : By = -1 Case 3 : Bx = 1 : By = 0 End Select Cnt = 0: Tx = Px + Bx : Ty = Py + By If Tx < 0 Or Tx > 11 Then Exit Sub If Ty < 0 Or Ty > 11 Then Exit Sub Do While SG( Tx, Ty ) = 0 Kc = 2: Call ChangeKong( ) : pickong.refresh( ) Px = Tx : Py = Ty: pickong.location = New Point( Px * 48, Py * 48 ) Cnt += 1 Tx = Px + Bx : Ty = Py + By If Tx < 0 Or Tx > 11 Then Exit Do If Ty < 0 Or Ty > 11 Then Exit Do Loop If Cnt > 1 Then PlayFlag = False For I = 1 To 5 Kc = 8: Call ChangeKong( ) : pickong.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Kc = 9: Call ChangeKong( ) : pickong.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Next I PlayFlag = True ' シートをクリアした時の処理を行うジェネラルプロシージャ Private Sub ClearSheet( ByRef X As Integer, ByRef Y As Integer ) Dim I As Integer Dim F As Boolean = False tmrtime.enabled = False: PlayFlag = False: Me.KeyPreview = False TotalTime += SW.ElapsedMilliseconds / 1000: lbltotal. = TotalTime.ToString( ) Px = X : Py = Y: pickong.location = New Point( Px * 48, Py * 48 ) For I = 1 To 5 Kc = 4: Call ChangeKong( ) : pickong.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Kc = 5: Call ChangeKong( ) : pickong.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Next I -96-
' 終了判定 ST += 1 If ST > SheetMax Then If HiScore < TotalTime Then HiScore = TotalTime : F = True With frminfo.lblscore. = TotalTime.ToString( ) If F Then.lblRecord. = " 記録を更新しました!".grpRecord.Enabled = True:.Record = True Else.lblRecord. = " 記録は更新されませんでした ".grprecord.enabled = False:.Record = False End With frminfo.showdialog( ) If F Then PlayerName = Me.Player Dim S As String = SD & "gravity.rec" FileOpen( 1, S, OpenMode.Output ) Print( 1, DateTime.Now.ToString( "yyyy/mm/dd hh:mm:ss" )): Print( 1, "," ) Print( 1, PlayerName ): Print( 1, "," ) PrintLine( 1, HiScore.ToString( )) FileClose( 1 ) Else btnplay.enabled = True End Class 追加フォーム Public Class frminfo ' プロパティの設定 Private RecordValue As Boolean Public Property Record( ) As Boolean Get Return RecordValue End Get Set( ByVal value As Boolean ) RecordValue = value End Set End Property 1 コード記述画面を表示して左記のコードを入力する ' ボタン ( 戻る ) がクリックされた時の処理 Private Sub btnreturn_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnreturn.click If Me.Record Then If txtname. = "" Then Exit Sub frmplayer.player = txtname. Me.Close( ) End Class -97-