ウォームアップ　61-70

Transcription

1 ランナー VB プログラムの概要 少し昔大流行したロードランナーを髣髴させるが 只々走る丈のアクションゲーム ランナー で有る 7 種のコースを夫々れ 3 周する 道路に埋まった赤い三角 ( コーン ) を踏むと 人が 1 人減り 3 人全員が失敗すると ゲームオーバーと成る コーンを踏まない様に スペースキーでジャンプし 右向き矢印キーで飛距離を伸ばす事が出来る 但し ジャンプして居る間は 時間が減算され 得点に影響するので 無闇にジャンプしては成らない 最後の第 7 コースは 結構大変で有る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -1-

2 オブジェクト プロパティ一覧 ラベル 2 ラベル 1 ピクチャボックス ラベル 3 ラベル 4 ラベル 5 ラベル 6 ラベル 7 コントロールの種類 プロパティ プロパティの設定値 フォーム Name runner AutoScaleMode None Font Impact 14 標準 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text RUNNER ピクチャボックス Name picstage Image stage.gif Size 256, 180 ラベル1 Name lbltime BackColor Black Font Impact 14 標準 ForeColor White Size 41, 23 Text 160 TextAlign MiddleRight ラベル2 Name lblmen BackColor Black Font Impact 14 標準 ForeColor White Size 23, 23 Text 3 TextAlign MiddleRight -2-

3 コントロールの種類 プロパティ プロパティの設定値 ラベル3 Name lblcourse BackColor Black Font Impact 14 標準 ForeColor White Size 23, 23 Text 3 TextAlign MiddleRight ラベル4 Name lblmes BackColor Red Font Impact 14 標準 ForeColor White Size 121, 22 Text GOAL!!!!! TextAlign MiddleCenter Visible False ラベル5 Name lblscore BackColor Black Font Impact 14 標準 ForeColor White Size 51, 23 Text 0 TextAlign MiddleRight ラベル6 Name lblhiscore BackColor Black Font Impact 14 標準 ForeColor White Size 51, 23 Text 1000 TextAlign MiddleRight ラベル7 Name lblstart Image start.gif Size 256, 36 Text 空白 参考 此処では フォームとは 完全に別スレッドで動作する System.Timers.Timer オブジェクトを使用して居る 此のタイマーは フォームのイベントで待機状態に成る事は無く 正確な時間間隔で動作するが フォームのコントロールを操作するには デリゲート機能を使用する必要が有る -3-

4 プログラムリスト Imports System.IO Public Class runner Private Bm( 4 ) As Bitmap Private Gb, Gf As Graphics Private Cd(6) As String Private SC, HS, TI, MN As Integer Private LO, MP, RO, PT, PY As Integer Private Game As Boolean = False Private Tm As System.Timers.Timer = New System.Timers.Timer( 200 ) Delegate Sub TimerDelegate( ) ' フォームが読み込まれた時の処理 Private Sub runner_load( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles MyBase.Load ' 画像の読込 Bm( 0 ) = New Bitmap( "runner0.gif" ) Bm( 1 ) = New Bitmap( "runner1.gif" ) Bm( 2 ) = New Bitmap( "block.gif" ) Bm( 3 ) = New Bitmap( "torn.gif" ) Bm( 4 ) = New Bitmap( "stage.gif" ) ' ステージデータの読込 Using Sr As StreamReader = New StreamReader( "runner.txt" ) For I As Integer = 0 To 6 Cd( I ) = Sr.ReadLine( ) Sr.Close( ) End Using ' ハイスコアの読込 If File.Exists( "runner.dat" ) Then Dim S As String Using Sr As StreamReader = New StreamReader( "runner.dat" ) S = Sr.ReadLine( ) Sr.Close( ) End Using HS = Integer.Parse( S ) Else HS = 1000 lblhiscore.text = HS.ToString( ) -4-

5 ' Graphics オブジェクトのインスタンス生成 With picstage.backgroundimage = New Bitmap(.Width,.Height ) Gb = Graphics.FromImage(.BackgroundImage ).Image = New Bitmap(.Width,.Height ) Gf = Graphics.FromImage(.Image ) End With Gb.DrawImage( Bm( 4 ), 0, 0 ) For I As Integer = 0 To 31 Gb.DrawImage( Bm( 2 ), I * 8, 130 ) Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( 0 ), 48, 114 ) ' タイマーの設定 Tm.AutoReset = True AddHandler Tm.Elapsed, New System.Timers.ElapsedEventHandler(AddressOf TimerCourse) ' キーが押し下げられた時の処理 Private Sub runner_keydown( ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs ) Handles Me.KeyDown Select Case e.keycode Case Keys.Space If Game Then If PY = 114 Then PY -= 16: Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( 0 ), 48, PY ) picstage.refresh( ) Case Keys.Right If Game Then If PY < 114 Then PY -= 2: Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( 0 ), 48, PY ) picstage.refresh( ) End Select ' フォームが閉じられた時の処理 Private Sub runner_formclosed( ByVal sender As Object, _ ByVal e As System.Windows.Forms.FormClosedEventArgs ) Handles Me.FormClosed Tm.Stop( ) : Application.DoEvents( ) : System.Threading.Thread.Sleep( 1000 ) : Tm.Dispose( ) -5-

6 ' ラベル (START) がクリックされた時の処理 Private Sub lblstart_click( ByVal sender As System.Object, ByVal e As System.EventArgs ) _ Handles lblstart.click lblmes.visible = False TI = 300 : lbltime.text = TI.ToString( ) SC = 0 : lblscore.text = SC.ToString( ) MN = 3 : lblmen.text = MN.ToString( ) LO = 0 : lblcourse.text = ( LO + 1 ).ToString( ) Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( 0 ), 48, 114 ) picstage.refresh( ) MP = 0 : RO = 0 : PT = 0 : PY = 114 Game = True : Tm.Start( ) ' タイマーが一定間隔で自動的に行う処理 Private Sub TimerCourse( ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs ) Invoke( New TimerDelegate( AddressOf DrawCourse )) ' コースを描画するジェネラルプロシージャ Private Sub DrawCourse( ) Dim N As Integer For I As Integer = 0 To 31 N = Integer.Parse( Cd( LO ).Substring( MP + I, 1 )) Gb.DrawImage( Bm( N + 2 ), I * 8, 130 ) PY += 3 If PY >= 114 Then PY = 114 ' 判定 If Integer.Parse( Cd( LO ).Substring( MP + 6, 1)) = 1 Then MN -= 1 : lblmen.text = MN.ToString( ) If MN = 0 Then lblmes.text = "GAME OVER!!" lblmes.visible = True Tm.Stop( ) : Game = False Exit Sub Else TI -= 1 : lbltime.text = TI.ToString( ) Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( PT ), 48, PY ) -6-

7 picstage.refresh( ) PT = PT Xor 1 : MP += 1 If MP = 160 Then MP = 0 : RO += 1 If RO = 3 Then Tm.Stop( ) : Game = False SC += (( LO + 1 ) * TI ) lblscore.text = SC.ToString( ) LO += 1 If LO > 6 Then lblmes.text = "ALL CLEAR!!" lblmes.visible = True If SC > HS Then HS = SC : lblhiscore.text = HS.ToString( ) Using Sw As StreamWriter = New StreamWriter( "runner.dat" ) Sw.WriteLine( HS ) Sw.Close( ) End Using Else lblmes.text = "GOAL!!!!!" lblmes.visible = True TI = 300 : PY = 114 lbltime.text = TI.ToString( ) lblcourse.text = ( LO + 1 ).ToString( ) Gf.Clear( Color.Transparent ) Gf.DrawImage( Bm( 0 ), 48, PY ) picstage.refresh( ) Application.DoEvents( ) : System.Threading.Thread.Sleep( 3000 ) lblmes.visible = False MP = 0 : RO = 0 : PT = 0 Game = True : Tm.Start( ) End Class -7-

8 ジャンピングカー VB プログラムの概要 スクロール型アクションゲーム ジャンピングカー で有る 永遠へと続く道を 只々走り続ける丈のゲームで有る ( 初期のゲームウォッチ風 ) 左右の矢印キーで減速と加速を行い スペースキーでジャンプする ジャンプは 加速が付いて居る程 高く跳ぶ事が出来る 時々 ミサイルが飛んで来るが 当ると勿論ゲームオーバーと成る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 此のゲームは 非常に単純なものだが スクロール型のゲームの参考に仕て欲しい 自動的に行われる処理 ( タイマーの利用 ) -8-

9 オブジェクト プロパティ一覧 ラベル 2 ピクチャボックス 1 ラベル 3 ラベル 4 ピクチャボックス 2 ラベル 1 ラベル 5 ラベル 6 ラベル 7 ラベル 8 ラベル 9 コントロールの種類 プロパティ プロパティの設定値 フォーム Name JumpingCar AutoScaleMode None BackColor Black Font Times New Roman 9 標準 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text JUMPING CAR ピクチャボックス1 Name picstage BackColor SkyBlue Size 400, 300 ピクチャボックス2 Name picacceleration Size 101, 101 ラベル1 Name lblmes AutoSize False BackColor Navy Font Times New Roman 16 太字 ForeColor White Size 322, 44 Text Push 'S' key to start!!!!! TextAlign MiddleCenter -9-

10 コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblhiscoretitle AutoSize False Font Times New Roman 12 太字 ForeColor Red Text High Score TextAlign MiddleCenter ラベル3 Name lblhiscore AutoSize False BackColor White ForeColor Red Text 0 TextAlign MiddleRight ラベル4 Name lblacceleration AutoSize False Font Times New Roman 12 太字 ForeColor White Text Acceleration TextAlign MiddleCenter ラベル5 Name lbldistancetitle AutoSize False Font Times New Roman 12 太字 ForeColor White Text Distance TextAlign MiddleCenter ラベル6 Name lbldistance AutoSize False BackColor White ForeColor Black Text 0 TextAlign MiddleRight ラベル7 Name lblleveltitle AutoSize False Font Times New Roman 12 太字 ForeColor White Text Level TextAlign MiddleCenter ラベル8 Name lbleasy AutoSize False BackColor ForeColor Red White Text TextAlign Easy MiddleCenter ラベル9 Name lbldifficult AutoSize False BackColor ForeColor Blue White Text TextAlign Difficult MiddleCenter -10-

11 プログラムリスト Imports System.IO Public Class JumpingCar Private Const SPEED As Integer = 200 Private Const DEG As Double = / Private Bm(3), Bb, Bt As Bitmap Private Gb, Gf, Ga As Graphics Private CX, CY As Integer ' 車の座標 Private AC As Integer = 10 加速 (0~19) Private DX, DY As Integer ' 道路の終端座標 Private FA As Integer = 0 ' 落下係数 Private JP As Integer = 0 ' 跳躍係数 Private SP As Integer = 10 ' 道路のスクロール幅 Private LV As Integer = 0 ' レベル (0: 簡単 1: 困難 ) Private FX, FY As Integer ' ミサイルの座標 Private MF As Boolean = False ' ミサイルフラグ Private CS, CR As Color ' 空と道路の色 Private BR As SolidBrush ' 道路を描画する刷毛 Private PN As Pen ' アクセルを描画するペン Private SC As Integer = 0 ' 走行距離 ( 得点 ) Private HI(1) As Integer ' 最長走行距離 ( ハイスコア ) Private Game As Boolean = False ' ゲームフラグ Private Rn As Random = New Random() Private Tb As System.Timers.Timer = New System.Timers.Timer(SPEED) ' 背景用タイマー Private Tc As System.Timers.Timer = New System.Timers.Timer(SPEED) ' 車用タイマー Private Tm As System.Timers.Timer = New System.Timers.Timer(SPEED) ' ミサイル用タイマー Delegate Sub TimerDelegate() ' フォームが読み込まれた時の処理 Private Sub JumpingCar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' 画像の読込 Bm(0) = New Bitmap("car_s.gif") Bm(1) = New Bitmap("missile_s.gif") Bm(2) = New Bitmap("acceleration.gif") Bm(3) = New Bitmap("bang.gif") ' 最長走行距離の読込 Using Sr As StreamReader = New StreamReader("JumpingCar.dat") HI(0) = Integer.Parse(Sr.ReadLine) HI(1) = Integer.Parse(Sr.ReadLine) Sr.Close() End Using lblhiscore.text = HI(0).ToString() -11-

12 ' 色と刷毛とペンの設定 CS = Color.FromArgb(255, 135, 206, 235) CR = Color.FromArgb(255, 169, 169, 169) BR = New SolidBrush(CR) PN = New Pen(Color.Red, 3) PN.EndCap = Drawing2D.LineCap.ArrowAnchor ' Graphics オブジェクトのインスタンス生成 With picstage Bb = New Bitmap(.Width * 2,.Height) Bt = New Bitmap(.Width * 2,.Height).BackgroundImage = Bb.Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With Gb.Clear(CS) Gf.Clear(Color.Transparent) With picacceleration.backgroundimage = New Bitmap(.Width,.Height).Image = New Bitmap("acceleration.gif") Ga = Graphics.FromImage(.BackgroundImage) End With Ga.Clear(Color.Black) Ga.DrawLine(PN, 50, 50, 50, 7) ' 初期画面の描画 Call DrawStage() ' タイマーの設定 Tb.AutoReset = True : Tc.AutoReset = True : Tm.AutoReset = True AddHandler Tb.Elapsed, New System.Timers.ElapsedEventHandler(AddressOf TimerBack) AddHandler Tc.Elapsed, New System.Timers.ElapsedEventHandler(AddressOf TimerCar) AddHandler Tm.Elapsed, New System.Timers.ElapsedEventHandler(AddressOf TimerMissile) ' フォームが閉じられた時の処理 Private Sub JumpingCar_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed Tb.Stop() : Tc.Stop() Application.DoEvents() : System.Threading.Thread.Sleep(1000) BR.Dispose() : PN.Dispose() : Gb.Dispose() : Gf.Dispose() : Ga.Dispose() Tb.Dispose() : Tc.Dispose() ' キーが押し下げられた時の処理 Private Sub JumpingCar_KeyDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown -12-

