ゴルフ VB 2005 68 プログラムの概要 ゴルフ版スポーツシミュレーションゲーム ゴルフ で有る 新規ゲームで ゲームを開始し 倶楽部ハウスでプログラムを終了する 操作方法や新しいコースを自作する方法に付いては ヘルプを観れば解る様に成って居る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -1-
オブジェクト プロパティ一覧 ラベル 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, 402-2-
コントロールの種類 プロパティ プロパティの設定値 ラベル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( 倶楽部ハウス ) -3-
アバウト用 ボタン 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: ゲームに戻る -4-
プログラムリスト 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) ' &H800000 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) ' &H808000 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 ' 使用可能なクラブ -5-
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 -6-
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 -7-
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 MaxDist = 2 If Not Delta.X = 0 Then Slope = System.Math.Abs(Delta.Y / Delta.X) Slope = 1 If Delta.X > 0 Then Direct.x = 1 If Delta.X < 0 Then Direct.x = -1 Direct.x = 0-8-
If Delta.Y > 0 Then Direct.y = 1 If Delta.Y < 0 Then Direct.y = -1 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.Next(0, 2) = 1 Then lblinfo.text = " 貴方の打ったポールは OB です ( おまけに倶楽部ハウスに当りました ) " _ & "2 打のペナルティ " My.Computer.Audio.Play("outobnd1.wav", AudioPlayMode.Background) lblinfo.text = " 貴方の打ったポールは OB です ( おまけに人に当りました ) " _ & "2 打のペナルティ " My.Computer.Audio.Play("outobnd2.wav", AudioPlayMode.Background) -9-
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") If Integer.Parse(lblScore.Text) < TotalPar Then lblscore.text &= (" - " & (TotalPar - Integer.Parse(lblScore.Text)).ToString() & _ " under par") 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 ' 次のコース 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 -10-
' 池に落ちた場合 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 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 If 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 -11-
ALine = Sr.ReadLine().Trim() If Not ALine.Trim() = "" Then If ALine.ToUpper() = "NEW HOLE" Then HoleNum += 1 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) -12-
' サウンド効果と共に背景を右側からスライド 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) Next 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 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 -13-
If Bb.GetPixel(X, Y - 1) = RED Or Bb.GetPixel(X + 1, Y - 1) = RED Then Return True If Bb.GetPixel(X, Y + 1) = RED Or Bb.GetPixel(X + 1, Y + 1) = RED Then Return True 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 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 -14-
' ボタン ( カスタマイズ ) がクリックされた時の処理 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 -15-