ウォームアップ講座 51～60

Similar documents
ルーレットプログラム

ブロック　パニック

倉庫番

ブロック崩し風テニス

ドライブは安全運転で in 滋賀♪

バスケットボール

インベーダープログラム

ウォームアップ講座　17～30

相性占いプログラム

３Ｄ回転体プログラム

かべうちテニス

Microsoft Word 練習問題の解答.doc

神経衰弱ゲーム

VB実用⑦　エクセル操作Ⅰ

グラフィックス

回文作成支援プログラム

ファイル操作

VB 資料 電脳梁山泊烏賊塾 音声認識 System.Speech の利用 System.Speech に依るディクテーション ( 音声を文字列化 ).NetFramework3.0 以上 (Visual Studio 2010 以降 ) では 標準で System.Speech が用意されて居るの

占領双六ゲーム

ListViewコントロール

ICONファイルフォーマット

回文作成支援プログラム

データアダプタ概要

ＶＢ．ＮＥＴ解説

相性占いプログラム

正規表現応用

ウィンドウ操作　応用

(Microsoft Word \203v\203\215\203O\203\211\203~\203\223\203O)

Userコントロール

わにわにパニックプログラム

チャットプログラム

パラパラ漫画

画像閲覧プログラム

草競馬プログラム

３Ｄ回転体プログラム

データを TreeView コントロールで表示 VisualStudio2017 の Web サイトプロジェクトで bootstrap, 及び script フォルダの js ファイルが使用できるマスターページを親とする TestTreeView.aspx ページを作成します 下記の html コー

VB実用⑨　エクセル操作Ⅲ

NotifyIconコントロール

プロセス間通信

VB実用⑧　エクセル操作Ⅱ

スロットプログラム


構造体

相性占いプログラム

Public Grid As ReverseGrid Public Position As Point ' 論理位置 Public Rectangle As Rectangle ' 物理位置 Status; 黒 白 なしの状態 Grid; オセロの盤面 Position; 盤面内の説明 Rectan

.NETプログラマー早期育成ドリル ～VB編 付録 文法早見表～

ファイル監視

万年暦プログラム

回文作成支援プログラム

VB実用⑯　印刷Ⅵ（Excel）

回文作成支援プログラム

DAOの利用

モグラ叩きプログラム

TOEIC

コンピュータ概論

VB実用⑩　エクセル操作Ⅳ

スレッド操作 タイマー

占領双六ゲーム

クリッピング領域

万年暦プログラム

万年暦プログラム

通信対戦プログラム

ファイル操作－バイナリファイル

VFD256 サンプルプログラム

Visual Studio2008 C# で JAN13 バーコードイメージを作成 xbase 言語をご利用の現場でバーコードの出力が必要なことが多々あります xbase 言語製品によっては 標準でバーコード描画機能が付加されているものもあるようで す C# では バーコードフォントを利用したりバー

回文作成支援プログラム

VB実用⑬　印刷Ⅲ（PrintFormメソッド）

パラパラ漫画


神経衰弱ゲーム

画像閲覧プログラム

Visual Basic 資料 電脳梁山泊烏賊塾 コレクション初期化子 コレクション初期化子 初めに.NET 版の Visual Basic では 其れ迄の Visual Basic 6.0 とは異なり 下記の例の様に変数宣言の構文に 初期値を代入する式が書ける様に成った 其の際 1 の様に単一の値

Microsoft Excel操作

グラフィックトレーニング 概要.NET のグラフィック描画は どんなことができるのでしょうか? グラフィックオブジェクトやグラフィック環境 概念を理解するためには クラスを使って馴れることが近道です 本 書に記載されているコードをカットアンドペーストして 一つ一つの機能を体験してください 前提 グラ

3軸加速度センサーモジュール MM-2860 書込み済みマイコンプログラム通信コマンド概要

３Ｄ回転体プログラム

D0090.PDF

Transcription:

カールおじさんの林檎狩 VB 2005 51 プログラムの概要 アクションゲーム カールおじさんの林檎狩 で有る 頭上の林檎が 段々と生長して落下して来るので カールおじさんを矢印キーで移動させて 林檎をキャッチする 前後も考慮されるので 上部の俯瞰図にも注意する 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -1-

オブジェクト プロパティ一覧 パネル 1 ピクチャボックス 1 パネル 2 パネル 3 ラベル 1 ラベル 2 ピクチャボックス 2 ボタン コントロールの種類 プロパティ プロパティの設定値 フォーム Name curl FormBorderStyle FixedSingle MaximizeBox False KeyPreview True StartPosition CenterScreen Text カールおじさんの林檎狩 パネル1 Name pnlbirdview BackColor 128, 255, 128 Size 850, 100 ピクチャボックス1 Name picbirdview ( パネル1の中 ) BackColor Transparent Size 850, 100 パネル2 Name pnlscreen BackColor 128, 255, 128 BackgroundImage back.gif Size 850, 500-2-

コントロールの種類 プロパティ プロパティの設定値 パネル3 Name pnlapple ( パネル2の中 ) BackColor Transparent Size 850, 500 ピクチャボックス1 Name piccurl ( パネル2の中 ) BackColor Transparent Image curl.gif Size 172, 230 ラベル1 Name lblscr ( パネル2の中 ) BackColor Blue Font Times New Roman 20 太字 ForeColor White Size 106, 39 Text 0 TextAlign MiddleRight ラベル2 Name lbltim ( パネル2の中 ) BackColor Red Font Times New Roman 20 太字 ForeColor White Size 106, 39 Text 60 TextAlign MiddleRight ボタン Name btnstart Font Times New Roman 16 太字 Text START -3-

プログラムリスト Public Class curl Private Structure Position Dim X As Integer Dim Y As Integer Dim Z As Integer End Structure Private Structure AppleState Dim Count As Integer Dim Pos As Position End Structure Private picapple(9) As PictureBox Private AppleImg(4) As Bitmap Private Apple( 9 ) As AppleState Private Rn As Random = New Random( ) Private Scr As Integer Private Tim As Integer Private Cnt As Integer Private Man As Position Private Gr, Gm, Ga As Graphics ' フォームが読み込まれた時の処理 Private Sub curl_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' 林檎画像の読込 For I As Integer = 0 To 4 AppleImg( I ) = New Bitmap("apple" & I.ToString( ) & ".gif" ) ' Graphics オブジェクトの生成 With pnlapple.backgroundimage = New Bitmap(.Width,.Height ) Gr = Graphics.FromImage(.BackgroundImage ) End With With pnlbirdview.backgroundimage = New Bitmap(.Width,.Height ) Gm = Graphics.FromImage(.BackgroundImage ) End With With picbirdview.image = New Bitmap(.Width,.Height ) Ga = Graphics.FromImage(.Image ) End With -4-

' ボタン (START) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click For I As Integer = 0 To 9 With Apple( I ).Count = 0.Pos.X = 0.Pos.Y = 0.Pos.Z = 0 End With With Man.X = 396.Y = 270.Z = 10 End With Scr = 0 : lblscr.text = "0" Tim = 600 : lbltim.text = "60" Cnt = 1 Call DispCurl( ) Gr.Clear( Color.Transparent ) : pnlapple.refresh( ) Ga.Clear( Color.Transparent ) : picbirdview.refresh( ) btnstart.visible = False tmrapple.enabled = True ' キー入力が為された時の処理 Private Sub curl_keyup( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyUp If Not tmrapple.enabled Then Exit Sub Select Case e.keycode Case Keys.Left Man.X -= 50 : Call DispCurl( ) Case Keys.Right Man.X += 50 : Call DispCurl( ) Case Keys.Up Man.Z -= 10 : Call DispCurl( ) Case Keys.Down Man.Z += 10 : Call DispCurl( ) End Select -5-

' タイマーが一定間隔で自動的に行う処理 Private Sub tmrapple_tick(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles tmrapple.tick Tim -= 5 : lbltim.text = ( Tim 10 ).ToString( "#0" ) If Tim <= 0 Then If Scr >= Cnt * 10 Then Tim = 600 : lbltim.text = "60": Cnt += 1 Else tmrapple.enabled = False: btnstart.visible = True Exit Sub For I As Integer = 0 To 9 With Apple( I ) If. Count < 5 Then If Rn.( 0, 5 ) < 2 Then If.Count = 0 Then.Pos.X = Rn.( 0, 800 ):.Pos.Y = Rn.( 0, 100 ):.Pos.Z = Rn.( 0, 80 ).Count += 1 Else Dim F As Boolean.Pos.Y += 30 F = ((.Pos.Y >= 240 ) AndAlso (.Pos.Y <= 290 )) F = ( F AndAlso ((.Pos.X > Man.X + 20 ) AndAlso (.Pos.X < Man.X + 100 ))) F = ( F AndAlso ((.Pos.Z > Man.Z ) AndAlso (.Pos.Z < Man.Z + 20 ))) If F Then Scr += 1 : lblscr.text = Scr.ToString( ):.Count = 0 Else If.Pos.Y > 450 Then.Count = 0 End With Gr.Clear( Color.Transparent ) For I As Integer = 0 To 9 With Apple( I ) If.Count > 0 Then Gr.DrawImage( AppleImg(.Count - 1 ),.Pos.X,.Pos.Y ) End With pnlapple.refresh( ) Call DispApple( ) Application.DoEvents( ) -6-

' カールおじさんを表示するジェネラルプロシージャ Private Sub DispCurl( ) With Man piccurl.location = New Point(.X,.Y ) Gm.Clear( Color.FromArgb( 128, 255, 128 )) Gm.FillEllipse( Brushes.Black,.X,.Z, 172, 40 ) pnlbirdview.refresh( ) End With ' 林檎を表示するジェネラルプロシージャ Private Sub DispApple( ) Dim N As Integer Ga.Clear( Color.Transparent ) For I As Integer = 0 To 9 With Apple( I ) If.Count > 0 Then N =.Count * 4 Ga.FillEllipse( Brushes.Red,.Pos.X + 15,.Pos.Z, N, N ) End With picbirdview.refresh( ) End Class -7-

ジェム VB 2005 52 プログラムの概要 アクションパズルゲーム ジェム で有る ジェム ( 赤い球 ) を矢印キーで操作して 出口に導くと 面クリアで有る 出口は 或る条件を満たすと出現する 猶 ジェムは 慣性で移動する 攻略法も用意して居るので 参考にされ度い 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -8-

プログラムリスト モジュール (gem.vb) Module gem Public RT As Integer Public WN As Integer End Module モジュールを gem.vb と謂う名前で追加する オブジェクト プロパティ一覧 スタート画面 ピクチャボックス 1 ラベル 1 ピクチャボックス 2 パネル 1 ピクチャボックス 3 パネル 2 ラベル 2 タイマー コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmstart BackColor Black ControlBox False FormBorderStyle FixedDialog StartPosition CenterScreen Text 空白 -9-

コントロールの種類 プロパティ プロパティの設定値 パネル1 Name pnlarea ピクチャボックス1 Name pictitle Image start1.gif Size 478, 222 パネル2 Name pnlcast Image start2.gif Size 400, 126 ピクチャボックス2 Name picgem Image sprite1.gif Size 32, 32 ピクチャボックス3 Name picdevil Image sprite7.gif Size 32, 32 ラベル1 Name lblmes BackColor Transparent Font HG 創英角ホ ッフ 体 16 太字 ForeColor 208, 208, 0 Size 546, 223 ラベル2 Name lblkey BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor 208, 208, 0 Text 何かキーを押して下さい (Sキーで説明スキップ)! ピクチャボックス 1(picTitle) とパネル 2(pnlCast) は 必ず パネル 1(pnlArea) の中に配置する ピクチャボックス 2(imgGem) とピクチャボックス 3(imgDevil) は パネル 2(pnlCast) の中に配置する ラベル 1(lblMes) とラベル 2(lblKey) は フォームに直接配置する -10-

プログラムリスト Imports System.Media Public Class frmstart Private D1, D2 As Integer Private FG As Boolean Private SD As String Private Player As SoundPlayer ' フォームが読み込まれた時の処理 Private Sub start_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load SD = Application.StartupPath : If Not SD.EndsWith( " " ) Then SD &= " " D1 = -1 : D2 = 1: FG = False Player = New System.Media.SoundPlayer( ) Player.SoundLocation = SD & "sound openning.wav" Player.PlayLooping( ) tmrmove.enabled = True ' フォームが閉じられる時の処理 Private Sub frmstart_formclosed( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosedEventArgs ) Handles Me.FormClosed Player.Stop( ): Player.Dispose( ) ' キー入力が為された時の処理 Private Sub frmstart_keypress( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyPressEventArgs ) Handles Me.KeyPress Dim K As String = e.keychar.tostring( ).ToUpper( ) If FG = False Then lblkey.visible = False tmrmove.enabled = False If K = "U" Or K = "S" Then If K = "U" Then RT = 2 Else RT = 1 Player.Stop( ): Player.Dispose( ) frmmain.show( ): Me.Hide( ) : Exit Sub Else RT = 1-11-

' 画面のスクロールアップ For I As Integer = 1 To 30 pnlarea.top -= 16 Application.DoEvents( ) System.Threading.Thread.Sleep( 100 ) pnlarea.visible = False ' メッセージの表示 Call DispMes( " 或る晴れた日のジュエル王国で " ) Call DispMes( " 王様は 王子に命じました " & Chr( 13 )) Call DispMes( " 悪魔の森の古城に行き デビルボールを倒せ! " ) Call DispMes( " 命令を遂行した暁には 王位を譲る " & Chr( 13 )) Call DispMes( " 精神力と体力と勇気が 幸運を齎すで有ろう " & Chr( 13 )) Call DispMes( " 何かキーを押して下さい " & Chr( 13 )) FG = True Else Player.Stop( ) Player.Dispose( ) frmmain.show( ) Me.Hide( ) e.handled = True ' タイマーが一定間隔で行う処理 Private Sub tmrmove_tick( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles tmrmove.tick D1 = -( D1 ) : D2 = -( D2 ) picgem.left += ( D1 * 8 ) picdevil.left += ( D2 * 8 ) ' メッセージを表示するジェネラルプロシージャ Private Sub DispMes( ByRef S As String ) S = S & Chr( 13 ) For I As Integer = 0 To ( S.Length - 1 ) lblmes.text &= S.Substring( I, 1 ) Application.DoEvents( ) System.Threading.Thread.Sleep( 100 ) End Class -12-

メイン画面 ピクチャボックス 2 ラベル 1 パネル 1 パネル 2 ピクチャボックス 1 グループボックス ラベル 2 ラベル 3 ラベル4 ラベル5 ラベル6 ラベル7 ラベル8 ラベル9 タイマー 1 タイマー 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmmain BackColor Black FormBorderStyle FixedSingle KeyPreview True MaximizeBox False Size 490, 447 StartPosition CenterScreen Text GEM パネル1 Name pnlboard BackColor Black Enabled False Size 352, 352 パネル2 Name pnldevil ( パネル1の中に配置 ) BackColor Transparent Size 352, 352 ピクチャボックス1 Name picboard ( パネル2の中に配置 ) BackColor Transparent Size 352, 352-13-

コントロールの種類 プロパティ プロパティの設定値 ピクチャボックス2 Name pictitle BackColor Black Image title.gif Size 192, 64 ラベル1 Name lbltitle AutoSize False BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor 208, 208, 0 Size 153, 19 Text 入り口 グループボックス Name grpinfo BackColor Black Text 空白 ラベル2 Name lbldetails0 BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor 208, 208, 0 Text ALIVE ラベル3 Name lblalive AutoSize False BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor White Text 0 TextAlign MiddleRight ラベル4 Name lbldetails1 BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor 208, 208, 0 Text LIMIT ラベル5 Name lbllimit AutoSize False BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor White Text 0 TextAlign MiddleRight ラベル6 Name lbldetails2 BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor 208, 208, 0 Text POWER -14-

コントロールの種類 プロパティ プロパティの設定値 ラベル7 Name lblpower AutoSize False BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor White Text 0 TextAlign MiddleRight ラベル8 Name lbldetails3 BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor 208, 208, 0 Text SOLID ラベル9 Name lblsolid AutoSize False BackColor Transparent Font HG 創英角ホ ッフ 体 14 太字 ForeColor White Text 0 TextAlign MiddleRight タイマー 1 Name tmrdevil Enabled False Interval 100 タイマー 2 Name tmrgem Enabled False Interval 100 パネル 2(pnlDevil) は 必ず パネル 1(pnlBoard) の中に配置する ピクチャボックス 1(picBoard) は 必ず パネル 2(pnlDevil) の中に配置する フォームを main.vb と謂う名前で追加する -15-

プログラムリスト Imports System.Media Public Class frmmain Private Structure SheetData Dim Cx As Integer Dim Cy As Integer Dim Dx As Integer Dim Dy As Integer Dim D1 As Integer Dim D2 As Integer Dim Sx( ) As Integer Dim Sy( ) As Integer Dim Sc( ) As Integer End Structure ' デビルX 座標 ' デビルY 座標 ' 出口出現 X 座標 ' 出口出現 Y 座標 ' 出口描画方向 ' 出口描画位置 ' 隠れキャラX 座標 ' 隠れキャラY 座標 ' 隠れキャラ種類 Private BD( 8, 21, 21) As Integer ' 盤面データ ( 面 行 列 ) Private SD( 8 ) As SheetData ' 盤面データ ( 隠れキャラ等 ) Private SS As Integer ' 隠れキャラ番号 Private RO As Integer ' 面番号 Private TL( 8 ) As String ' タイトル文字列 Private Gs As Integer = 0 ' ジェム状態 (0: 通常 3: 翼 4: 超 5: 王様 ) Private Bx, By As Integer ' ジェム座標 Private B1, B2 As Integer ' ジェム移動係数 (X 方向 Y 方向 ) Private BO As Integer ' 命 (ALIVE) Private PO As Integer ' 体力 (POWER) Private HA As Integer ' 破壊力 (SOLID) Private WG As Integer ' 翼フラグ Private HS As Integer ' 鋏フラグ Private Gx As Integer Private Ux, Uy As Integer ' デビル座標 Private U1, U2 As Integer ' デビル移動係数 (X 方向 Y 方向 ) Private U3 As Integer ' デビル方向変換 Private UU As Integer ' デビル出現 (1: 出現 0: 不在 ) Private TI As Integer ' 制限時間 ( 秒単位 ) Private ST As Long ' 開始時間 Private FG As Boolean = False ' 残時間フラグ (30 秒以下で True) Private BM( 8 ) As Bitmap ' スプライト画像 Private CH As Bitmap ' キャラクタ画像 Private Gb As Graphics ' 描画用 Graphics オブジェクト ( 背景用 ) Private Gg As Graphics ' 描画用 Graphics オブジェクト ( ジェム用 ) Private Gd As Graphics ' 描画用 Graphics オブジェクト ( デビル用 ) Private Player As SoundPlayer Private SP As String ' 起動パス -16-

' フォームが読み込まれた時の処理 Private Sub frmmain_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load Dim F, S As String Dim H, I, J As Integer ' 起動パスの取得 SP = Application.StartupPath : If Not SP.EndsWith( " " ) Then SP &= " " ' 盤面データの読込 F = SP & "gem.dat" : S = "" FileOpen( 1, F, OpenMode.Input ) For H = 0 To 8 SD( I ).Sx = New Integer( 8 ) { } SD( I ).Sy = New Integer( 8 ) { } SD( I ).Sc = New Integer( 8 ) { } For I = 0 To 21 Input( 1, S ) For J = 0 To 21 BD( H, I, J ) = System.Convert.ToInt32( S.Substring( J, 1 ), 16 ) J I Input( 1, S ) If S = "U" Then Input( 1, S ) : SD( H ).Cx = Val( S ) Input( 1, S ) : SD( H ).Cy = Val( S ) Input( 1, S ) : SD( H ).Dx = Val( S ) - 1 Input( 1, S ) : SD( H ).Dy = Val( S ) - 1 Input( 1, S ) : SD( H ).D1 = Val( S ) - 1 Input( 1, S ) : SD( H ).D2 = Val( S ) - 1 For I = 0 To H Input( 1, S ) : SD( H ).Sx( I ) = Val( S ) Input( 1, S ) : SD( H ).Sy( I ) = Val( S ) Input( 1, S ) : SD( H ).Sc( I ) = Val( "&H" & S ) I H FileClose( 1 ) ' 画像の読込 For I = 0 To 8 S = "sprite" & ( I + 1 ).ToString( ) & ".gif" BM( I ) = New Bitmap( S ) CH = New Bitmap( "charactor.gif" ) -17-

' Graphics オブジェクトの生成 With pnlboard.backgroundimage = New Bitmap(.Width,.Height ) Gb = Graphics.FromImage(.BackgroundImage ) End With With picboard.image = New Bitmap(.Width,.Height ) Gg = Graphics.FromImage(.Image ) End With With pnldevil.backgroundimage = New Bitmap(.Width,.Height ) Gd = Graphics.FromImage(.BackgroundImage ) End With ' タイトル文字列の設定 TL( 0 ) = " 入り口 ": TL( 1 ) = " 庭 ": TL( 2 ) = " 水園 ": TL( 3 ) = " 迷路 ": TL( 4 ) = " 宝石箱 " TL( 5 ) = " 倉庫 ": TL( 6 ) = " 温室 ": TL( 7 ) = " 看板 ": TL( 8 ) = " ダイアモンドの塔 " ' 乱数系列の初期化 Randomize( ) ' SoundPlayer オブジェクトの初期化 Player = New System.Media.SoundPlayer( ) ' 変数等の初期化 Bx = 32 : By = 58 : B1 = 0 : B2 = 0 : Gs = 0 : Gg.DrawImage( BM( Gs ), Bx, By ) BO = 5 * RT : Call AliveDisp( ) PO = 100 : Call PowerDisp( ) HA = 0 : Call SolidDisp( ) TI = 180 * RT : Call LimitDisp( ) Gx = 25 : U1 = 3 : U2 = -3 : U3 = 0 : HS = 0 : UU = 0 : WG = 0 : WN = 0 RO = 1 : Call SheetDisp( RO - 1 ) ST = DateTime.Now.Ticks tmrgem.enabled = True ' フォームが閉じられる時の処理 Private Sub frmmain_formclosed( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosedEventArgs ) Handles Me.FormClosed If tmrgem.enabled = True Then tmrgem.enabled = False If tmrdevil.enabled = True Then tmrdevil.enabled = False Player.Dispose( ) Me.Dispose( ) Application.Exit( ) -18-

' キーが押された時の処理 Private Sub frmmain_keydown( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyDown Dim K As Integer = e.keycode B1 = B1 - ( K = System.Windows.Forms.Keys.Right Or B1 = -10 ) _ + ( K = System.Windows.Forms.Keys.Left Or B1 = 10 ) B2 = B2 - ( K = System.Windows.Forms.Keys.Down Or B2 = -10 ) _ + ( K = System.Windows.Forms.Keys.Up Or B2 = 10 ) ' タイマー ( ジェム ) が一定間隔で行う処理 Private Sub tmrgem_tick(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles tmrgem.tick Dim C, I, X, Y, N As Integer Dim R As Rectangle ' Ticks は 0001 年 1 月 1 日午前 00:00:00 以降の経過時間 (100 ナノ秒単位 ナノ秒は 1 秒の 10 億分の 1) TI = ( 180 * RT ) - CInt(( DateTime.Now.Ticks ST ) / 10000000 ) : If TI < 0 Then TI = 0 Call LimitDisp( ) If TI = 0 Then tmrgem.enabled = False If UU = 1 Then tmrdevil.enabled = False Me.Hide( ) frmover.showdialog( ) Me.Close( ) Exit Sub ElseIf TI = 30 Then If Not FG Then With pnlboard Gb.FillRectangle( New SolidBrush( Color.FromArgb(86, 255, 0, 0)), 0, 0,.Width,.Height ).Refresh( ) End With FG = True If Not (( B1 = 0 ) And ( B2 = 0 )) Then Bx += B1 : By += B2 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) N = RO - 1 C = BD( N, ( By + 16 ) 16, ( Bx + 16 ) 16 ) -19-

Select Case C Case 0 Player.SoundLocation = SP & "sound wall.wav": Player.Play( ) B1 = -B1 Call HiddenDisp( ) PO = PO - 5 : Call PowerDisp( ) Case 1 Player.SoundLocation = SP & "sound damper.wav": Player.Play( ) B1 = 5 : B2 = 5 Case 2 Player.SoundLocation = SP & "sound wall.wav": Player.Play( ) B2 = -B2 Call HiddenDisp( ) PO -= 5 : Call PowerDisp( ) Case 3 Case 4 If WG < 1 Then Call HiddenDisp( ) If HA * ( System.Math.Abs( B1 ) + System.Math.Abs( B2 )) + PO > 150 Then Call ChangeDisp( 3 ) PO -= 2 : Call PowerDisp( ) Else Player.SoundLocation = SP & "sound wall.wav": Player.Play( ) B1 = -B1 : B2 = -B2 PO -= 5 : Call PowerDisp( ) Case 5 If PO > 100 * ( RT ^ 2 ) Then Player.SoundLocation = SP & "sound pyramid1.wav": Player.Play( ) Call ChangeDisp( 8 ) ElseIf PO <= 50 * ( RT ^ 3 ) Then Player.SoundLocation = SP & "sound pyramid2.wav": Player.Play( ) Call ChangeDisp( 3 ) HA += 10 : Call SolidDisp( ) PO += 30 : Call PowerDisp( ) Case 6 If WG < 1 Then tmrgem.enabled = False Player.SoundLocation = SP & "sound water.wav": Player.Play( ) For I = 1 To 4 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx + I * 3, By + I * 3, 32 - I * 6, 32 - I * 6 ) picboard.refresh( ) Call Sleep( 0.3 ) I Gg.Clear( Color.Transparent ) -20-

picboard.refresh( ) Call Sleep( 0.5 ) If HA >= 100 Then Call ChangeDisp( 3 ) Do While BD( N, ( By + 16 ) 16, ( Bx + 16 ) 16 ) = 6 Bx -= B1 : By -= B2 Loop Gg.Clear( Color.Transparent ) picboard.refresh( ) BO -= 1 If BO < 0 Then tmrgem.enabled = False If UU = 1 Then tmrdevil.enabled = False Me.Hide( ) frmover.showdialog( ) Me.Close( ) Exit Sub Call AliveDisp( ) B1 = 0 : B2 = 0 Ux = SD( N ).Cx : Uy = SD( N ).Cy Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) tmrgem.enabled = True Case 7 If WG < 1 Then If HS = 1 Then Call ChangeDisp( 3 ) Else Player.SoundLocation = SP & "sound grass.wav": Player.Play( ) PO -= 1 : Call PowerDisp( ) Case 8 If RT = 2 Then Call ChangeDisp( 3 ) HA += 10 : Call SolidDisp( ) PO += 30 : Call PowerDisp( ) Else Player.SoundLocation = SP & "sound skull.wav": Player.Play( ) HA -= 5 : Call SolidDisp( ) Case 9 Player.SoundLocation = SP & "sound gold.wav": Player.Play( ) Call ChangeDisp( 3 ) PO += 50 : Call PowerDisp( ) -21-