13 Select Case e.keycode Case Keys.S If Not Game Then lblmes.visible = False Call DrawStage() AC = 10 : Call DrawAcceleration() SC = 0 : lbldistance.text = SC.ToString() FA = 0 : JP = 0 Game = True : Tb.Start() : Tc.Start() Case Keys.Right If Game AndAlso (AC < 20) Then If (LV = 0) OrElse ((LV = 1) AndAlso (JP + FA = 0)) Then AC += 1 : Call DrawAcceleration() Case Keys.Left If Game AndAlso (AC > 0) Then If (LV = 0) OrElse ((LV = 1) AndAlso (JP + FA = 0)) Then AC -= 1 : Call DrawAcceleration() Case Keys.Space If Game AndAlso (FA = 0) AndAlso (JP = 0) Then JP = AC * (3 - LV) + 30 End Select ' タイマー ( 背景 ) が一定間隔で自動的に行う処理 Private Sub TimerBack(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Invoke(New TimerDelegate(AddressOf ScrollBack)) ' タイマー ( 車 ) が一定間隔で自動的に行う処理 Private Sub TimerCar(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Invoke(New TimerDelegate(AddressOf MoveCar)) ' タイマー ( ミサイル ) が一定間隔で自動的に行う処理 Private Sub TimerMissile(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Invoke(New TimerDelegate(AddressOf MoveMissile)) ' 背景をスクロールさせるジェネラルプロシージャ Private Sub ScrollBack() SC += 1 : lbldistance.text = SC.ToString() Bt = New Bitmap(picStage.BackgroundImage) -13-

14 Gb.DrawImage(Bt, 0, 0, New Rectangle(SP, 0, SP, 500), GraphicsUnit.Pixel) picstage.refresh() DX -= 10 If DX <= 400 Then Dim W, H, B As Integer W = Rn.(3, 6) * 50 : H = Rn.(3, 6) * 10 : B = Rn.(1, LV + 3) * DX = B + W : DY += Rn.(-1, 2) * 50 If DY < 100 Then DY = 100 If DY > 250 Then DY = 250 Gb.FillRectangle(BR, B, DY, W, H) If Not MF Then If (SC Mod (20 - LV * 10)) = 0 Then If Rn.(0, 3) < (LV + 1) Then FX = 400 : FY = Rn.(100, 200) : MF = True Tm.Start() ' 車を移動させるジェネラルプロシージャ Private Sub MoveCar() CX -= (SP - AC) : CY += (FA - JP) : JP = 0 Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(0), CX, CY) picstage.refresh() If CX < -36 Or CY > 300 Then Call GameOver() : Exit Sub If (CX + 6 > 0) And (CY + 26 < 300) Then Dim C1 As Color = Bb.GetPixel(CX + 6, CY + 26) Dim C2 As Color = Bb.GetPixel(CX + 27, CY + 26) If C1 = CS And C2 = CS Then FA = 10 ElseIf C1 = CR Or C2 = CR Then If Not FA = 0 Then FA = 0 ' ミサイルを移動させるジェネラルプロシージャ Private Sub MoveMissile() Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(0), CX, CY) -14-

15 Gf.DrawImage(Bm(1), FX, FY) picstage.refresh() If (FY >= CY) AndAlso (FY <= CY + 15) Then If (FX >= CX) AndAlso (FX <= CX + 36) Then Gf.DrawImage(Bm(3), CX - 20, CY - 20) picstage.refresh() Call GameOver() : Exit Sub FX -= 30 : If FX < -100 Then Tm.Stop() : MF = False ' 初期画面を描画するジェネラルプロシージャ Private Sub DrawStage() CX = 50 : CY = 124 Gb.Clear(CS) Gf.Clear(Color.Transparent) Gb.FillRectangle(BR, 0, 150, 200, 40) Gb.FillRectangle(BR, 250, 200, 100, 30) Gb.FillRectangle(BR, 390, 190, 200, 50) Gf.DrawImage(Bm(0), CX, CY) : DX = 590 : DY = 190 picstage.refresh() ' アクセルを描画するジェネラルプロシージャ Private Sub DrawAcceleration() Dim X, Y As Integer Dim A As Double A = (AC / 20.0) * 360 * DEG X = 50 + Math.Sin(A) * 43 Y = 50 - Math.Cos(A) * 43 Ga.Clear(Color.Black) Ga.FillPie(Brushes.Pink, 5, 5, 91, 91, 270, System.Convert.ToInt32(A / DEG)) Ga.DrawLine(PN, 50, 50, X, Y) picacceleration.refresh() ' ゲームオーバー処理を行うジェネラルプロシージャ Private Sub GameOver() Tb.Stop() : Tc.Stop() : Tm.Stop() lblmes.backcolor = Color.Red lblmes.text = "Game Over!!!!!" lblmes.visible = True Game = False : MF = False If SC > HI(LV) Then lblmes.text = "High Score!!!!!" -15-

16 HI(LV) = SC : lblhiscore.text = HI(LV).ToString() Using Sw As StreamWriter = New StreamWriter("JumpingCar.dat") Sw.WriteLine(HI(0)) Sw.WriteLine(HI(1)) Sw.Close() End Using ' ラベル ( レベル ) がクリックされた時の処理 Private Sub lbllevel_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles lbleasy.click, lbldifficult.click Dim L As Label = DirectCast(sender, Label) If Game Then Exit Sub If L.BackColor = Color.Red Then Exit Sub Select Case L.Name.Substring(3, 1).ToUpper() Case "E" LV = 0 lbleasy.backcolor = Color.Red lbldifficult.backcolor = Color.Blue Case "D" LV = 1 lbleasy.backcolor = Color.Blue lbldifficult.backcolor = Color.Red End Select lblhiscore.text = HI(LV).ToString() End Class -16-

17 倉庫番 VB プログラムの概要 其の昔 一世を風靡し世界中に愛好家の居るパズルゲーム 倉庫番 で有る 荷物 ( 蛸 ) を押して ( 引く事は出来ない ) 所定の場所 ( 壺 ) に納める単純明快な物で有る 猶 一度クリアした面は 自由に再度プレイする事が出来るが 新たな面には 前の面をクリアしないと進む事は出来ない 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -17-

18 オブジェクト プロパティ一覧 ピクチャボックス 1 ピクチャボックス 2 パネル セーブファイルダイアログ オープンファイルダイアログ テキストボックスボタン 1 ボタン2 ラベル1 ボタン3 リストボックス ( リストボックスの下に ボタン 2 個とラベル 1 個が有る ) コントロールの種類 プロパティ プロパティの設定値 フォーム Name sokoban FormBorderStyle FixedSingle MaximizeBox False Size 975, 674 StartPosition CenterScreen Text 倉庫番 ピクチャボックス1 Name picstage BackColor Black Size 1601,

19 コントロールの種類 プロパティ プロパティの設定値 パネル Name pnlmenu BackColor White Location 643, 3 Size 325, 349 ピクチャボックス2 Name piclogo Image sokoban.gif テキストボックス Name txtstage Font MS 明朝 12 太字 ReadOnly True TextAlign Center ボタン1 Name cmdstage Image combo.gif Text 空白 ボタン2 Name btnmove0 Enabled False Image ARW01LT.ICO Text 空白 ボタン3 Name btnmove1 Enabled False Image ARW01RT.ICO Text 空白 ラベル1 Name lblstage AutoSize False BorderStyle FixedSingle Font MS 明朝 16 太字 Text 第 100 面 TextAlign MiddleCenter リストボックス Name lststage Font MS 明朝 12 標準 オープンファイルダイアログ Name cdlloadopen DefaultExt txt Filter データファイル (*.txt) *.txt 総てのファイル (*.*) *.* Title 任意ステージの読込 セーブファイルダイアログ Name cdlfilesave DefaultExt txt Filter データファイル (*.txt) *.txt 総てのファイル (*.*) *.* Title 倉庫番ステージデータの保存 -19-

20 プログラムリスト Imports System.IO Public Class sokoban Private SD As String ' 起動パス Private SG As Integer ' ステージグループ番号 Private ST As Integer ' ステージ番号 Private CL As Integer ' クリアした最大ステージ番号 Private Px, Py As Integer ' 烏賊 ( 番人 ) の座標 Private Sx, Sy As Integer ' 左上隅に表示する仮想画面の座標 Private BD(49, 49) As Integer ' 仮想画面 ( ゲーム用 ) Private GameFlag As Boolean ' ゲームフラグ (True: ゲーム中 False: 待受中 ) Private InitFlag As Boolean = True ' 初期化フラグ Private Bm(7) As Bitmap Private Gb, Gf As Graphics ' フォームが読み込まれた時の処理 Private Sub sokoban_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load Dim F, S, T, D() As String Dim C, I, J As Integer ' 起動パスの取得 SD = Application.StartupPath : If Not SD.EndsWith(" ") Then SD &= " " ' 画像の読込 Bm(0) = New Bitmap(SD & "ikad.gif") Bm(1) = New Bitmap(SD & "ikau.gif") Bm(2) = New Bitmap(SD & "ikar.gif") Bm(3) = New Bitmap(SD & "ikal.gif") Bm(4) = New Bitmap(SD & "block.gif") Bm(5) = New Bitmap(SD & "tako.gif") Bm(6) = New Bitmap(SD & "pot.gif") Bm(7) = New Bitmap(SD & "tako-pot.gif") ' Graphics オブジェクトのインスタンス生成 With picstage.backgroundimage = New Bitmap(.Width,.Height).Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With -20-

