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

(1)

プログラムの概要

アクションゲーム『カールおじさんの林檎狩』で有る。頭上の林檎が、段々と生長して落下して来るので、カールおじさんを矢印キーで移動させて、林檎をキャッチする。前後も考慮されるので、上部の俯瞰図にも注意する。一般的に、実用プログラムに比較するとゲームプログラムは、高度なテクニックを要求される事が多い。此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を目的として居る。制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。

カールおじさんの林檎狩

VB 2005 ○51 □ アプリケーション画面のデザイン（標準コントロールの利用） □ プログラムの動作原理（イベント駆動型のプログラム） □ プログラムの構成要素（オブジェクトとプロパティ） □ 値の代入（変数、オブジェクトのプロパティ） □ グラフィックスの利用（Graphics オブジェクト） □ 条件に応じた処理（If 文の利用） □ 自動的に行われる処理（タイマーの利用）今回の課題項目

(2)

コントロールの種類プロパティプロパティの設定値フォーム Name curl FormBorderStyle FixedSingle MaximizeBox False KeyPreview True StartPosition CenterScreen Text カールおじさんの林檎狩パネル１ Name pnlBirdview BackColor 128, 255, 128 Size 850, 100 ピクチャボックス１ Name picBirdview （パネル１の中） BackColor Transparent Size 850, 100 パネル２ Name pnlScreen BackColor 128, 255, 128 BackgroundImage back.gif Size 850, 500

オ

ブ

ジ

ェ

ク

ト

・

プ

ロ

パ

テ

ィ

一

覧

パネル１ピクチャボックス２ピクチャボックス１ボタンパネル２パネル３ラベル１ラベル２

(3)

コントロールの種類プロパティプロパティの設定値パネル３ Name pnlApple （パネル２の中） BackColor Transparent Size 850, 500 ピクチャボックス１ Name picCurl （パネル２の中） BackColor Transparent Image curl.gif Size 172, 230 ラベル１ Name lblScr （パネル２の中） BackColor Blue

Font Times New Roman、２０、太字

ForeColor White Size 106, 39 Text 0 TextAlign MiddleRight ラベル２ Name lblTim （パネル２の中） BackColor Red

ForeColor White

Size 106, 39

Text 60

TextAlign MiddleRight

ボタン Name btnStart

Font Times New Roman、１６、太字

(4)

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" ) Next

' 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

End Sub

プ

(5)

' ボタン（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 Next 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 End Sub ' キー入力が為された時の処理

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

(6)

' タイマーが一定間隔で自動的に行う処理

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 End If End If For I As Integer = 0 To 9 With Apple( I ) If . Count < 5 Then If Rn.Next( 0, 5 ) < 2 Then If .Count = 0 Then

.Pos.X = Rn.Next( 0, 800 ): .Pos.Y = Rn.Next( 0, 100 ): .Pos.Z = Rn.Next( 0, 80 ) End If .Count += 1 End If 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 If End If End With Next 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 If End With Next pnlApple.Refresh( ) Call DispApple( ) Application.DoEvents( ) End Sub

(7)

' カールおじさんを表示するジェネラルプロシージャ 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 End Sub ' 林檎を表示するジェネラルプロシージャ 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 If End With Next picBirdview.Refresh( ) End Sub End Class

(8)

プログラムの概要

アクションパズルゲーム『ジェム』で有る。ジェム（赤い球）を矢印キーで操作して、出口に導くと、面クリアで有る。出口は、或る条件を満たすと出現する。猶、ジェムは、慣性で移動する。攻略法も用意して居るので、参考にされ度い。一般的に、実用プログラムに比較するとゲームプログラムは、高度なテクニックを要求される事が多い。此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を目的として居る。制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。

ジェム

(9)

■ モジュール（gem.vb） ■ Module gem Public RT As Integer Public WN As Integer End Module ■ スタート画面 ■ コントロールの種類プロパティプロパティの設定値フォーム Name frmStart BackColor Black ControlBox False FormBorderStyle FixedDialog StartPosition CenterScreen Text 空白

オ

ブ

ジ

ェ

ク

ト

・

プ

ロ

パ

テ

ィ

一

覧

ラベル２ピクチャボックス１パネル１ラベル１パネル２ピクチャボックス２ピクチャボックス３タイマー

プ

ロ

グ

ラ

ム

リ

ス

ト

モジュールをgem.vb と謂う名前で追加する。

(10)

