職案人

求職・歴史・仏教などについて掲載するつもりだが、自分の思いつきが多いブログだよ。適当に付き合って下さい。

仲間を探せ2--続

2019年11月02日 | VB2017
仲間を探せ2--続

【開発環境】
os:Windows 10
IDE(統合開発環境):VisualStudio 2017
言語;VB

【参考書】
株式会社秀和システム「作って覚えるVisualBasic2017」
著者:萩原 博之/宮崎 昭世

【仲間を探せ2】
この前の続き、この前はボールが一つ勝手に動いてるだけで、未完成でしたが、今度はボールを5つにしてプログラムを完成させる。

【ゲーム起動】
1.開始
5つのボールが背景の「烏」を消して行く

2.正解
「烏」と書いてあるボールの色と、同じ色のボールを上部から選んでクリックする。正解すると、背景が○になり、時計が止まり、再スタートボタンがアクティブになる。

3.間違えた場合
ゲームを再スタートしたい場合は「再スタート」ボタンを押す。同じ様に、「烏」と書いてあるボールを探す。間違えると、速度が遅くなる。



【コーデング】
1.FormBallGame

Public Class FormBallGame
'=============================================================
'メンバー変数
'====================================================================
   ’クラス宣言
Private canvas As Bitmap '画面下の描画領域

'配列宣言
Private ボール As Ball() 'ボールを管理
Private 漢字 As String() 'ボールに書く漢字の配列
Private ブラシ As Brush() 'ボールを塗る色の配列

'文字
Private fontName As String = "HG教科書体" '表示する漢字のフォント名
Private correcText As String = "烏"    '正解の文字
Private mistakeText As String = "鳥"   '間違いの文字[4]

'背景
Private circleText As String = "○" '正解した場合背景文字を○にする
Private 間違 As String = "☓" '間違えた場合

'ボール数
Private randomResult As Integer = 0 '正解の番号:0~ボールの数のいすれか
Private ボール数 As Integer = 5 'ボールの数

'時間
Private nowTime As Double = 0 '経過時間

'====================================================
'戻り値の無いSub関数を作る
'===================================================
'---------------------------
'配列の初期化、画面の初期化
'---------------------------
Private Sub InitGraphics()
'初期化
ブラシ = New Brush(ボール数) {}
漢字 = New String(ボール数) {}
ボール = New Ball(ボール数) {}

'ブラシ色の設定
ブラシ(0) = Drawing.Brushes.LightPink
ブラシ(1) = Drawing.Brushes.LightBlue
ブラシ(2) = Drawing.Brushes.LightGray
ブラシ(3) = Drawing.Brushes.LightCoral
ブラシ(4) = Drawing.Brushes.LightGreen

'上のImageオブジェクト
DrowCircleSelectPictureBox()

'下のImageオブジェクト
'引数1は文字色:引数2はフォント:引数3は文字:引数4は背景色
DrowMainPictureBox(Drawing.Brushes.Orange, fontName, correcText, False)

RestartButton.Enabled = False '再スタートボタンを操作できる様にする
textHunt.Text = correcText '上部のtextboxに正解文字を表記

End Sub
'--------------------------------------------------------
'ボールのインスタンスの作成・ランダムな位置にボールを描く
'--------------------------------------------------------

'漢字の設定
Private Sub SetStartPosition()
For i As Integer = 0 To ボール数 - 1    'for文
漢字(i) = mistakeText    '間違え文字「鳥」を4つセットする
Next
'ボール数の分の範囲で乱数を取得し、変数にセット
randomResult = New Random().Next(ボール数)
漢字(randomResult) = correcText '正解の文字「烏」を一つセットする

'ボールクラスのインスタンス作成
For i As Integer = 0 To ボール数 - 1
ボール(i) = New Ball(MainPictureBox, ブラシ(i), 漢字(i))
Next

'ランダムな位置にボールを描く
Dim 下幅 As Integer = MainPictureBox.Width
Dim 下高 As Integer = MainPictureBox.Height
SetBalls(New Random().Next(下幅), New Random().Next(下高))

'タイマーをスタートさせる
nowTime = 0
Timer1.Start()

End Sub
'----------------------------------------------
'引数の位置情報を利用してランダムにボールを描く
'----------------------------------------------
Private Sub SetBalls(x As Integer, y As Integer)
'ローカル変数
Dim 下幅 As Integer = MainPictureBox.Width  '下部ピクチャボックスの幅
Dim 下高 As Integer = MainPictureBox.Height '下部ピクチャボックスの高
Dim rndX As Integer 'ランダム幅
Dim rndY As Integer        'ランダム高