21 ' ステージグループ番号の取得 F = SD & "sokoban.stg" If System.IO.File.Exists(F) Then Using Br As BinaryReader = New BinaryReader(File.Open(F, FileMode.Open)) SG = Br.ReadInt32() Br.Close() End Using Else SG = 1 Using Bw As BinaryWriter = New BinaryWriter(File.Open(F, FileMode.Create)) Bw.Write(SG) Bw.Close() End Using ' コンボボックス ( ステージグループ ) の設定 F = SD & "data " : T = "" D = Directory.GetDirectories(F) C = D.Length - 1 For I = 0 To C For J = (I + 1) To C If D(I) > D(J) Then S = D(I) D(I) = D(J) D(J) = S J I For I = 0 To C lststage.items.add(d(i).substring(d(i).length - 8)) If Integer.Parse(D(I).Substring(D(I).Length - 3)) = SG Then lststage.selectedindex = I I If lststage.selectedindex < 0 Then lststage.selectedindex = 0 SG = Integer.Parse(lstStage.SelectedItem.ToString()) Call SetCombo() ' ゲームの初期化 InitFlag = False Call GameInit() ' フォームが閉じられ様と仕た時の処理 Private Sub sokoban_formclosing(byval sender As Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing -21-

22 Dim F As String = SD & "screen.tmp" If File.Exists(F) Then File.Delete(F) ' ボタン ( コンボボックス ) がクリックされた時の処理 Private Sub cmdstage_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles cmdstage.click If lststage.visible = False Then lststage.visible = True Else lststage.visible = False picstage.focus() ' リストボックス ( ステージグループ ) がクリックされた時の処理 Private Sub lststage_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles lststage.click Dim F, S As String If InitFlag Then Exit Sub S = lststage.selecteditem.tostring() SG = Integer.Parse(S.Substring(S.Length - 3)) ' ステージグループの保存 F = SD & "sokoban.stg" Using Bw As BinaryWriter = New BinaryWriter(File.Open(F, FileMode.Create)) Bw.Write(SG) Bw.Close() End Using ' コンボボックス風の表示 Call SetCombo() lststage.visible = False ' ゲームの初期化 Call GameInit() picstage.focus() ' キー入力が為された時の処理 Private Sub sokoban_keyup(byval sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp Dim Dx, Dy, Dr, Nc As Integer Dim X1, Y1, X2, Y2, N As Integer Dim F As String -22-

23 If Not GameFlag Then Exit Sub ' 移動方向の設定 Dx = 0 : Dy = 0 Select Case e.keycode Case Keys.A ' 解法 If e.control Then Call SolveStage() Exit Sub Case Keys.F1 ' メニューの表示 非表示 If pnlmenu.visible Then pnlmenu.visible = False Else pnlmenu.visible = True Exit Sub Case Keys.Escape ' 遣り直し Call DispStage() Case Keys.Up Dy = -1 : Dr = 1 Case Keys.Down Dy = 1 : Dr = 0 Case Keys.Left Dx = -1 : Dr = 3 Case Keys.Right Dx = 1 : Dr = 2 End Select ' 移動先の処理 X1 = Px + Dx : Y1 = Py + Dy : N = BD(X1, Y1) Select Case N Case 0, 4 Px = X1 : Py = Y1 Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(Dr), Px * 32, Py * 32) Call ScrollStage(Dr) Case 2, 6 X2 = Px + Dx * 2 : Y2 = Py + Dy * 2 Nc = BD(X2, Y2) If Nc = 0 Or Nc = 4 Then BD(X1, Y1) = (BD(X1, Y1) And 4) BD(X2, Y2) = (BD(X2, Y2) Or 2) Gb.FillRectangle(Brushes.Black, X1 * 32, Y1 * 32, 32, 32) If Not BD(X1, Y1) = 0 Then Gb.DrawImage(Bm(6), X1 * 32, Y1 * 32) Gb.FillRectangle(Brushes.Black, X2 * 32, Y2 * 32, 32, 32) -23-

24 If BD(X2, Y2) = 2 Then Gb.DrawImage(Bm(5), X2 * 32, Y2 * 32) Else Gb.DrawImage(Bm(7), X2 * 32, Y2 * 32) Px += Dx : Py += Dy Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(Dr), Px * 32, Py * 32) Call ScrollStage(Dr) End Select picstage.refresh() ' クリアのチェック N = 0 For I As Integer = 0 To 49 For J As Integer = 0 To 49 If (BD(I, J) And 2) = 2 Then If Not BD(I, J) = 6 Then N = 1 : Exit Sub MsgBox(" 第 " & ST.ToString() & " 面クリア!", vbexclamation, " 倉庫番 ") ST += 1 F = SD & "data " & lststage.selecteditem & " store" & Format$(ST, "000") & ".txt" If Not File.Exists(F) Then MsgBox(" 第 " & SG.ToString() & " ステージ全面クリア!!", vbexclamation, " 倉庫番 ") GameFlag = False ST -= 1 Else If ST > CL Then CL = ST : F = SD & "sokoban.bin" Using Bw As BinaryWriter = _ New BinaryWriter(File.Open(F, FileMode.Open, FileAccess.Write)) Bw.Seek(SG * 4, SeekOrigin.Begin) Bw.Write(CL) Bw.Close() End Using lblstage.text = " 第 " & ST.ToString() & " 面 " Call DispStage() If ST > 1 Then btnmove0.enabled = True -24-

25 ' コンボボックス風リストを設定するジェネラルプロシージャ Private Sub SetCombo() Dim F, S, D() As String F = SD & "sokoban.num" : S = "" Using Sr As StreamReader = New StreamReader(F) Do Until Sr.EndOfStream S = Sr.ReadLine() : D = S.Split(",") If Integer.Parse(D(0)) = SG Then S = " - 全 " & D(1) & " 面 " Exit Do Loop Sr.Close() End Using txtstage.text = lststage.selecteditem.tostring() & S ' ゲームを初期化するジェネラルプロシージャ Private Sub GameInit() ' ステージ番号の取得 Dim F As String = SD & "sokoban.bin" If Not File.Exists(F) Then Using Bw As BinaryWriter = New BinaryWriter(File.Open(F, FileMode.Create)) Bw.Close() End Using Using Br As BinaryReader = _ New BinaryReader(File.Open(F, FileMode.Open, FileAccess.Read)) Try For I As Integer = 0 To SG CL = Br.ReadInt32() Catch ex As EndOfStreamException CL = 0 Catch ex As Exception MessageBox.Show(ex.Message) Finally Br.Close() End Try End Using If CL = 0 Then CL = 1 Using Bw As BinaryWriter = _ New BinaryWriter(File.Open(F, FileMode.Open, FileAccess.Write)) Bw.Seek(SG * 4, SeekOrigin.Begin) Bw.Write(CL) Bw.Close() -25-

26 End Using ST = CL lblstage.text = " 第 " & ST.ToString() & " 面 " ' ステージ移動の設定 If CL > 1 Then btnmove0.enabled = True Else btnmove0.enabled = False ' ゲームの開始 Call DispStage() Me.KeyPreview = True GameFlag = True ' ステージを表示するジェネラルプロシージャ Private Sub DispStage(Optional ByVal HF As String = "") Dim F, S As String Dim C, R As Integer ' データファイル名の設定 If HF = "" Then F = SD & "data " & lststage.selecteditem & " store" & ST.ToString("000") & ".txt" Else F = HF If Not File.Exists(F) Then MessageBox.Show( _ "Not Exist!!", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub ' データの読込と画面の描画 For I As Integer = 0 To 49 For J As Integer = 0 To 49 BD(I, J) = 0 picstage.location = New Point(0, 0) Gb.Clear(Color.Black) : Gf.Clear(Color.Transparent) Using Sr As StreamReader = New StreamReader(F) R = 0 Do Until Sr.EndOfStream S = Sr.ReadLine For I As Integer = 0 To (S.Length - 1) -26-

27 C = System.Convert.ToInt32(S.Substring(I, 1), 16) BD(I, R) = C Select Case C Case 1 ' 壁 Gb.DrawImage(Bm(4), I * 32, R * 32) Case 2 ' 蛸 Gb.DrawImage(Bm(5), I * 32, R * 32) Case 4 ' 壺 Gb.DrawImage(Bm(6), I * 32, R * 32) Case 6 ' 壺入蛸 Gb.DrawImage(Bm(7), I * 32, R * 32) Case 8 ' 烏賊 Px = I : Py = R : BD(I, R) = 0 Gf.DrawImage(Bm(0), I * 32, R * 32) Case 12 ' 壺上烏賊 Px = I : Py = R : BD(I, R) = (C And 4) Gb.DrawImage(Bm(6), I * 32, R * 32) Gf.DrawImage(Bm(0), I * 32, R * 32) End Select R += 1 Loop Sr.Close() End Using picstage.refresh() lblstage.text = " 第 " & ST.ToString() & " 面 " ' 画面をスクロールするジェネラルプロシージャ Private Sub ScrollStage(ByVal Dr As Integer) Select Case Dr Case 1 ' 上 If Py > 4 AndAlso Py < Sy + 5 Then Sy -= 1 : picstage.top = -Sy * 32 Case 0 ' 下 If Py > Sy + 14 AndAlso Py < 45 Then Sy += 1 : picstage.top = -Sy * 32 Case 2 ' 右 If Px > Sx + 24 AndAlso Px < 45 Then Sx += 1 : picstage.left = -Sx * 32 Case 3 ' 左 If Px > 4 AndAlso Px < Sx + 5 Then Sx -= 1 : picstage.left = -Sx *

28 End Select ' 解答を求めるジェネラルプロシージャ (Ctrl+A) Private Sub SolveStage() Dim Fs, Fd As String Dim S, T As String Dim I, C As Integer Fs = SD & "data " & lststage.selecteditem & " store" & ST.ToString("000") & ".txt" Fd = SD & "screen.tmp" Using Sr As StreamReader = New StreamReader(Fs) Using Sw As StreamWriter = New StreamWriter(Fd) Do Until Sr.EndOfStream S = Sr.ReadLine() T = "" For I = 0 To (S.Length - 1) C = System.Convert.ToInt32(S.Substring(I, 1), 16) Select Case C Case 0 : T &= " " Case 1 : T &= "#" Case 2 : T &= "$" Case 4 : T &= "." Case 6 : T &= "*" Case 8 : T &= "@" Case 12 : T &= "+" End Select T = T.Trim() Sw.WriteLine(T) Loop Sw.Close() End Using Sr.Close() End Using Shell(SD & "", AppWinStyle.NormalFocus) End Class -28-

29 倉庫番エディタ VB プログラムの概要 其の昔 一世を風靡し世界中に愛好家の居るパズルゲーム 倉庫番 の面エディタで有る パーツを選択し 配置する場所をクリックする丈で ステージを作成する事が出来る 亦 作成して居る面を 任意の段階でプレイして 動作チェックする事も出来る 一般に 面クリア型のゲームでは 此の様に面エディタを作成して データを作る事が多い 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -29-

30 オブジェクト プロパティ一覧 パネル 1 ピクチャボックス 1 ピクチャボックス 2 パネル 2 ラジオボタン 1~7 ボタン 1~6 ラベル 1 コントロールの種類 プロパティ プロパティの設定値 フォーム Name sokoban FormBorderStyle FixedSingle KeyPreview True MaximizeBox False Size 975, 674 StartPosition CenterScreen Text 倉庫番 - エディタ ピクチャボックス1 Name picstage BackColor Black Size 1601, 1601 パネル Name pnlmenu BackColor White Location 643, 3 Size 325, 356 ピクチャボックス2 Name piclogo Image sokoban.gif パネル2 Name pnloperation ピクチャボックス3 Name picpointer Image combo.gif Location 20, 3 Size 15,

31 コントロールの種類 プロパティ プロパティの設定値 ラジオボタン1~7 Name 1:radBlock 2:radPot 3:radOctopus 4:radOctopusInPot 5:radSquid 6:radSquidOnPot 7:radSpace Appearance Button BackColor 7:Black 他 : 無設定 Checked 1:True 他 :False Image 1:block.gif 2:pot.gif 3:tako.gif 4:tako-pot.gif 5:ikaD.gif 6:ika-pot.gif 7: 無し Size 38, 38 Tag 1:1 2:4 3:2 4:6 5:8 6:12 7:0 ボタン1~6 Name 1:btnNew 2:btnLoad 3:btnSave 4:btnEdit 5:btnTest 6:btnSolv Image 1:new.gif 2:load.gif 3:save.gif 4:edit.gif 5:play.gif 6:solver.gif Size 42, 42 Text 空白 ToolTips 1: 新規 2: 読込 3: 保存 4: 編集 5: 試験 6: 解法 -31-

32 オープンファイルダイアログ Name cdlloadopen DefaultExt txt Filter データファイル (*.txt) *.txt 総てのファイル (*.*) *.* Title 任意ステージの読込 セーブファイルダイアログ Name cdlfilesave DefaultExt txt Filter データファイル (*.txt) *.txt 総てのファイル (*.*) *.* Title 倉庫番ステージデータの保存 ツールチップ Name tipsokoban -32-

33 プログラムリスト Imports System.IO Public Class sokoban Private SD As String ' 起動パス Private Px, Py As Integer ' 烏賊 ( 番人 ) の座標 Private Sx, Sy As Integer ' 左上隅に表示する仮想画面の座標 Private Ch As Integer ' 配置するキャラクタの種類 Private BD(49, 49) As Integer ' 仮想画面 ( ゲーム用 ) Private ED(49, 49) As Integer ' 仮想画面 ( 編集用 ) Private GameFlag As Boolean ' ゲームフラグ (True: ゲーム中 False: 待受中 ) Private EditFlag As Boolean ' 編集フラグ (True: 編集中 False: 待受中 ) Private InitFlag As Boolean = True ' 初期化フラグ Private Bm(8) As Bitmap Private Gb, Gf As Graphics ' フォームが読み込まれた時の処理 Private Sub sokoban_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' 起動パスの取得 SD = Application.StartupPath : If Not SD.EndsWith(" ") Then SD &= " " ' 画像の読込 Bm(0) = New Bitmap(SD & "ikad.gif") Bm(1) = New Bitmap(SD & "ikau.gif") Bm(2) = New Bitmap(SD & "ikar.gif") Bm(3) = New Bitmap(SD & "ikal.gif") Bm(4) = New Bitmap(SD & "block.gif") Bm(5) = New Bitmap(SD & "tako.gif") Bm(6) = New Bitmap(SD & "pot.gif") Bm(7) = New Bitmap(SD & "tako-pot.gif") Bm(8) = New Bitmap(SD & "ika-pot.gif") ' Graphics オブジェクトのインスタンス生成 With picstage.backgroundimage = New Bitmap(.Width,.Height).Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With ' 初期化 EditFlag = True : GameFlag = False : InitFlag = False Ch = 1 : Call ScreenInit() : Call DrawGrid() : Px = -1 : Py =

34 ' フォームが閉じられ様と仕た時の処理 Private Sub sokoban_formclosing(byval sender As Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Dim F As String = SD & "screen.tmp" If File.Exists(F) Then File.Delete(F) ' ラジオボタンがクリックされた時の処理 Private Sub RadioButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles radsquidonpot.click, radsquid.click, radspace.click, radpot.click, _ radoctopusinpot.click, radoctopus.click, radblock.click If Not EditFlag Then Exit Sub Dim R As RadioButton = DirectCast(sender, RadioButton) Ch = Integer.Parse(R.Tag) picpointer.left = R.Left + 11 ' ピクチャボックスがクリックされた時の処理 Private Sub picstage_mouseup(byval sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) Handles picstage.mouseup If Not EditFlag Then Exit Sub Dim X As Integer = e.x 32 Dim Y As Integer = e.y 32 Dim N As Integer Gb.FillRectangle(Brushes.Black, X * 32, Y * 32, 32, 32) Select Case Ch Case 0 If ED(X, Y) = 8 Or ED(X, Y) = 12 Then Px = -1 : Py = -1 ED(X, Y) = 0 Gb.DrawRectangle(Pens.Gray, X * 32, Y * 32, 32, 32) picstage.refresh() : Exit Sub Case 1 : N = 4 Case 2 : N = 5 Case 4 : N = 6 Case 6 : N = 7 Case 8 If Px < 0 Then N = 0 : Px = X : Py = Y Else MessageBox.Show( "Unable to place two squids", "Warning", _ MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub -34-

35 Case 12 If Px < 0 Then N = 8 : Px = X : Py = Y Else MessageBox.Show("Unable to place two squids", "Warning", _ MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End Select ED(X, Y) = Ch Gb.DrawImage(Bm(N), X * 32, Y * 32) picstage.refresh() ' キー入力が為された時の処理 Private Sub sokoban_keyup(byval sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp Dim Dx, Dy, Dr, Nc As Integer Dim X1, Y1, X2, Y2, N As Integer If e.keycode = Keys.F1 Then If pnlmenu.visible Then pnlmenu.visible = False Else pnlmenu.visible = True Exit Sub ' ゲーム中の場合 If GameFlag Then ' 移動方向の設定 Dx = 0 : Dy = 0 Select Case e.keycode Case Keys.Escape ' 遣り直し Call ScreenInit() Call ED2BD() : Call DrawStage() Case Keys.Up Dy = -1 : Dr = 1 Case Keys.Down Dy = 1 : Dr = 0 Case Keys.Left Dx = -1 : Dr = 3 Case Keys.Right Dx = 1 : Dr = 2 End Select ' 移動先の処理 X1 = Px + Dx : Y1 = Py + Dy : N = BD(X1, Y1) -35-

36 Select Case N Case 0, 4 Px = X1 : Py = Y1 Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(Dr), Px * 32, Py * 32) Call ScrollStage(Dr) Case 2, 6 X2 = Px + Dx * 2 : Y2 = Py + Dy * 2 Nc = BD(X2, Y2) If Nc = 0 Or Nc = 4 Then BD(X1, Y1) = (BD(X1, Y1) And 4) BD(X2, Y2) = (BD(X2, Y2) Or 2) Gb.FillRectangle(Brushes.Black, X1 * 32, Y1 * 32, 32, 32) If Not BD(X1, Y1) = 0 Then Gb.DrawImage(Bm(6), X1 * 32, Y1 * 32) Gb.FillRectangle(Brushes.Black, X2 * 32, Y2 * 32, 32, 32) If BD(X2, Y2) = 2 Then Gb.DrawImage(Bm(5), X2 * 32, Y2 * 32) Else Gb.DrawImage(Bm(7), X2 * 32, Y2 * 32) Px += Dx : Py += Dy Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(Dr), Px * 32, Py * 32) Call ScrollStage(Dr) End Select picstage.refresh() ' クリアのチェック N = 0 For I As Integer = 0 To 49 For J As Integer = 0 To 49 If (BD(I, J) And 2) = 2 Then If Not BD(I, J) = 6 Then N = 1 : Exit Sub MessageBox.Show(" クリア!", " 倉庫番 ", _ MessageBoxButtons.OK, MessageBoxIcon.Information) ' 編集中の場合 If EditFlag Then Select Case e.keycode Case Keys.Left -36-

37 If Sx < 20 Then Sx += 1 : picstage.left = -Sx * 32 : e.handled = True Case Keys.Right If Sx > 0 Then Sx -= 1 : picstage.left = -Sx * 32 : e.handled = True Case Keys.Up If Sy < 30 Then Sy += 1 : picstage.top = -Sy * 32 : e.handled = True Case Keys.Down If Sy > 0 Then Sy -= 1 : picstage.top = -Sy * 32 : e.handled = True End Select ' ボタン ( 有効 無効 ) がクリックされた時の処理 Private Sub btnenabled_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnenabled.click If btnenabled.text = " 無効 " Then pnloperation.enabled = False btnenabled.text = " 有効 " Else pnloperation.enabled = True btnenabled.text = " 無効 " ' ボタン ( 新規 ) がクリックされた時の処理 Private Sub btnnew_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnnew.click btnedit.enabled = False : btntest.enabled = True EditFlag = True : GameFlag = False Call DataInit() : Call ScreenInit() : Call DrawGrid() ' ボタン ( 読込 ) がクリックされた時の処理 Private Sub btnload_click(byval sender As System.Object, ByVal e As System.EventArgs) Handles btnload.click ' データファイル名の設定 If cdlfileopen.showdialog() = Windows.Forms.DialogResult.Cancel Then Exit Sub Dim F As String = cdlfileopen.filename -37-

38 ' 指定ファイルの存在確認 If Not File.Exists(F) Then MessageBox.Show("Not Exist!!", "Warning", _ MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub ' データの読込 Dim S As String Dim C, R As Integer Call DataInit() Using Sr As StreamReader = New StreamReader(F) R = 0 Do Until Sr.EndOfStream S = Sr.ReadLine For I As Integer = 0 To (S.Length - 1) C = System.Convert.ToInt32(S.Substring(I, 1), 16) ED(I, R) = C : BD(I, R) = C R += 1 Loop Sr.Close() End Using ' 画面の描画 Call ScreenInit() : Call DrawGrid() : Call DrawStage() ' ボタン ( 保存 ) がクリックされた時の処理 Private Sub btnsave_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnsave.click ' データファイル名の設定 If cdlfilesave.showdialog() = Windows.Forms.DialogResult.Cancel Then Exit Sub Dim F As String = cdlfilesave.filename ' データの保存 Dim S As String Dim I, J As Integer Using Sw As StreamWriter = New StreamWriter(F) For I = 0 To 19 S = "" For J = 0 To 49 S &= ED(J, I).ToString("X") For J = 49 To 0 Step -1 If Not S.Substring(J, 1) = "0" Then -38-

39 Exit For S = S.Substring(0, J + 1) Sw.WriteLine(S) Sw.Close() End Using MessageBox.Show(" 保存しました ", " 保存 ", _ MessageBoxButtons.OK, MessageBoxIcon.Information) ' ボタン ( 編集 ) がクリックされた時の処理 Private Sub btnedit_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnedit.click Call ScreenInit() : Call DrawGrid() Call ED2BD() : Call DrawStage() btnedit.enabled = False : btntest.enabled = True EditFlag = True : GameFlag = False ' ボタン ( 試験 ) がクリックされた時の処理 Private Sub btntest_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btntest.click Call ScreenInit() Call ED2BD() : Call DrawStage() btntest.enabled = False : btnedit.enabled = True EditFlag = False : GameFlag = True ' ボタン ( 解法 ) がクリックされた時の処理 Private Sub btnsolv_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnsolv.click Call SolveStage() ' 仮想画面データを初期化するジェネラルプロシージャ Private Sub DataInit() For I As Integer = 0 To 49 For J As Integer = 0 To 49 ED(I, J) = 0 : BD(I, J) = 0 Px = -1 : Py = -1 ' 編集データを画面データにコピーするジェネラルプロシージャ Private Sub ED2BD() -39-

40 For I As Integer = 0 To 49 For J As Integer = 0 To 49 BD(I, J) = ED(I, J) ' 仮想画面グラフィックを初期化するジェネラルプロシージャ Private Sub ScreenInit() picstage.location = New Point(0, 0) : Sx = 0 : Sy = 0 Gb.Clear(Color.Black) : Gf.Clear(Color.Transparent) picstage.refresh() ' グリッドを表示するジェネラルプロシージャ Private Sub DrawGrid() ' グリッドの描画 For I As Integer = 0 To 1600 Step 32 Gf.DrawLine(Pens.Gray, I, 0, I, 1600) Gf.DrawLine(Pens.Gray, 0, I, 1600, I) picstage.refresh() ' ステージを表示するジェネラルプロシージャ Private Sub DrawStage() ' 画面の描画 For I As Integer = 0 To 49 For J As Integer = 0 To 49 Select Case BD(I, J) Case 1 ' 壁 Gb.DrawImage(Bm(4), I * 32, J * 32) Case 2 ' 蛸 Gb.DrawImage(Bm(5), I * 32, J * 32) Case 4 ' 壺 Gb.DrawImage(Bm(6), I * 32, J * 32) Case 6 ' 壺入蛸 Gb.DrawImage(Bm(7), I * 32, J * 32) Case 8 ' 烏賊 Px = I : Py = J : BD(I, J) = 0 Gf.DrawImage(Bm(0), I * 32, J * 32) Case 12 ' 壺上烏賊 Px = I : Py = J : BD(I, J) = (BD(I, J) And 4) Gb.DrawImage(Bm(6), I * 32, J * 32) Gf.DrawImage(Bm(0), I * 32, J * 32) End Select -40-

41 picstage.refresh() ' 画面をスクロールするジェネラルプロシージャ Private Sub ScrollStage(ByVal Dr As Integer) Select Case Dr Case 1 ' 上 If Py > 4 AndAlso Py < Sy + 5 Then Sy -= 1 : picstage.top = -Sy * 32 Case 0 ' 下 If Py > Sy + 14 AndAlso Py < 45 Then Sy += 1 : picstage.top = -Sy * 32 Case 2 ' 右 If Px > Sx + 24 AndAlso Px < 45 Then Sx += 1 : picstage.left = -Sx * 32 Case 3 ' 左 If Px > 4 AndAlso Px < Sx + 5 Then Sx -= 1 : picstage.left = -Sx * 32 End Select ' 解答を求めるジェネラルプロシージャ (Ctrl+A) Private Sub SolveStage() Dim Fs, Fd As String Dim S, T As String Dim I, C As Integer If cdlfileopen.showdialog = Windows.Forms.DialogResult.OK Then Fs = cdlfileopen.filename Fd = SD & "screen.tmp" Using Sr As StreamReader = New StreamReader(Fs) Using Sw As StreamWriter = New StreamWriter(Fd) Do Until Sr.EndOfStream S = Sr.ReadLine() T = "" For I = 0 To (S.Length - 1) C = System.Convert.ToInt32(S.Substring(I, 1), 16) Select Case C Case 0 : T &= " " Case 1 : T &= "#" Case 2 : T &= "$" Case 4 : T &= "." Case 6 : T &= "*" Case 8 : T &= "@" -41-

42 Case 12 : T &= "+" End Select T = T.Trim() Sw.WriteLine(T) Loop Sw.Close() End Using Sr.Close() End Using System.Diagnostics.Process.Start(SD & "solver.exe", SD & "screen.tmp") 'Shell(SD & "solver.exe", AppWinStyle.NormalFocus) End Class -42-

43 Q ちゃんの大脱走 VB プログラムの概要 面クリア型のパズルゲーム Q ちゃんの大脱走 で有る 荷物 ( 林檎 洋菓子 飴 ) や鍵を押して移動させる 倉庫番 型のゲームで有る 鍵を扉に差し込むと 扉が開き次の面に移動する事が出来る Q ちゃんが 決められた順番で 決められた回数丈 荷物を食べる事が出来る点が特色で有る 全 15 面 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -43-

44 オブジェクト プロパティ一覧 ラベル ピクチャボックス コントロールの種類 プロパティ プロパティの設定値 フォーム Name Qchan AutoScaleMode None Font MS 明朝 11 標準 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text Qちゃんの大脱走 ピクチャボックス Name picstage BackColor Maroon Size 640, 400 ラベル Name lbltitle AutoSize False BackColor Transparent Font Times New Roman 22 太字 ForeColor Black Size 274, 32 Text Qちゃんの大脱走 TextAlign MiddleCenter -44-

45 選択用フォーム (QchanSelect) ラベル ピクチャボックス ボタン 1 ボタン 2 ボタン 3 ボタン 4 コントロールの種類 プロパティ プロパティの設定値 フォーム Name QchanSelect BackColor Maroon ControlBox False FormBorderStyle FixedSingle MaximizeBox False MinimizeBox False StartPosition CenterScreen ラベル Name lblmes Font MS 明朝 12 太字 ForeColor White Text 何のキャンディを食べますか? ピクチャボックス Name picqchan Image Qchan01.gif ボタン1 Name btnup BackColor IndianRed Image Qchan09.gif Tag 1 ボタン2 Name btnleft BackColor IndianRed Image Qchan09.gif Tag 4 ボタン3 Name btnright BackColor IndianRed Image Qchan09.gif Tag 2 ボタン4 Name btndown BackColor IndianRed Image Qchan09.gif Tag 3-45-

46 メッセージ用フォーム (QchanInfo) ラベル ピクチャボックス 1 ピクチャボックス 2 ボタン 1 ボタン 2 ボタン 3 コントロールの種類 プロパティ プロパティの設定値 フォーム Name QchanInfo BackColor Maroon FormBorderStyle None StartPosition CenterScreen ピクチャボックス1 Name picbaloon Image baloon.gif ピクチャボックス2 Name picqchan Image Qchan01.gif ラベル Name lblmes AutoSize False Font MS 明朝 12 太字 Text 残念乍 GAME OVER です! もう一度しますか? TextAlign MiddleCenter ボタン1~3 Name 1:btnOK 2:btnYes 3:btnNo BackColor Font ForeColor Text IndianRed MS 明朝 12 太字 White 1:OK 2: はい 3: いいえ -46-

47 プログラムリスト メイン Imports System.IO Public Class Qchan ' プロパティ設定 ( フォーム間受渡用 ) Private RetValue As Integer Public Property Ret() As Integer Get Return RetValue End Get Set(ByVal value As Integer) RetValue = value End Set End Property Private SD(14) As String ' ステージデータ ( 全面 ) Private MD(16, 11) As Integer ' 面データ ( 対象面 ) Private RD As Integer = 0 ' ステージ番号 Private LF As Integer = 3 ' ライフ ( 遣り直し3 回迄 ) Private QX, QY As Integer ' Qちゃんの位置 Private NE As Integer ' 食べられる回数 Private FR As Integer = 0 ' 次に食べられる物の指標 Private TI As Integer = 0 ' 画像表示用 Private Bm(16), YA, BL As Bitmap Private Gb, Gf As Graphics ' フォームが読み込まれた時の処理 Private Sub Qchan_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load Dim I, J As Integer ' 画像の読込 For I = 0 To 16 Bm(I) = New Bitmap("Qchan" & (I + 1).ToString("00") & ".gif") YA = New Bitmap("QchanYA.gif") BL = New Bitmap("QchanBL.gif") ' 面データの読込 Using Sr As StreamReader = New StreamReader("QchanST.txt") For I = 0 To 14 SD(I) = Sr.ReadLine() -47-

48 Sr.Close() End Using ' Graphics オブジェクトのインスタンス生成 With picstage.backgroundimage = New Bitmap(.Width,.Height).Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With Gb.Clear(Color.Green) Gf.Clear(Color.Transparent) ' 初期画面の描画 For I = 16 To 512 Step 16 : Gb.DrawImage(BL, I, 24) : For I = 16 To 512 Step 16 : Gb.DrawImage(BL, I, 360) : For I = 40 To 344 Step 16 Gb.DrawImage(BL, 16, I) : Gb.DrawImage(BL, 512, I) For I = 24 To 344 Step 32 For J = 528 To 608 Step 32 Gb.DrawImage(Bm(11), J, I) Gb.FillRectangle(Brushes.Blue, 536, 40, 80, 32) Gb.FillRectangle(Brushes.Blue, 536, 88, 80, 32) Gb.FillRectangle(Brushes.Black, 32, 40, 480, 320) ' 外枠の設定 For I = 0 To 16 MD(I, 0) = 4 : MD(I, 11) = 4 For I = 1 To 10 MD(0, I) = 4 : MD(16, I) = 4 ' メッセージの表示 Using Sr As StreamReader = _ New StreamReader("QchanMS.txt", System.Text.Encoding.Default) Dim S As String : I = 45 Do Until Sr.EndOfStream S = Sr.ReadLine Gf.DrawString(S, Me.Font, Brushes.White, 38, I) I += 24 Loop Sr.Close() End Using -48-

49 ' キー入力が為された時の処理 Private Sub Qchan_KeyUp(ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp Dim I As Integer = 0 Dim K, L, X, Y As Integer ' 入力キーの判定 Select Case e.keycode Case Keys.S Gf.Clear(Color.Transparent) Call DrawStage() Case Keys.Escape ' 遣り直し LF -= 1 ' フォーム ( メッセージ ) の表示 Dim Frm As QchanInfo = New QchanInfo() If LF < 1 Then Frm.btnYes.Visible = True Frm.btnNo.Visible = True Frm.btnOK.Visible = False Frm.lblMes.Text = " 残念乍 GAME OVER です!" & _ vbcrlf & vbcrlf & " もう一度しますか?" Frm.ShowDialog() Frm.Dispose() If Me.Ret = 1 Then Application.Run() : Exit Sub Else Application.Exit() : Exit Sub Else Frm.btnYes.Visible = False Frm.btnNo.Visible = False Frm.btnOK.Visible = True Frm.lblMes.Text = " 遣り直しは後 " & LF.ToString() & " 回迄です!" & _ vbcrlf & vbcrlf & " 頑張って下さい!!" Frm.ShowDialog() Frm.Dispose() Gf.Clear(Color.Transparent) Call DrawStage() : Exit Sub Case Keys.Down : X = 0 : Y = 1 : I = 7 Case Keys.Left : X = -1 : Y = 0 : I = 1 Case Keys.Right : X = 1 : Y = 0 : I = 3 Case Keys.Up : X = 0 : Y = -1 : I = 5 Case Keys.Space ' 食べる If NE > 0 Then K = 0 : L = 0-49-

50 If MD(QX, QY - 1) = FR + 1 Then K += 1 : L = 1 If MD(QX + 1, QY) = FR + 1 Then K += 1 : L = 2 If MD(QX, QY + 1) = FR + 1 Then K += 1 : L = 3 If MD(QX - 1, QY) = FR + 1 Then K += 1 : L = 4 If K > 1 Then Dim Frm As QchanSelect = New QchanSelect() ' ラベル ( メッセージ ) の設定 Select Case FR Case 0 : Frm.lblMes.Text = " 何のリンゴを食べますか?" Case 1 : Frm.lblMes.Text = " 何のケーキを食べますか?" Case 2 : Frm.lblMes.Text = " 何のキャンディを食べますか?" End Select ' ボタン ( 選択 ) の設定 Select Case MD(QX, QY - 1) Case 0 Frm.btnUp.Image = Nothing Frm.btnUp.Enabled = False Case (FR + 1) Frm.btnUp.Image = Bm(MD(QX, QY - 1) + 7) Frm.btnUp.Enabled = True Case Else Frm.btnUp.Image = Bm(MD(QX, QY - 1) + 7) Frm.btnUp.Enabled = False End Select Select Case MD(QX + 1, QY) Case 0 Frm.btnRight.Image = Nothing Frm.btnRight.Enabled = False Case (FR + 1) Frm.btnRight.Image = Bm(MD(QX + 1, QY) + 7) Frm.btnRight.Enabled = True Case Else Frm.btnRight.Image = Bm(MD(QX + 1, QY) + 7) Frm.btnRight.Enabled = False End Select Select Case MD(QX, QY + 1) Case 0 Frm.btnDown.Image = Nothing Frm.btnDown.Enabled = False Case (FR + 1) Frm.btnDown.Image = Bm(MD(QX, QY + 1) + 7) Frm.btnDown.Enabled = True Case Else Frm.btnDown.Image = Bm(MD(QX, QY + 1) + 7) Frm.btnDown.Enabled = False End Select Select Case MD(QX - 1, QY) Case 0-50-

51 Frm.btnLeft.Image = Nothing Frm.btnLeft.Enabled = False Case (FR + 1) Frm.btnLeft.Image = Bm(MD(QX - 1, QY) + 7) Frm.btnLeft.Enabled = True Case Else Frm.btnLeft.Image = Bm(MD(QX - 1, QY) + 7) Frm.btnLeft.Enabled = False End Select ' 選択フォームの表示 Frm.Show() ' 選択フォームでのボタンクリックの待機 Do While Frm.Direction = 0 Application.DoEvents() Loop ' 押し下げボタンの取得と後始末 L = Frm.Direction Frm.Close() : Frm.Dispose() If K > 0 Then If L = 1 Then X = 0 : Y = -1 If L = 2 Then X = 1 : Y = 0 If L = 3 Then X = 0 : Y = 1 If L = 4 Then X = -1 : Y = 0 Gb.FillRectangle(Brushes.Maroon, (QX + X) * 32, (QY + Y) * , 32, 32) MD(QX + X, QY + Y) = 0 QX += X : QY += Y Gf.Clear(Color.Transparent) If L < 3 Then Gf.DrawImage(Bm(15), QX * 32, QY * ) If L > 2 Then Gf.DrawImage(Bm(14), QX * 32, QY * ) ' 次に食べられる物に矢印を移動 Gb.FillRectangle(Brushes.Black, 588, FR * , 16, 16) Gb.DrawImage(BL, 588, FR * ) FR += 1 : If FR > 2 Then FR = 0 Gb.DrawImage(YA, 588, FR * ) ' 残り回数の表示 NE -= 1 Gb.FillRectangle(Brushes.Blue, 536, 88, 80, 32) Gb.DrawString(NE.ToString().PadLeft(2, " ") & " 回 ", Me.Font, Brushes.White, 560, 96) picstage.refresh() Case Keys.T ' テスト RD += 1 : If RD > 14 Then RD = 0 Gf.Clear(Color.Transparent) Call DrawStage() : LF = 3 End Select -51-

52 ' Q ちゃん等の移動 If I > 0 Then If TI = I Then I += 1 TI = I K = MD(QX + X, QY + Y) Select Case K Case 0 QX += X : QY += Y Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(I - 1), QX * 32, QY * ) picstage.refresh() Case 4, 6 Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(I - 1), QX * 32, QY * ) picstage.refresh() Case 7 ' クリア RD += 1 If RD > 14 Then Dim Frm As QchanInfo = New QchanInfo() Frm.btnYes.Visible = False Frm.btnNo.Visible = False Frm.btnOK.Visible = True Frm.lblMes.Text = " おめでとう!!!" & _ vbcrlf & vbcrlf & " 全 15 面クリアです!" Frm.ShowDialog() Frm.Dispose() Application.Exit() Else Gf.Clear(Color.Transparent) Call DrawStage() : LF = 3 Case 1 To 3, 5 L = MD(QX + X * 2, QY + Y * 2) If K = 5 AndAlso L = 6 Then ' ドアをオープン Gb.FillRectangle(Brushes.Maroon, (QX + X) * 32, (QY + Y) * , 32, 32) Gb.FillRectangle(Brushes.Maroon, (QX + X * 2) * 32, (QY + Y * 2) * , 32, 32) Gb.DrawImage(Bm(16), (QX + X * 2) * 32, (QY + Y * 2) * ) MD(QX + X, QY + Y) = 0 : MD(QX + X * 2, QY + Y * 2) = 7 QX += X : QY += Y Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(I - 1), QX * 32, QY * ) picstage.refresh() ElseIf L = 0 Then ' 荷物の移動 Gb.FillRectangle(Brushes.Maroon, (QX + X) * 32, (QY + Y) * , 32, 32) Gb.DrawImage(Bm(K + 7), (QX + X * 2) * 32, (QY + Y * 2) * ) -52-

53 MD(QX + X, QY + Y) = 0 : MD(QX + X * 2, QY + Y * 2) = K QX += X : QY += Y Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(I - 1), QX * 32, QY * ) picstage.refresh() End Select ' ステージを描画するジェネラルプロシージャ Private Sub DrawStage() Dim S As String = SD(RD) Dim D() As String = S.Split(",") Dim C As Integer = 0 Dim X, Y As Integer ' 面データの設定 For I As Integer = 1 To 15 For J As Integer = 1 To 10 MD(I, J) = Integer.Parse(D(C)) C += 1 X = Integer.Parse(D(C)) : C += 1 Y = Integer.Parse(D(C)) : C += 1 NE = Integer.Parse(D(C)) : C += 1 ' 画面の描画 S = " 第 " & (RD + 1).ToString() & " 面 " Gb.FillRectangle(Brushes.Maroon, 32, 40, 480, 320) Gb.FillRectangle(Brushes.Blue, 536, 40, 80, 32) Gb.FillRectangle(Brushes.Blue, 536, 88, 80, 32) Gb.DrawString(S, Me.Font, Brushes.White, 552, 48) Gb.DrawString(NE.ToString().PadLeft(2, " ") & " 回 ", Me.Font, Brushes.White, 560, 96) If Not FR = 0 Then Gb.FillRectangle(Brushes.Black, 588, FR * , 16, 16) Gb.DrawImage(BL, 588, FR * ) FR = 0 Gb.DrawImage(YA, 588, FR * ) Gb.DrawImage(Bm(8), 548, 152) Gb.DrawImage(Bm(9), 548, 184) Gb.DrawImage(Bm(10), 548, 216) For I As Integer = 1 To 15 For J As Integer = 1 To 10 If Not MD(I, J) = 0 Then Gb.DrawImage(Bm(MD(I, J) + 7), I * 32, J * ) -53-