コントロールの種類プロパティプロパティの設定値パネル１ Name pnlArea ピクチャボックス１ Name picTitle Image start1.gif Size 478, 222 パネル２ Name pnlCast Image start2.gif Size 400, 126 ピクチャボックス２ Name picGem Image sprite1.gif Size 32, 32 ピクチャボックス３ Name picDevil Image sprite7.gif Size 32, 32 ラベル１ Name lblMes BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１６、太字 ForeColor 208, 208, 0 Size 546, 223 ラベル２ Name lblKey BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor 208, 208, 0 Text 何かキーを押して下さい（Ｓキーで説明スキップ）！ ※ ピクチャボックス１（picTitle）とパネル２（pnlCast）は、必ず、パネル１（pnlArea）の中に配置する。 ※ ピクチャボックス２（imgGem）とピクチャボックス３（imgDevil）は、パネル２（pnlCast）の中に配置する。 ※ ラベル１（lblMes）とラベル２（lblKey）は、フォームに直接配置する。

(11)

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 End Sub ' フォームが閉じられる時の処理

Private Sub frmStart_FormClosed( ByVal sender As Object, _

ByVal e As System.Windows.Forms.FormClosedEventArgs ) Handles Me.FormClosed

Player.Stop( ): Player.Dispose( ) End Sub

' キー入力が為された時の処理

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 End If

プ

(12)

' 画面のスクロールアップ For I As Integer = 1 To 30 pnlArea.Top -= 16 Application.DoEvents( ) System.Threading.Thread.Sleep( 100 ) Next 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( ) End If e.Handled = True End Sub ' タイマーが一定間隔で行う処理

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 ) End Sub ' メッセージを表示するジェネラルプロシージャ 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 ) Next

End Sub End Class

(13)

■ メイン画面 ■ コントロールの種類プロパティプロパティの設定値フォーム Name frmMain BackColor Black FormBorderStyle FixedSingle KeyPreview True MaximizeBox False Size 490, 447 StartPosition CenterScreen Text GEM パネル１ Name pnlBoard BackColor Black Enabled False Size 352, 352 パネル２ Name pnlDevil （パネル１の中に配置） BackColor Transparent Size 352, 352 ピクチャボックス１ Name picBoard （パネル２の中に配置） BackColor Transparent Size 352, 352 ラベル３グループボックスピクチャボックス１ラベル２パネル１パネル２ピクチャボックス２ラベル５ラベル４ラベル７ラベル６ラベル９ラベル８タイマー１タイマー２ラベル１

(14)

コントロールの種類プロパティプロパティの設定値ピクチャボックス２ Name picTitle BackColor Black Image title.gif Size 192, 64 ラベル１ Name lblTitle AutoSize False BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor 208, 208, 0 Size 153, 19 Text 入り口グループボックス Name grpInfo BackColor Black Text 空白ラベル２ Name lblDetails0 BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor 208, 208, 0 Text ＡＬＩＶＥラベル３ Name lblAlive AutoSize False BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor White Text 0 TextAlign MiddleRight ラベル４ Name lblDetails1 BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor 208, 208, 0 Text ＬＩＭＩＴラベル５ Name lblLimit AutoSize False BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor White Text 0 TextAlign MiddleRight ラベル６ Name lblDetails2 BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor 208, 208, 0 Text ＰＯＷＥＲ

(15)

コントロールの種類プロパティプロパティの設定値ラベル７ Name lblPower AutoSize False BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor White Text 0 TextAlign MiddleRight ラベル８ Name lblDetails3 BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor 208, 208, 0 Text ＳＯＬＩＤラベル９ Name lblSolid AutoSize False BackColor Transparent Font HG 創英角ﾎﾟｯﾌﾟ体、１４、太字 ForeColor White Text 0 TextAlign MiddleRight タイマー１ Name tmrDevil Enabled False Interval 100 タイマー２ Name tmrGem Enabled False Interval 100 ※ パネル２（pnlDevil）は、必ず、パネル１（pnlBoard）の中に配置する。 ※ ピクチャボックス１（picBoard）は、必ず、パネル２（pnlDevil）の中に配置する。

フォームを、

main.vb と謂う名前で追加する。

(16)

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 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 ' ジェム移動係数（Ｘ方向、Ｙ方向） 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 ' デビル移動係数（Ｘ方向、Ｙ方向） Private U3 As Integer ' デビル方向変換

Private UU As Integer ' デビル出現（１：出現、０：不在）

Private TI As Integer ' 制限時間（秒単位） Private ST As Long ' 開始時間

Private FG As Boolean = False ' 残時間フラグ（３０秒以下で 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 ' 起動パス

プ