'for文でランダム値を生成している
For i As Integer = 0 To ボール数 - 1
rndX = New Random(i * x).Next(下幅)
rndY = New Random(i * y).Next(下高)
'クラスメソッド
ボール(i).DeleteCircle() '以前のボールを削除
ボール(i).PutCircle(rndX, rndY) '新しい位置にボールを描く
Next
End Sub

'-------------------------------------------
'画面上部のPictureBoxに円を書くサブルーチン
'------------------------------------------
Private Sub DrowCircleSelectPictureBox()
     'ローカル変数
Dim 上高 As Integer = SelectPictureBox.Height '上部のピクチャボックスの高さ
Dim 上幅 As Integer = SelectPictureBox.Width '上部のピクチャボックスの幅

'図形のサイズを決める
Dim selectCanvas As Bitmap = New Bitmap(上幅, 上高)

'キャンパスに書くための筆を決める
Using g As Graphics = Graphics.FromImage(selectCanvas)
'For文
For i As Integer = 0 To ボール数 - 1
        '5つのボールの塗りつぶし
 g.FillEllipse(ブラシ(i), i * 上高, 0, 上高, 上高) 
Next

'書いた内容をコントロールに割り当てる
SelectPictureBox.Image = selectCanvas
End Using

End Sub

'---------------------------------------------
'画面下部のPictureBoxに文字を書くサブルーチン
'---------------------------------------------
Private Sub DrowMainPictureBox(color As Brush, font As String, text As String, truePlag As Boolean)
     'ローカル変数
Dim 下幅 As Integer = MainPictureBox.Width '下部ピクチャボックスの幅
Dim 下高 As Integer = MainPictureBox.Height '下部ピクチャボックスの高

'描画先とするImageオブジェクトを作成する
      '初回は変数canvasがまだないのでNothingに成る
If canvas Is Nothing Then    
canvas = New Bitmap(下幅, 下高)
End If

'キャンパスに文字を描くための筆を用意
Using g As Graphics = Graphics.FromImage(canvas)
'正解用の背景
If truePlag Then
g.FillRectangle(Drawing.Brushes.LightPink, 0, 0, 下幅, 下高)
'不正解用の背景
Else
g.FillRectangle(Drawing.Brushes.White, 0, 0, 下幅, 下高)
End If

'背景に引数で指定した文字列を描画する
g.DrawString(text, New Font("HG教科書", 下高 - 下高 / 4),
color, 0, 0, New StringFormat())

'MainPictureBoxに表示する
MainPictureBox.Image = canvas

End Using
End Sub

'=====================================================
'イベントを処理するイベントハンドラーの作成
'=====================================================

'起動される時に呼ばれるハンドラー
Private Sub FormBallGame_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'初期化
InitGraphics()

'ボールのインスタンスの作成・ランダムな位置にボールを描く
SetStartPosition()


End Sub

'再スタートボタンが押された時、呼ばれるイベントハンドラ
Private Sub RestartButton_Click(sender As Object, e As EventArgs) Handles RestartButton.Click
'初期化
InitGraphics()

'ボールのインスタンスの作成・ランダムな位置にボールを描く
SetStartPosition()

End Sub

'上のピクチャーボックスが押された時、呼ばれるイベントハンドラ
Private Sub SelectPictereBox_MuuseClick(sender As Object, e As MouseEventArgs) Handles SelectPictureBox.MouseClick
'再スタートボタンが操作可能が操作可能な場合は何もせず処理を終了
If (RestartButton.Enabled) Then
Exit Sub
End If

'押されたx座標で正解判定
'<判定>押されたボタンがマウスの左ボタン?
If (e.Button = MouseButtons.Left) Then
'どの円を選択したかを算出(クリックしたx座標の位置/pictureBoxの横幅)
Dim selectCircle As Integer = e.X / SelectPictureBox.Height

      '正解ならば
If (randomResult = selectCircle) Then
       ’タイマー停止
Timer1.Stop()
       '背景に赤○を描く
DrowMainPictureBox(Drawing.Brushes.Red, fontName, circleText, True)
       '再スタートボタンを操作可能に
RestartButton.Enabled = True

      '不正解ならば
Else 
DrowMainPictureBox(Drawing.Brushes.Black, fontName,間違, False)
'移動の割合を減少させる
For i As Integer = 0 To ボール数 - 1
   ボール(i).pitch = ボール(i).pitch - ボール(i).pitch / 2
Next
nowTime = nowTime + 10 'ペナルティ
End If

End If
End Sub

'下のピクチャーボックスが押された時、呼ばれるイベントハンドラ
Private Sub MainPictureBox_MouseClick(sender As Object, e As MouseEventArgs) Handles MainPictureBox.MouseClick