54 ' Q ちゃんの描画 QX = X 2 : QY = Y 2 Gf.DrawImage(Bm(6), QX * 32, QY * ) picstage.refresh() End Class 選択用 Public Class QchanSelect Private DirectionValue As Integer = 0 Public Property Direction() As Integer Get Return DirectionValue End Get Set(ByVal value As Integer) DirectionValue = value End Set End Property ' ボタンをクリックした時の処理 Private Sub btnup_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnup.click, btnright.click, btnleft.click, btndown.click Dim B As Button = DirectCast(sender, Button) Dim N As Integer = Integer.Parse(B.Tag) Me.Direction = N End Class メッセージ用 Public Class QchanInfo ' ボタンがクリックされた時の処理 Private Sub btnok_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnyes.click, btnok.click, btnno.click Dim B As Button = DirectCast(sender, Button) Dim N As Integer = Integer.Parse(B.Tag) Qchan.Ret = N ' 1:OK, 2:YES, 3:NO Me.Close() End Class -54-

55 福笑い VB プログラムの概要 日本古来のパーティーゲーム 福笑い で有る F5 キーでゲームを開始する 暫く仕て盤が灰色に成れば パーツを盤上にドラッグする マウスボタンを離すと パーツが回転するので タイミングを計りクリックする 総てのパーツを配置すると F1 キーを押す 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -55-