Case 10 If WG < 2 Then Call HiddenDisp( ) If HA * ( System.Math.Abs( B1 ) + System.Math.Abs( B2 )) + PO > 300 Then Call ChangeDisp( 3 ) PO -= 3 : Call PowerDisp( ) Else Player.SoundLocation = SP & "sound wall.wav": Player.Play( ) B1 = -B1 : B2 = -B2 PO -= 10 : Call PowerDisp( ) Case 11 Player.SoundLocation = SP & "sound mevius.wav": Player.Play( ) Call ChangeDisp( 3 ) BO += 1 : Call AliveDisp( ) Case 12 Call ChangeDisp( 3 ) WG = 1 Gs = 3 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) Case 13 Call ChangeDisp( 3 ) HS = 1 Case 16 To 19 If WG < 2 Then If HA * (System.Math.Abs(B1) + System.Math.Abs(B2)) + PO > 700 And WG = 1 Then Bx = 192 : By = 192 : B1 = 0 : B2 = 0 : WG = 2 Gs = 4 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) Else Player.SoundLocation = SP & "sound tower.wav": Player.Play( ) B1 = -B1 : B2 = -B2 Case Else tmrgem.enabled = False If UU = 1 Then tmrdevil.enabled = False Gd.Clear( Color.Transparent ) pnldevil.refresh( ) UU = 0-22-

For I = TI To 0 Step -1 TI = I : Call LimitDisp( ) PO += 1 : Call PowerDisp( ) Call Sleep( 0.1 ) I Gb.Clear( Color.Black ) Bx = ( Bx 16 ) * 16 : By = ( By 16 ) * 16 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) Select Case SD( N ).D1 Case 0 X = 0 : Y = 8 Case 1 X = -8 : Y = 0 Case 2 X = 0 : Y = -8 Case 3 X = 8 : Y = 0 End Select For I = 1 To 39 Bx = Bx + X : By = By + Y Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) Call Sleep( 0.1 ) I If WG > 0 Then Gs = 0 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picboard.refresh( ) WG = 0 TI = 180 : FG = False : Call LimitDisp( ) B1 = 0 : B2 = 0 RO += 1 : Call SheetDisp( RO - 1 ) If SD( RO - 1 ).Cx > 0 And SD( RO - 1 ).Cy > 0 Then UU = 1 : Ux = SD( RO - 1 ).Cx : Uy = SD( RO - 1 ).Cy Gd.Clear( Color.Transparent ) Gd.DrawImage( BM( 6 ), Ux, Uy ) pnldevil.refresh( ) tmrdevil.enabled = True ST = DateTime.Now.Ticks tmrgem.enabled = True End Select -23-

If SD( N ).Dx = (( Bx + 16 ) 16 ) And SD( N ).Dy = (( By + 16 ) 16) Then Select Case SD( N ).D1 Case 0 To 3 For I = 0 To 2 Select Case SD( N ).D1 Case 0 X = SD( N ).D2 + I : Y = 0 Case 1 X = 21 : Y = SD( N ).D2 + I Case 2 X = SD( N ).D2 + I : Y = 21 Case 3 X = 0 : Y = SD( N ).D2 + I End Select BD( N, Y, X ) = -1 R = New Rectangle( 3 * 16, 0, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) I Case 4 X = SD( N ).D2 Y = 10 : BD( N, Y, X ) = 16 R = New Rectangle( 1 * 16, 3 * 16, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) Y = 11 : BD( N, Y, X ) = 17 R = New Rectangle( 2 * 16, 3 * 16, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) X = X + 1 Y = 10 : BD( N, Y, X ) = 18 R = New Rectangle( 3 * 16, 3 * 16, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) Y = 11 : BD( N, Y, X ) = 19 R = New Rectangle( 4 * 16, 3 * 16, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) End Select pnlboard.refresh( ) ' タイマー ( デビル ) が一定間隔で行う処理 Private Sub tmrdevil_tick( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles tmrdevil.tick If System.Math.Abs( Bx - Ux ) < 24 And System.Math.Abs( By - Uy ) < 24 Then If WG = 2 Then tmrgem.enabled = False tmrdevil.enabled = False Gd.Clear( Color.Transparent ): Gd.DrawImage( BM( 7 ), Ux, Uy ): pnldevil.refresh( ) Call Sleep( 0.5 ) -24-

Gd.Clear( Color.Transparent ): Gd.DrawImage( BM( 8 ), Ux, Uy ): pnldevil.refresh( ) Call Sleep( 0.5 ) Gd.Clear( Color.Transparent ): pnldevil.refresh( ) Call Sleep( 2.0 ) WN = 1 Me.Hide( ) frmover.showdialog( ) Me.Close( ) Exit Sub Else Call GemCrash( ) Else If BD( RO - 1, ( Uy + U2 + 16 ) 16, ( Ux + U1 + 16 ) 16) = 3 Then Ux += U1 : Uy += U2 Else U3 += 1 Select Case U3 Case 1: U1 = B1 Case 2: U2 = B2 Case 3: U1 = -B1 Case 4: U2 = -B2 : U3 = 0 End Select Gd.Clear( Color.Transparent ): Gd.DrawImage( BM( 6 ), Ux, Uy ): pnldevil.refresh( ) '======================= ' ジェネラルプロシージャ '======================= ' 盤面を表示するジェネラルプロシージャ Private Sub SheetDisp( ByVal N As Integer ) Dim I, J, C As Integer Dim R As Rectangle Gb.Clear( Color.Black ) For I = 0 To 21 For J = 0 To 21 C = BD( N, I, J ) R = New Rectangle(( C Mod 5 ) * 16, ( C 5 ) * 16, 16, 16 ) Gb.DrawImage( CH, J * 16, I * 16, R, GraphicsUnit.Pixel ) J I pnlboard.refresh( ) lbltitle.text = TL( N ): SS = 0-25-

' 隠れキャラを表示するジェネラルプロシージャ Private Sub HiddenDisp( ) Dim N, X, Y, C As Integer If SS < RO Then If Int( Rnd( ) * 5 ) = 3 Then N = RO - 1 : X = SD( N ).Sx( SS ) - 1 : Y = SD( N ).Sy( SS ) 1 C = Val( CStr( SD( N ).Sc( SS ))): BD( N, Y, X ) = C Dim R As Rectangle = New Rectangle(( C Mod 5 ) * 16, ( C 5 ) * 16, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) If TI <= 30 Then Gb.FillRectangle(New SolidBrush(Color.FromArgb(86, 255, 0, 0)), X * 16, Y * 16, 16, 16) pnlboard.refresh( ) SS += 1 ' 地面を表示するジェネラルプロシージャ Private Sub ChangeDisp( ByRef N As Integer ) Dim X, Y As Integer X = ( Bx + 16 ) 16 : Y = ( By + 16 ) 16 BD( RO - 1, Y, X ) = N Dim R As Rectangle = New Rectangle( 3 * 16, 0, 16, 16 ) Gb.DrawImage( CH, X * 16, Y * 16, R, GraphicsUnit.Pixel ) pnlboard.refresh( ) ' 命 (ALIVE) を表示するジェネラルプロシージャ Private Sub AliveDisp( ) lblalive.text = StrConv( BO.ToString( ), VbStrConv.Wide ) ' 体力 (POWER) を表示するジェネラルプロシージャ Private Sub PowerDisp( ) If PO < 0 Then PO = 0 ElseIf PO > 200 * RT Then PO = 200 * RT lblpower.text = StrConv( PO.ToString( ), VbStrConv.Wide ) If PO = 0 Then Call GemCrash( ) -26-

' 破壊力 (SOLID) を表示するジェネラルプロシージャ Private Sub SolidDisp( ) lblsolid.text = StrConv( HA.ToString( ), VbStrConv.Wide ) ' 残り時間 (LIMIT) を表示するジェネラルプロシージャ Private Sub LimitDisp( ) lbllimit.text = StrConv( TI.ToString( ), VbStrConv.Wide ) ' ジェムが破壊されるジェネラルプロシージャ Private Sub GemCrash( ) tmrgem.enabled = False Player.SoundLocation = SP & "sound crash.wav": Player.Play( ) Gg.Clear( Color.Transparent ): Gg.DrawImage( BM( 1 ), Bx, By ): picboard.refresh( ) Call Sleep( 0.5 ) Gg.Clear( Color.Transparent ): Gg.DrawImage( BM( 2 ), Bx, By ): picboard.refresh( ) Call Sleep( 0.5 ) Gg.Clear( Color.Transparent ): picboard.refresh( ) Call Sleep( 0.5 ) Bx += B1 : By += B2 BO -= 1 If BO < 0 Then tmrgem.enabled = False If UU = 1 Then tmrdevil.enabled = False Me.Hide( ) frmover.showdialog( ) Me.Close( ) Exit Sub Call AliveDisp( ) B1 = 0 : B2 = 0 If UU = 1 Then Ux = SD( RO - 1 ).Cx : Uy = SD( RO - 1 ).Cy PO = 100 * ( RT 1 ) : lblpower.text = StrConv( PO.ToString( ), VbStrConv.Wide ) Gg.Clear( Color.Transparent ): Gg.DrawImage( BM( Gs ), Bx, By ): picboard.refresh( ) tmrgem.enabled = True ' 時間待ちを行うジェネラルプロシージャ Private Sub Sleep( ByRef P As Single ) Dim T As Long T = DateTime.Now.Ticks Do While T + P > DateTime.Now.Ticks : System.Windows.Forms.Application.DoEvents() : Loop End Class -27-

フィニッシュ画面 ラベル ピクチャボックス 2 ピクチャボックス 4 ピクチャボックス 1 ピクチャボックス 3 ボタン コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmover BackColor Teal ControlBox False FormBorderStyle FixedDialog Size 490, 447 StartPosition CenterScreen Text 空白 ピクチャボックス1 Name picgem Image sprite1.gif ピクチャボックス2 Name picsprite0 Image sprite4.gif ピクチャボックス3 Name picsprite1 Image sprite5.gif ピクチャボックス4 Name picsprite2 Image sprite6.gif ラベル Name lblmes AutoSize False Font HG 創英角ホ ッフ 体 16 太字 ForeColor 208, 208, 0 Text 空白 ボタン Name btnfinish Image finish.gif -28-

プログラムリスト Imports System.Media Public Class frmover Private SD As String Private SP( 2 ) As PictureBox Private Player As SoundPlayer ' フォームが読み込まれた時の処理 Private Sub frmover_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load SP( 0 ) = picsprite0 SP( 1 ) = picsprite1 SP( 2 ) = picsprite2 SD = Application.StartupPath : If Not SD.EndsWith( " " ) Then SD &= " " Player = New System.Media.SoundPlayer( ) Player.SoundLocation = SD & "sound ending.wav" ' フォームがアクティブに成った時の処理 Private Sub frmover_activated( ByVal sender As Object, ByVal e As System.EventArgs ) _ Handles Me.Activated ' メッセージの表示 If WN = 0 Then Call DispMes( " 戦いに敗れてジュエル王国に帰還した王子に " ) Call DispMes( " 王様は 烈火の如く怒り 謂いました " & Chr( 13 )) Call DispMes( " 未熟者め!! " ) Call DispMes( " デビルボールを倒せずに 舞い戻るとは! " ) Call DispMes( " 此んな様では 王位を譲る訳には行かん! " ) Call DispMes( " 今一度 悪魔の森の古城に行け! " ) Call DispMes( " 然して デビルボールを倒せ! " ) Call DispMes( " 武運を祈る!! " & Chr( 13 )) Call DispMes( " 精神力と体力と勇気が 幸運を齎すで有ろう " & Chr( 13 )) Else Player.Play( ) picgem.visible = True Call DispMes( "CONGRATULATIONS!" & Chr( 13 )) Call DispMes( " 戦いに勝利してジュエル王国に凱旋した王子に " ) Call DispMes( " 王様は 相好を崩して 謂いました " & Chr( 13 )) Call DispMes( " 汝は 目的を成就した " ) Call DispMes( " 依って 汝に 王位を譲る事とする " ) Call DispMes( " 末永くジュエル王国に栄光を! " & Chr( 13 )) -29-

Call DispMes( " 精神力と体力と勇気が 幸運を齎したので有る " & Chr( 13 )) Call DispMes( " 亦 御逢いしませう " & Chr( 13 )) For I As Integer = 0 To 2 picgem.image = SP( I ).Image Application.DoEvents( ) System.Threading.Thread.Sleep( 1000 ) I btnfinish.enabled = True ' フォームが閉じられる時の処理 Private Sub frmover_formclosed( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosedEventArgs ) Handles Me.FormClosed Player.Stop( ) Player.Dispose( ) Me.Dispose( ) Application.Exit( ) ' ボタン ( 終了 ) がクリックされた時の処理 Private Sub cmdfinish_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnfinish.click Me.Close( ) ' メッセージを表示するジェネラルプロシージャ Private Sub DispMes( ByRef S As String ) S = S & Chr( 13 ) For I As Integer = 0 To ( S.Length - 1 ) lblmes.text &= S.Substring( I, 1 ) Application.DoEvents( ) System.Threading.Thread.Sleep( 100 ) I End Class -30-

アレンジボール VB 2005 53 プログラムの概要 ギャンブルゲーム アレンジボール で有る 1 ゲーム 15 個の球を弾いて 出来る丈多くのパターン ( 縦 横 斜め 四隅 中央 4 個 四隅を除く周囲 8 個 ) を揃える 猶 最初は コイン 10 枚から始める 但し コインが無く成っても続けられる 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -31-