(17)

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 ) Next J Next I Input( 1, S ) If S = "U" Then Input( 1, S ) : SD( H ).Cx = Val( S ) Input( 1, S ) : SD( H ).Cy = Val( S ) End If

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 ) Next I Next H FileClose( 1 ) ' 画像の読込 For I = 0 To 8

S = "sprite" & ( I + 1 ).ToString( ) & ".gif" BM( I ) = New Bitmap( S )

(18)

' 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 End Sub ' フォームが閉じられる時の処理

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( ) End Sub

(19)

' キーが押された時の処理

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 ) End Sub ' タイマー（ジェム）が一定間隔で行う処理

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 End If End If

If Not (( B1 = 0 ) And ( B2 = 0 )) Then Bx += B1 : By += B2 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picBoard.Refresh( ) End If N = RO - 1 C = BD( N, ( By + 16 ) ¥ 16, ( Bx + 16 ) ¥ 16 )

(20)

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( ) End If End If 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( ) End If 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 ) Next I Gg.Clear( Color.Transparent )

(21)

picBoard.Refresh( ) Call Sleep( 0.5 ) If HA >= 100 Then Call ChangeDisp( 3 ) End If 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 End If 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 End If 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( ) End If End If 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( )

End If Case 9

Player.SoundLocation = SP & "sound¥gold.wav": Player.Play( ) Call ChangeDisp( 3 )

(22)

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( ) End If

End If 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 End If End If Case Else tmrGem.Enabled = False If UU = 1 Then tmrDevil.Enabled = False Gd.Clear( Color.Transparent ) pnlDevil.Refresh( ) UU = 0 End If

(23)

For I = TI To 0 Step -1 TI = I : Call LimitDisp( ) PO += 1 : Call PowerDisp( ) Call Sleep( 0.1 ) Next 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 ) Next I If WG > 0 Then Gs = 0 Gg.Clear( Color.Transparent ) Gg.DrawImage( BM( Gs ), Bx, By ) picBoard.Refresh( ) WG = 0 End If

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 End If ST = DateTime.Now.Ticks tmrGem.Enabled = True End Select

(24)

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 ) Next 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( ) End If End Sub ' タイマー（デビル）が一定間隔で行う処理

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 )

(25)

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( ) End If 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 End If

Gd.Clear( Color.Transparent ): Gd.DrawImage( BM( 6 ), Ux, Uy ): pnlDevil.Refresh( ) End If End Sub '======================= ' ジェネラルプロシージャ '======================= ' 盤面を表示するジェネラルプロシージャ

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 ) Next J

Next I

pnlBoard.Refresh( )

(26)

' 隠れキャラを表示するジェネラルプロシージャ 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) End If pnlBoard.Refresh( ) SS += 1 End If End If End Sub ' 地面を表示するジェネラルプロシージャ

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( )

End Sub

' 命（ALIVE）を表示するジェネラルプロシージャ Private Sub AliveDisp( )

lblAlive.Text = StrConv( BO.ToString( ), VbStrConv.Wide ) End Sub

' 体力（POWER）を表示するジェネラルプロシージャ Private Sub PowerDisp( )

If PO < 0 Then PO = 0

ElseIf PO > 200 * RT Then PO = 200 * RT

End If

lblPower.Text = StrConv( PO.ToString( ), VbStrConv.Wide ) If PO = 0 Then

Call GemCrash( ) End If

End Sub

(27)

' 破壊力（SOLID）を表示するジェネラルプロシージャ Private Sub SolidDisp( )

lblSolid.Text = StrConv( HA.ToString( ), VbStrConv.Wide ) End Sub

' 残り時間（LIMIT）を表示するジェネラルプロシージャ Private Sub LimitDisp( )

lblLimit.Text = StrConv( TI.ToString( ), VbStrConv.Wide ) End Sub

' ジェムが破壊されるジェネラルプロシージャ Private Sub GemCrash( )

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

If UU = 1 Then tmrDevil.Enabled = False Me.Hide( ) frmOver.ShowDialog( ) Me.Close( ) Exit Sub End If 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

End Sub

' 時間待ちを行うジェネラルプロシージャ 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 Sub

(28)

■ フィニッシュ画面 ■ コントロールの種類プロパティプロパティの設定値フォーム Name frmOver BackColor Teal ControlBox False FormBorderStyle FixedDialog Size 490, 447 StartPosition CenterScreen Text 空白ピクチャボックス１ Name picGem Image sprite1.gif ピクチャボックス２ Name picSprite0 Image sprite4.gif ピクチャボックス３ Name picSprite1 Image sprite5.gif ピクチャボックス４ Name picSprite2 Image sprite6.gif ラベル Name lblMes AutoSize False Font HG 創英角ﾎﾟｯﾌﾟ体、１６、太字 ForeColor 208, 208, 0 Text 空白ボタン Name btnFinish Image finish.gif ボタンピクチャボックス１ラベルピクチャボックス２ピクチャボックス４ピクチャボックス３