56 オブジェクト プロパティ一覧 ラベル ピクチャボックス メニューストリップ コントロールの種類 プロパティ プロパティの設定値 フォーム Name fukuwarai StartPosition CenterScreen Text 福笑い ラベル Name lblmes BackColor GradientInactiveCaption Text F5 で開始 ( 盤が灰色に成ってからパーツをドラッグ ) F1 で判定 ( 盤の表示 ) ピクチャボックス Name picstage Size 240, 489 メニューストリップ Name mnufukuwarai 次頁参照 -56-

57 メニューバーの作成 メニューバーを作成するには 先ず ツールボックスで MenuStrip コントロールをダブルクリックして フォームに追加する 猶 オブジェクト名は プロパティ欄で設定する事が出来る 上記の画面で ここに入力 と表示されて居る部分をクリックして 項目名 (Text プロパティ ) を入力する 猶 アクセスキーを指定する &F は 必ず 半角英数文字で入力する 上記の要領で 下記に示すメニューを作成する 猶 Text 欄でインデントが付いて居る項目は 下層の項目で有る事を示して居る 亦 Name ShortCutKeys Checked の各プロパティは プロパティ欄で設定する 区分線は 挿入し度い位置の直下の項目を右クリックして ポップアップメニューの 挿入 から Separator をクリックすると設定される ( 右端の をクリックしても良い ) Text Name ShortCutKeys Checked ゲーム (&G) mnugame 種類 (&K) mnugamekind ダミー mnugamekinddummy 回転 (&R) mnugamerotate 遅い (&S) mnugamerotateslow 普通 (&M) mnugamerotatenomal True 速い (&F) mnugamerotatefast 開始 '&S) mnugamestart F5 判定 (&J) mnugamejudge F1 区分線 mnugameline 終了 (&Q) mnugamefinish Ctrl+Q ヘルプ (&H) mnuhelp ヴァージョン (&V) mnuhelpversion -57-

58 プログラムリスト Imports System.IO Imports System.Drawing.Drawing2D Public Class fukuwarai Private Structure Fukuwarai Dim Title As String Dim FileName As String Dim Parts As Integer End Structure Private Num As Integer Private Ptr As Integer Private PD() As Fukuwarai Private Gb, Gf As Graphics Private Bm() As Bitmap Private picparts() As PictureBox Private Tp As PictureBox Private CX, CY As Integer Private CF As Boolean = False Private RF As Boolean = False Private mnuitem() As ToolStripMenuItem Private Game As Boolean = False Private An As Integer Private Da As Integer = 20 ' 福笑いのパターン数 ' 使用する福笑いの種類 ' 各福笑いの基本データ ' 描画用 ' 盤とパーツ画像用 ' パーツ表示用 ' 対象ピクチャボックス ' カーソル位置 ' ドラッグフラグ ' 回転フラグ ' 福笑い種類メニュー用 ' ゲームフラグ ' 画像回転用角度 ' 回転角度変化率 Private Tm As System.Timers.Timer = New System.Timers.Timer(50) Private Delegate Sub TimerDelegate() ' フォームが読み込まれた時の処理 Private Sub fukuwarai_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' 基本データの読込 Using Sr As StreamReader = _ New StreamReader("fukuwarai.txt", System.Text.Encoding.Default) Dim S As String = Sr.ReadLine() If Not Integer.TryParse(S, Num) Then MessageBox.Show(" 基本データに誤りが有ります!", " 要確認 ", _ MessageBoxButtons.OK, MessageBoxIcon.Error) Application.Exit() ReDim PD(Num - 1) For I As Integer = 0 To (Num - 1) S = Sr.ReadLine() : PD(I).Title = S S = Sr.ReadLine() : PD(I).FileName = S -58-

59 S = Sr.ReadLine() : PD(I).Parts = Integer.Parse(S) Sr.Close() End Using ' メニュー項目の追加 ReDim mnuitem(num - 1) For I As Integer = 0 To (Num - 1) mnuitem(i) = New ToolStripMenuItem() With mnuitem(i).text = PD(I).Title.Tag = I.Owner = mnugamekinddummy.owner AddHandler.Click, AddressOf mnugamekind_click End With ' タイマーの設定 Tm.AutoReset = True AddHandler Tm.Elapsed, _ New System.Timers.ElapsedEventHandler(AddressOf TimerElapsed) ' 初期福笑いの表示 mnuitem(1).checked = True Ptr = 1 : Call DispFukuwarai() ' メニュー項目 ( 福笑いの種類 ) がクリックされた時の処理 Private Sub mnugamekind_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles mnugamekinddummy.click Dim M As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim N As Integer = Integer.Parse(M.Tag) mnuitem(ptr).checked = False M.Checked = True Ptr = N ' メニュー項目 ( 回転速度 ) がクリックされた時の処理 Private Sub mnugamerotate_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles mnugamerotateslow.click Dim M As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) mnugamerotateslow.checked = False mnugamerotatenomal.checked = False mnugamerotatefast.checked = False M.Checked = True Da = Integer.Parse(M.Tag) -59-