オブジェクト プロパティ一覧 ピクチャボックス 2 ピクチャボックス 3 パネル 1 パネル 2 ラベル 5 ラベル 6 パネル 3 ピクチャボックス 1 ピクチャボックス 4 ピクチャボックス 5 ラベル 3 ボタン ラベル 1 ラベル 2 ラベル 4 コントロールの種類 プロパティ プロパティの設定値 フォーム Name Arrangeball BackColor Black FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text アレンジボール - 海 その愛 パネル1 Name pnlback BackColor Teal Size 600, 600 パネル2 Name pnlplate BackColor Transparent Size 600, 600 パネル3 Name pnlball Size 600, 600 ピクチャボックス1 Name picfore BackColor Transparent Image arrangeball_board1.gif Size 600, 600-32-

コントロールの種類 プロパティ プロパティの設定値 ピクチャボックス2 Name picsea Image umi.gif Size 120, 120 ピクチャボックス3 Name piclove Image love.gif Size 120, 120 ピクチャボックス4 Name picnihonmaru Image akogare.gif Size 140, 100 ピクチャボックス5 Name pickaiomaru Image kaiou.gif Size 140, 100 ラベル1 Name lblball BackColor Black ForeColor White Font Times New Roman 16 太字 Text BALL ラベル2 Name lblballcnt BackColor Black ForeColor Yellow Font Times New Roman 16 太字 Text 0 ラベル3 Name lblcion BackColor Black ForeColor White Font Times New Roman 16 太字 Text COIN ラベル4 Name lblcoincnt BackColor Black ForeColor Yellow Font Times New Roman 16 太字 Text 0 ラベル5 Name lblget Font Times New Roman 20 太字 ForeColor Red Text You get!! ラベル6 Name lblgetnum AutoSize False Font Times New Roman 48 太字 ForeColor Red Text 10 TextAlign MiddleCenter ボタン Name btnstart Text START -33-

プログラムリスト Imports System.IO Public Class arrangeball Private GrBack, GrPlate, GrBall As Graphics Private Ball, Plate As Bitmap Private Rn As Random = New Random( ) Private Pos( 19 ) As Point Private Num( 49 ) As Integer Private Bd( 57, 64 ) As Integer Private Pt( 15 ) As Integer Private Pow As Integer = 0 Private Flg As Boolean = True Private Loc As Point Private Cnt As Integer Private Coin As Integer = 10 Private Game As Boolean = False ' フォームが読み込まれた時の処理 Private Sub arrangeball_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load Dim S, D( ) As String ' ボールの軌跡データの読込 Using Sr As StreamReader = New StreamReader( "pos.txt" ) For I As Integer = 0 To 19 S = Sr.ReadLine( ) D = S.Split( "," ) Pos( I ).X = Integer.Parse( D( 0 )) Pos( I ).Y = Integer.Parse( D( 1 )) Sr.Close( ) End Using ' 盤面データの読込 Using Sr As StreamReader = New StreamReader( "board.txt" ) For I As Integer = 0 To 57 S = Sr.ReadLine( ) For J As Integer = 0 To 64 Bd( I, J ) = Integer.Parse( S.Substring( J, 1 )) End Using -34-

' 数字データの読込 Using Sr As StreamReader = New StreamReader( "number.txt" ) S = Sr.ReadLine( ) D = S.Split( "," ) For I As Integer = 0 To 49 Num( I ) = Integer.Parse( D( I )) End Using ' 画像の読込 Ball = New Bitmap( "arrangeball_ball.gif" ) Plate = New Bitmap( "arrangeball_plate.gif" ) ' Graphics オブジェクトの生成 With pnlback.backgroundimage = New Bitmap(.Width,.Height ) GrBack = Graphics.FromImage(.BackgroundImage ) End With With pnlplate.backgroundimage = New Bitmap(.Width,.Height ) GrPlate = Graphics.FromImage(.BackgroundImage ) End With With pnlball.backgroundimage = New Bitmap(.Width,.Height ) GrBall = Graphics.FromImage(.BackgroundImage ) End With Call InitScreen( ) ' 画面を初期化するジェネラルプロシージャ Private Sub InitScreen( ) GrBack.Clear( Color.Transparent ) GrBack.FillRectangle( Brushes.Gray, 178, 174, 242, 242 ) GrBack.FillRectangle( Brushes.Red, 494, 585, 103, 12 ) pnlback.refresh( ) GrPlate.DrawImage( Plate, 168, 164 ) pnlplate.refresh( ) If Game Then GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( 482, 585 )) pnlball.refresh( ) ' ボタン (START) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click -35-

lblget.visible = False : lblgetnum.visible = False For I As Integer = 0 To 15 : Pt( I ) = 0 : Cnt = 15 : lblballcnt.text = Cnt.ToString( ) Coin -= 1 : lblcoincnt.text = Coin.ToString( ) Game = True Call InitScreen( ) btnstart.enabled = False ' キーが押し下げられた時の処理 Private Sub arrangeball_keydown( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyDown If Not Game Then Exit Sub If ( e.keycode = Keys.Space ) And Flg Then GrBack.FillRectangle( Brushes.Teal, 494, 585, Pow * 5, 12 ) pnlback.refresh( ) Pow += 1 If Pow > 19 Then Flg = False GrBack.FillRectangle( Brushes.Red, 494, 585, 103, 12 ) pnlback.refresh( ) For I As Integer = 0 To 19 GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, Pos( I )) pnlball.refresh( ) Pow = 0 Call BoundBall( ) ' キーが開放された時の処理 Private Sub arrangeball_keyup( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyUp If Not Game Then Exit Sub If ( e.keycode = Keys.Space ) And Flg Then Flg = False GrBack.FillRectangle( Brushes.Red, 494, 585, 103, 12 ) pnlback.refresh( ) For I As Integer = 0 To Pow GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, Pos( I )) pnlball.refresh( ) -36-

If Pow = 19 Then Call BoundBall( ) ElseIf Pow < 10 Then For I As Integer = ( Pow - 1 ) To 0 Step -1 GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, Pos( I )) pnlball.refresh( ) GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( 482, 585 )): pnlball.refresh( ) Flg = True Else Loc.X = ( Pos( Pow ).X - 6 ) 9 + 2 + Rn.( 0, 3 ) Loc.Y = ( Pos( Pow ).Y - 2 ) 9 + 2 Call DispBall( ): Call DropBall( ) Pow = 0 ' 球が落下する処理を行うジェネラルプロシージャ Private Sub DropBall( ) Do Until Loc.Y = 56 Select Case Bd( Loc.Y + 1, Loc.X ) Case 0: Loc.Y += 1 Case 1 If Rn.( 0, 2 ) = 0 Then Loc.X -= 1 Else Loc.X += 1 Case 2: Loc.X += 1 Case 3: Loc.X -= 1 End Select Call DispBall( ) Loop Dim N As Integer = Num( Loc.X ) If Not N < 1 Then GrBack.FillRectangle(Brushes.Red, ((N - 1) Mod 4) * 63 + 178, ((N - 1) 4) * 63 + 174, 53, 53) pnlback.refresh( ) Pt( N - 1 ) = 1 Cnt -= 1 : lblballcnt.text = Cnt.ToString( ) If Cnt = 0 Then Call Judge( ) Game = False btnstart.enabled = True -37-

If Game Then GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( 482, 585 )) pnlball.refresh( ) Flg = True ' 球が跳ね返る処理を行うジェネラルプロシージャ Private Sub BoundBall( ) GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( 466, 68 )): pnlball.refresh( ) GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( 443, 63 )): pnlball.refresh( ) GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( 420, 70 )): pnlball.refresh( ) Loc.X = ( 420-6 ) 9-1 Loc.Y = ( 70-2 ) 9 + 1 Call DispBall( ) Call DropBall( ) ' 球を表示するジェネラルプロシージャ Private Sub DispBall( ) Dim X As Integer = Loc.X * 9 + 6 Dim Y As Integer = Loc.Y * 9 + 2 GrBall.Clear( Color.Transparent ) GrBall.DrawImage( Ball, New Point( X, Y )): pnlball.refresh( ) ' 判定を行うジェネラルプロシージャ Private Sub Judge( ) Dim N As Integer = 0 If Pt( 0 ) + Pt( 1 ) + Pt( 2 ) + Pt( 3 ) = 4 Then N += 1 If Pt( 4 ) + Pt( 5 ) + Pt( 6 ) + Pt( 7 ) = 4 Then N += 1 If Pt( 8 ) + Pt( 9 ) + Pt( 10 ) + Pt( 11 ) = 4 Then N += 1 If Pt( 12 ) + Pt( 13 ) + Pt( 14 ) + Pt( 15 ) = 4 Then N += 1 If Pt( 0 ) + Pt( 4 ) + Pt( 8 ) + Pt( 12 ) = 4 Then N += 1 If Pt( 1 ) + Pt( 5 ) + Pt( 9 ) + Pt( 13 ) = 4 Then N += 1 If Pt( 2 ) + Pt( 6 ) + Pt( 10 ) + Pt( 14 ) = 4 Then N += 1 If Pt( 3 ) + Pt( 7 ) + Pt( 11 ) + Pt( 15 ) = 4 Then N += 1 If Pt( 0 ) + Pt( 3 ) + Pt( 12 ) + Pt( 15 ) = 4 Then N += 3 If Pt( 5 ) + Pt( 6 ) + Pt( 9 ) + Pt( 10 ) = 4 Then N += 3 If Pt( 1 ) + Pt( 2 ) + Pt( 4 ) + Pt( 7 ) + Pt( 8 ) + Pt( 11 ) + Pt( 13 ) + Pt( 14 ) = 8 Then N += 5 Coin += N: lblgetnum.text = N.ToString( ) lblget.visible = True : lblgetnum.visible = True: lblcoincnt.text = Coin.ToString( ) End Class -38-

ワイヤーフレーム少女 VB 2005 54 プログラムの概要 3D グラフィックスのワイヤーフレーム人形 Wire Girl で有る 予め用意された 10 種類のポーズを色々な角度で表示させる事が出来る 亦 グリッドの値を変更する事で 更に色々なポーズを取らせる事も出来る 猶 ポーズデータを保存する事は出来ないが ファイル操作を覚えれば 簡単に保存機能を追加出来る様に作成して有るので 挑戦して欲しい 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -39-

オブジェクト プロパティ一覧 ボタン 1 ラベル コンボボックス ピクチャボックス データグリッドビュー ラジオボタン 1 ラジオボタン 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name WireGirl FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text Wire Girl ピクチャボックス Name picdisp BackColor Black Size 640, 400 ラベル Name lblviewangle AutoSize False Font MS 明朝 10 標準 ForeColor White Text 視角 :360.0 度 コンボボックス Name cboangle ボタン1 Name btnload Font MS 明朝 10 太字 Text 読込 データグリッドビュー Name dgvpose Columns 部位 TH1 TH2 TH3 ラジオボタン1 Name radseisha Font MS 明朝 12 太字 Text 正射影図 ラジオボタン2 Name radenkin Font MS 明朝 12 太字 Text 遠近図 ボタン2 Name btndraw Text 描画 -40-

描画設定部分 lblalpha txtalpha lblbeta txtbeta ラベル lblx lbly lblz txtx txty txtz テキストボックス lbll txtl lblh txth コントロールの種類 プロパティ プロパティの設定値 ラベル AutoSize False Font MS 明朝 12 太字 Text 上記の通り TextAlign MiddleRight Text Wire Girl テキストボックス Font MS 明朝 12 標準 Text 0.0 TextAlign Right -41-

プログラムリスト Imports System.IO Public Class WireGirl Private Const PI As Single = 3.14159F Private PX( 350 ), PY( 350 ), PZ( 350 ) As Single Private QX( 350 ), QY( 350 ), QZ( 350 ) As Single Private RX( 350 ), RY( 350 ) As Single Private LNP( 600 ) As Integer Private HSP( 24 ), HSL( 24 ) As Integer Private MSP( 19 ), MSL( 19 ), MEP(19), MEL( 19 ) As Integer Private MCP( 18 ), KST( 18 ) As Integer, EYE( 19 ) As Single Private G( 18, 2, 2 ) As Single Private AG1( 18 ), AG2( 18 ), AG3( 18 ) As Single Private KW1( 30 ), KW2( 30 ) As Integer Private COL( ) As Color = { _ Color.Black, _ Color.White, _ Color.White, _ Color.Yellow, _ Color.Yellow, _ Color.White, _ Color.White, _ Color.Cyan, _ Color.Cyan, _ Color.Cyan, _ Color.Cyan, _ Color.Cyan, _ Color.Cyan, _ Color.Green, _ Color.Green, _ Color.Green, _ Color.Green, _ Color.Green, _ Color.Green, _ Color.Magenta _ } Private A( 2, 2 ), B( 2, 2 ), C( 2, 2 ) As Single Private ALP, BET As Single Private AngleFile( 99 ) As String Private Gr As Graphics Private Bm As Bitmap -42-

' フォームが読み込まれた時の処理 Private Sub WireGirl_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 ' 変数の初期化 ALP = 0.0F : BET = 0.0F ' コンボボックス ( アングル ) の初期化 Call SetCombo( ) cboangle.selectedindex = 0 ' データグリッドビューの初期化 Dim NM( ) As String = { " 胸 ", " 腰 ", " 首 ", " 頭 ", " 左肩 ", " 右肩 ", _ " 左腕 ( 肘上 )", " 右腕 ( 肘上 )", " 左腕 ( 肘下 )", " 右腕 ( 肘下 )", _ " 左手 ", " 右手 ", " 左脚 ( 膝上 )", " 右脚 ( 膝上 )", " 左脚 ( 膝下 )", _ " 右脚 ( 膝下 )", " 左足 ", " 右足 " _ } Dim S, D( ) As String For I As Integer = 0 To 17 Dim R As New DataGridViewRow R.CreateCells( dgvpose ) R.Cells( 0 ).Value = NM( I ) R.Cells( 0 ).Style.Alignment = DataGridViewContentAlignment.MiddleLeft R.Cells( 1 ).Value = "" R.Cells( 1 ).Style.Alignment = DataGridViewContentAlignment.MiddleRight R.Cells( 2 ).Value = "" R.Cells( 2 ).Style.Alignment = DataGridViewContentAlignment.MiddleRight R.Cells( 3 ).Value = "" R.Cells( 3 ).Style.Alignment = DataGridViewContentAlignment.MiddleRight dgvpose.rows.add( R ) Using Sr As StreamReader = _ New StreamReader( "AngleData00.txt", System.Text.Encoding.Default ) For I As Integer = 0 To 17 S = Sr.ReadLine( ): D = S.Split( "," ) With dgvpose.rows( I ).Cells( 1 ).Value = D( 0 ):.Cells( 2 ).Value = D( 1 ):.Cells( 3 ).Value = D( 2 ) End With Sr.Close( ) End Using -43-

' ボタン ( 読込 ) がクリックされた時の処理 Private Sub btnload_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnload.click Dim S, D( ) As String ' データの読込 ( 角度データ ) Dim N As Integer = cboangle.selectedindex : If N < 0 Then Exit Sub Using Sr As StreamReader = _ New StreamReader( AngleFile( N ), System.Text.Encoding.Default ) For I As Integer = 0 To 17 S = Sr.ReadLine( ) D = S.Split( "," ) With dgvpose.rows( I ).Cells( 1 ).Value = D( 0 ).Cells( 2 ).Value = D( 1 ).Cells( 3 ).Value = D( 2 ) End With Sr.Close( ) End Using ' ボタン ( 描画 ) がクリックされた時の処理 Private Sub btndraw_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btndraw.click Dim S, D( ) As String Dim IMAX, DT As Integer Dim N, L, LS As Integer Dim NP, NL, NK As Integer Dim NP_MAX, NL_MAX, NK_MAX As Integer Dim NP0, NP1 As Integer Dim NL0, NL1 As Integer Dim HC1, HC2 As Integer Dim N1, N2 As Integer Dim X, Y, Z As Single Dim CX, CY, CZ As Single Dim SX, SY, SZ As Single Dim VX, VY, VZ As Single Dim WX, WY, WZ As Single Dim SK, SH As Single Dim WC, WD, BNB As Single Dim EYE_MAX As Single Dim H, MC As Integer Dim X1, Y1, X2, Y2 As Integer Dim Pn As Pen -44-

N = cboangle.selectedindex : If N < 0 Then Exit Sub ' 視線方向の取得 If Not Single.TryParse( txtalpha.text, ALP ) Then ' α( 視線方向の経度 ) txtalpha.select( 0, txtalpha.text.length ) txtalpha.focus( ) : Exit Sub If Not Single.TryParse( txtbeta.text, BET ) Then ' β( 視線方向の緯度 ) txtbeta.select( 0, txtbeta.text.length ) txtbeta.focus( ) : Exit Sub txtalpha.text = ALP.ToString( "##0.0" ) txtbeta.text = BET.ToString( "##0.0" ) ' 遠近設定値の取得 If Not Single.TryParse( txtx.text, SX ) Then ' 視線が投影面を垂直に貫く点の X 座標 txtx.select( 0, txtx.text.length ) txtx.focus( ) : Exit Sub txtx.text = SX.ToString( "##0.0" ) If Not Single.TryParse( txty.text, SY ) Then ' 視線が投影面を垂直に貫く点の Y 座標 txty.select( 0, txty.text.length ) txty.focus( ) : Exit Sub txty.text = SY.ToString( "##0.0" ) If Not Single.TryParse( txtz.text, SZ ) Then ' 視線が投影面を垂直に貫く点の Z 座標 txtz.select( 0, txtz.text.length ) txtz.focus( ) : Exit Sub txtz.text = SZ.ToString( "##0.0" ) WX = SX * 2 : WY = -SY * 2 : WZ = SZ * 2 If Not Single.TryParse( txtl.text, SK ) Then ' 視点から投影面迄の距離 txtl.select( 0, txtl.text.length ) txtl.focus( ) : Exit Sub If SK <= 0 Then txtl.select( 0, txtl.text.length ) txtl.focus( ) : Exit Sub txtl.text = SK.ToString( "##0.0" ) WC = SK * 200 If Not Single.TryParse( txth.text, SH ) Then ' 投影面の上下幅 txth.select( 0, txth.text.length ) txth.focus( ) : Exit Sub txth.text = SH.ToString( "##0.0" ) WD = SH * 100-45-

' 角度データの取込 If dgvpose.rows( 0 ).Cells( 1 ).Value = "" Then Exit Sub For MC = 1 To 18 With dgvpose.rows( MC - 1 ) S =.Cells( 1 ).Value & "," &.Cells( 2 ).Value & "," &.Cells( 3 ).Value End With D = S.Split( "," ) If D( 0 ).Trim( ) = "FIX" Then AG1( MC ) = 0.0F Else AG1(MC) = Single.Parse(D(0)) AG2( MC ) = Single.Parse( D( 1 )) If D(2).Trim() = "FIX" Then AG3(MC) = -AG1(MC) Else AG3(MC) = Single.Parse(D(2)) AG1( MC ) *= ( PI / 180 ) AG2( MC ) *= ( PI / 180 ) AG3( MC ) *= ( PI / 180 ) ' データの読込 ( 点データ ) Using Sr As StreamReader = _ New StreamReader( "PointData.txt", System.Text.Encoding.Default ) NP = 1 : NL = 0 : NK = 0 For HC As Integer = 1 To 24 Step 2 S = Sr.ReadLine( ) ' 部位名 S = Sr.ReadLine( ) : D = S.Split( "," ) IMAX = Integer.Parse( D( 0 )) DT = Integer.Parse( D( 1 )) : If Not DT = 999 Then Stop NP0 = NP : HSP( HC ) = NP0 + 1 NP1 = NP + IMAX : HSP( HC + 1 ) = NP1 + 1 S = Sr.ReadLine( ) : D = S.Split( "," ) X = Single.Parse( D( 0 )) : CX = X Y = Single.Parse( D( 1 )) : CY = Y Z = Single.Parse( D( 2 )) : CZ = Z N = NP0 + 1 : PX( N ) = X : PY( N ) = Y : PZ( N ) = Z N = NP1 + 1 : PX( N ) = -X : PY( N ) = Y : PZ( N ) = Z For I As Integer = 2 To IMAX S = Sr.ReadLine( ) : D = S.Split( "," ) X = Single.Parse( D( 0 )) : X = X - CX Y = Single.Parse( D( 1 )) : Y = Y - CY Z = Single.Parse( D( 2 )) : Z = Z - CZ N = NP0 + I : PX( N ) = X : PY( N ) = Y : PZ( N ) = Z N = NP1 + I : PX( N ) = -X : PY( N ) = Y : PZ( N ) = Z NP = NP + 2 * IMAX S = Sr.ReadLine( ) : D = S.Split( "," ) IMAX = Integer.Parse( D( 0 )) DT = Integer.Parse( D( 1 )) : If Not DT = 999 Then Stop NL0 = NL : HSL( HC ) = NL0 + 1-46-

