プログラムの概要
ゴルフ版スポーツシミュレーションゲー ム『ゴルフ』で有る。 新規ゲームで、ゲームを開始し、倶楽部 ハウスでプログラムを終了する。操作方 法や新しいコースを自作する方法に付い ては、ヘルプを観れば解る様に成って居 る。 一般的に、実用プログラムに比較すると ゲームプログラムは、高度なテクニック を要求される事が多い。 此処では、ゲームプログラムを作成する 事に依り、楽しみ乍ら、プログラムの制 作手順を習得する事を目的として居る。 制作手順としては、実際の作業過程に従 い、段階的に機能を追加する方法を採用 して居る。 此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。ゴルフ
VB 2005 ○68 □ アプリケーション画面のデザイン（標準コントロールの利用） □ プログラムの動作原理（イベント駆動型のプログラム） □ プログラムの構成要素（オブジェクトとプロパティ） □ 値の代入（変数、オブジェクトのプロパティ） □ グラフィックスの利用（Graphics オブジェクト） □ 条件に応じた処理（If 文の利用） □ 自動的に行われる処理（タイマーの利用） 今回の課題項目コントロールの種類 プロパティ プロパティの設定値
フォーム Name golf
AutoScaleMode None
Font Times New Roman、９、標準
FormBorderStyle FixedSingle MaximizeBox False StartPosition CenterScreen Text ゴルフ ラベル１ Name lblCourseName AutoSize False BackColor Green Font ＭＳ ゴシック、１１、標準 ForeColor White
Text Course Name
TextAlign MiddleCenter ピクチャボックス１ Name picBG BackColor 0, 128, 0 BorderStyle FixedSingle Cursor Cross Size 252, 402
オ
オ
ブ
ブ
ジ
ジ
ェ
ェ
ク
ク
ト
ト
・
・
プ
プ
ロ
ロ
パ
パ
テ
テ
ィ
ィ
一
一
覧
覧
ピクチャボックス１ ラベル１ ラベル２ ラベル３ ラベル11 ラベル４ ラベル５ ラベル６ ラベル７ ラベル８ ラベル９ ラベル10 ラベル12 ラベル13 ピクチャボックス２～４ ボタン１～３コントロールの種類 プロパティ プロパティの設定値 ラベル２ Name lblFrame BorderStyle Fixed3D ラベル３～６ Name ３：lblHoleCaption ４：lblParCaption ５：lblStrokesCaption ６：lblScoreCaption ForeColor 0, 0, 128 Text ３：Score ４：Par ５：Strokes ６：Score ラベル７～１０ Name ７：lblHole ８：lblPar ９：lblStrokes 10：lblScore AutoSize False BackColor 255, 255, 128 BorderStyle FixedSingle ForeColor Blue Text 0 TextAlign MiddleCenter ラベル１１ Name lblInfo BorderStyle FixedSingle Font ＭＳ 明朝、８、標準 Text ボールの後ろ側をダブルクリックしてス イングして下さい。スイングが強ければボ ールの飛距離が長く成ります。 ラベル１２ Name lblSelectClub AutoSize False BorderStyle FixedSingle Font ＭＳ 明朝、９、標準 Text クラブ選択 TextAlign MiddleCenter ピクチャボックス２～４ Name ２：picClub0 ３：picClub1 ４：picClub2 BorderStyle FixedSingle Image ２：driver.bmp ３：iron.bmp ４：putter.bmp Size 35, 43 ボタン１～３ Name １：btnNewGame（新規ゲーム） ２：btnHelp（ヘルプ） ３：btnQuit（倶楽部ハウス）
■ アバウト用 ■ コントロールの種類 プロパティ プロパティの設定値 フォーム Name about FormBorderStyle FixedSingle Icon golf.ico MaximizeBox False StartPosition CenterScreen Text ゴルフ - 説明 テキストボックス Name txtHelp BorderStyle FixedSingle Font ＭＳ ゴシック、９、標準 MultiLines True ScrollBars Vertical TextAlign MiddleCenter ピクチャボックス Name picGolf Image golf.ico Size 32, 32 ボタン１～４ Name １：btnHowToPlay ２：btnHints ３：btnCustomizing ４：btnCancel Font ＭＳ ゴシック、９、標準 Text １：操作方法 ２：ヒント ３：カスタマイズ ４：ゲームに戻る テキストボックス ボタン１ ボタン２ ボタン３ ボタン４ ピクチャボックス
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
' 使用可能なクラブ
プ
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) End Sub ' ボタン（ヘルプ）がクリックされた時の処理
Private Sub btnHelp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnHelp.Click
about.ShowDialog() End Sub
' ボタン（倶楽部ハウス）がクリックされた時の処理
Private Sub btnQuit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnQuit.Click Me.Close() Application.Exit() End Sub ' ボタン（新規ゲーム）がクリックされた時の処理
Private Sub btnNewGame_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles btnNewGame.Click GameState = GAME_IN_PROGRESS
TotalPar = 0 lblScore.Text = "0 - Par" SetupHole(1) End Sub ' ピクチャボックス（クラブ）がクリックされた時の処理
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 End Sub ' ピクチャボックス（コース）をダブルクリックした時の処理
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
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 End If
' 打数のインクリメント
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) End If
' バンカーの場合（先に進みたければ，アイアンを使用した方が良い） If (BG_Color = WHITE) Or (BG_Color = YELLOW) Then
If ClubNumber = CLUB_IRON Then MaxDist = MaxDist * 0.75 Else MaxDist = 2 End If End If
If Not Delta.X = 0 Then
Slope = System.Math.Abs(Delta.Y / Delta.X) Else Slope = 1 End If If Delta.X > 0 Then Direct.x = 1
ElseIf Delta.X < 0 Then Direct.x = -1
Else
Direct.x = 0 End If
If Delta.Y > 0 Then Direct.y = 1
ElseIf Delta.Y < 0 Then Direct.y = -1 Else Direct.y = 0 End If 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 です（おまけに倶楽部ハウスに当りました）。" _ & "２打のペナルティ" My.Computer.Audio.Play("outobnd1.wav", AudioPlayMode.Background) Else lblInfo.Text = "貴方の打ったポールは OB です（おまけに人に当りました）。" _ & "２打のペナルティ" My.Computer.Audio.Play("outobnd2.wav", AudioPlayMode.Background)
End If Call DrawBall() Exit Sub End If ' 木に当たった場合
If (BG_Color = BLACK) And (Not InTree) Then
My.Computer.Audio.Play("treehit.wav", AudioPlayMode.Background) OK = False
End If
' カップインの場合
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" End If
' ホールアウトの判定
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 End If End If 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)
' 池に落ちた場合
Temp.X = Ball.X : Temp.Y = Ball.Y
lblInfo.Text = "池に落ちたので１打のペナルティ"
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 End If
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) End If Call DrawBall() End Sub ' ホールを定義するデータ構造体を作成するジェネラルプロシージャ 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() End If
Using Sr As StreamReader = _
New StreamReader("gameinfo.txt", System.Text.Encoding.Default) HoleNum = 0
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
End If
If Not Integer.TryParse(D(1), Hole(HoleNum).Tee.Y) Then Hole(HoleNum).Tee.Y = DefaultTee.Y
End If Case "PAR"
If Not Integer.TryParse(ALine.Substring(ALine.IndexOf(":") + 1).Trim(), _ Hole(HoleNum).Par) Then Hole(HoleNum).Par = DefaultPar End If End Select End If End If Loop Sr.Close() End Using NumHoles = HoleNum End Sub ' クラブ係数の配列を設定するジェネラルプロシージャ Private Sub InitClubs()
ClubFactor(CLUB_DRIVER) = 8 ClubFactor(CLUB_IRON) = 3 ClubFactor(CLUB_PUTTER) = 1 End Sub ' 新規ホールを設定するジェネラルプロシージャ 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
End If
' サウンド効果と共に背景を右側からスライド
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()) End Sub
' ボールを現在の X、Y 座標に描画するジェネラルプロシージャ Private Sub DrawBall()
Gf.Clear(Color.Transparent)
Gf.FillEllipse(Brushes.Magenta, Ball.X, Ball.Y, 5, 5) picBG.Refresh()
End Sub
' 特定のカラーに対し何に対応して居るかを示す文字列を返すジェネラルプロシージャ 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
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 If 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 If 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 End Sub ' ボタン（ヒント）がクリックされた時の処理
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 End Sub
' ボタン（カスタマイズ）がクリックされた時の処理
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 End Sub ' ボタン（ゲームに戻る）がクリックされた時の処理
Private Sub btnCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnCancel.Click
Me.Close() End Sub End Class