'再スタートボタンが操作可能な場合は何もせずに終了可能
If (RestartButton.Enabled) Then
Exit Sub
End If
'マウスをクリックした位置にボールをセットする関数を呼び出す
SetBalls(e.X, e.Y)
End Sub

'タイマーが動いてる時、呼ばれるイベントハンドラ
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
For i As Integer = 0 To ボール数 - 1
ボール(i).Move()

Next

nowTime = nowTime + 0.02
TextBox2.Text = nowTime.ToString("0.00")

End Sub
End Class


2.Ballクラス
Imports System.Drawing
Imports System.Windows.Forms
Public Class Ball
'------------------------------------------
'クラスのデータ部(必要な情報の定義)
'------------------------------------------
'公開データ

Public pitch As Integer '移動の割合

'===============================================
'非公開データ
'===============================================
Private pictureBox As PictureBox '描画する
Private canvas As Bitmap '描画するキャンパス
Private brushColor As Brush '塗りつぶす色

Private positionX As Integer '横位置(X座標)
Private positionY As Integer '縦位置(Y座標)

Private previousX As Integer '以前の横位置(X座標)
Private previousY As Integer '以前の縦位置(Y座標)

Private directionX As Integer '移動方向(X座標)(+1 Or -1)
Private directionY As Integer '移動方向(Y座標)(+1 Or -1)

Private radius As Integer '円の半径
Private kanji As String '表示する漢字
Private fontName As String '表示する漢字のフォント

'====================メソッド部門======================================

'---------------------------------------------
'Ballコンストラクタ
'----------------------------------------------
'4つの引数を指定しクラスの内部に保持する。4つの引数は、描画するPictureBox
'描画するキャンパス、塗りつぶす色、表示する漢字

Public Sub New(pb As PictureBox, cl As Brush, st As String)
pictureBox = pb '描画するpictureBox
canvas = pb.Image '描画するキャンパス
brushColor = cl '塗りつぶす色
kanji = st '表示する漢字

radius = 40 '円の半径の初期設定
pitch = radius / 2 '移動の割合の初期設定(半径の半分)
directionX = +1 '移動方向を+1で初期設定
directionY = +1 '移動方向を+1で初期設定
fontName = "HG教科書体" '漢字のフォント名の初期設定
End Sub

'-------------------------------------
'指定した位置にボールを描くメソッド
'-----------------------------------
Public Sub PutCircle(x As Integer, y As Integer)
'現在の位置を記憶
positionX = x
positionY = y
'------------------------------------
'usingステートメント
'-----------------------------------
Using g As Graphics = Graphics.FromImage(canvas)
'円をbrushColorで指定された色で描く
g.FillEllipse(brushColor, x, y, radius * 2, radius * 2)

'文字列を描画する
g.DrawString(kanji, New Font(fontName, radius),
Brushes.Black, x + 4, y + 12, New StringFormat())

'mainPictureBoxの表示する
pictureBox.Image = canvas

End Using
End Sub

'-----------------------------------
'指定した位置のボールを消すメソッド(白く描く)
'--------------------------------------
Public Sub DeleteCircle()
'初めて呼ばれて以前の値がない場合
If (previousX = 0) Then
previousX = positionX
End If
If (previousY = 0) Then
previousY = positionY
End If
'------------------------------------
'usingステートメント
'-----------------------------------
Using g As Graphics = Graphics.FromImage(canvas)
'円を白で描く
g.FillEllipse(Brushes.White, previousX, previousY, radius * 2, radius * 2)
'mainPictureBoxに表示する
pictureBox.Image = canvas
End Using
End Sub
'-----------------------------------
'指定した位置にボールを動かすメソッド
'--------------------------------------
Public Sub Move()
'以前の表示を削除
DeleteCircle()

'新しい移動先の計算
Dim x As Integer = positionX + pitch * directionX
Dim Y As Integer = positionY + pitch * directionY

'壁で跳ね返る補正
If (x >= pictureBox.Width - radius * 2) Then '右端に来た場合の判断
directionX = -1
End If
If (x <= 0) Then '左端に来た場合の判断
directionX = +1
End If
If (Y >= pictureBox.Height - radius * 2) Then '下端に来た場合の判断
directionY = -1
End If
If (Y <= 0) Then '上端に来た場合の判断
directionY = +1
End If

'跳ね返り補正を反映した値で新しい位置を計算
positionX = x + directionX
positionY = Y + directionY

'新しい位置に描画
PutCircle(positionX, positionY)

'新しい位置を以前の値として記憶
previousX = positionX
previousY = positionY

End Sub
End Class


コメント    この記事についてブログを書く
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする
« 息子介護物語-エピソード13(... | トップ | 「Twitter投稿」アプリ »
最新の画像もっと見る

コメントを投稿

VB2017」カテゴリの最新記事