NL1 = NL + IMAX : HSL( HC + 1 ) = NL1 + 1 S = Sr.ReadLine( ) : D = S.Split( "," ) For I As Integer = 1 To IMAX L = Integer.Parse( D( I - 1 )) If L > 0 Then LS = 1 Else LS = -1 : L = -L If L < 100 Then LNP( NL0 + I ) = LS * ( NP0 + L ) LNP( NL1 + I ) = LS * ( NP1 + L ) Else NK += 1 KW1( NK ) = HC * 100 + I KW2( NK ) = LS * L NL = NL + 2 * IMAX NP_MAX = NP NL_MAX = NL NK_MAX = NK For NK = 1 To NK_MAX HC1 = KW1( NK ) 100 NL = KW1( NK ) Mod 100 If KW2( NK ) > 0 Then LS = 1 Else LS = -1 : KW2( NK ) = -KW2( NK ) HC2 = KW2( NK ) 100 NP = KW2( NK ) Mod 100 If HC2 Mod 2 = 1 Then H = 1 Else H = -1 LNP( HSL( HC1 ) - 1 + NL ) = LS * ( HSP( HC2 ) - 1 + NP ) LNP( HSL( HC1 + 1 ) - 1 + NL ) = LS * ( HSP( HC2 + H ) - 1 + NP ) Sr.Close( ) End Using ' データの設定 Dim T1( ) As Integer = { 0, 1, 3, 5, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23 } For I As Integer = 1 To 19 MSP( I ) = HSP( T1( I )) MSL( I ) = HSL( T1( I )) For I As Integer = 1 To 18 MEP( I ) = MSP( I + 1 ) - 1 MEL( I ) = MSL( I + 1 ) - 1 MEP( 19 ) = NP_MAX MEL( 19 ) = NL_MAX -47-

Dim T2( ) As Integer = { 0, 0, 0, 1, 5, 1, 2, 9, 10, 11, 12, 13, 14, 3, 4, 17, 18, 19, 20 } For I As Integer = 1 To 18 MCP( I ) = HSP( T2( I )) MCP( 2 ) = 1: MCP( 3 ) = HSP( 2 ) - 1 N = MCP( 3 ) : PX( N ) = 0 : PY( N ) = 0 : PZ( N ) = 0 For I As Integer = 1 To 18 N1 = MCP( I ): N2 = MSP( I ) PX( N1 ) = PX( N2 ) - PX( N1 ) PY( N1 ) = PY( N2 ) - PY( N1 ) PZ( N1 ) = PZ( N2 ) - PZ( N1 ) Dim T3( ) As Integer = { 0, 6, 7, 8, 15, 16, 21, 22 } For I As Integer = 1 To 7 N = HSP( T3( I )) : PX( N ) = 0 : PY( N ) = 0 : PZ( N ) = 0 Dim T4( ) As Integer = { 0, 0, 0, 1, 0, 1, 1, 0, 0, 7, 8, 9, 10, 0, 0, 13, 14, 15, 16 } For I As Integer = 1 To 18: KST( I ) = T4( I ): ' データの作成 Dim GM As Single = 0.0F Dim MC0 As Integer For MC = 1 To 18 ' マトリックスの初期化 Call InitMatrix( ) ' マトリックスの作成 Select Case MC Case 2, 7 To 18 Call MtrTH( "Y", AG3( MC )) Call MtrTH( "X", AG2( MC )) Call MtrTH( "Y", AG1( MC )) Case 1, 3, 4 Call MtrTH( "Y", AG3( MC )) Call MtrTH( "X", -AG2( MC )) Call MtrTH( "Y", AG1( MC )) Case 5, 6 Call MtrTH( "X", AG3( MC )) If MC = 5 Then Call MtrTH( "Y", -AG2( MC )) Else Call MtrTH( "Y", AG2( MC )) Call MtrTH( "X", AG1( MC )) End Select -48-

MC0 = KST( MC ) If MC0 > 0 Then A( 0, 0 ) = G( MC0, 0, 0 ) : A( 0, 1 ) = G( MC0, 0, 1 ) : A( 0, 2 ) = G( MC0, 0, 2 ) A( 1, 0 ) = G( MC0, 1, 0 ) : A( 1, 1 ) = G( MC0, 1, 1 ) : A( 1, 2 ) = G( MC0, 1, 2 ) A( 2, 0 ) = G( MC0, 2, 0 ) : A( 2, 1 ) = G( MC0, 2, 1 ) : A( 2, 2 ) = G( MC0, 2, 2 ) Call SekiAB( ) CX = PX( MCP( MC )): CY = PY( MCP( MC )): CZ = PZ( MCP( MC )) For NP = MSP( MC ) To MEP( MC ) X = PX( NP ): Y = PY( NP ): Z = PZ( NP ) PX( NP ) = B( 0, 0 ) * X + B( 0, 1 ) * Y + B( 0, 2 ) * Z + CX PY( NP ) = B( 1, 0 ) * X + B( 1, 1 ) * Y + B( 1, 2 ) * Z + CY PZ( NP ) = B( 2, 0 ) * X + B( 2, 1 ) * Y + B( 2, 2 ) * Z + CZ If GM < PY( NP ) Then GM = PY( NP ) G( MC, 0, 0 ) = B( 0, 0 ) : G( MC, 0, 1 ) = B( 0, 1 ) : G( MC, 0, 2 ) = B( 0, 2 ) G( MC, 1, 0 ) = B( 1, 0 ) : G( MC, 1, 1 ) = B( 1, 1 ) : G( MC, 1, 2 ) = B( 1, 2 ) G( MC, 2, 0 ) = B( 2, 0 ) : G( MC, 2, 1 ) = B( 2, 1 ) : G( MC, 2, 2 ) = B( 2, 2 ) ' 地面データの読込 Using Sr As StreamReader = _ New StreamReader( "GroundData.txt", System.Text.Encoding.Default ) S = Sr.ReadLine( ) If Not S = "AUTO" Then GM = Single.Parse( S ) * ( -2 ) Sr.Close( ) End Using For NP = MSP( 19 ) To MEP( 19 ): PY(NP) = GM: ' データの複写 (PX QX) Call InitMatrix( ) For NP = NP_MAX To 0 Step -1 QX( NP ) = PX( NP ): QY( NP ) = PY( NP ): QZ( NP ) = PZ( NP ) ' 視線方向の加味 Call InitMatrix( ) Call MtrTH( "Y", -ALP * PI / 180 ) Call MtrTH( "X", -BET * PI / 180 ) For NP = NP_MAX To 0 Step -1 X = PX( NP ): Y = PY( NP ): Z = PZ( NP ) QX( NP ) = B( 0, 0 ) * X + B( 0, 1 ) * Y + B( 0, 2 ) * Z QY( NP ) = B( 1, 0 ) * X + B( 1, 1 ) * Y + B( 1, 2 ) * Z QZ( NP ) = B( 2, 0 ) * X + B( 2, 1 ) * Y + B( 2, 2 ) * Z -49-

' 描画 If radseisha.checked Then For MC = 1 To 18: EYE( MC ) = -QZ( MEP( MC )): If Not BET < 0 Then EYE( 19 ) = 1000 Else EYE( 19 ) = -1000 Gr.Clear( Color.Black ) For MM As Integer = 1 To 19 EYE_MAX = -1000000.0 For I As Integer = 1 To 19 If EYE_MAX < EYE( I ) Then EYE_MAX = EYE( I ) : MC = I EYE( MC ) = -1000000.0F Pn = New Pen( COL( MC )) For NL = MSL( MC ) To MEL( MC ) NP = LNP( NL ) If NP > 0 Then X2 = 320 + QX( NP ) : Y2 = 200 + QY( NP ) Gr.DrawLine( Pn, X1, Y1, X2, Y2 ) X1 = X2 : Y1 = Y2 Else X2 = 320 + QX( -NP ) : Y2 = 200 + QY( -NP ) If ( X2 >= 0 And X2 < 640 ) AndAlso ( Y2 >= 0 And Y2 < 400 ) Then Bm.SetPixel( X2, Y2, COL( MC )) X1 = X2 : Y1 = Y2 picdisp.refresh( ) Else VX = B( 0, 0 ) * WX + B( 0, 1 ) * WY + B( 0, 2 ) * WZ VY = B( 1, 0 ) * WX + B( 1, 1 ) * WY + B( 1, 2 ) * WZ VZ = B( 2, 0 ) * WX + B( 2, 1 ) * WY + B( 2, 2 ) * WZ Dim EK As Single = 1 / WC Dim WDM As Single = WD * 160 For NP = NP_MAX To 0 Step -1 X = QX( NP ) VX: Y = QY( NP ) VY: Z = -( QZ( NP ) VZ ) BNB = EK * Z + 1 If BNB > 0.001 Then X = X / BNB : RX( NP ) = X: Y = Y / BNB : RY( NP ) = Y If WDM < Math.Abs( X ) Or WDM < Math.Abs( Y ) Then RX( NP ) = 1000000.0 : RY( NP ) = 1000000.0 Else RX( NP ) = 1000000.0 : RY( NP ) = 1000000.0-50-

Dim CHS As Single If Math.Abs( BET ) < 85 Then CHS = -Math.Tan( BET * PI / 180 ) * WC Else CHS = 1000000.0 Dim ADDX As Single = WD * 1.6 Dim ADDY As Single = WD lblviewangle.text = " 視角 " & (2 * Math.Atan(WD / WC) * 180 / PI).ToString("##0.0") & " 度 " Gr.Clear( Color.Black ) If -WD < CHS And CHS < WD Then Gr.DrawLine( Pens.Blue, -WD * 1.6F + ADDX, CHS + ADDY, _ WD * 1.6F + ADDX, CHS + ADDY ) For MC = 1 To 18 NP = MEP( MC ) EYE(MC) = Math.Sqrt((QX(NP) - VX) ^ 2 + (QY(NP) - VY) ^ 2 + (WC - (QZ(NP) - VZ)) ^ 2) Dim EYE0 As Single = Math.Sqrt( VX ^ 2 + VY ^ 2 + ( WC - VZ ) ^ 2 ) If -GM <= Math.Sin( BET * PI / 180 ) Then EYE( 19 ) = EYE0 + 1000 Else EYE( 19 ) = EYE0-1000 For MM As Integer = 1 To 19 EYE_MAX = -1000000.0 For I As Integer = 1 To 19 If EYE_MAX < EYE( I ) Then EYE_MAX = EYE( I ) : MC = I EYE( MC ) = -1000000.0 Pn = New Pen( COL( MC )) Dim K As Integer = 0 For NL = MSL( MC ) To MEL( MC ) NP = LNP( NL ) If NP < 0 Then NP = -NP : K = 0 If RX( NP ) = 1000000.0 Then K = 0 : Continue For If K = 1 Then X2 = ADDX + RX( NP ) : Y2 = ADDY + RY( NP ) Gr.DrawLine( Pn, X1, Y1, X2, Y2 ) X1 = X2 : Y1 = Y2 Else X2 = ADDX + RX( NP ) : Y2 = ADDY + RY( NP ) If ( X2 >= 0 And X2 < 640 ) AndAlso ( Y2 >= 0 And Y2 < 400 ) Then Bm.SetPixel( X2, Y2, COL( MC )) X1 = X2 : Y1 = Y2-51-

K = 1 picdisp.refresh( ) ' テキストボックス (L) の検証が行われて居る時の処理 Private Sub txtl_validating( ByVal sender As System.Object, _ ByVal e As System.ComponentModel.CancelEventArgs ) Handles txtl.validating Dim SK, SH As Single If Not Single.TryParse( txtl.text, SK ) Then txtl.select( 0, txtl.text.length ) txtl.focus( ) : Exit Sub If SK <= 0 Then txtl.select( 0, txtl.text.length ) txtl.focus( ) : Exit Sub SH = SK * 2 * Math.Tan( PI * 14 / 180 ) txth.text = SH.ToString( "#0.0" ) ' コンボボックス ( アングル ) を設定するジェネラルプロシージャ Private Sub SetCombo( ) Dim S, D( ) As String Dim Cnt As Integer = 0 cboangle.items.clear( ) Using Sr As StreamReader = _ New StreamReader( "TitleData.txt", System.Text.Encoding.Default ) Cnt = 0 Do Until Sr.EndOfStream S = Sr.ReadLine( ) D = S.Split( "," ) cboangle.items.add( D( 0 )) AngleFile( Cnt ) = D( 1 ) : Cnt += 1 Loop Sr.Close( ) End Using -52-

' マトリックスを作成するジェネラルプロシージャ Private Sub MtrTH( ByVal JK As String, ByVal TH As Single ) Select Case JK Case "X" A( 0, 0 ) = 1 : A( 0, 1 ) = 0 : A( 0, 2 ) = 0 A( 1, 0 ) = 0 : A( 1, 1 ) = Math.Cos( TH ) : A( 1, 2 ) = -Math.Sin( TH ) A( 2, 0 ) = 0 : A( 2, 1 ) = Math.Sin( TH ) : A( 2, 2 ) = Math.Cos( TH ) Case "Y" A( 0, 0 ) = Math.Cos( TH ) : A( 0, 1 ) = 0 : A( 0, 2 ) = Math.Sin( TH ) A( 1, 0 ) = 0 : A( 1, 1 ) = 1 : A( 1, 2 ) = 0 A( 2, 0 ) = -Math.Sin(TH) : A( 2, 1 ) = 0 : A( 2, 2 ) = Math.Cos( TH ) Case "Z" A( 0, 0 ) = Math.Cos( TH ) : A( 0, 1 ) = -Math.Sin( TH ) : A( 0, 2 ) = 0 A( 1, 0 ) = Math.Sin( TH ) : A( 1, 1 ) = Math.Cos( TH ) : A( 1, 2 ) = 0 A( 2, 0 ) = 0 : A( 2, 1 ) = 0 : A( 2, 2 ) = 1 End Select ' Call SekiAB( ) ' マトリックスを初期化 ( 単位行列 ) するジェネラルプロシージャ Private Sub InitMatrix( ) B( 0, 0 ) = 1 : B( 0, 1 ) = 0 : B( 0, 2 ) = 0 B( 1, 0 ) = 0 : B( 1, 1 ) = 1 : B( 1, 2 ) = 0 B( 2, 0 ) = 0 : B( 2, 1 ) = 0 : B( 2, 2 ) = 1 ' マトリックスの積を求めるジェネラルプロシージャ Private Sub SekiAB( ) C( 0, 0 ) = A( 0, 0 ) * B( 0, 0 ) + A( 0, 1 ) * B( 1, 0 ) + A( 0, 2 ) * B( 2, 0 ) C( 0, 1 ) = A( 0, 0 ) * B( 0, 1 ) + A( 0, 1 ) * B( 1, 1 ) + A( 0, 2 ) * B( 2, 1 ) C( 0, 2 ) = A( 0, 0 ) * B( 0, 2 ) + A( 0, 1 ) * B( 1, 2 ) + A( 0, 2 ) * B( 2, 2 ) C( 1, 0 ) = A( 1, 0 ) * B( 0, 0 ) + A( 1, 1 ) * B( 1, 0 ) + A( 1, 2 ) * B( 2, 0 ) C( 1, 1 ) = A( 1, 0 ) * B( 0, 1 ) + A( 1, 1 ) * B( 1, 1 ) + A( 1, 2 ) * B( 2, 1 ) C( 1, 2 ) = A( 1, 0 ) * B( 0, 2 ) + A( 1, 1 ) * B( 1, 2 ) + A( 1, 2 ) * B( 2, 2 ) C( 2, 0 ) = A( 2, 0 ) * B( 0, 0 ) + A( 2, 1 ) * B( 1, 0 ) + A( 2, 2 ) * B( 2, 0 ) C( 2, 1 ) = A( 2, 0 ) * B( 0, 1 ) + A( 2, 1 ) * B( 1, 1 ) + A( 2, 2 ) * B( 2, 1 ) C( 2, 2 ) = A( 2, 0 ) * B( 0, 2 ) + A( 2, 1 ) * B( 1, 2 ) + A( 2, 2 ) * B( 2, 2 ) B( 0, 0 ) = C( 0, 0 ) : B( 0, 1 ) = C( 0, 1 ) : B( 0, 2 ) = C( 0, 2 ) B( 1, 0 ) = C( 1, 0 ) : B( 1, 1 ) = C( 1, 1 ) : B( 1, 2 ) = C( 1, 2 ) B( 2, 0 ) = C( 2, 0 ) : B( 2, 1 ) = C( 2, 1 ) : B( 2, 2 ) = C( 2, 2 ) End Class -53-

キーボード VB 2005 55 プログラムの概要 MIDI 音源で音階を鳴らす キーボード で有る コンボボックスで指定した音色で キーボード上をマウスカーソルを動かす事に依り 音を鳴らす事が出来る 猶 音を鳴らさない様に マウスカーソルをキーボード上を移動させるには マウスボタンを押し下げた状態で 移動させる 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -54-

オブジェクト プロパティ一覧 ボタン 1 ボタン 2 コンボボックス トラックバー ピクチャボックス コントロールの種類 プロパティ プロパティの設定値 フォーム Name MML FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text 音階を鳴らす ピクチャボックス Name pickeyboard Image keyboard.gif Size 631, 200 ボタン1 Name btnopen Font Times New Roman 16 太字 Text OPEN ボタン2 Name btnclose Font Times New Roman 16 太字 Text CLOSE コンボボックス Name cbotone Font Times New Roman 12 標準 トラックバー Name barvolume LargeChange 10 Maximum 127 Value 70-55-

プログラムリスト Imports System.IO Public Class MML ' API 関数の宣言 < System.Runtime.InteropServices.DllImport( _ "winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midioutopen( _ ByRef hmidiout As Integer, _ ByVal udeviceid As Integer, _ ByVal dwcallback As Integer, _ ByVal dwinstance As Integer, _ ByVal dwflags As Integer ) As Integer End Function < System.Runtime.InteropServices.DllImport( _ "winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midioutshortmsg( _ ByVal hmidiout As Integer, _ ByVal dwmsg As Integer ) As Integer End Function < System.Runtime.InteropServices.DllImport( _ "winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midioutclose( _ ByVal hmidiout As Integer ) As Integer End Function < System.Runtime.InteropServices.DllImport( _ "winmm.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto )> _ Private Shared Function midioutgetnumdevs( ) As Integer End Function ' フォームクラスレベルでグローバルな変数の宣言 Private HDL As Integer ' MIDI のハンドル Private Tone( 127 ) As String ' 音色 Private Pos( 35 ) As Rectangle ' 鍵盤の位置 Private ToneNo( 35 ) As String ' 音階番号 Private Cmd As String = "" ' 命令コード保存用 Private Num As Integer = 255 Private Flg As Boolean = False -56-