60 ' メニュー項目 ( 開始 ) がクリックされた時の処理 Private Sub mnugamestart_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles mnugamestart.click Call DispFukuwarai() Application.DoEvents() System.Threading.Thread.Sleep(10000) Gf.Clear(Color.DarkGray) : picstage.refresh() CF = False : RF = False : Game = True ' メニュー項目 ( 判定 ) がクリックされた時の処理 Private Sub mnugamejudge_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles mnugamejudge.click Gf.Clear(Color.Transparent) picstage.refresh() Game = False ' メニュー項目 ( 終了 ) がクリックされた時の処理 Private Sub mnugamefinish_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles mnugamefinish.click Me.Dispose() Application.Exit() ' ピクチャボックス ( パーツ ) でマウスボタンが押し下げられた時の処理 Private Sub picparts_mousedown(byval sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) If Game Then If Not RF Then CX = e.x : CY = e.y : CF = True ' ピクチャボックス ( パーツ ) でマウスカーソルが移動した時の処理 Private Sub picparts_mousemove(byval sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) If CF Then Dim P As PictureBox = DirectCast(sender, PictureBox) P.Left += (e.x - CX) P.Top += (e.y - CY) Dim A As Point = picstage.pointtoclient(windows.forms.cursor.position) If picstage.clientrectangle.contains(a) Then picstage.controls.add(p) Else Me.Controls.Add(P) -60-

61 ' ピクチャボックス ( パーツ ) でマウスボタンが開放された時の処理 Private Sub picparts_mouseup(byval sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) If CF Then Dim P As PictureBox = DirectCast(sender, PictureBox) Dim N As Integer = Integer.Parse(P.Tag) CF = False : RF = True Tp = P : An = 10 : Tm.Start() ElseIf RF Then Tm.Stop() Gb.DrawImage(Tp.Image, Tp.Left, Tp.Top) Tp.Visible = False : RF = False ' タイマーが一定間隔で自動的に行う処理 Private Sub TimerElapsed(ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs) Invoke(New TimerDelegate(AddressOf RotateImage)) ' 画像を回転させるジェネラルプロシージャ Private Sub RotateImage() ' Bitmap オブジェクトと Graphics オブジェクトの生成 Dim B As Bitmap = Bm(Integer.Parse(Tp.Tag)) Dim G As Graphics With Tp.Image = New Bitmap(.Width,.Height) G = Graphics.FromImage(.Image) End With G.Clear(Color.Transparent) Dim C As Matrix = G.Transform ' 現在の座標系の変換行列を保存 ( 必須 ) Dim P As Matrix = New Matrix() ' 現在の座標系をリセット G.ResetTransform() ' 新しい行列に 45 度回転の定義を追加 Dim X As Integer = Tp.Width 2 Dim Y As Integer = Tp.Height 2 P.RotateAt(An, New Point(X, Y), MatrixOrder.Append) ' 座標系に行列の適用 G.Transform = P ' 補完モードの設定 G.InterpolationMode = InterpolationMode.HighQualityBicubic -61-

62 ' 描画 ( 回転前の左上座標を指定 ) G.DrawImage(B, 0, 0) Tp.Refresh() ' 座標系の復元 G.Transform = C ' 後始末 P.Dispose() C.Dispose() G.Dispose() ' 回転角の増加 An += Da : If An >= 360 Then An = 0 ' 福笑いを表示させるジェネラルプロシージャ Private Sub DispFukuwarai() Dim X, Y As Integer Dim M As Integer = 0 Dim N As Integer = Ptr ' タイトルの表示 Me.Text = " 福笑い - " & PD(N).Title & "( パーツ数 :" & PD(N).Parts.ToString() & ")" ' 画像の読込 If Bm IsNot Nothing Then For I As Integer = 0 To (Bm.Length - 1) Bm(I).Dispose() ReDim Bm(PD(N).Parts) Bm(0) = New Bitmap(PD(N).FileName & ".gif") For I As Integer = 1 To PD(N).Parts Bm(I) = New Bitmap(PD(N).FileName & "_" & I.ToString() & ".gif") ' Graphics オブジェクトのインスタンス生成 picstage.size = Bm(0).Size With picstage.backgroundimage = New Bitmap(.Width,.Height).Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With Gb.Clear(Color.White) Gf.Clear(Color.Transparent) -62-

63 ' 画像の配置 Gb.DrawImage(Bm(0), 0, 0) X = picstage.left + Bm(0).Width + 16 Y = picstage.top ' PictureBox オブジェクトのインスタンス生成 If picparts IsNot Nothing Then For I As Integer = 0 To (picparts.length - 1) picparts(i).dispose() ReDim picparts(pd(n).parts - 1) For I As Integer = 1 To PD(N).Parts picparts(i - 1) = New PictureBox() Me.Controls.Add(picParts(I - 1)) With picparts(i - 1).Size = Bm(I).Size.BackColor = Color.Transparent.Image = Bm(I).Location = New Point(X, Y).Tag = I.BringToFront() AddHandler.MouseDown, AddressOf picparts_mousedown AddHandler.MouseMove, AddressOf picparts_mousemove AddHandler.MouseUp, AddressOf picparts_mouseup End With If M < Bm(I).Width Then M = Bm(I).Width Y += (Bm(I).Height + 16) If Y > 400 Then X += (M + 16) : M = 0 Y = picstage.top End Class -63-

64 はるよちゃんっ! VB プログラムの概要 バレーボール版スポーツアクションゲーム はるよちゃんっ! で有る スペースキーでゲームを開始する ネットの向こう側から飛んで来るボールを はるよちゃんを左右の矢印キーで動かして レシーブする丈のゲームで有る はるよちゃんの動きが可愛い!! 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -64-

65 オブジェクト プロパティ一覧 パネル ラベル 1 ピクチャボックス ラベル 2 ラベル 3 コントロールの種類 プロパティ プロパティの設定値 フォーム Name haruyo FormBorderStyle FixedSingle StartPosition CenterScreen Text はるよちゃんっ! パネル Name pnlback BackColor Black Size 320, 257 ピクチャボックス Name picfore BackColor Transparent Size 320, 257 ラベル1~3 Name 1:lblScr 2:lblRound 3:lblMes AutoSize False BackColor 3:Black 他 :Transparent Font HG 創英角ホ ッフ 体 10 標準 ForeColor 255, 255, 192 Text 1:0 2:= 20 回目 = 3: スペースキーで開始 TextAlign 1:MiddleRight 他:MiddleCenter -65-

66 プログラムリスト Public Class haruyo Private Bm As Bitmap Private Gr, Gb, Gf As Graphics Private Rc(12) As Rectangle Private SC As Integer ' 得点 Private RO As Integer ' ラウンド Private HX As Integer ' はるよ座標 Private MU As Integer '??? Private BX, BY As Integer ' ボール座標 Private CO As Integer ' ボールコース Private Cnt As Integer ' ボール移動カウント Private MO(,) As Integer = { _ {0, 1, 2, 3, 4, 5, 6, 7}, _ {0, 0, 0, 0, 0, 0, 0, 0}, _ {0, -1, -2, -3, -4, -5, -6, -7}} ' ボール軌跡用 Private MX() As Integer = _ {0, 0, 1, 2, 2, 2, 2, 2} ' ボール高さ用 Private TX() As Integer = _ {0, 35, 32, 28, 23, 18, 13, 10, 7, 5, 3} ' ハーフタイム用 Private TY() As Integer = _ {0, 14, 12, 10, 9, 9, 11, 13, 16, 20, 23} ' ハーフタイム用 Private Game As Boolean = False ' ゲームフラグ Private First As Boolean = True ' 初回フラグ Private Rn As Random = New Random() Private TM As System.Timers.Timer = New System.Timers.Timer() Delegate Sub TimerDelegate() ' フォームが読み込まれた時の処理 Private Sub haruyo_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' 画像の読込 Bm = New Bitmap("haruyo.gif") ' Graphics オブジェクトのインスタンス生成 With pnlback.backgroundimage = New Bitmap(.Width,.Height) Gr = Graphics.FromImage(.BackgroundImage) End With With picfore.backgroundimage = New Bitmap(.Width,.Height).Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) -66-

67 Gf = Graphics.FromImage(.Image) End With Gb.Clear(Color.Transparent) Gf.Clear(Color.Transparent) ' Timer オブジェクトの設定 TM.AutoReset = True TM.Interval = 500 AddHandler TM.Elapsed, _ New System.Timers.ElapsedEventHandler(AddressOf TemerElapsed) ' 画像切取領域の設定 Rc(0) = New Rectangle(0, 16, 16, 16) ' はるよ Rc(1) = New Rectangle(16, 16, 16, 16) ' はるよ Rc(2) = New Rectangle(32, 16, 16, 16) ' はるよ Rc(3) = New Rectangle(48, 16, 16, 16) ' はるよ Rc(4) = New Rectangle(0, 0, 16, 16) ' ボール ( 小 ) Rc(5) = New Rectangle(0, 0, 16, 16) ' ボール ( 小 ) Rc(6) = New Rectangle(16, 0, 16, 16) ' ボール Rc(7) = New Rectangle(32, 0, 16, 16) ' ボール Rc(8) = New Rectangle(32, 0, 16, 16) ' ボール Rc(9) = New Rectangle(48, 0, 16, 16) ' ボール ( 大 ) Rc(10) = New Rectangle(48, 0, 16, 16) ' ボール ( 大 ) Rc(11) = New Rectangle(0, 32, 56, 8) ' タイトル Rc(12) = New Rectangle(56, 32, 8, 8) '? ' コートの描画 Gr.DrawLine(Pens.White, 42, 199, 100, 160) Gr.DrawLine(Pens.White, 100, 160, 100, 120) Gr.DrawLine(Pens.White, 100, 120, 219, 120) Gr.DrawLine(Pens.White, 219, 120, 219, 160) Gr.DrawLine(Pens.White, 219, 160, 277, 199) Gr.DrawLine(Pens.White, 42, 199, 105, 157) Gr.DrawLine(Pens.White, 277, 199, 214, 157) Gr.DrawLine(Pens.White, 277, 199, 42, 199) Gr.DrawLine(Pens.White, 100, 160, 219, 160) Gr.DrawLine(Pens.White, 85, 170, 234, 170) Gr.DrawLine(Pens.Red, 100, 120, 100, 110) Gr.DrawLine(Pens.Red, 219, 120, 219, 110) For I As Integer = 120 To 146 Step 2 Gr.DrawLine(Pens.Cyan, 100, I, 219, I) For I As Integer = 101 To 218 Step 3 Gr.DrawLine(Pens.Cyan, I, 120, I, 146) ' キー入力が為された時の処理 -67-