(29)

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" End Sub

' フォームがアクティブに成った時の処理

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( "ＣＯＮＧＲＡＴＵＬＡＴＩＯＮＳ！" & Chr( 13 )) Call DispMes( "戦いに勝利してジュエル王国に凱旋した王子に" ) Call DispMes( "王様は、相好を崩して、謂いました。" & Chr( 13 )) Call DispMes( "『汝は、目的を成就した。』" )

Call DispMes( "『依って、汝に、王位を譲る事とする。』" )

プ

(30)

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 ) Next I End If btnFinish.Enabled = True End Sub ' フォームが閉じられる時の処理

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( ) End Sub ' ボタン（終了）がクリックされた時の処理

Private Sub cmdFinish_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnFinish.Click Me.Close( ) End Sub ' メッセージを表示するジェネラルプロシージャ 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 ) Next I

End Sub End Class

(31)

プログラムの概要

ギャンブルゲーム『アレンジボール』で有る。１ゲーム１５個の球を弾いて、出来る丈多くのパターン（縦、横、斜め、四隅、中央４個、四隅を除く周囲８個）を揃える。猶、最初は、コイン１０枚から始める。但し、コインが無く成っても続けられる。一般的に、実用プログラムに比較するとゲームプログラムは、高度なテクニックを要求される事が多い。此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を目的として居る。制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。

アレンジボール

(32)

コントロールの種類プロパティプロパティの設定値フォーム Name Arrangeball BackColor Black FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text アレンジボール - 海、その愛パネル１ Name pnlBack BackColor Teal Size 600, 600 パネル２ Name pnlPlate BackColor Transparent Size 600, 600 パネル３ Name pnlBall Size 600, 600 ピクチャボックス１ Name picFore BackColor Transparent Image arrangeball_board1.gif Size 600, 600

オ

ブ

ジ

ェ

ク

ト

・

プ

ロ

パ

テ

ィ

一

覧

ボタンピクチャボックス１パネル１ラベル１ラベル２ラベル３ラベル４ラベル５ラベル６パネル２パネル３ピクチャボックス２ピクチャボックス３ピクチャボックス４ピクチャボックス５

(33)

コントロールの種類プロパティプロパティの設定値ピクチャボックス２ Name picSea Image umi.gif Size 120, 120 ピクチャボックス３ Name picLove Image love.gif Size 120, 120 ピクチャボックス４ Name picNihonMaru Image akogare.gif Size 140, 100 ピクチャボックス５ Name picKaioMaru Image kaiou.gif Size 140, 100 ラベル１ Name lblBall BackColor Black ForeColor White

Text BALL

ラベル２ Name lblBallCnt

BackColor Black

ForeColor Yellow

Text 0

ラベル３ Name lblCion

BackColor Black

ForeColor White

Text COIN

ラベル４ Name lblCoinCnt

BackColor Black

ForeColor Yellow

Text 0

ラベル５ Name lblGet

ForeColor Red

Text You get!!

ラベル６ Name lblGetNum

AutoSize False

Font Times New Roman、４８、太字

ForeColor Red

Text 10

TextAlign MiddleCenter

ボタン Name btnStart

(34)

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 )) Next

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 )) Next Next End Using

プ

ロ

グ

ラ

ム

リ

ス

ト

(35)

' 数字データの読込

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 )) Next 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( ) End Sub

' 画面を初期化するジェネラルプロシージャ 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( )

End If End Sub

' ボタン（START）がクリックされた時の処理

Private Sub btnStart_Click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles btnStart.Click

(36)

lblGet.Visible = False : lblGetNum.Visible = False For I As Integer = 0 To 15 : Pt( I ) = 0 : Next Cnt = 15 : lblBallCnt.Text = Cnt.ToString( )

Coin -= 1 : lblCoinCnt.Text = Coin.ToString( ) Game = True Call InitScreen( ) btnStart.Enabled = False End Sub ' キーが押し下げられた時の処理

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( ) Next Pow = 0 Call BoundBall( ) End If End If End Sub ' キーが開放された時の処理

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( )

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.DrawImage( Ball, New Point( 482, 585 )): pnlBall.Refresh( ) Flg = True

Else

Loc.X = ( Pos( Pow ).X - 6 ) ¥ 9 + 2 + Rn.Next( 0, 3 ) Loc.Y = ( Pos( Pow ).Y - 2 ) ¥ 9 + 2