' フォームが読み込まれた時の処理 Private Sub MML_Load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' MIDI デバイスが有るか何うかの判定 If midioutgetnumdevs( ) = 0 Then MessageBox.Show( " 御使用の環境では MIDI 音源を使用出来ません " ) Exit Sub Else MessageBox.Show( " 御使用の環境で MIDI 音源が使用出来ます " ) ' 音色の読込 Dim Sr As StreamReader = New StreamReader( "tone.txt" ) Dim S, D( ) As String For I As Integer = 0 To 127 S = Sr.ReadLine( ) D = S.Split( "," ) Tone( I ) = D( 0 ) cbotone.items.add( D( 1 )) Sr.Close( ) ' 鍵盤位置の読込 Sr = New StreamReader( "position.txt" ) For I As Integer = 0 To 35 S = Sr.ReadLine( ) D = S.Split( "," ) Pos( I ) = New Rectangle( Integer.Parse( D( 0 )), Integer.Parse( D( 1 )), _ Integer.Parse( D( 2 )), Integer.Parse( D( 3 ))) ToneNo( I ) = D( 4 ) Sr.Close( ) Sr.Dispose( ) ' ボタン (OPEN) がクリックされた時の処理 Private Sub btnopen_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnopen.click Dim Ret As Integer ' ハンドルの取得 (Handle にハンドルが入る ) Ret = midioutopen( HDL, -1, 0, 0, 0 ) ' コントロールの有効化 btnclose.enabled = True: cbotone.enabled = True: pickeyboard.enabled = True -57-

' ボタン (CLOSER) がクリックされた時の処理 Private Sub btnclose_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnclose.click ' クローズ midioutclose( HDL ) ' コントロールの無効化 btnclose.enabled = False: cbotone.enabled = False: pickeyboard.enabled = False ' コンボボックス (TONE) の選択項目が変化した時の処理 Private Sub cbotone_selectedindexchanged( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles cbotone.selectedindexchanged Dim Ret As Integer Dim S As String S = Tone( cbotone.selectedindex ) & "C0" ' 音色を変える Ret = midioutshortmsg( HDL, System.Convert.ToInt32( S, 16 )) ' ピクチャボックス (KEYBOARD) でマウスカーソルが移動した時の処理 Private Sub pickeyboard_mousemove( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles pickeyboard.mousemove If Flg Then Exit Sub Dim P As Point = New Point( e.x, e.y ) Dim N As Integer = 0 Dim S As String = "" ' 鍵盤位置の取得 For I As Integer = 0 To 35 If Pos( I ).Contains( P ) Then N = I: Exit For If Not N = Num Then If Not Cmd = "" Then ' 音を止める S = Cmd & "80" midioutshortmsg( HDL, System.Convert.ToInt32( S, 16 )) ' 命令コードの生成 Cmd = ( barvolume.value.tostring( ) & ToneNo( N )) S = Cmd & "90" ' 音を出す midioutshortmsg( HDL, System.Convert.ToInt32( S, 16 )) Num = N -58-

' ピクチャボックス (KEYBOARD) からマウスカーソルが退去した時の処理 Private Sub pickeyboard_mouseleave(byval sender As Object, ByVal e As System.EventArgs) _ Handles pickeyboard.mouseleave If Not Cmd = "" Then ' 音を止める Dim S As String = Cmd & "80" midioutshortmsg( HDL, System.Convert.ToInt32( S, 16 )) Cmd = "" : Num = 0 ' ピクチャボックス (KEYBOARD) でマウスボタンが押し下げられた時の処理 Private Sub pickeyboard_mousedown( ByVal sender As Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles pickeyboard.mousedown Flg = True ' ピクチャボックス (KEYBOARD) でマウスボタンが離された時の処理 Private Sub pickeyboard_mouseup( ByVal sender As Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles pickeyboard.mouseup Flg = False End Class -59-

フルーツポン! VB 2005 56 プログラムの概要 連鎖型落下ゲーム フルーツ ポン! で有る 縦か横に同じ図柄のパネルを 3 個以上並べて消して行く 消去された処には上からパネルがスライドダウンして来る 猶 移動させるパネルをクリックし 次いで 移動先のパネルをクリックすると 2 枚のパネルが入れ替わる 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -60-

オブジェクト プロパティ一覧 ピクチャボックス 1 ピクチャボックス 3 ピクチャボックス 2 ラベル 1 ラベル 2 ラベル 3 ラベル 4 ボタン 1 ボタン 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name fruits FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text Fruits Pon ( 尾立作品のリメイク ) ピクチャボックス1 Name picscore Image score.gif Size 49, 314 ピクチャボックス2 Name picg BackColor White BorderStyle FixedSingle Size 290, 354 ピクチャボックス3 Name pictime BorderStyle Fixed3D Size 16, 354 ラベル1 Name lbltotalcaption Font MS 明朝 12 太字 Text 合計 -61-

コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblgcnt AutoSize False BackColor White Font MS 明朝 12 太字 Size 80, 16 Text 0 TextAlign MiddleRight ラベル3 Name lblmes AutoSize False BackColor 192, 255, 255 BorderStyle FixedSingle Font HG 創英角ホ ッフ 体 16 太字 ForeColor Red Size 250, 90 Text 開始ボタンクリックでゲームスタート! TextAlign MiddleCenter ラベル4 Name lblexplain AutoSize False Font MS 明朝 10 太字 Size 489, 36 Text ルールは簡単です 隣り合う2 個のパネルを入れ替えて 縦か横に3 個以上揃えましょう 右側のメーターが一杯に成る迄に幾つ消せるかな!! ボタン1 Name btnstart Font MS 明朝 12 太字 Text 開始 ボタン2 Name btnfinish Font MS 明朝 12 太字 Text 終了 此のプログラムは 以前 ノアに居られた尾立先生が製作された物を リメイクした物です 従来のプログラムでは 正確なタイマー処理を行うのに API 関数が使用されて居ましたが 今回は.NET Framework の機能で有る System.Timers 名前空間の Timer オブジェクトを使用しました 完全な別スレッドで処理が行われる為 正確なタイマー処理が行えます 但し フォームのコントロールを操作するには デリゲート機能を使用する必要が有ります 少し難しいかも知れませんが 役に立つ知識に成る筈です 少しコードが長いですが 其の分 楽しいです -62-

プログラムリスト Public Class fruits Private Const ENP As Integer = 20 Private Const INS As Integer = 21 Private Map( 9, 7 ) As Integer Private Map1( 9, 7 ), Map2( 9, 7 ), Map3( 19, 7 ) As Integer Private Fcnt( 7 ), Tcnt, Ecnt As Integer Private Px1, Py1, Px2, Py2 As Integer Private Sx, Sy, Ex, Ey As Integer Private FirstFlg, EndFlg As Boolean Private Cstop, Sact, Gact As Boolean Private lblfcnt( 7 ) As Label Private Bm As Bitmap Private Gr, Gt As Graphics Private Rn As Random = New Random( ) Private Tm As System.Timers.Timer = New System.Timers.Timer( ) Delegate Sub TimerDelegate( ) ' フォームが読み込まれた時の処理 Private Sub fruits_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' 得点表示用ラベルの生成 Dim T As Integer = picscore.top + 16 For I As Integer = 0 To 7 lblfcnt( I ) = New Label With lblfcnt( I ).Size = New Size( 80, 16 ).Location = New Point( 103, I * 40 + T ).BackColor = Color.White.Font = New Font( "MS 明朝 ", 12, FontStyle.Bold, GraphicsUnit.Point ).TextAlign = ContentAlignment.MiddleRight End With Me.Controls.Add( lblfcnt( I )) ' 画像の読込 Bm = New Bitmap( "fruits.gif" ) ' Graphics オブジェクトのインスタンス生成 With picg.image = New Bitmap(.Width,.Height ) Gr = Graphics.FromImage(.Image ) End With -63-

With pictime.image = New Bitmap(.Width,.Height ) Gt = Graphics.FromImage(.Image ) End With ' タイマーの設定 AddHandler Tm.Elapsed, _ New System.Timers.ElapsedEventHandler( AddressOf TimerProc ) Tm.Interval = 500 Tm.AutoReset = True ' フォームが閉じられ様とした時の処理 Private Sub fruits_formclosing( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs ) Handles Me.FormClosing Gr.Dispose( ) Application.Exit( ) ' ボタン ( 開始 ) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click Dim I, X, Y, N As Integer Dim R As Rectangle Gact = True : EndFlg = False : Cstop = False Sx = 0 : Sy = 349 : Ex = 13 : Ey = 349 Ecnt = 0 Gt.Clear( Color.White ) : pictime.refresh( ) Gr.Clear( Color.White ) For Y = 0 To 9 For X = 0 To 7 Do N = Rn.( 0, 8 ) Loop Until PutChk( N, Y, X ) R = New Rectangle( 0, N * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) Map( Y, X ) = N picg.refresh( ) For I = 0 To 7 Fcnt( I ) = 0 : lblfcnt( I ).Text = Fcnt( I ).ToString( ) Tcnt = 0 : lblgcnt.text = Tcnt.ToString( ) FirstFlg = False : lblmes.visible = False : Tm.Enabled = True -64-

' ボタン ( 終了 ) がクリックされた時の処理 Private Sub btnfinish_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnfinish.click Me.Close( ) ' ピクチャボックスでマウスボタンが押し下げられた時の処理 Private Sub picg_mousedown( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picg.mousedown Dim X As Integer = e.x Dim Y As Integer = e.y Dim C As Integer Dim R As Rectangle If X >= 16 And X <= 271 And Y >= 16 And Y <= 335 And _ EndFlg = False And Gact = True Then X = X - 16 : Y = Y - 16 If FirstFlg = False Then Py1 = Int( Y / 32 ) : Px1 = Int( X / 32 ) If Map( Py1, Px1 ) <= 7 Then FirstFlg = True R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) Else Cstop = True : Ecnt = 0 Select Case Map( Py1, Px1 ) Case 8 Call ChrDel( Py1, Px1, 1 ): Call MoveProc( ): Call SetProc( ) Case 9 Call ChrDel( Py1, Px1, 2 ): Call MoveProc( ): Call SetProc( ) Case 10 Call Del3Line( Py1, Px1 ): Call MoveProc( ): Call SetProc( ) Case 11 Call ChrDel( Py1, Px1, 3 ): Call MoveProc( ): Call SetProc( ) Case 12 Call ChrChange( Py1, Px1 ) Case 13 Call Vsort( Py1, Px1 ) End Select While MatchChk( ) = True Application.DoEvents( ) : System.Threading.Thread.Sleep( 200 ) Call EraseProc( ): Call MoveProc( ): Call SetProc( ) End While Cstop = False -65-

If NoMoreMove( ) = True And Sact = False Then While NoMoreMove( ) = True Call ReInitialize( ) End While Else Py2 = Int( Y / 32 ) : Px2 = Int( X / 32 ) If Py1 = Py2 And Px1 = Px2 Then FirstFlg = False R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) If ( Py1 = Py2 And ( Px1 = Px2 + 1 Or Px1 = Px2 1 )) Or _ ( Px1 = Px2 And ( Py1 = Py2 + 1 Or Py1 = Py2-1 )) Then C = Map( Py1, Px1 ): Map( Py1, Px1 ) = Map( Py2, Px2 ): Map( Py2, Px2 ) = C If MatchChk( ) = True Then C = Map( Py1, Px1 ): Map( Py1, Px1 ) = Map( Py2, Px2 ): Map( Py2, Px2 ) = C Call TwoFlip( True ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16, R, GraphicsUnit.Pixel) picg.refresh( ) FirstFlg = False C = Map( Py1, Px1 ): Map( Py1, Px1 ) = Map( Py2, Px2 ): Map( Py2, Px2 ) = C Do Application.DoEvents( ) : System.Threading.Thread.Sleep( 200 ) Call EraseProc( ): Call MoveProc( ): Call SetProc( ) Loop While MatchChk( ) = True If NoMoreMove( ) = True And Sact = False Then While NoMoreMove( ) = True Call ReInitialize( ) End While Else C = Map( Py1, Px1 ) Map( Py1, Px1 ) = Map( Py2, Px2 ) Map( Py2, Px2 ) = C Call TwoFlip( False ) FirstFlg = False -66-

'======================= ' ジェネラルプロシージャ '======================= ' タイマー処理を行うジェネラルプロシージャ Private Sub TimerProc( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) If Gact = True Then Invoke( New TimerDelegate( AddressOf DrawTimer )) Sy -= 1: Ey -= 1 If Sy <= -1 Then Tm.Enabled = False EndFlg = True Invoke( New TimerDelegate( AddressOf ShowGameOver )) Gact = False ' 経過時間を表示するジェネラルプロシージャ ( デリゲート用 ) Private Sub DrawTimer( ) Gt.DrawLine( Pens.Magenta, Sx, Sy, Ex, Ey ) pictime.refresh( ) ' 遊戯終了を表示するジェネラルプロシージャ ( デリゲート用 ) Private Sub ShowGameOver( ) lblmes.backcolor = Color.Yellow lblmes.text = "Game Over" lblmes.visible = True ' 最初から 3 個並ぶのを検証するジェネラルプロシージャ Private Function PutChk( ByVal N As Integer, ByVal Y As Integer, ByVal X As Integer ) _ As Boolean If X > 1 Then If N = Map( Y, X 1 ) And N = Map( Y, X - 2 ) Then Return False If Y > 1 Then If N = Map( Y - 1, X ) And N = Map( Y - 2, X ) Then Return False Return True End Function -67-

' 3 個並んで居るかを検証するジェネラルプロシージャ Private Function MatchChk( ) As Boolean Dim X, Y, C As Integer For Y = 0 To 9 C = 1 For X = 1 To 7 If Map( Y, X ) = Map( Y, X - 1 ) Then C += 1 : If C = 3 Then Return True Else C = 1 For X = 0 To 7 C = 1 For Y = 1 To 9 If Map( Y, X ) = Map( Y - 1, X ) Then C += 1 : If C = 3 Then Return True Else C = 1 Return False End Function ' パネルを消去するジェネラルプロシージャ Private Sub EraseProc( ) Dim ClsCnt As Integer Dim I, X, Y As Integer Dim Bx, By, Cnt As Integer Dim R As Rectangle ClsCnt = 0 For X = 0 To 7 For Y = 0 To 9 Map1( Y, X ) = Map( Y, X ) : Map2( Y, X ) = Map( Y, X ) For Y = 0 To 9 Bx = 0 : Cnt = 1 For X = 1 To 7 If Map1( Y, Bx ) = Map1( Y, X ) Then Cnt += 1 Else If Cnt >= 3 Then For Bx = Bx To ( X - 1 ) -68-

Fcnt( Map1( Y, Bx )) += 1 : Tcnt += 1 : Map1( Y, Bx ) = ENP lblfcnt( Map( Y, Bx - 1 )).Text = Fcnt( Map( Y, Bx - 1 )).ToString( ) lblgcnt.text = Tcnt.ToString( ) Bx = X : Cnt = 1 If Cnt >= 3 Then For Bx = Bx To ( X - 1 ) Fcnt( Map1( Y, Bx )) += 1 : Tcnt += 1 : Map1( Y, Bx ) = ENP lblfcnt( Map( Y, Bx - 1 )).Text = Fcnt( Map( Y, Bx - 1 )).ToString( ) lblgcnt.text = Tcnt.ToString( ) For X = 0 To 7 By = 0 : Cnt = 1 For Y = 1 To 9 If Map2( By, X ) = Map2( Y, X ) Then Cnt += 1 Else If Cnt >= 3 Then For By = By To ( Y - 1 ) If Not Map1( By, X ) = ENP Then Fcnt( Map2( By, X )) += 1 : Tcnt += 1 lblfcnt( Map2( By, X )).Text = Fcnt( Map2( By, X )).ToString( ) lblgcnt.text = Tcnt.ToString( ) Map2( By, X ) = ENP By = Y : Cnt = 1 If Cnt >= 3 Then For By = By To ( Y - 1 ) If Not Map1( By, X ) = ENP Then Fcnt( Map2( By, X )) += 1 : Tcnt += 1 lblfcnt( Map2( By, X )).Text = Fcnt( Map2( By, X )).ToString( ) lblgcnt.text = Tcnt.ToString( ) Map2( By, X ) = ENP R = New Rectangle( 0, 8 * 32, 32, 32 ) -69-

For Y = 0 To 9 For X = 0 To 7 If Map1( Y, X ) = ENP Or Map2( Y, X ) = ENP Then Map( Y, X ) = ENP: If Not Cstop Then Ecnt += 1 ClsCnt += 1 Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ): System.Threading.Thread.Sleep( 200 ) For Y = 0 To 9 For X = 0 To 7 Map3( Y + 10, X ) = Map( Y, X ) If Map( Y, X ) = ENP Then Gr.FillRectangle( Brushes.White, X * 32 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) For I = ClsCnt To 0 Step -1 If Sy < 349 Then Gt.DrawLine( Pens.White, Sx, Sy, Ex, Ey ) Sy += 1 : Ey += 1 pictime.refresh( ) ' パネルを移動するジェネラルプロシージャ Private Sub MoveProc( ) Dim X, Y, I As Integer For Y = 9 To 0 Step -1 For X = 0 To 7 Do While Map( Y, X ) = ENP For I = Y To 1 Step -1 Map( I, X ) = Map( I - 1, X ) Map( I, X ) = INS Loop ' パネルをセットするジェネラルプロシージャ Private Sub SetProc( ) Dim I, X, Y, InsCnt( 7 ), Dpoint( 7 ) As Integer Dim R As Rectangle -70-

For I = 0 To 7 : InsCnt( I ) = 9 : For Y = 0 To 9 : For X = 0 To 7 : Map3( Y, X ) = ENP : : For Y = 9 To 0 Step -1 For X = 0 To 7 If Map( Y, X ) = INS Then If Ecnt < 150 Or Sact = True Then If Sact Then Map( Y, X ) = Rn.( 0, 8 ) Else Select Case Rn.( 0, 10000 ) Case Is < 9829 : Map( Y, X ) = Rn.( 0, 8 ) Case Is < 9889 : Map( Y, X ) = Rn.( 0, 9 ) Case Is < 9939 : Map( Y, X ) = Rn.( 0, 11 ) Case Is < 9974 : Map( Y, X ) = Rn.( 0, 13 ) Case Else : Map( Y, X ) = Rn.( 0, 14 ) End Select If Map( Y, X ) > 7 Then Ecnt = 0 : Sact = True Else Map( Y, X ) = Rn.( 0, 14 ) : If Map( Y, X ) > 7 Then Ecnt = 0 : Sact = True Map3( InsCnt( X ), X) = Map( Y, X ) : InsCnt( X ) -= 1 Do For I = 0 To 7 : Dpoint( I ) = 20 : For X = 0 To 7 For Y = 19 To 10 Step -1 If Map3( Y, X ) = ENP And Dpoint( X ) = 20 Then Dpoint( X ) = Y For I = 2 To 32 Step 2 For X = 0 To 7 For Y = 19 To 1 Step -1 If Dpoint( X ) <> 20 And Dpoint( X ) >= Y Then If Map3( Y - 1, X ) <= 13 Then R = New Rectangle( 0, Map3( Y - 1, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, ( Y - 11 ) * 32 + 16 + I, R, GraphicsUnit.Pixel ) Else Gr.FillRectangle( Brushes.White, X * 32 + 16, ( Y - 11 ) * 32 + 16 + I, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) : System.Threading.Thread.Sleep( 15 ) Loop While FruitDown( ) -71-

For Y = 0 To 9 For X = 0 To 7 R = New Rectangle( 0, Map( Y, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) ' パネルを落下させるジェネラルプロシージャ Private Function FruitDown( ) As Boolean Dim I, X, Y As Integer FruitDown = False For X = 0 To 7 Y = 19 Do Until Map3( Y, X ) = ENP : Y -= 1 : Loop If Map3( Y, X ) = ENP Then For I = Y To 1 Step -1 Map3( I, X ) = Map3( I - 1, X ) Map3( 0, X ) = ENP For Y = 0 To 9 For X = 0 To 7 If Not Map3( Y, X ) = ENP Then FruitDown = True End Function ' パネルを消去するジェネラルプロシージャ Private Sub Del3Line( ByVal Sy As Integer, ByVal Sx As Integer ) Dim N( 2 ), X, I As Integer Dim R As Rectangle Sact = False R = New Rectangle( 0, 8 * 32, 32, 32 ) Gr.DrawImage( Bm, Sx * 32 + 16, Sy * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) Map( Sy, Sx ) = ENP : Map3( Sy + 10, Sx ) = ENP Application.DoEvents( ) System.Threading.Thread.Sleep( 200 ) Gr.FillRectangle( Brushes.White, Sx * 32 + 16, Sy * 32 + 16, 32, 32 ) Do N( 0 ) = Rn.( 0, 10 ) Loop While N( 0 ) = Sy Do N( 1 ) = Rn.( 0, 10 ) Loop While N( 1 ) = N( 0 ) Or N( 1 ) = Sy -72-

Do N( 2 ) = Rn.( 0, 10 ) Loop While N( 2 ) = N( 0 ) Or N( 2 ) = N( 1 ) Or N( 2 ) = Sy For I = 0 To 2 For X = 0 To 7 Fcnt( Map( N( I ), X )) += 1 : Tcnt += 1 : Map( N( I ), X ) = ENP Gr.DrawImage( Bm, X * 32 + 16, N( I ) * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) For I = 0 To 7 lblfcnt( I ).Text = Fcnt( I ).ToString( ) lblgcnt.text = Tcnt.ToString( ) Application.DoEvents( ) System.Threading.Thread.Sleep( 200 ) For I = 0 To 2 For X = 0 To 7 Map3( N( I ) + 10, X ) = Map( N( I ), X ) If Map( N( I ), X ) = ENP Then Gr.FillRectangle( Brushes.White, X * 32 + 16, N( I ) * 32 + 16, 32, 32 ) picg.refresh( ) For I = 24 To 0 Step -1 If Sy < 349 Then Gt.DrawLine( Pens.White, Sx, Sy, Ex, Ey ) Sy += 1 : Ey += 1 pictime.refresh( ) ' キャラクタを変更するジェネラルプロシージャ Private Sub ChrChange( ByVal Sy As Integer, ByVal Sx As Integer ) Dim X, Y, I, J, W As Integer Dim ChrCnt( 7 ) As Integer Dim ChrIdx( 7 ) As Integer Dim R As Rectangle For I = 0 To 7 : ChrCnt( I ) = 0 : ChrIdx( I ) = I : For Y = 0 To 9 For X = 0 To 7 If Map( Y, X ) <= 7 Then ChrCnt( Map( Y, X )) += 1-73-

For I = 0 To 6 For J = 7 To ( I + 1 ) Step -1 If ChrCnt( J - 1 ) > ChrCnt( J ) Then W = ChrCnt( J - 1 ) : ChrCnt( J - 1 ) = ChrCnt( J ) : ChrCnt( J ) = W W = ChrIdx( J - 1 ) : ChrIdx( J - 1 ) = ChrIdx( J ) : ChrIdx( J ) = W Sact = False Map( Sy, Sx ) = ChrIdx( 7 ) R = New Rectangle( 0, ChrIdx( 7 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Sx * 32 + 16, Sy * 32 + 16, R, GraphicsUnit.Pixel ) For Y = 0 To 9 For X = 0 To 7 If Map( Y, X ) = ChrIdx( 0 ) Then Map( Y, X ) = ChrIdx( 7 ) R = New Rectangle(0, ChrIdx(7) * 32, 32, 32) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) ElseIf Map( Y, X ) = ChrIdx( 1 ) Then Map( Y, X ) = ChrIdx( 6 ) R = New Rectangle( 0, ChrIdx( 6 ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) ElseIf Map( Y, X ) = ChrIdx( 2 ) Then Map( Y, X ) = ChrIdx( 5 ) R = New Rectangle( 0, ChrIdx( 5 ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) For Y = 0 To 9 For X = 0 To 7 R = New Rectangle( 0, Map( Y, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) ' 垂直方向のソートを行うジェネラルプロシージャ Private Sub Vsort( ByVal Sy As Integer, ByVal Sx As Integer ) Dim X, Y, I, J, W As Integer Dim R As Rectangle Sact = False R = New Rectangle( 0, 8 * 32, 32, 32 ) Gr.DrawImage( Bm, Sx * 32 + 16, Sy * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 200 ) -74-

Map( Sy, Sx ) = ENP : Map3( Sy + 10, Sx ) = ENP Gr.FillRectangle( Brushes.White, Sx * 32 + 16, Sy * 32 + 16, 32, 32 ) picg.refresh( ) Call MoveProc( ) Call SetProc( ) For X = 0 To 7 If Not X = Sx Then For I = 0 To 8 For J = 9 To ( I + 1 ) Step -1 If Map( J - 1, X ) > Map( J, X ) Then W = Map( J - 1, X ) : Map( J - 1, X ) = Map( J, X ) : Map( J, X ) = W For Y = 0 To 9 For X = 0 To 7 R = New Rectangle( 0, Map( Y, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 1000 ) ' キャラクタを消去するジェネラルプロシージャ Private Sub ChrDel( ByVal Sy As Integer, ByVal Sx As Integer, ByRef cnt As Integer ) Dim I, J, X, Y As Integer Dim DelChr( 2 ) As Integer Dim R As Rectangle Sact = False R = New Rectangle( 0, 8 * 32, 32, 32 ) Gr.DrawImage( Bm, Sx * 32 + 16, Sy * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) Map( Sy, Sx ) = ENP : Map3( Sy + 10, Sx ) = ENP DelChr( 0 ) = Rn.( 0, 8 ) If cnt > 1 Then Do DelChr( 1 ) = Rn.( 0, 8 ) Loop While DelChr( 1 ) = DelChr( 0 ) If cnt > 2 Then Do DelChr( 2 ) = Rn.( 0, 8 ) Loop While DelChr( 2 ) = DelChr( 0 ) Or DelChr( 2 ) = DelChr( 1 ) -75-

For cnt = cnt To 1 Step -1 For Y = 0 To 9 For X = 0 To 7 If DelChr( cnt 1 ) = Map( Y, X ) Then Gr.DrawImage( Bm, X * 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) Fcnt( Map( Y, X )) += 1 : J += 1 : Tcnt += 1 Map( Y, X ) = ENP : Map3( Y + 10, X ) = ENP picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 200 ) For Y = 0 To 9 For X = 0 To 7 If Map( Y, X ) = ENP Then Gr.FillRectangle( Brushes.White, X * 32 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) For I = 0 To 7 lblfcnt( I ).Text = Fcnt( I ).ToString( ) lblgcnt.text = Tcnt.ToString( ) For J = J To 0 Step -1 If Sy < 349 Then Gt.DrawLine( Pens.White, Sx, Sy, Ex, Ey ) Sy += 1 : Ey += 1 pictime.refresh( ) ' 2 個のパネルを交換するジェネラルプロシージャ Private Sub TwoFlip(ByVal Mac As Boolean) Dim I As Integer Dim R As Rectangle If Mac = True Then If Px1 = Px2 Then If Py1 > Py2 Then For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16 - I, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map(Py2, Px2) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16 + I, R, GraphicsUnit.Pixel ) -76-

picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16, Py1 * 32 + 16 - I, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16, Py2 * 32 + 16 + I, 32, 32 ) Else For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16 + I, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16 - I, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16, Py1 * 32 + 16 + I, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16, Py2 * 32 + 16 - I, 32, 32 ) Else If Px1 > Px2 Then For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16 - I, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16 + I, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16 - I, Py1 * 32 + 16, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16 + I, Py2 * 32 + 16, 32, 32 ) Else For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16 + I, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16 - I, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16 + I, Py1 * 32 + 16, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16 - I, Py2 * 32 + 16, 32, 32 ) Else If Px1 = Px2 Then If Py1 > Py2 Then For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16 - I, R, GraphicsUnit.Pixel ) -77-

R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16 + I, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16, Py1 * 32 + 16 - I, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16, Py2 * 32 + 16 + I, 32, 32 ) For I = 32 To 0 Step -2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16 - I, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16 + I, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16, Py1 * 32 + 16 - I, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16, Py2 * 32 + 16 + I, 32, 32 ) R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) Else For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16 + I, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16 - I, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16, Py1 * 32 + 16 + I, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16, Py2 * 32 + 16 - I, 32, 32 ) For I = 32 To 0 Step -2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16 + I, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16 - I, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16, Py1 * 32 + 16 + I, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16, Py2 * 32 + 16 - I, 32, 32 ) R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) Else -78-