68 Private Sub haruyo_keydown(byval sender As System.Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown Select Case e.keycode Case Keys.Space If Not Game Then Game = True SC = 0 : RO = 1 : MU = 0 : HX = 152 lblscr.text = SC.ToString() lblscr.visible = True ' タイトルの描画 If First Then Call DrawTitle() First = False ' はるよちゃんの描画 Call DrawHaruyo() ' ゲーム開始 lblmes.text = "" Do Until RO > 10 ' ラウンドの表示 lblround.text = "= " & (RO).ToString() & " 回目 =" lblround.visible = True ' ボールのコースと座標の設定 CO = Rn.(0, 3) BX = Rn.(0, 12) + 14 BY = 14 ' ボール移動カウントの初期化 Cnt = 1 ' サーブ TM.Start() Do While TM.Enabled Application.DoEvents() Loop ' ラウンドのインクリメント RO += 1 If RO = 6 Then lblround.text = "= ハーフタイム! =" Call HalfTime() Loop lblmes.text = SC.ToString() & " 回受けたんだって ツカレタァ ~" Game = False Case Keys.Left HX -= 2 : If HX < 44 Then HX = 44 Call DrawHaruyo() Case Keys.Right HX += 2 : If HX > 259 Then HX =

69 Call DrawHaruyo() Case Keys.D Call HalfTime() End Select ' タイマーが一定間隔で自動的に行う処理 Private Sub TemerElapsed(ByVal sender As Object, _ ByVal e As System.Timers.ElapsedEventArgs) Invoke(New TimerDelegate(AddressOf DrawBall)) ' デモを描画するジェネラルプロシージャ Private Sub DrawTitle() Dim L As Integer = 19 Dim M As Integer = 14 ' デモの表示 For I As Integer = 1 To 7 Gb.DrawImage(Bm, L * 8, M * 8, Rc(I + 3), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(200) Gb.Clear(Color.Transparent) L -= 1 : M += MX(I) ' タイトルの描画 Gr.DrawImage(Bm, 132, 50, Rc(11), GraphicsUnit.Pixel) pnlback.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(1000) ' はるよちゃんを描画するジェネラルプロシージャ Private Sub DrawHaruyo() Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, HX, 176, Rc(0), GraphicsUnit.Pixel) picfore.refresh() ' ボールを描画するジェネラルプロシージャ Private Sub DrawBall() Dim X, Y As Integer X = (MO(CO, Cnt) + BX) * 8 : Y = BY * 8 Gb.Clear(Color.Transparent) Gb.DrawImage(Bm, X, Y, Rc(Cnt + 3), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() BY += MX(Cnt) -69-

70 Cnt += 1 If Cnt > 7 Then TM.Stop() Dim C As Integer = X + 8 If C >= HX AndAlso C < HX + 16 Then ' レシーブ lblmes.text = " レシーブ!" SC += 1 : lblscr.text = SC.ToString() Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, HX, 176, Rc(1), GraphicsUnit.Pixel) BX = X 8 : BY -= MX(7) For I As Integer = 1 To 7 BY -= MX(I) X = (BX - MO(CO, I)) * 8 : Y = BY * 8 Gb.Clear(Color.Transparent) Gb.DrawImage(Bm, X, Y, Rc(11 - I), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(500) Gb.Clear(Color.Transparent) picfore.refresh() lblmes.text = "" Else ' 失敗 lblmes.text = " ミス!" Dim N As Integer = Rn.(2, 4) Gb.Clear(Color.Transparent) Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, HX, 176, Rc(N), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(500) lblmes.text = "" ' ハーフタイムショーを表示するジェネラルプロシージャ Private Sub HalfTime() HX = 152 For I As Integer = (HX 8) To 1 Step -1 Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, I * 8, 176, Rc(0), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(150) Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, 8, 176, Rc(1), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() -70-

71 System.Threading.Thread.Sleep(200) Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, 8, 176, Rc(3), GraphicsUnit.Pixel) Gb.DrawString(" タオル!", lblmes.font, Brushes.White, 24, 165) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(1000) For I As Integer = 1 To 10 Gb.Clear(Color.Transparent) Gb.DrawImage(Bm, TX(I) * 8, TY(I) * 8, Rc(12), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(150) Gb.DrawString(" ドーモ!", lblmes.font, Brushes.White, 24, 165) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(1000) For I As Integer = 9 To 1 Step -1 Gb.Clear(Color.Transparent) Gb.DrawImage(Bm, TX(I) * 8, TY(I) * 8, Rc(12), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(150) Gb.Clear(Color.Transparent) picfore.refresh() For I As Integer = 1 To (HX 8) Gf.Clear(Color.Transparent) Gf.DrawImage(Bm, I * 8, 176, Rc(0), GraphicsUnit.Pixel) picfore.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(150) End Class -71-

72 ゴルフ VB プログラムの概要 ゴルフ版スポーツシミュレーションゲーム ゴルフ で有る 新規ゲームで ゲームを開始し 倶楽部ハウスでプログラムを終了する 操作方法や新しいコースを自作する方法に付いては ヘルプを観れば解る様に成って居る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -72-

73 オブジェクト プロパティ一覧 ラベル 1 ラベル 2 ラベル 3 ラベル 4 ラベル 7 ラベル 8 ラベル 11 ピクチャボックス 1 ラベル 5 ラベル 6 ラベル 9 ラベル 12 ラベル 10 ピクチャボックス 2~4 ラベル 13 ボタン 1~3 コントロールの種類 プロパティ プロパティの設定値 フォーム Name golf AutoScaleMode None Font Times New Roman 9 標準 FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text ゴルフ ラベル1 Name lblcoursename AutoSize False BackColor Green Font MS ゴシック 11 標準 ForeColor White Text Course Name TextAlign MiddleCenter ピクチャボックス1 Name picbg BackColor 0, 128, 0 BorderStyle FixedSingle Cursor Cross Size 252,

74 コントロールの種類 プロパティ プロパティの設定値 ラベル2 Name lblframe BorderStyle Fixed3D ラベル3~6 Name 3:lblHoleCaption 4:lblParCaption 5:lblStrokesCaption 6:lblScoreCaption ForeColor 0, 0, 128 Text 3:Score 4:Par 5:Strokes 6:Score ラベル7~10 Name 7:lblHole 8:lblPar 9:lblStrokes 10:lblScore AutoSize False BackColor 255, 255, 128 BorderStyle FixedSingle ForeColor Blue Text 0 TextAlign MiddleCenter ラベル11 Name lblinfo BorderStyle FixedSingle Font MS 明朝 8 標準 Text ボールの後ろ側をダブルクリックしてスイングして下さい スイングが強ければボールの飛距離が長く成ります ラベル12 Name lblselectclub AutoSize False BorderStyle FixedSingle Font MS 明朝 9 標準 Text クラブ選択 TextAlign MiddleCenter ピクチャボックス2~4 Name 2:picClub0 3:picClub1 4:picClub2 BorderStyle FixedSingle Image 2:driver.bmp 3:iron.bmp 4:putter.bmp Size 35, 43 ボタン1~3 Name 1:btnNewGame( 新規ゲーム ) 2:btnHelp( ヘルプ ) 3:btnQuit( 倶楽部ハウス ) -74-

75 アバウト用 ボタン 1 ボタン 2 テキストボックス ボタン 3 ピクチャボックス ボタン 4 コントロールの種類 プロパティ プロパティの設定値 フォーム Name about FormBorderStyle FixedSingle Icon golf.ico MaximizeBox False StartPosition CenterScreen Text ゴルフ - 説明 テキストボックス Name txthelp BorderStyle FixedSingle Font MS ゴシック 9 標準 MultiLines True ScrollBars Vertical TextAlign MiddleCenter ピクチャボックス Name picgolf Image golf.ico Size 32, 32 ボタン1~4 Name 1:btnHowToPlay 2:btnHints 3:btnCustomizing 4:btnCancel Font MS ゴシック 9 標準 Text 1: 操作方法 2: ヒント 3: カスタマイズ 4: ゲームに戻る -75-

76 プログラムリスト Imports System.IO Public Class golf ' 特定のゴルフコースに関連する情報を定義するデータ型 Private Structure HoleInfo Dim FileName As String Dim Tee As Point Dim Par As Integer Dim Tips As String End Structure ' 有効なゲーム状態 Private Const GAME_OVER As Integer = 0 Private Const GAME_IN_PROGRESS As Integer = 1 ' 使用可能なクラブ ( 軽い装備でプレイする ) Private Const CLUB_DRIVER As Integer = 0 Private Const CLUB_IRON As Integer = 1 Private Const CLUB_PUTTER As Integer = 2 ' RGB カラー定数 Private BLUE As Color = Color.FromArgb(255, 0, 0, 255) ' &HFF0000 Private DK_BLUE As Color = Color.FromArgb(255, 0, 0, 128) ' &H Private WHITE As Color = Color.FromArgb(255, 255, 255, 255) ' &HFFFFFF Private RED As Color = Color.FromArgb(255, 255, 0, 0) ' &HFF Private BLACK As Color = Color.FromArgb(255, 0, 0, 0) ' &H0 Private CYAN As Color = Color.FromArgb(255, 0, 255, 255) ' &HFFFF00 Private DK_CYAN As Color = Color.FromArgb(255, 0, 128, 128) ' &H Private YELLOW As Color = Color.FromArgb(255, 255, 255, 0) ' &HFFFF Private BROWN As Color = Color.FromArgb(255, 128, 128, 0) ' &H8080 Private GREEN As Color = Color.FromArgb(255, 0, 255, 0) ' &HFF00 Private DK_GREEN As Color = Color.FromArgb(255, 0, 128, 0) ' &H8000 Private MAGENTA As Color = Color.FromArgb(255, 255, 0, 255) ' &HFF00FF ' ボールの座標 Private Ball As Point ' コースの個々のホールを定義する構造体の配列 Dim Hole(18) As HoleInfo ' 現行コースの実際のホール数 Dim NumHoles As Integer ' 使用可能なクラブ -76-

77 Private ClubFactor(2) As Integer Private ClubNumber As Integer Private GameState As Integer ' スコアを表示する為に此れ迄に使用したコースのパー合計 Private TotalPar As Integer ' 画像処理を行うオブジェクト Private Bm, Bb As Bitmap Private Gb, Gf As Graphics ' フォームが読み込まれた時の処理 Private Sub golf_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' 初期化 Call ReadGameData() Call InitClubs() ' Graphics オブジェクトのインスタンス生成 With picbg Bb = New Bitmap(.Width,.Height).BackgroundImage = Bb.Image = New Bitmap(.Width,.Height) Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With Gb.Clear(Color.FromArgb(255, 0, 128, 0)) Gf.Clear(Color.Transparent) ' ボタン ( ヘルプ ) がクリックされた時の処理 Private Sub btnhelp_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnhelp.click about.showdialog() ' ボタン ( 倶楽部ハウス ) がクリックされた時の処理 Private Sub btnquit_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnquit.click Me.Close() Application.Exit() ' ボタン ( 新規ゲーム ) がクリックされた時の処理 Private Sub btnnewgame_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles btnnewgame.click GameState = GAME_IN_PROGRESS -77-

78 TotalPar = 0 lblscore.text = "0 - Par" SetupHole(1) ' ピクチャボックス ( クラブ ) がクリックされた時の処理 Private Sub picclub_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles picclub1.click, picclub2.click, picclub0.click Dim P As PictureBox = DirectCast(sender, PictureBox) Dim N As Integer = Integer.Parse(P.Tag) ' 新しいクラブを選択 lblselectedclub.left = P.Left ClubNumber = N ' ピクチャボックス ( コース ) をダブルクリックした時の処理 Private Sub picbg_mousedoubleclick(byval sender As System.Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) Handles picbg.mousedoubleclick Dim Slope As Single Dim Dist As Single Dim MaxDist As Single Dim Direct As Point Dim I As Integer Dim Xf, Yf As Single Dim OK As Integer Dim BG_Color As Color Dim Loc As String Dim PauseFactor As Integer Dim InTree As Integer Dim Temp As Point Dim MoveDir As Integer Dim Delta As Point Dim Rn As Random = New Random() Dim WaveFileName As String = "" ' ゲームが終了して居る場合 If GameState = GAME_OVER Then Exit Sub InTree = False -78-

79 lblinfo.text = " ボールの後ろ側をダブルクリックしてスイングして下さい " lblinfo.text &= " スイングが強ければボールの飛距離が長く成ります " Delta.X = (Ball.X + 2) - e.x Delta.Y = (Ball.Y + 2) - e.y MaxDist = Math.Sqrt(Delta.X ^ 2 + Delta.Y ^ 2) * ClubFactor(ClubNumber) ' ティーショット以外は飛距離はピクチャボックスの高さの 1/3 が上限 If Integer.Parse(lblStrokes.Text) > 0 Then If MaxDist > (picbg.height / 3) Then MaxDist = picbg.height / 3 ' 打数のインクリメント lblstrokes.text = (Integer.Parse(lblStrokes.Text) + 1).ToString() ' ボール下のカラーの取得 BG_Color = Bb.GetPixel(Ball.X + 2, Ball.Y + 2) ' 樹木の中の場合 If (BG_Color = BLACK) Or (BG_Color = BROWN) Then InTree = True MaxDist = 2 * ClubFactor(ClubNumber) ' バンカーの場合 ( 先に進みたければ, アイアンを使用した方が良い ) If (BG_Color = WHITE) Or (BG_Color = YELLOW) Then If ClubNumber = CLUB_IRON Then MaxDist = MaxDist * 0.75 Else MaxDist = 2 If Not Delta.X = 0 Then Slope = System.Math.Abs(Delta.Y / Delta.X) Else Slope = 1 If Delta.X > 0 Then Direct.x = 1 ElseIf Delta.X < 0 Then Direct.x = -1 Else Direct.x = 0-79-

80 If Delta.Y > 0 Then Direct.y = 1 ElseIf Delta.Y < 0 Then Direct.y = -1 Else Direct.y = 0 Xf = Ball.X Yf = Ball.Y ' 使用するクラブに応じたサウンドを再生 Select Case ClubNumber Case CLUB_DRIVER : WaveFileName = "swing1.wav" Case CLUB_IRON : WaveFileName = "swing2.wav" Case CLUB_PUTTER : WaveFileName = "swing3.wav" End Select My.Computer.Audio.Play(WaveFileName, AudioPlayMode.Background) System.Threading.Thread.Sleep(250) PauseFactor = System.Math.Abs(Delta.Y * 1.85) ' ボールの軌跡表示 ) OK = True : I = 0 Do While OK I += 1 Xf += Direct.X Yf += (Slope * Direct.Y) Dist = Math.Sqrt(Convert.ToInt32(Ball.X - Xf) ^ 2 + Convert.ToInt32(Ball.Y - Yf) ^ 2) If Dist >= MaxDist Then OK = False Gf.Clear(Color.Transparent) Gf.FillEllipse(Brushes.Magenta, Convert.ToInt32(Xf), Convert.ToInt32(Yf), 5, 5) picbg.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(PauseFactor) BG_Color = Bb.GetPixel(Convert.ToInt32(Xf) + 2, Convert.ToInt32(Yf) + 2) ' OB の場合 If OutOfBounds(Convert.ToInt32(Xf), Convert.ToInt32(Yf)) Then lblstrokes.text = (Integer.Parse(lblStrokes.Text) + 2).ToString() If Rn.(0, 2) = 1 Then lblinfo.text = " 貴方の打ったポールは OB です ( おまけに倶楽部ハウスに当りました ) " _ & "2 打のペナルティ " My.Computer.Audio.Play("outobnd1.wav", AudioPlayMode.Background) Else lblinfo.text = " 貴方の打ったポールは OB です ( おまけに人に当りました ) " _ & "2 打のペナルティ " My.Computer.Audio.Play("outobnd2.wav", AudioPlayMode.Background) -80-

81 Call DrawBall() Exit Sub ' 木に当たった場合 If (BG_Color = BLACK) And (Not InTree) Then My.Computer.Audio.Play("treehit.wav", AudioPlayMode.Background) OK = False ' カップインの場合 If InHole(Convert.ToInt32(Xf) + 2, Convert.ToInt32(Yf) + 2) Then My.Computer.Audio.Play("inhole.wav", AudioPlayMode.Background) ' スコア表示 lblscore.text = (Integer.Parse(lblScore.Text.Substring(0, lblscore.text.indexof(" "))) + _ Integer.Parse(lblStrokes.Text)).ToString() TotalPar = TotalPar + Integer.Parse(lblPar.Text) If Integer.Parse(lblScore.Text) > TotalPar Then lblscore.text &= (" - " & (Integer.Parse(lblScore.Text) - TotalPar).ToString() & _ " over par") ElseIf Integer.Parse(lblScore.Text) < TotalPar Then lblscore.text &= (" - " & (TotalPar - Integer.Parse(lblScore.Text)).ToString() & _ " under par") Else lblscore.text &= " - Par" ' ホールアウトの判定 If Integer.Parse(lblHole.Text) = NumHoles Then ' ホールアウト GameState = GAME_OVER My.Computer.Audio.Play("applaus2.wav", AudioPlayMode.Background) lblinfo.text = " 全コースをラウンドしました 御疲れ様!" Exit Sub Else ' 次のコース SetupHole(Integer.Parse(lblHole.Text) + 1) Exit Sub Loop Ball.X = Convert.ToInt32(Xf) Ball.Y = Convert.ToInt32(Yf) ' ボールの移動先 BG_Color = Bb.GetPixel(Ball.X + 2, Ball.Y + 2) Loc = GetLocationByColor(BG_Color) If Loc = "WATER" Then -81-

82 ' 池に落ちた場合 Temp.X = Ball.X : Temp.Y = Ball.Y lblinfo.text = " 池に落ちたので 1 打のペナルティ " lblstrokes.text = (Integer.Parse(lblStrokes.Text) + 1).ToString() My.Computer.Audio.Play("splash.wav", AudioPlayMode.Background) If Ball.X > (picbg.width / 2) Then MoveDir = -5 Else MoveDir = 5 Do While ((BG_Color = BLUE) Or (BG_Color = DK_BLUE) Or (BG_Color = DK_CYAN)) Temp.X += MoveDir Gf.Clear(Color.Transparent) Gf.FillEllipse(Brushes.Magenta, Temp.X, Temp.Y, 5, 5) picbg.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(250) BG_Color = Bb.GetPixel(Temp.X + 2, Temp.Y + 2) Loop Ball.X = Temp.X ElseIf Loc = "SANDTRAP" Then ' バンカーに落ちた場合 lblinfo.text = " バンカーに捕まりました!" My.Computer.Audio.Play("bunker2.wav", AudioPlayMode.Background) Call DrawBall() ' ホールを定義するデータ構造体を作成するジェネラルプロシージャ Private Sub ReadGameData() Dim ALine, ID, D() As String Dim HoleNum As Integer Dim DefaultTee As Point Dim DefaultPar As Integer DefaultTee.X = picbg.clientrectangle.width 2 DefaultTee.Y = picbg.clientrectangle.height - 50 DefaultPar = 5 If Not File.Exists("gameinfo.txt") Then MessageBox.Show(" ゲームの定義ファイルが見付かりません!", " 確認 ", _ MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Me.Close() : Application.Exit() Using Sr As StreamReader = _ New StreamReader("gameinfo.txt", System.Text.Encoding.Default) HoleNum = 0 Do Until Sr.EndOfStream -82-

83 ALine = Sr.ReadLine().Trim() If Not ALine.Trim() = "" Then If ALine.ToUpper() = "NEW HOLE" Then HoleNum += 1 Else ID = ALine.Substring(0, ALine.IndexOf(":")).ToUpper().Trim() Select Case ID Case "COURSE" lblcoursename.text = ALine.Substring(ALine.IndexOf(":") + 1).Trim() Case "FILE" Hole(HoleNum).FileName = ALine.Substring(ALine.IndexOf(":") + 1).Trim() Case "TEE" D = ALine.Substring(ALine.IndexOf(":") + 1).Trim().Split(",") If Not Integer.TryParse(D(0), Hole(HoleNum).Tee.X) Then Hole(HoleNum).Tee.X = DefaultTee.X If Not Integer.TryParse(D(1), Hole(HoleNum).Tee.Y) Then Hole(HoleNum).Tee.Y = DefaultTee.Y Case "PAR" If Not Integer.TryParse(ALine.Substring(ALine.IndexOf(":") + 1).Trim(), _ Hole(HoleNum).Par) Then Hole(HoleNum).Par = DefaultPar End Select Loop Sr.Close() End Using NumHoles = HoleNum ' クラブ係数の配列を設定するジェネラルプロシージャ Private Sub InitClubs() ClubFactor(CLUB_DRIVER) = 8 ClubFactor(CLUB_IRON) = 3 ClubFactor(CLUB_PUTTER) = 1 ' 新規ホールを設定するジェネラルプロシージャ Private Sub SetupHole(ByVal HoleNum As Integer) If Not File.Exists(Hole(HoleNum).FileName) Then MessageBox.Show(" ホール " & HoleNum.ToString() & " のビットマップが見付かりません!", _ " 確認 ", MessageBoxButtons.OK, MessageBoxIcon.Stop) Exit Sub Bm = New Bitmap(Hole(HoleNum).FileName) -83-

84 ' サウンド効果と共に背景を右側からスライド My.Computer.Audio.Play("slide.wav", AudioPlayMode.BackgroundLoop) Gb.Clear(Color.FromArgb(255, 0, 128, 0)) Gf.Clear(Color.Transparent) For I As Integer = picbg.clientrectangle.width - 2 To 0 Step -2 Gb.DrawImage(Bm, I, 0) picbg.refresh() : Application.DoEvents() System.Threading.Thread.Sleep(20) My.Computer.Audio.Stop() ' 此のホールの変数の初期化 lblhole.text = HoleNum.ToString() lblpar.text = Hole(Integer.Parse(lblHole.Text)).Par.ToString() Ball.X = Hole(Integer.Parse(lblHole.Text)).Tee.X Ball.Y = Hole(Integer.Parse(lblHole.Text)).Tee.Y lblstrokes.text = (0).ToString() Call DrawBall() ' デフォルトのクラブはドライバー picclub_click(me.controls("picclub" & CLUB_DRIVER.ToString()), New System.EventArgs()) ' ボールを現在の X Y 座標に描画するジェネラルプロシージャ Private Sub DrawBall() Gf.Clear(Color.Transparent) Gf.FillEllipse(Brushes.Magenta, Ball.X, Ball.Y, 5, 5) picbg.refresh() ' 特定のカラーに対し何に対応して居るかを示す文字列を返すジェネラルプロシージャ Private Function GetLocationByColor(ByRef AColor As Color) As String Select Case AColor Case RED : Return "HOLE" Case BLUE, DK_BLUE, DK_CYAN : Return "WATER" Case WHITE, YELLOW : Return "SANDTRAP" Case Else Return "" End Select End Function ' ボールがカップインしたか何うかを判定するジェネラルプロシージャ Private Function InHole(ByVal X As Integer, ByVal Y As Integer) As Boolean ' ボールがカップに有れば True を返し 其他の場合は False を返す If Bb.GetPixel(X, Y) = RED Or Bb.GetPixel(X + 1, Y) = RED Then Return True -84-

85 ElseIf Bb.GetPixel(X, Y - 1) = RED Or Bb.GetPixel(X + 1, Y - 1) = RED Then Return True ElseIf Bb.GetPixel(X, Y + 1) = RED Or Bb.GetPixel(X + 1, Y + 1) = RED Then Return True Else Return False End Function ' ボール座標がビットマップの外にある場合は True を返すジェネラルプロシージャ Private Function OutOfBounds(ByVal X As Integer, ByVal Y As Integer) As Boolean Dim B As Integer = 4 If (X < B) Or (X > picbg.clientrectangle.width - B) Or _ (Y < B) Or (Y > picbg.clientrectangle.height - B) Then Return True Else Return False End Function End Class アバウト用 Imports System.IO Public Class about ' ボタン ( 操作方法 ) がクリックされた時の処理 Private Sub btnhowtoplay_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles btnhowtoplay.click Using Sr As StreamReader = New StreamReader("howto.txt", System.Text.Encoding.Default) Dim S As String = Sr.ReadToEnd() txthelp.text = S Sr.Close() End Using ' ボタン ( ヒント ) がクリックされた時の処理 Private Sub btnhints_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btnhints.click Using Sr As StreamReader = New StreamReader("hints.txt", System.Text.Encoding.Default) Dim S As String = Sr.ReadToEnd() txthelp.text = S Sr.Close() End Using -85-

86 ' ボタン ( カスタマイズ ) がクリックされた時の処理 Private Sub btncustomizing_click(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles btncustomizing.click Using Sr As StreamReader = _ New StreamReader("customize.txt", System.Text.Encoding.Default) Dim S As String = Sr.ReadToEnd() txthelp.text = S Sr.Close() End Using ' ボタン ( ゲームに戻る ) がクリックされた時の処理 Private Sub btncancel_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btncancel.click Me.Close() End Class -86-

87 星座で遊ぼう VB プログラムの概要 主要な星座を表示するプログラムで有る 星座を構成する星や星座に纏わる話等を紹介して居る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) -87-

88 オブジェクト プロパティ一覧 ラベル 1 ボタン コンボボックス ラベル 2 WEB ブラウザ コントロールの種類 プロパティ プロパティの設定値 フォーム Name constellation BackColor Black Font MS 明朝 9 標準 ForeColor Yellow FormBorderStyle FixedSingle StartPosition CenterScreen Text 星座で遊ぼう コンボボックス Name cboconstellation Font MS 明朝 10 標準 ボタン Name btndetails Text 詳細 ラベル1 Name lblfixedstar AutoSize False Font MS 明朝 12 太字 ForeColor Yellow Text 空白 TextAlign MiddleLeft ラベル2 Name lblline AutoSize False BackColor White Location 681, 16 Size 2, 443 Text 空白 Web ブラウザ Name webdetails Size 499,

89 プログラムリスト Imports System.IO Public Class constellation Private CD(31) As String Private Gr As Graphics Private Cl() As Color = {Color.Black, Color.Blue, Color.Red, Color.Magenta, _ Color.Green, Color.Cyan, Color.Yellow, Color.White} ' フォームが読み込まれた時の処理 Private Sub constellation_load(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load ' 星座データの読込 Using Sr As StreamReader = _ New StreamReader("constellation.txt", System.Text.Encoding.Default) Dim D() As String For I As Integer = 0 To 31 CD(I) = Sr.ReadLine() D = CD(I).Split(",") cboconstellation.items.add(d(0)) End Using ' Graphics オブジェクトのインスタンス生成 With Me.BackgroundImage = New Bitmap(.ClientSize.Width,.ClientSize.Height) Gr = Graphics.FromImage(.BackgroundImage) End With Gr.Clear(Color.Black) ' 初期 WEB ページの表示 Dim P As String = Application.StartupPath : If Not P.EndsWith(" ") Then P &= " " webdetails.navigate(p & "constellation.html") ' コンボボックス ( 星座一覧 ) の選択項目が変更された時の処理 Private Sub cboconstellation_selectedindexchanged(byval sender As System.Object, _ ByVal e As System.EventArgs) Handles cboconstellation.selectedindexchanged Dim N As Integer = cboconstellation.selectedindex If N < 0 Then Exit Sub Dim X, Y, R, C As Integer Dim S As String = CD(N) Dim D() As String = S.Split(",") lblfixedstar.text = D(1) -89-

90 N = Integer.Parse(D(2)) Gr.Clear(Color.Black) For I As Integer = 0 To (N - 1) X = Integer.Parse(D(I * 4 + 3)) + 50 Y = Integer.Parse(D(I * 4 + 4)) * R = Integer.Parse(D(I * 4 + 5)) C = Integer.Parse(D(I * 4 + 6)) Gr.FillEllipse(New SolidBrush(Cl(C)), X, Y, R, R) Me.Refresh() ' ボタン ( 詳細 ) がクリックされた時の処理 Private Sub btndetails_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btndetails.click Dim N As Integer = cboconstellation.selectedindex If N < 0 Then Exit Sub Dim P As String = Application.StartupPath : If Not P.EndsWith(" ") Then P &= " " P &= "details " Dim F As String = P & "exp" & N.ToString("00") & ".txt" Dim I1 As String = "img" & N.ToString("00") & "a.gif" Dim I2 As String = "img" & N.ToString("00") & "b.gif" Using Sw As StreamWriter = _ New StreamWriter(P & "stars.html", False, System.Text.Encoding.Default) Dim S As String = "<IMG SRC=" & Chr(34) & I1 & Chr(34) & _ " ALIGN=" & Chr(34) & "left" & Chr(34) & _ " NAME=" & Chr(34) & "stars" & Chr(34) & _ " onmouseover=" & Chr(34) & "stars.src='" & I2 & "'" & Chr(34) & _ " onmouseout =" & Chr(34) & "stars.src='" & I1 & "'" & Chr(34) & ">" Sw.WriteLine("<HTML>") Sw.WriteLine("<HEAD>") Sw.WriteLine("<META HTTP-EQUIV='Content-Type' CONTENT='text/html; CHARSET=Shift_JIS'>") Sw.WriteLine("</HEAD>") Sw.WriteLine("<BODY BGCOLOR='#000000'>") Sw.WriteLine("<FONT FACE='MS 明朝 ' COLOR='#FFFFFF' STYLE='font-size:12pt'>") Sw.WriteLine("<DIV STYLE='text-align:justify;text-justify:distribute'>") Sw.WriteLine(S) Using Sr As StreamReader = New StreamReader(F, System.Text.Encoding.Default) Do Until Sr.EndOfStream S = Sr.ReadLine() S &= "<BR />" Sw.WriteLine(S) Loop Sr.Close() End Using Sw.WriteLine("</DIV>") Sw.WriteLine("</FONT>") -90-

91 Sw.WriteLine("</BODY>") Sw.WriteLine("</HTML>") Sw.Close() End Using F = P & "stars.html" webdetails.navigate(f) End Class -91-

92 ドライブは安全運転で in 滋賀 VB プログラムの概要 古典的なドライビングゲーム ドライブは安全運転で in 滋賀 で有る マウスで車を左右に動かして 側壁に衝突しない様に 出来る丈遠くに行くゲームで有る 開始ボタンをクリックすると スタートランプが点灯するので 総てが赤ランプに成ると ドライブ開始で有る 田舎道らしく 色々な動物が道路を横切るので 此等を旨く避けて運転しなければ成らない 側壁や動物に衝突すると 即ゲームオーバーと成る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) -92-

93 オブジェクト プロパティ一覧 ラベル 1 ラベル 2 ラベル 3 ラベル 4 ピクチャボックス 3 ピクチャボックス 1 ボタン ピクチャボックス 2 コントロールの種類 プロパティ プロパティの設定値 フォーム Name driving AutoScaleMode None Font Times New Roman, 9.0!, Regular FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text ドライブは安全運転で in 滋賀 ピクチャボックス1 Name picroad Location 8, 52 Size 300, 300 TabStop False ボタン Name btnstart Font Times New Roman, 15.75!, Bold Location 82, 363 Size 153, 38 Text START ピクチャボックス2 Name picwork Location 262, 363 Size 46, 38 TabStop False Visible False -93-