Call DispBall( ): Call DropBall( ) End If Pow = 0 End If End Sub ' 球が落下する処理を行うジェネラルプロシージャ 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.Next( 0, 2 ) = 0 Then Loc.X -= 1 Else Loc.X += 1 End If 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 End If

(38)

If Game Then

GrBall.DrawImage( Ball, New Point( 482, 585 )) pnlBall.Refresh( ) End If Flg = True End Sub ' 球が跳ね返る処理を行うジェネラルプロシージャ Private Sub BoundBall( )

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( ) End Sub ' 球を表示するジェネラルプロシージャ 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( ) End Sub

' 判定を行うジェネラルプロシージャ 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 Sub

(39)

プログラムの概要

3D グラフィックスのワイヤーフレーム人形『Wire Girl』で有る。予め用意された10 種類のポーズを色々な角度で表示させる事が出来る。亦、グリッドの値を変更する事で、更に色々なポーズを取らせる事も出来る。猶、ポーズデータを保存する事は出来ないが、ファイル操作を覚えれば、簡単に保存機能を追加出来る様に作成して有るので、挑戦して欲しい。一般的に、実用プログラムに比較するとゲームプログラムは、高度なテクニックを要求される事が多い。此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を目的として居る。制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。

ワイヤーフレーム少女

(40)

コントロールの種類プロパティプロパティの設定値

フォーム Name WireGirl

FormBorderStyle FixedSingle

MaximizeBox False

StartPosition CenterScreen

Text Wire Girl

ピクチャボックス Name picDisp BackColor Black Size 640, 400 ラベル Name lblViewAngle AutoSize False Font ＭＳ明朝、１０、標準 ForeColor White Text 視角：360.0 度コンボボックス Name cboAngle ボタン１ Name btnLoad Font ＭＳ明朝、１０、太字 Text 読込データグリッドビュー Name dgvPose Columns 部位、TH1、TH2、TH3 ラジオボタン１ Name radSeisha Font ＭＳ明朝、１２、太字 Text 正射影図ラジオボタン２ Name radEnkin Font ＭＳ明朝、１２、太字 Text 遠近図ボタン２ Name btnDraw Text 描画

オ

ブ

ジ

ェ

ク

ト

・

プ

ロ

パ

テ

ィ

一

覧

ボタン１ラジオボタン１ピクチャボックスラジオボタン２ラベルデータグリッドビューコンボボックス

(41)

描画設定部分コントロールの種類プロパティプロパティの設定値ラベル AutoSize False Font ＭＳ明朝、１２、太字 Text 上記の通り TextAlign MiddleRight

Text Wire Girl

テキストボックス Font ＭＳ明朝、１２、標準 Text 0.0 TextAlign Right txtAlpha txtBeta txtX txtY txtZ txtL txtH lblAlpha lblBeta lblX lblY lblZ lblL lblH テキストボックスラベル

(42)

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

プ

(43)

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 )

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

Next Sr.Close( ) End Using End Sub

(44)

' ボタン（読込）がクリックされた時の処理

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 Next Sr.Close( ) End Using End Sub ' ボタン（描画）がクリックされた時の処理

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

(45)

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 End If

If Not Single.TryParse( txtBeta.Text, BET ) Then ' β（視線方向の緯度） txtBeta.Select( 0, txtBeta.Text.Length )

txtBeta.Focus( ) : Exit Sub End If

txtAlpha.Text = ALP.ToString( "##0.0" ) txtBeta.Text = BET.ToString( "##0.0" )

' 遠近設定値の取得

If Not Single.TryParse( txtX.Text, SX ) Then ' 視線が投影面を垂直に貫く点のＸ座標 txtX.Select( 0, txtX.Text.Length )

txtX.Focus( ) : Exit Sub End If

txtX.Text = SX.ToString( "##0.0" )

If Not Single.TryParse( txtY.Text, SY ) Then ' 視線が投影面を垂直に貫く点のＹ座標 txtY.Select( 0, txtY.Text.Length )

txtY.Focus( ) : Exit Sub End If

txtY.Text = SY.ToString( "##0.0" )

If Not Single.TryParse( txtZ.Text, SZ ) Then ' 視線が投影面を垂直に貫く点のＺ座標 txtZ.Select( 0, txtZ.Text.Length )

txtZ.Focus( ) : Exit Sub End If

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 End If

If SK <= 0 Then

txtL.Select( 0, txtL.Text.Length ) txtL.Focus( ) : Exit Sub

End If

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 End If

txtH.Text = SH.ToString( "##0.0" ) WD = SH * 100