If Px1 > Px2 Then For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16 - I, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16 + I, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16 - I, Py1 * 32 + 16, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16 + I, Py2 * 32 + 16, 32, 32 ) For I = 32 To 0 Step -2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16 - I, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16 + I, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16 - I, Py1 * 32 + 16, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16 + I, Py2 * 32 + 16, 32, 32 ) R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) Else For I = 0 To 32 Step 2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16 + I, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16 - I, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16 + I, Py1 * 32 + 16, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16 - I, Py2 * 32 + 16, 32, 32 ) For I = 32 To 0 Step -2 R = New Rectangle( 32, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16 + I, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16 - I, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 25 ) Gr.FillRectangle( Brushes.White, Px1 * 32 + 16 + I, Py1 * 32 + 16, 32, 32 ) Gr.FillRectangle( Brushes.White, Px2 * 32 + 16 - I, Py2 * 32 + 16, 32, 32 ) R = New Rectangle( 0, Map( Py1, Px1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px1 * 32 + 16, Py1 * 32 + 16, R, GraphicsUnit.Pixel ) -79-

R = New Rectangle( 0, Map( Py2, Px2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, Px2 * 32 + 16, Py2 * 32 + 16, R, GraphicsUnit.Pixel ) ' 消去出来るパネルパネルが有るか検証するジェネラルプロシージャ Private Function NoMoreMove( ) As Boolean Dim Y, X As Integer NoMoreMove = True For X = 0 To 7 For Y = 0 To 9 If NoMoreMove = True Then Select Case X Case 0 Select Case Y Case 0 If (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 1 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 2 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 3 To 6 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 7 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ -80-

(Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 8 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 9 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False End Select Case 1 To 6 Select Case Y Case 0 If (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 1 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 2 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 3 To 6 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ -81-

(Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 7 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 8 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 9 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 2, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False End Select Case 7 Select Case Y Case 0 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 1 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False Case 2 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Then NoMoreMove = False -82-

Case 3 To 6 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y + 2, X) And Map(Y, X) = Map(Y + 3, X)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 7 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 8 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False Case 9 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 2, X - 1)) Or _ (Map(Y, X) = Map(Y - 2, X) And Map(Y, X) = Map(Y - 3, X)) Then NoMoreMove = False End Select End Select If NoMoreMove = True Then For Y = 0 To 9 For X = 0 To 7 If NoMoreMove = True Then Select Case Y Case 0 Select Case X Case 0 If (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 1 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then -83-

NoMoreMove = False Case 2 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 3 To 4 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 5 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 6 If (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X - 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 7 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False End Select Case 1 To 8 Select Case X Case 0 If (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 1 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ -84-

(Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 2 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 3 To 4 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 5 If (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X + 1) And Map(Y, X) = Map(Y + 1, X + 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 6 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X + 1)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 7 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y + 1, X - 1) And Map(Y, X) = Map(Y + 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False -85-

End Select Case 9 Select Case X Case 0 If (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 1 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 2 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Then NoMoreMove = False Case 3 To 4 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X + 2) And Map(Y, X) = Map(Y, X + 3)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 5 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X + 1) And Map(Y, X) = Map(Y - 1, X + 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 6 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X + 1)) Or _ (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False Case 7 If (Map(Y, X) = Map(Y - 1, X - 1) And Map(Y, X) = Map(Y - 1, X - 2)) Or _ (Map(Y, X) = Map(Y, X - 2) And Map(Y, X) = Map(Y, X - 3)) Then NoMoreMove = False -86-

End Select End Select End Function ' パネルを移動出来ない時に再描画するジェネラルプロシージャ Private Sub ReInitialize( ) Dim X, Y, N As Integer Dim R As Rectangle lblmes.text = " 移動不可 " & vbcrlf & " 盤面を更新します " lblmes.backcolor = Color.Cyan lblmes.visible = True ' 渦巻状に画面を消去 For Y = 0 To 9 Gr.FillRectangle( Brushes.White, 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 1 To 7 Gr.FillRectangle( Brushes.White, X * 32 + 16, 32 * 9 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 8 To 0 Step -1 Gr.FillRectangle( Brushes.White, 32 * 7 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 6 To 1 Step -1 Gr.FillRectangle( Brushes.White, X * 32 + 16, 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 1 To 8 Gr.FillRectangle( Brushes.White, 32 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 2 To 6 Gr.FillRectangle( Brushes.White, X * 32 + 16, 32 * 8 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) -87-

For Y = 7 To 1 Step -1 Gr.FillRectangle( Brushes.White, 32 * 6 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 5 To 2 Step -1 Gr.FillRectangle( Brushes.White, X * 32 + 16, 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 2 To 7 Gr.FillRectangle( Brushes.White, 32 * 2 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 3 To 5 Gr.FillRectangle( Brushes.White, X * 32 + 16, 32 * 7 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 6 To 2 Step -1 Gr.FillRectangle( Brushes.White, 32 * 5 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 4 To 3 Step -1 Gr.FillRectangle( Brushes.White, X * 32 + 16, 32 * 2 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 3 To 6 Gr.FillRectangle( Brushes.White, 32 * 3 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 6 To 3 Step -1 Gr.FillRectangle( Brushes.White, 32 * 4 + 16, Y * 32 + 16, 32, 32 ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) ' 新たなパネルの作成 For Y = 0 To 9 For X = 0 To 7 Do: N = Rn.( 0, 8 ): Loop Until PutChk( N, Y, X ) Map( Y, X ) = N -88-

' 渦巻状に画面を描画 For Y = 3 To 6 R = New Rectangle( 0, Map( Y, 4 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 * 4 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 6 To 3 Step -1 R = New Rectangle( 0, Map( Y, 3 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 * 3 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 3 To 4 R = New Rectangle( 0, Map( 2, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, 32 * 2 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 2 To 6 R = New Rectangle( 0, Map( Y, 5 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 * 5 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 5 To 3 Step -1 R = New Rectangle( 0, Map( 7, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, 32 * 7 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 7 To 2 Step -1 R = New Rectangle( 0, Map( Y, 2 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 * 2 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 2 To 5 R = New Rectangle( 0, Map( 1, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 1 To 7 R = New Rectangle( 0, Map( Y, 6 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 * 6 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) -89-

For X = 6 To 2 Step -1 R = New Rectangle( 0, Map( 8, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, 32 * 8 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 8 To 1 Step -1 R = New Rectangle( 0, Map( Y, 1 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 1 To 6 R = New Rectangle( 0, Map( 0, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 0 To 8 R = New Rectangle( 0, Map( Y, 7 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 32 * 7 + 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For X = 7 To 1 Step -1 R = New Rectangle( 0, Map( 9, X ) * 32, 32, 32 ) Gr.DrawImage( Bm, X * 32 + 16, 32 * 9 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) For Y = 9 To 0 Step -1 R = New Rectangle( 0, Map( Y, 0 ) * 32, 32, 32 ) Gr.DrawImage( Bm, 16, Y * 32 + 16, R, GraphicsUnit.Pixel ) picg.refresh( ) : Application.DoEvents( ) System.Threading.Thread.Sleep( 20 ) lblmes.visible = False End Class -90-

トレジャーハンター VB 2005 57 プログラムの概要 地中から宝物を掘り当てる トレジャハンター で有る 宝物の有り然うな場所をクリックして宝物を掘り当てる 周囲の数字は 其の列と行に有る宝物の数を示す 総ての宝物を掘り当てるか 10 回失敗すれば 終了する 猶 宝物の無い場所をクリックすると 其の場所が接して居る宝物の数が表示される 考えれば必ず解けると謂う物でも無く 運も必要で有る 要は マインスイーパーの逆バージョンで有る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -91-

オブジェクト プロパティ一覧 ピクチャボックス 1 ピクチャボックス 2 ピクチャボックス 3 ラベル ピクチャボックス 4 ボタン コントロールの種類 プロパティ プロパティの設定値 フォーム Name TreasureHunter AutoScaleMode None Font Times New Roman 28 太字 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text 宝探し ピクチャボックス1 Name picground BackColor White Size 601, 481 ピクチャボックス2 Name pictitle Image title.gif Size 202, 148 SizeMode StretchImage ピクチャボックス3 4 Name picscr piclos BackColor Black Size 202, 121 ラベル Name lblmes BackColor Blue ForeColor Yellow Text CONGRATULATINS! TextAlign MiddleCenter ボタン Name btnstart Font Times New Roman 18 太字 Text START -92-

プログラムリスト Public Class TreasureHunter Private Const LOSS As Integer = 10 Private Gr, Gs, Gl As Graphics Private Bm, Ng, Nm As Bitmap Private BD(11, 11) As Integer Private Scr, Los, Cnt As Integer Private Gm As Boolean = False Private Rn As Random = New Random( ) ' フォームが読み込まれた時の処理 Private Sub TreasureHunter_Load( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles MyBase.Load ' 画像の読み込み Bm = New Bitmap( "treasure.gif" ) Ng = New Bitmap( "skull.gif" ) Nm = New Bitmap( "number.gif" ) ' Graphics オブジェクトのインスタンス生成 With picground.image = New Bitmap(.Width,.Height ) Gr = Graphics.FromImage(.Image ) End With With picscr.image = New Bitmap(.Width,.Height ) Gs = Graphics.FromImage(.Image ) End With With piclos.image = New Bitmap(.Width,.Height ) Gl = Graphics.FromImage(.Image ) End With ' ボタン (START) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click ' 画面の初期化 Gr.Clear( Color.White ) For I As Integer = 0 To 600 Step 50 Gr.DrawLine( Pens.Gray, I, 0, I, 480 ) Gr.FillRectangle( Brushes.DarkGray, I + 1, 1, 49, 39 ) Gr.FillRectangle( Brushes.DarkGray, I + 1, 441, 49, 39 ) -93-

For I As Integer = 0 To 480 Step 40 Gr.DrawLine( Pens.Gray, 0, I, 600, I ) Gr.FillRectangle( Brushes.DarkGray, 1, I + 1, 49, 39 ) Gr.FillRectangle( Brushes.DarkGray, 551, I + 1, 49, 39 ) picground.refresh( ) ' 盤面の設定 For I As Integer = 0 To 11 For J As Integer = 0 To 11 If I = 0 Or I = 11 Or J = 0 Or J = 11 Then BD( I, J ) = 2 Else BD( I, J ) = 0 Dim N As Integer = Rn.( 0, 30 ) + 20 Dim R As Integer Cnt = 0 For I As Integer = 0 To N R = Rn.( 0, 100 ) If BD( R 10 + 1, R Mod 10 + 1) = 0 Then BD( R 10 + 1, R Mod 10 + 1 ) = 1 Cnt += 1 ' 宝の個数の表示 For I As Integer = 1 To 10 N = 0 For J As Integer = 1 To 10 If BD( I, J ) = 1 Then N += 1 Gr.DrawString( N.ToString( "X" ), Me.Font, Brushes.LightGray, 10, I * 40 ) Gr.DrawString( N.ToString( "X" ), Me.Font, Brushes.LightGray, 560, I * 40 ) For I As Integer = 1 To 10 N = 0 For J As Integer = 1 To 10 If BD( J, I ) = 1 Then N += 1 Gr.DrawString( N.ToString( "X" ), Me.Font, Brushes.LightGray, I * 50 + 10, 0 ) Gr.DrawString( N.ToString( "X" ), Me.Font, Brushes.LightGray, I * 50 + 10, 440 ) picground.refresh( ) -94-

' 得点と失敗数の表示 Scr = 0 : Los = 0 Call DispScr( ) Call DispLos( ) ' ゲームフラグの設定 Gm = True lblmes.visible = False btnstart.enabled = False ' ピクチャボックス (GOUND) がクリックされた時の処理 Private Sub picground_mouseup( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs ) Handles picground.mouseup If Not Gm Then Exit Sub Dim X As Integer = e.x 50 Dim Y As Integer = e.y 40 If e.button = Windows.Forms.MouseButtons.Right Then If ( BD( Y, X ) And 8 ) = 0 Then If ( BD( Y, X ) And 4 ) = 0 Then Gr.DrawImage( Ng, X * 50 + 1, Y * 40 + 1 ) BD( Y, X ) = BD( Y, X ) Or 4 Else Gr.FillRectangle( Brushes.White, X * 50 + 1, Y * 40 + 1, 49, 39 ) BD( Y, X ) = BD( Y, X ) And 11 picground.refresh( ) Else If ( BD( Y, X ) And 1 ) = 1 Then If ( BD( Y, X ) And 8 ) = 0 Then Gr.DrawImage( Bm, X * 50 + 1, Y * 40 + 1 ) picground.refresh( ) BD( Y, X ) = BD( Y, X ) Or 8 Scr += 1 : Call DispScr( ) If Scr >= Cnt Then lblmes.backcolor = Color.Blue lblmes.text = "CONGRATULATINS!" lblmes.visible = True Gm = False btnstart.enabled = True Else If Rn.( 0, 5 ) < 1 Then lblmes.backcolor = Color.Green lblmes.text = "LUCKY!" -95-

lblmes.visible = True Application.DoEvents( ) For I As Integer = -1 To 1 For J As Integer = -1 To 1 If Not BD( Y + I, X + J ) = 2 Then If ( BD( Y + I, X + J ) And 9 ) = 0 Then Dim C As Integer = CountTreasure( X + J, Y + I ) If ( BD( Y + I, X + J ) And 4 ) = 4 Then Gr.FillRectangle( Brushes.White, _ ( X + J ) * 50 + 1, ( Y + I ) * 40 + 1, 49, 39 ) BD( Y + I, X + J ) = BD( Y + I, X + J ) And 11 Gr.DrawString( C.ToString( ), Me.Font, Brushes.Black, _ ( X + J ) * 50 + 10, ( Y + I ) * 40 ) picground.refresh( ) System.Threading.Thread.Sleep( 1000 ) lblmes.visible = False ElseIf ( BD( Y, X ) And 1 ) = 0 Then If ( BD( Y, X ) And 8 ) = 0 Then If ( BD( Y, X ) And 4 ) = 4 Then Gr.FillRectangle( Brushes.White, X * 50 + 1, Y * 40 + 1, 49, 39 ) BD( Y, X ) = BD( Y, X ) And 11 Dim C As Integer = CountTreasure( X, Y ) Gr.DrawString( C.ToString( ), Me.Font, Brushes.Black, X * 50 + 10, Y * 40 ) picground.refresh( ) Los += 1 : Call DispLos( ) If Los >= LOSS Then lblmes.backcolor = Color.Red lblmes.text = "GAME OVER!" lblmes.visible = True Gm = False btnstart.enabled = True Else -96-

' 得点を表示するジェネラルプロシージャ Private Sub DispScr( ) Dim N As Integer Dim S As String Dim R As Rectangle S = Scr.ToString( "000" ) For I As Integer = 0 To 2 N = Integer.Parse( S.Substring( I, 1 )) R = New Rectangle(( N Mod 5 ) * 62, ( N 5 ) * 105, 62, 105 ) Gs.DrawImage( Nm, I * 62 + 8, 8, R, GraphicsUnit.Pixel ) picscr.refresh( ) ' 失敗数を表示するジェネラルプロシージャ Private Sub DispLos( ) Dim N As Integer Dim S As String Dim R As Rectangle S = Los.ToString( "000" ) For I As Integer = 0 To 2 N = Integer.Parse( S.Substring( I, 1 )) R = New Rectangle(( N Mod 5 ) * 62, ( N 5 ) * 105, 62, 105 ) Gl.DrawImage( Nm, I * 62 + 8, 8, R, GraphicsUnit.Pixel ) piclos.refresh( ) ' 周囲の宝の数を取得するジェネラルプロシージャ Private Function CountTreasure( ByVal X As Integer, ByVal Y As Integer) As Integer Dim C As Integer = 0 For I As Integer = -1 To 1 For J As Integer = -1 To 1 Try If ( BD( Y + I, X + J ) And 1 ) = 1 Then C += 1 Catch ex As System.IndexOutOfRangeException C = C End Try Return C End Function End Class -97-

いもむしカタピー VB 2005 58 プログラムの概要 全 10 面の面クリア型ゲーム いもむしカタピー で有る テンキーでカタピーを操作して メロンを総て取れば 面クリアで有る 出現するパイナップルは 100 点だが 毒茸はダメージ 10 下に何も無い時は落下し ダメージ 1 ダメージが 100 に成るか 害虫駆除装置のポピーに捕まると カタピーが 1 匹減る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -98-

オブジェクト プロパティ一覧 パネル ラベル 1 ラベル 2 ラベル 4 ラベル 3 ラベル 5 ラベル 6 ラベル 7 ラベル 8 ボタン ピクチャボックス コントロールの種類 プロパティ プロパティの設定値 フォーム Name caterpi BackColor 64, 64, 64 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text キャタピー パネル Name pnlstage BackColor Black Size 640, 384 ピクチャボックス Name picca Size 16, 16 ラベル1 Name lblmes BackColor Transparent Font Times New Roman 20 太字 ForeColor Cyan Text STAGE 10 CLEARED!! TextAlign MiddleCenter Visible False -99-

コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblscrcaption Font Times New Roman 14 太字 ForeColor White Text SCORE ラベル3 Name lblscr AutoSize False Font Times New Roman 16 太字 ForeColor Yellow Text 00000 TextAlign MiddleRight ラベル4 Name lbldamcaption Font Times New Roman 14 太字 ForeColor White Text DAMAGE ラベル5 Name lbldam AutoSize False Font Times New Roman 16 太字 ForeColor Yellow Text 000 TextAlign MiddleRight ラベル6 Name lblstgcaption Font Times New Roman 14 太字 ForeColor White Text STAGE ラベル7 Name lblstg AutoSize False Font Times New Roman 16 太字 ForeColor Yellow Text 00 TextAlign MiddleRight ラベル8 Name lblca AutoSize False Font Times New Roman 16 太字 ForeColor Yellow Text 00 TextAlign MiddleRight ボタン Name btnstart Font MS 明朝 12 太字 Text 開始 -100-

プログラムリスト Imports System.IO Public Class caterpi Private AD( 12 ) As Integer Private HM( 8 ) As Integer Private HC( 8 ) As Integer Private SD( 9, 1 ) As String Private ST, CA, SC, DM, FL As Integer Private FF As Integer Private BD( 39, 23 ) As Integer Private Game As Boolean = False Private Gr, Gc As Graphics Private Bm As Bitmap Private IR( 11 ) As Rectangle ' キャラクタアドレス ' 各方向のアドレス増減値 ' キャタピーの顔のキャラクタ ' 全ステージデータ ' ステージデータ ' ゲームフラグ ' フォームが読み込まれた時の処理 Private Sub caterpi_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' ステージデータの読込 Dim S, D( ) As String Using Sr As StreamReader = New StreamReader( "stage.txt" ) For I As Integer = 0 To 9 S = Sr.ReadLine( ): D = S.Split( "," ) SD( I, 0 ) = D( 0 ) : SD( I, 1 ) = D( 1 ) Sr.Close( ) End Using ' 画像の読込 Bm = New Bitmap( "all_16x16.gif" ) ' 画像切取範囲の設定 For I As Integer = 0 To 11 IR( I ) = New Rectangle(( I Mod 6 ) * 16, ( I 6 ) * 16, 16, 16 ) ' Graphics オブジェクトのインスタンス生成 With pnlstage.backgroundimage = New Bitmap(.Width,.Height ) Gr = Graphics.FromImage(.BackgroundImage ) End With With picca.image = New Bitmap(.Width,.Height ) Gc = Graphics.FromImage(.Image ) End With -101-

' 外枠の描画 For I As Integer = 0 To 39 Gr.DrawImage( Bm, I * 16, 0, IR( 5 ), GraphicsUnit.Pixel ) Gr.DrawImage( Bm, I * 16, 368, IR( 5 ), GraphicsUnit.Pixel ) BD( I, 0 ) = 1 : BD( I, 23 ) = 1 For I As Integer = 1 To 22 Gr.DrawImage( Bm, 0, I * 16, IR( 5 ), GraphicsUnit.Pixel ) Gr.DrawImage( Bm, 624, I * 16, IR( 5 ), GraphicsUnit.Pixel ) BD( 0, I ) = 1 : BD( 39, I ) = 1 ' 変数の初期化 For I As Integer = 0 To 8 : HM( I ) = 0 : HM( 2 ) = 40 : HM( 4 ) = -1 : HM( 6 ) = 1 : HM( 8 ) = -40 HC( 2 ) = 1 : HC( 4 ) = 2 : HC( 6 ) = 3 : HC( 8 ) = 4 ' ボタン ( 開始 ) がクリックされた時の処理 Private Sub btnstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnstart.click ' 変数の初期化 ST = 1 : CA = 5 : SC = 0 lblscr.text = SC.ToString( "00000" ) lblca.text = CA.ToString( "00" ) Gc.DrawImage( Bm, 0, 0, IR( 1 ), GraphicsUnit.Pixel ) : picca.refresh( ) lblmes.visible = False Call DrawStage( ) btnstart.enabled = False Game = True ' キー入力が為された時の処理 Private Sub caterpi_keydown( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyDown If Not Game Then Exit Sub Dim S As Integer = -( e.keycode = Keys.Down ) * 2 _ - ( e.keycode = Keys.Left ) * 4 _ - ( e.keycode = Keys.Right ) * 6 _ - ( e.keycode = Keys.Up ) * 8 : If S = 0 Then Exit Sub Dim M As Integer = HM( S ) Dim C As Integer = HC( S ) Dim F As Boolean = False AD( 12 ) = AD( 11 ) + M -102-

Select Case BD( AD( 12 ) Mod 40, AD( 12 ) 40 ) Case 1 ' ブロック M = -M : C = 5 - C : AD( 12 ) = AD( 12 ) + M DM -= ( DM < 100 ) : lbldam.text = DM.ToString( "000" ) Case 2 ' メロン FL -= 1 : SC += 10 : lblscr.text = SC.ToString( "00000" ) If ( FL = ( DM Mod 10 )) Or ( FL = ( CA Mod 10 )) Then Gr.DrawImage(Bm, (AD(0) Mod 40) * 16, (AD(0) 40) * 16, IR(8), GraphicsUnit.Pixel) BD( AD( 0 ) Mod 40, AD( 0 ) 40 ) = 4 Else Gr.DrawImage(Bm, (AD(0) Mod 40) * 16, (AD(0) 40) * 16, IR(7), GraphicsUnit.Pixel) BD( AD( 0 ) Mod 40, AD( 0 ) 40 ) = 3 pnlstage.refresh( ): BD( AD( 12 ) Mod 40, AD( 12 ) 40 ) = 0 Case 3 ' 茸 DM -= (( DM < 91 ) * 10 ) : lbldam.text = DM.ToString( "000" ) BD( AD( 12 ) Mod 40, AD( 12 ) 40 ) = 0 Case 4 ' パイナップル SC += 100 : lblscr.text = SC.ToString( "00000" ) BD( AD( 12 ) Mod 40, AD( 12 ) 40 ) = 0 End Select For I As Integer = 0 To 11 : AD( I ) = AD( I + 1 ) : Gr.FillRectangle( Brushes.Black, ( AD( 5 ) Mod 40 ) * 16, ( AD( 5 ) 40 ) * 16, 16, 16 ) Gr.FillRectangle( Brushes.Black, ( AD( 0 ) Mod 40 ) * 16, ( AD( 0 ) 40 ) * 16, 16, 16 ) For I As Integer = 6 To 10 Gr.DrawImage(Bm, (AD(I) Mod 40) * 16, (AD(I) 40) * 16, IR(0), GraphicsUnit.Pixel) Gr.DrawImage(Bm, (AD(11) Mod 40) * 16, (AD(11) 40) * 16, IR(C), GraphicsUnit.Pixel) Gr.DrawImage(Bm, (AD(1) Mod 40) * 16, (AD(1) 40) * 16, IR(10 + FF), GraphicsUnit.Pixel) FF = ( FF = 0 ) For I As Integer = 6 To 11 If AD( I ) = AD( 1 ) Then F = True : Exit For If F Then DM = 100 Else Dim N As Integer = 0 For I As Integer = 6 To 11 N += ( BD( AD( I ) Mod 40, AD( I ) 40 + 1 ) > 0 ) Do While N = 0 For I As Integer = 6 To 11 Gr.FillRectangle( Brushes.Black, ( AD( I ) Mod 40 ) * 16, ( AD( I ) 40 ) * 16, 16, 16 ) AD( I ) += 40 For I As Integer = 6 To 10 Gr.DrawImage(Bm, (AD(I) Mod 40) * 16, (AD(I) 40) * 16, IR(0), GraphicsUnit.Pixel) -103-

Gr.DrawImage(Bm, (AD(11) Mod 40) * 16, (AD(11) 40) * 16, IR(C), GraphicsUnit.Pixel) pnlstage.refresh( ) F = False For I As Integer = 6 To 11 If AD( I ) = AD( 1 ) Then F = True : Exit For If F Then DM = 100 : Exit Do DM -= ( DM < 100 ) : lbldam.text = DM.ToString( "000" ) N = 0 For I As Integer = 6 To 11 N += ( BD( AD( I ) Mod 40, AD( I ) 40 + 1 ) > 0 ) If N = 0 Then Application.DoEvents( ) System.Threading.Thread.Sleep( 500 ) Loop pnlstage.refresh( ) If DM = 100 Then For I As Integer = 1 To 5 For J As Integer = 6 To 11 Gr.FillRectangle( Brushes.Black, ( AD( J ) Mod 40 ) * 16, ( AD( J ) 40 ) * 16, 16, 16 ) pnlstage.refresh( ) Application.DoEvents( ) : System.Threading.Thread.Sleep( 100 ) For J As Integer = 6 To 10 Gr.DrawImage(Bm, (AD(J) Mod 40) * 16, (AD(J) 40) * 16, IR(0), GraphicsUnit.Pixel) Gr.DrawImage(Bm, (AD(11) Mod 40) * 16, (AD(11) 40) * 16, IR(C), GraphicsUnit.Pixel) pnlstage.refresh( ) Application.DoEvents( ) : System.Threading.Thread.Sleep( 200 ) Gr.FillRectangle( Brushes.Black, ( AD( 1 ) Mod 40) * 16, ( AD( 1 ) 40 ) * 16, 16, 16 ) CA -= 1 : lblca.text = CA.ToString( "00" ) If CA < 1 Then Gr.FillRectangle(New SolidBrush(Color.FromArgb(128, 255, 0, 0)), 16, 16, 38 * 16, 22 * 16) pnlstage.refresh( ) lblmes.forecolor = Color.LightGreen lblmes.text = "GAME OVER!!" : lblmes.visible = True Game = False btnstart.enabled = True Else Call DrawStage( ) ElseIf FL = 0 Then lblmes.forecolor = Color.Cyan -104-

lblmes.text = "STAGE " & ST.ToString( ) & "CLEARED!!" : lblmes.visible = True Application.DoEvents( ) : System.Threading.Thread.Sleep( 1000 ) lblmes.visible = False ST += 1 If ST > 10 Then Gr.FillRectangle(New SolidBrush(Color.FromArgb(128, 0, 255, 0)), 16, 16, 38 * 16, 22 * 16) pnlstage.refresh( ) lblmes.forecolor = Color.LightGreen lblmes.text = "ALL CLEARED!!" : lblmes.visible = True Game = False btnstart.enabled = True Else If DM < 30 Then CA += 1 : lblca.text = CA.ToString( "00" ) For I As Integer = DM To 0 Step -1 lbldam.text = I.ToString( "000" ) SC -= 1 : lblscr.text = SC.ToString( "00000" ) Call DrawStage( ) ' ステージ画面を表示するジェネラルプロシージャ Private Sub DrawStage( ) Dim D As String = SD( ST - 1, 0 ) Dim X, Y, I, J, XF, YF As Integer ' 情報の表示 DM = 0 : FF = 0 lblstg.text = ST.ToString( "00" ) lbldam.text = DM.ToString( "000" ) ' 画面のクリア Gr.FillRectangle( Brushes.Black, 16, 16, 38 * 16, 22 * 16 ) For I = 1 To 38 For J = 1 To 22 BD( I, J ) = 0 ' 基本ブロックの設定 For I = 0 To 12 For J = 2 To 8 Gr.DrawImage( Bm, ( I * 3 + 3 ) * 16, ( J * 3 3 ) * 16, IR( 5 ), GraphicsUnit.Pixel ) BD( I * 3 + 3, J * 3 3 ) = 1-105-

' メロンの設定 FL = 0 For I = 0 To 19 Step 2 X = System.Convert.ToInt32( D.Substring( I, 1 ), 16 ) Y = System.Convert.ToInt32( D.Substring( I + 1, 1 ), 16 ) Gr.DrawImage( Bm, ( X * 3 ) * 16, ( Y * 3 ) * 16, IR( 6 ), GraphicsUnit.Pixel ) BD( X * 3, Y * 3 ) = 2 : FL += 1 ' 連続ブロックの設定 D = SD( ST - 1, 1 ) I = 0 : XF = 3 : YF = 0 Do Do X = System.Convert.ToInt32( D.Substring( I, 1 ), 16 ) Y = System.Convert.ToInt32( D.Substring( I + 1, 1 ), 16 ) If XF = 3 Then For J = 0 To 3 Gr.DrawImage( Bm, ( X * 3 + J ) * 16, ( Y * 3 ) * 16, IR( 5 ), GraphicsUnit.Pixel ) If X < 15 And Y < 15 Then BD( X * 3 + J, Y * 3 ) = 1 Else For J = 0 To 3 Gr.DrawImage( Bm, ( X * 3 ) * 16, ( Y * 3 + J ) * 16, IR( 5 ), GraphicsUnit.Pixel ) If X < 15 And Y < 15 Then BD( X * 3, Y * 3 + J ) = 1 I += 2 Loop Until X = 15 XF = 0 : YF = 3 Loop Until Y = 15 ' 下段ブロックの消去 For I = 3 To 10 Gr.FillRectangle( Brushes.Black, ( I * 3 ) * 16, 21 * 16, 16, 16 ) BD( I * 3, 21 ) = 0 ' キャタピーとポピーの設定 For I = 0 To 12 : AD( I ) = 891 + I : For I = 6 To 10 Gr.DrawImage( Bm, ( AD( I ) Mod 40 ) * 16, ( AD( I ) 40 ) * 16, IR( 0 ), GraphicsUnit.Pixel ) Gr.DrawImage( Bm, ( AD( 11 ) Mod 40 ) * 16, ( AD( I ) 40 ) * 16, IR( 3 ), GraphicsUnit.Pixel ) Gr.DrawImage( Bm, ( AD( 1 ) Mod 40 ) * 16, ( AD( I ) 40 ) * 16, IR( 9 ), GraphicsUnit.Pixel ) pnlstage.refresh( ) End Class -106-

ロック & ダイアモンド VB 2005 59 プログラムの概要 面クリア型アクションパズル ロック & ダイアモンド で有る カーソルキーでポッピーを操作して 10 個のダイアモンドを取れば面クリアで有る 但し 岩は 下に何も無く成ると落下し 此れに押し潰されると ポッピーは 1 人減る 素早いキー操作が必要とされる 猶 行き詰まれば Esc キーで遣り直す事が出来る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 此れは 1987 年に 航海中に作成し POPCOM 誌に掲載された物のリメイクで有る 自動的に行われる処理 ( タイマーの利用 ) -107-

オブジェクト プロパティ一覧 ピクチャボックス 1 ピクチャボックス 2 ピクチャボックス 4 ピクチャボックス 3 ラベル 4 ラベル 5 ラベル 6 ラベル 1 ラベル 2 ラベル 3 ピクチャボックス 5 コントロールの種類 プロパティ プロパティの設定値 フォーム Name RockAndDiamond AutoScaleMode None BackColor DimGray Font Times New Roman 9 標準 FormBorderStyle FixedSingle KeyPreview True MaximizeBox False StartPosition CenterScreen Text Rock & Diamond ピクチャボックス1 Name pictitle BackColor Transparent Image title_big.gif ピクチャボックス2 Name picback BackColor Black Location 16, 64 Size 504, 384 ピクチャボックス3 Name picstage Location 40, 88 Size 456, 312-108-

コントロールの種類 プロパティ プロパティの設定値 ピクチャボックス4 Name picpanel BackColor Black Image panel.gif Size 220, 329 SizeMode CenterImage ピクチャボックス5 Name picsubtitle BackColor Transparent Image subtitle_big.gif ラベル1 Name lblmes AutoSize False BackColor 192, 255, 255 Font Times New Roman 16 太字 ForeColor Blue Text Press 'S' key to start. TextAlign MiddleCenter ラベル2 Name lbltimecaption BackColor Black Font Impact 14 標準 ForeColor Yellow Text TIME ラベル3 Name lbltime BackColor Black Font Impact 14 標準 ForeColor White Text 10 TextAlign MiddleRight ラベル4 Name lblsheet BackColor Black Font Impact 20 標準 ForeColor White Text 1 TextAlign MiddleRight ラベル5 Name lblman BackColor Black Font Impact 20 標準 ForeColor White Text 3 TextAlign MiddleRight ラベル6 Name lbldia BackColor Black Font Impact 20 標準 ForeColor White Text 0 TextAlign MiddleRight -109-

プログラムリスト Public Class RockAndDiamond Private Bm( 7 ) As Bitmap Private Gb, Gf As Graphics 面データは 一般に此の様に定義される事が多い 外枠に アルゴリズムで謂う処の 番兵法 が用いられて居る Private Sd(, ) = {{"3333333333333333333", "3111111111111111113", _ "3111344441444431113", "3111131111111341113", _ "3311113111113141113", "3114141322231141113", _ "3112141233321141413", "3411141322231141113", _ "3141113142413111113", "3112131444441311413", _ "3141311241421131123", "3141114112211411413", _ "3333333333333333333"}, _ {"3333333333333333333", "3111414111141111143", _ "3111111141141144113", "3111114333322333323", _ "3112132341111414313", "3211131321414112313", _ "3111131323311332313", "3444131313411431343", _ "3424131313111131313", "3444132313122434313", _ "3121114113133131113", "3111111111121111413", _ "3333333333333333333"}, _ {"3333333333333333333", "3111144441442411423", _ "3111124241441111443", "3413333313333331113", _ "3413241111114231113", "3413411111114431123", _ "3213111111111431113", "3113141111111231213", _ "3143111111111134223", "3143111424111112143", _ "3113114424411434113", "3111144444444434123", _ "3333333333333333333"}, _ {"3333333333333333333", "3114411111111111143", _ "3114113333333333113", "3111432414444112323", _ "3431341411441444133", "3231211211221421133", _ "3431311111441211133", "3411131214444111323", _ "3114113333333333443", "3114111111214111413", _ "3111111111122111113", "3111111111111111213", _ "3333333333333333333"}, _ {"3333333333333333333", "3111111144111111113", _ "3111411111241141143", "3111433333333341443", _ "3111411144214121123", "3114112111241124113", _ "3114333333333334113", "3111111422241114113", _ "3112111144411112113", "3143333333333333413", _ "3141411144111111213", "3121133312133311213", _ "3333333333333333333"}, _ {"3333333333333333333", "3114423111333111443", _ "3114443113313411443", "3114443133222411113", _ "3114113131212111113", "3111443333333333113", _ "3111122221112221113", "3111143333333333113", _ -110-

"3114143411111141413", "3442143141111441413", _ "3424143244444411413", "3441143111111111113", _ "3333333333333333333"}, _ {"3333333333333333333", "3111111411114111113", _ "3111111142411411143", "3111433333333311143", _ "3441434411442311143", "3241432211444311123", _ "3341431111111311113", "3241231333331311413", _ "3241211333331214413", "3213233333333343413", _ "3411114433314141213", "3111111112111411123", _ "3333333333333333333"}, _ {"3333333333333333333", "3111111114111111423", _ "3111144442411111443", "3111421444441111143", _ "3141444414144441443", "3421112111112111143", _ "3413333333133333113", "3443111111114423423", _ "3421411111114444223", "3334413331114444333", _ "3214113211111111143", "3111113231111211123", _ "3333333333333333333"}, _ {"3333333333333333333", "3111141414224114443", _ "3111114211141112213", "3133333333333331313", _ "3134444124432411313", "3132241414414414313", _ "3131111114411114313", "3131441114411114313", _ "3131244214414431313", "3132444434432422313", _ "3133333332133133313", "3111111111111111113", _ "3333333333333333333"}, _ {"3333333333333333333", "3111111112411111423", _ "3111111113311111443", "3441111134131111113", _ "3241111314143111113", "3441113142124341113", _ "3114131112111141413", "3414113414444344243", _ "3114111322223244443", "3132111134431144243", _ "3214111113311111123", "3131141111111111113", _ "3333333333333333333"} _ } Private BD( 18, 12 ) As Integer ' ゲーム中の画面データ Private PX, PY As Integer ' ポッピーの座標 Private RC As Integer ' 岩の数 Private RP( ) As Point ' 岩の座標 Private Sheet As Integer = 1 ' ステージ番号 Private Man As Integer = 3 ' 残り人数 Private Dia As Integer = 0 ' 収集ダイアの数 Private Tim As Integer = 10 ' 岩落下時間 Private Game As Boolean = False ' ゲームフラグ (False: 待機中 Trua: 遊戯中 ) Private Tr As Integer '??? Private Tm As System.Timers.Timer = New System.Timers.Timer( 300 ) ' 他スレッド ( タイマー ) よりフォームにアクセスする為のデリゲート Delegate Sub TimerDelegate( ) -111-

' フォームが読み込まれた時の処理 Private Sub RockAndDiamond_Load( ByVal sender As System.Object, _ ByVal e As System.EventArgs ) Handles MyBase.Load ' 画像ファイルの読込 Bm( 0 ) = New Bitmap( "wall.gif" ) Bm( 1 ) = New Bitmap( "ground.gif" ) Bm( 2 ) = New Bitmap( "diamond.gif" ) Bm( 3 ) = New Bitmap( "block.gif" ) Bm( 4 ) = New Bitmap( "rock.gif" ) Bm( 5 ) = New Bitmap( "left.gif" ) Bm( 6 ) = New Bitmap( "right.gif" ) Bm( 7 ) = New Bitmap( "angel.gif" ) ' Graphics オブジェクトのインスタンス生成 With picback.image = New Bitmap(.Width,.Height ) Gb = Graphics.FromImage(.Image ) End With With picstage.image = New Bitmap(.Width,.Height ) Gf = Graphics.FromImage(.Image ) End With ' 外枠の描画 For I As Integer = 0 To 20 Gb.DrawImage( Bm( 0 ), I * 24, 0 ) Gb.DrawImage( Bm( 0 ), I * 24, 360 ) For I As Integer = 1 To 14 Gb.DrawImage( Bm( 0 ), 0, I * 24 ) Gb.DrawImage( Bm( 0 ), 480, I * 24 ) ' タイマーの設定 Tm.AutoReset = True AddHandler Tm.Elapsed, New System.Timers.ElapsedEventHandler( _ AddressOf TimerProc ) ' キー入力が為された時の処理 Private Sub RockAndDiamond_KeyDown( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyDown Select Case e.keycode Case Keys.S If Not Game Then lblmes.visible = False -112-

Call DrawStage( ) If e.shift Then Tr = 2 Else Tr = 1 Tm.Interval = Tr * 300 Man = Tr * 3 : lblman.text = Man.ToString( ) Game = True Case Keys.Left If Game Then Call PoppyMove( -1, 0 ) Case Keys.Right If Game Then Call PoppyMove( 1, 0 ) Case Keys.Down If Game Then Call PoppyMove( 0, 1 ) Case Keys.Up If Game Then Call PoppyMove( 0, -1 ) Case Keys.Escape If Game Then Man -= 1 : lblman.text = Man.ToString( ) Call DrawStage( ) End Select ' タイマーが一定間隔で自動的に行う処理 Private Sub TimerProc( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) Invoke( New TimerDelegate( AddressOf RockFall )) ' ポッピーを移動させるジェネラルプロシージャ Private Sub PoppyMove( ByVal DX As Integer, ByVal DY As Integer ) Dim A As Integer = BD( PX + DX, PY + DY ) Dim F As Boolean = False ' 移動先の検証 Select Case A Case 3, 4 ' 壁 岩 Exit Sub Case 2 ' ダイアモンド Dia += 1 If Dia = 16 Then Tm.Stop( ) Sheet += 1 If Sheet > 10 Then Game = False lblmes.text = "All Clear!!!!!!!!" lblmes.visible = True Exit Sub -113-

Else Call DrawStage( ) Exit Sub Else lbldia.text = Dia.ToString( ) End Select ' 岩の検証 If BD( PX, PY - 1 ) = 4 Or BD( PX + DX, PY + DY - 1 ) = 4 Then F = True ' ポッピーの移動 Call PoppyErase( ) : PX = PX + DX : PY = PY + DY Call PoppyDisp( ) : picstage.refresh( ) ' 岩の落下 If F Then Tim = 10 : lbltime.text = Tim.ToString( ) : Tm.Start( ) ' ポッピーを消去するジェネラルプロシージャ Private Sub PoppyErase( ) Gf.FillRectangle( Brushes.Black, PX * 24, PY * 24, 24, 24 ) : BD( PX, PY ) = 0 ' ポッピーを表示するジェネラルプロシージャ Private Sub PoppyDisp( ) Gf.DrawImage( Bm( 5 ), PX * 24, PY * 24 ) : BD( PX, PY ) = 5 ' タイマーのデリゲート処理を行うジェネラルプロシージャ Private Sub RockFall( ) Dim C As Integer = 0 Tim -= 1 : lbltime.text = Tim.ToString( ) For I As Integer = 0 To ( RC - 1 ) Select Case BD( RP( I ).X, RP( I ).Y + 1 ) Case 0 Gf.FillRectangle( Brushes.Black, RP( I ).X * 24, RP( I ).Y * 24, 24, 24 ) BD(RP( I ).X, RP( I ).Y) = 0 : RP( I ).Y += 1 Gf.DrawImage( Bm( 4 ), RP( I ).X * 24, RP( I ).Y * 24 ) BD( RP( I ).X, RP( I ).Y ) = 4 : C += 1 Case 5 Gf.FillRectangle( Brushes.Black, RP( I ).X * 24, RP( I ).Y * 24, 24, 24 ) BD( RP( I ).X, RP( I ).Y ) = 0 : RP( I ).Y += 1 Gf.DrawImage( Bm( 4 ), RP( I ).X * 24, RP( I ).Y * 24 ) -114-

Gf.DrawImage( Bm( 7 ), RP( I ).X * 24, RP( I ).Y * 24 ) picstage.refresh( ) Man -= 1 : lblman.text = Man.ToString( ) If Man < 1 Then Tm.Stop( ) Game = False : Sheet = 1 lblmes.text = "Game Over!!!!!!!!" lblmes.visible = True Else lblmes.text = "Dead!!!!!!!!" lblmes.visible = True Application.DoEvents( ) : System.Threading.Thread.Sleep( 1000 ) lblmes.visible = False Call DrawStage( ) Exit Sub End Select picstage.refresh( ) If C = 0 Then Tm.Stop( ) ' 画面を表示するジェネラルプロシージャ Private Sub DrawStage( ) Dim S As String Dim N, C As Integer ' 面情報の初期化と表示 Dia = 0 : Tim = 10 lbltime.text = Tim.ToString( ) lblsheet.text = Sheet.ToString( ) lbldia.text = Dia.ToString( ) ' 画面の描画 RC = 0 Gf.Clear( Color.Black ) For I As Integer = 0 To 12 S = Sd( Sheet - 1, I ) For J As Integer = 0 To 18 N = Integer.Parse( S.Substring( J, 1 )) Gf.DrawImage( Bm( N ), J * 24, I * 24 ) BD( J, I ) = N : If N = 4 Then RC += 1 Gf.DrawImage( Bm( 5 ), 24, 24 ) : PX = 1 : PY = 1 : BD( PX, PY ) = 5 picstage.refresh( ) -115-

' 岩の位置の取得 ReDim RP( RC 1 ) : C = 0 For I As Integer = 11 To 1 Step -1 For J As Integer = 1 To 17 If BD( J, I ) = 4 Then RP( C ).X = J : RP( C ).Y = I : C += 1 ' 確認用 : ラベルがクリックされた時の処理 Private Sub picsubtitle_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles picsubtitle.click Sheet += 1 : If Sheet > 10 Then Sheet = 1 Call DrawStage( ) End Class -116-

鉄砲魚 VB 2005 60 プログラムの概要 レトロ風シューティングゲーム 鉄砲魚 で有る カーソルキーで鉄砲魚を左右に移動させ 虫を目掛けて水を飛ばして捕獲する 水を飛ばすには スペースキーを押すが 連続して何発も飛ばす事は出来ない 2 分間に何匹の虫を捕獲出来るかを競う 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 此れは 昔懐かしい はるみのゲームライブラリ の中の物のリメイクで有る 自動的に行われる処理 ( タイマーの利用 ) -117-

オブジェクト プロパティ一覧 ラベル 3 ラベル 1 ラベル 4 パネル ピクチャボックス ( パネルの中に ) ラベル 5 ラベル 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name gunfish AutoScaleMode None Font Times New Roman 9 標準 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text 鉄砲魚 パネル Name pnlstage BackgroundImage stage.gif Size 304, 184 ピクチャボックス Name picstage BackColor Transparent Size 304, 184 ラベル1 Name lbltitleback AutoSize False BackColor Transparent Font Times New Roman 18 太字 ForeColor Teal Text GUN FISH TextAlign MiddleCenter ラベル2 Name lbltitlefore AutoSize False BackColor Transparent Font Times New Roman 18 太字 ForeColor Cyan Text GUN FISH TextAlign MiddleCenter -118-

コントロールの種類 プロパティ プロパティの設定値 ラベル3 Name lblscore AutoSize False BackColor 192, 255, 255 Font Times New Roman 10 太字 Padding 2, 2, 2, 2 Size 80, 20 Text SCORE 000 TextAlign MiddleLeft ラベル4 Name lbltime AutoSize False BackColor 192, 255, 255 Font Times New Roman 10 太字 Padding 2, 2, 2, 2 Size 80, 20 Text TIME 000 TextAlign MiddleLeft ラベル5 Name lblmes AutoSize False BackColor White BorderStyle FixedSingle Font Times New Roman 10 太字 ForeColor Blue Size 176, 27 Text Push 'S' key to start! TextAlign MiddleCenter -119-

プログラムリスト Public Class gunfish Private Bm( 4 ) As Bitmap Private Gb, Gf As Graphics Private FX As Integer = 25 ' 鉄砲魚の座標 Private FD As Integer ' 鉄砲魚の方向 (0: 左向き 1: 右向き ) Private IX, IY As Integer ' 虫の座標 Private CX, CY As Integer ' 弾丸の座標 Private CF As Boolean ' 弾丸のフラグ (False: 待機中 True: 発射中 ) Private CD As Integer ' 弾丸の方向 (0: 左向き 1: 右向き ) Private SC, TM As Integer ' 得点 時間 Private Game As Boolean ' ゲームフラグ Private Rn As Random = New Random( ) Private Sw As Stopwatch = New Stopwatch( ) Private Ti As System.Timers.Timer = New System.Timers.Timer( 3000 ) Private Tc As System.Timers.Timer = New System.Timers.Timer( 100 ) Private Tt As System.Timers.Timer = New System.Timers.Timer( 500 ) ' タイマーがデリゲートする処理 Delegate Sub TimerDelegate( ) ' フォームが読み込まれた時の処理 Private Sub gunfish_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' 画像の読込 Bm( 0 ) = New Bitmap( "gunfish_left.gif" ) Bm( 1 ) = New Bitmap( "gunfish_right.gif" ) Bm( 2 ) = New Bitmap( "commet_left.gif" ) Bm( 3 ) = New Bitmap( "commet_right.gif" ) Bm( 4 ) = New Bitmap( "insect.gif" ) ' Graphics オブジェクトのインスタンス生成 With picstage.backgroundimage = New Bitmap(.Width,.Height ) Gb = Graphics.FromImage(.BackgroundImage ).Image = New Bitmap(.Width,.Height ) Gf = Graphics.FromImage(.Image ) End With ' 鉄砲魚と虫の表示 IX = 30 : IY = 3 : FX = 25 : FD = 0 Gb.DrawImage( Bm( 4 ), IX * 8, IY * 8 ) Gf.DrawImage( Bm( FD ), FX * 8, 120 ) -120-

' タイトルの設定 lbltitleback.controls.add( lbltitlefore ) lbltitlefore.location = New Point( -1, -1 ) ' System.Timers.Timer の設定 Ti.AutoReset = True : Tc.AutoReset = True : Tt.AutoReset = True AddHandler Ti.Elapsed, New System.Timers.ElapsedEventHandler( _ AddressOf TimerInsect ) AddHandler Tc.Elapsed, New System.Timers.ElapsedEventHandler( _ AddressOf TimerCommet ) AddHandler Tt.Elapsed, New System.Timers.ElapsedEventHandler( _ AddressOf TimerTimer ) ' フォームが閉じられ様と仕た時の処理 Private Sub gunfish_formclosing( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs ) Handles Me.FormClosing Ti.Stop( ) : Tc.Stop() : Tt.Stop( ) : Sw.Stop( ) Ti.Dispose( ) : Tc.Dispose( ) : Tt.Dispose( ) : Sw = Nothing ' キーが押し下げられた時の処理 Private Sub gunfish_keydown( ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles MyBase.KeyDown Select Case e.keycode Case Keys.S If Not Game Then SC = 0 : lblscore.text = "SCORE " & SC.ToString( "000" ) TM = 120 : lbltime.text = "TIME " & TM.ToString( "000" ) lblmes.visible = False Sw.Reset( ) : Sw.Start( ) Game = True : Ti.Start( ) : Tt.Start( ) Case Keys.Left If Game Then If FX > 0 Then FX -= 1 : FD = 0 Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( FD ), FX * 8, 120 ) picstage.refresh( ) -121-

Case Keys.Right If Game Then If FX < 32 Then FX += 1 : FD = 1 Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( FD ), FX * 8, 120 ) picstage.refresh( ) Case Keys.Space If Game Then If Not CF Then CD = FD : CX = FX - ( CD = 1 ) * 5 : CY = 16 CF = True : Tc.Start( ) End Select ' タイマー ( 虫用 ) が一定間隔で自動的に行う処理 Private Sub TimerInsect( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) Invoke( New TimerDelegate( AddressOf DispInsect )) ' タイマー ( 弾丸用 ) が一定間隔で自動的に行う処理 Private Sub TimerCommet( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) Invoke( New TimerDelegate( AddressOf DispCommet )) ' タイマー ( タイマー用 ) が一定間隔で自動的に行う処理 Private Sub TimerTimer( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) Invoke( New TimerDelegate( AddressOf DispTimer )) ' タイマー ( 虫用 ) にデリゲートされるジェネラルプロシージャ Private Sub DispInsect( ) IX = Rn.( 0, 32 ) : IY = Rn.( 2, 15 ) Gb.Clear( Color.Transparent ) Gb.DrawImage( Bm( 4 ), IX * 8, IY * 8 ) If CF Then Gb.DrawImage( Bm( CD + 2 ), CX * 8, CY * 8 ) picstage.refresh( ) -122-

' タイマー ( 弾丸用 ) にデリゲートされるジェネラルプロシージャ Private Sub DispCommet( ) CX += (( CD = 0 ) - ( CD = 1 )) : CY -= 1 If CX < 0 OrElse CX > 31 OrElse CY < 2 Then Tc.Stop( ) : CF = False : Exit Sub Gb.Clear( Color.Transparent ) Gb.DrawImage( Bm( 4 ), IX * 8, IY * 8 ) Gb.DrawImage( Bm( CD + 2 ), CX * 8, CY * 8 ) picstage.refresh( ) If CX = IX AndAlso CY = IY Then Ti.Stop( ) : Tc.Stop( ) : CF = False SC += 1 : lblscore.text = "SCORE " & SC.ToString( "000" ) Do Until IY = 17 Gb.Clear( Color.Transparent ) Gb.DrawImage( Bm( 4 ), IX * 8, IY * 8 ) IY += 1 : picstage.refresh( ) Application.DoEvents( ) : System.Threading.Thread.Sleep( 200 ) Loop Gb.Clear( Color.Transparent ) Ti.Start( ) ' タイマー ( タイマー用 ) にデリゲートされるジェネラルプロシージャ Private Sub DispTimer( ) Dim N As Integer = TM - Sw.ElapsedMilliseconds 1000 If N < 0 Then Ti.Stop( ) : Tc.Stop( ) : Tt.Stop( ) CF = False : Game = False lblmes.text = "Game Over!!!" lblmes.visible = True Exit Sub lbltime.text = "TIME " & N.ToString( "000" ) End Class -123-

2026 © docsplayer.net プライバシー | 利用規約 | フィードバック