素人がゲームプログラム作成に挑戦

Imports System.Drawing.Imaging

Public Class FadeClass
　　Dim _img As Bitmap
　　Dim _att As ImageAttributes
　　Dim _mtx As ColorMatrix
　　Dim _m33 As Decimal
　　Dim _lasttime As Double
　　Dim _fmode As Boolean

　　Public Sub New(ByVal io As Boolean)
　　　　Dim g As Graphics
　　　　_fmode = io
　　　　_img = New Bitmap(640, 480)
　　　　g = Drawing.Graphics.FromImage(_img)
　　　　g.FillRectangle(Brushes.Black, New Rectangle(0, 0, 640, 480))
　　　　_att = New ImageAttributes
　　　　_mtx = New ColorMatrix
　　　　_mtx.Matrix00 = 1
　　　　_mtx.Matrix11 = 1
　　　　_mtx.Matrix22 = 1
　　　　_mtx.Matrix44 = 1
　　End Sub

　　Public Sub Update(ByVal nowTime As Double, ByVal elapsedTime As Double)
　　　　If _lasttime = 0 Then
　　　　　　If _fmode = False Then 'フェードアウト
　　　　　　　　_m33 = 0D '不透明
　　　　　　Else 'フェードイン
　　　　　　　　_m33 = 1D '透明
　　　　　　End If
　　　　　　_lasttime = nowTime
　　　　ElseIf nowTime - _lasttime > 0.1 Then
　　　　　　If _fmode = False Then 'フェードアウト
　　　　　　　　If _m33 < 1 Then
　　　　　　　　　　_m33 += 0.1D '不透明に
　　　　　　　　End If
　　　　　　Else 'フェードイン
　　　　　　　　If _m33 > 0 Then
　　　　　　　　　　_m33 -= 0.1D '透明に
　　　　　　　　End If
　　　　　　End If
　　　　　　_lasttime = nowTime
　　　　End If
　　　　_mtx.Matrix33 = _m33 'ColorMatrixの33行列に設定
　　　　_att.SetColorMatrix(_mtx)
　　End Sub

　　Public Sub Draw(ByVal g As Graphics)
　　　　g.DrawImage(_img, New Rectangle(0, 0, 640, 480), 0, 0, 640, 480, GraphicsUnit.Pixel, _att)
　　End Sub
End Class

Public Class Form1
　　Dim swatch As Stopwatch = New Stopwatch( ) 'ストップウォッチ
　　Dim lastTime As Double '前回実行時の時間
　　Dim fade As FadeClass 'フェードイン・フェードアウトオブジェクト変数
　　Dim sflg As Boolean 'フェードイン・フェードアウト開始フラグ
　　Dim fmode As Boolean 'フェードイン・フェードアウトのモード

　　Public Sub New( )
　　　　' この呼び出しは、Windows フォーム デザイナで必要です。
　　　　InitializeComponent( )
　　　　' InitializeComponent( ) 呼び出しの後で初期化を追加します。
　　　　Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.UserPaint Or ControlStyles.OptimizedDoubleBuffer, True)
　　　　Me.ClientSize = New Size(640, 480) 'クライアント領域を640×480に設定
　　　　Me.Init( )
　　End Sub

　　Sub Init( )
　　　　lastTime = 0.0
　　　　swatch.Reset( )
　　　　swatch.Start( )
　　End Sub

　　Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
　　　　Dim nowTime As Double = swatch.ElapsedMilliseconds / 1000.0 'Paintメソッドを実行した瞬間の時間
　　　　Dim elapsedTime As Double = nowTime - lastTime
　　　　lastTime = nowTime
　　　　'Update…変更処理
　　　　If sflg Then 'フェードイン・フェードアウト開始状態なら
　　　　　　fade.Update(nowTime, elapsedTime)
　　　　End If
　　　　'Draw…描画処理
　　　　If sflg Then 'フェードイン・フェードアウト開始状態なら
　　　　　　fade.Draw(e.Graphics)
　　　　End If
　　　　Me.Invalidate( ) 'Formの強制描画
　　End Sub

　　Private Sub Form1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
　　　　fade = New FadeClass(fmode) 'フェードイン・フェードアウトオブジェクトの生成
　　　　sflg = True
　　　　fmode = Not fmode 'モード切替
　　End Sub
End Class

Public Class MessageClass
　　…（省略）
　　Public Sub Draw(ByVal g As Graphics)
　　　　Dim dy As Integer = 0
　　　　If mflg = True Then
　　　　　　g.DrawImage(img, 0, 320)
　　　　　　g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
　　　　　　For i As Integer = 0 To dmsg.Count - 1
　　　　　　　　If i = dmsg.Count - 1 Then '最終行なら
　　　　　　　　　　g.DrawString(dmsg(i) & dmark, mfont, Brushes.White, 20, 342 + dy)
　　　　　　　　Else
　　　　　　　　　　g.DrawString(dmsg(i), mfont, Brushes.White, 20, 342 + dy)
　　　　　　　　End If
　　　　　　　　dy += 24
　　　　　　Next
　　　　End If
　　End Sub
　　…（省略）
End Class

Public Class MaptipClass
　　 Dim _tNo As Integer 'マップチップ番号
　　 Dim _mflg As Boolean '移動可否フラグ

　　 Public Sub New(ByVal t As Integer)
　　　　 _tNo = t
　　 End Sub

　　 Public Property TipNo( ) As Integer
　　　　 Get
　　　　　　　　Return _tNo
　　　　 End Get
　　　　 Set(ByVal value As Integer)
　　　　　　　　_tNo = value
　　　　 End Set
　　 End Property

　　 Public Property MoveFlg( ) As Boolean
　　　　 Get
　　　　　　　　Return _mflg
　　　　 End Get
　　　　 Set(ByVal value As Boolean)
　　　　　　　　_mflg = value
　　　　 End Set
　　 End Property
End Class

Public Class CharaClass
　　Enum Direction
　　　　down = 0 '前向き
　　　　up = 1 '後ろ向き
　　　　left = 2 '左向き
　　　　right = 3 '右向き
　　End Enum

　　Const ImgWidth As Integer = 32 '画像横幅
　　Const ImgHeight As Integer = 32 '画像縦幅
　　Const MoveSpd As Integer = 64 '移動速度
　　Dim img As Bitmap = New Bitmap(My.Resources.anime6) 'スプライト画像
　　Dim imgRect(,) As Rectangle '画像矩形配列
　　Dim iNo As Integer '表示画像インデックス
　　Dim direct As Direction
　　Dim position As Point '画像表示座標ブロック
　　Dim locate As PointF '画像表示座標
　　Dim destination As PointF '目的座標
　　Dim velocity As PointF '移動ベクトル
　　Dim MoveFlg As Boolean

　　Public Sub New(ByVal px As Integer, ByVal py As Integer)
　　　　imgRect = New Rectangle(3, 3) { }
　　　　For y As Integer = 0 To imgRect.GetUpperBound(0)
　　　　　　For x As Integer = 0 To imgRect.GetUpperBound(1)
　　　　　　　　imgRect(y, x) = New Rectangle(x * ImgWidth, y * ImgHeight, ImgWidth, ImgHeight)
　　　　　　Next
　　　　Next
　　　　iNo = 0
　　　　direct = Direction.down '前向き
　　　　position = New Point(px, py) '初期位置
　　　　locate = New PointF(position.X * ImgWidth, position.Y * ImgHeight)
　　　　destination = locate
　　　　velocity = New PointF(0, 0)
　　End Sub

　　Public Sub Update(ByVal nowTime As Double, ByVal elapsedTime As Double)
　　　　iNo = CInt(Fix((nowTime * 2) Mod 4.0F))
　　　　If MoveFlg Then
　　　　　　locate.X += velocity.X * CSng(elapsedTime)
　　　　　　locate.Y += velocity.Y * CSng(elapsedTime)
　　　　　　Select Case direct
　　　　　　　　Case Direction.up
　　　　　　　　　　If locate.Y <= destination.Y Then
　　　　　　　　　　　　position.Y -= 1
　　　　　　　　　　　　locate.Y = position.Y * ImgHeight
　　　　　　　　　　　　MoveFlg = False
　　　　　　　　　　End If
　　　　　　　　Case Direction.down
　　　　　　　　　　If locate.Y >= destination.Y Then
　　　　　　　　　　　　position.Y += 1
　　　　　　　　　　　　locate.Y = position.Y * ImgHeight
　　　　　　　　　　　　MoveFlg = False
　　　　　　　　　　End If
　　　　　　　　Case Direction.left
　　　　　　　　　　If locate.X <= destination.X Then
　　　　　　　　　　　　position.X -= 1
　　　　　　　　　　　　locate.X = position.X * ImgWidth
　　　　　　　　　　　　MoveFlg = False
　　　　　　　　　　End If
　　　　　　　　Case Direction.right
　　　　　　　　　　If locate.X >= destination.X Then
　　　　　　　　　　　　position.X += 1
　　　　　　　　　　　　locate.X = position.X * ImgWidth
　　　　　　　　　　　　MoveFlg = False
　　　　　　　　　　End If
　　　　　　End Select
　　　　End If
　　End Sub

　　Public Sub Draw(ByVal g As Graphics)
　　　　g.DrawImage(img, locate.X, locate.Y, imgRect(direct, iNo), GraphicsUnit.Pixel)
　　End Sub

　　Public Sub KeyDown(ByVal k As Keys, ByVal _map As MapClass)
　　　　If MoveFlg = False Then
　　　　　　Select Case k
　　　　　　　　Case Keys.Up
　　　　　　　　　　If _map.MapData(position.Y - 1, position.X).MoveFlg Then
　　　　　　　　　　　　direct = Direction.up
　　　　　　　　　　　　velocity = New PointF(0, -MoveSpd)
　　　　　　　　　　　　MoveFlg = True
　　　　　　　　　　End If
　　　　　　　　Case Keys.Down
　　　　　　　　　　If _map.MapData(position.Y + 1, position.X).MoveFlg Then
　　　　　　　　　　　　direct = Direction.down
　　　　　　　　　　　　velocity = New PointF(0, MoveSpd)
　　　　　　　　　　　　MoveFlg = True
　　　　　　　　　　End If
　　　　　　　　Case Keys.Left
　　　　　　　　　　If _map.MapData(position.Y, position.X - 1).MoveFlg Then
　　　　　　　　　　　　direct = Direction.left
　　　　　　　　　　　　velocity = New PointF(-MoveSpd, 0)
　　　　　　　　　　　　MoveFlg = True
　　　　　　　　　　End If
　　　　　　　　Case Keys.Right
　　　　　　　　　　If _map.MapData(position.Y, position.X + 1).MoveFlg Then
　　　　　　　　　　　　direct = Direction.right
　　　　　　　　　　　　velocity = New PointF(MoveSpd, 0)
　　　　　　　　　　　　MoveFlg = True
　　　　　　　　　　End If
　　　　　　End Select
　　　　　　destination = New PointF(locate.X + velocity.X / 2, locate.Y + velocity.Y / 2)

　　　　　　If destination.X < 0 OrElse destination.X > 640 - ImgWidth _
　　　　　　　　OrElse destination.Y < 0 OrElse destination.Y > 480 - ImgHeight Then
　　　　　　　　velocity = New Point(0, 0)
　　　　　　　　MoveFlg = False
　　　　　　End If
　　　　End If
　　End Sub
End Class

Imports System.IO
Imports System.Text

Public Class MapClass
　　Const TipSize As Integer = 32
　　Public MapData(,) As MaptipClass
　　Dim _MapImg As Bitmap
　　Dim _MapRect( ) As Rectangle
　　Dim _xCnt, _yCnt As Integer 'マップチップの数（行数・列数）

　　Public Sub New( )
　　　　Dim sr As StreamReader = New StreamReader("data\mapfile.txt")
　　　　Dim buffer As String = "" '1行分のデータ
　　　　Dim dlist As List(Of String) = New List(Of String) '読み込んだデータのリスト
　　　　Dim dtip( ) As String '1マス分のチップ番号配列
　　　　Dim r As Integer '読み込み開始行

　　　　_xCnt = 19 'Xマス数
　　　　_yCnt = 14 'Yマス数
　　　　MapData = New MaptipClass(_yCnt, _xCnt) { }
　　　　_MapImg = New Bitmap(My.Resources.map) '画像の読み込み

　　　　buffer = sr.ReadLine
　　　　Do Until buffer Is Nothing
　　　　　　dlist.Add(buffer)
　　　　　　buffer = sr.ReadLine
　　　　Loop

　　　　r = dlist.IndexOf("::マップデータ") + 1 'ここからマップチップ配列を作成
　　　　For y As Integer = r To r + _yCnt
　　　　　　dtip = dlist(y).Split(",")
　　　　　　For x As Integer = 0 To _xCnt
　　　　　　　　MapData(y - r, x) = New MaptipClass(dtip(x))
　　　　　　Next
　　　　Next
　　　　r = dlist.IndexOf("::移動可否") + 1 'ここから移動可否配列を作成
　　　　For y As Integer = r To r + _yCnt
　　　　　　dtip = dlist(y).Split(",")
　　　　　　For x As Integer = 0 To _xCnt
　　　　　　　　MapData(y - r, x).MoveFlg = dtip(x)
　　　　　　Next
　　　　Next
　　　　Me.MakeRect( ) '画像矩形の作成メソッド呼び出し
　　End Sub

　　Sub MakeRect( )
　　　　Dim i As Integer = 0
　　　　_MapRect = New Rectangle(5) { }
　　　　For y As Integer = 0 To 1
　　　　　　For x As Integer = 0 To 2
　　　　　　　　_MapRect(i) = New Rectangle(x * TipSize, y * TipSize, TipSize, TipSize)
　　　　　　　　i += 1
　　　　　　Next
　　　　Next
　　End Sub

　　Public Sub Draw(ByVal g As Graphics)
　　　　For y As Integer = 0 To MapData.GetUpperBound(0)
　　　　　　For x As Integer = 0 To MapData.GetUpperBound(1)
　　　　　　　　g.DrawImage(_MapImg, x * TipSize, y * TipSize, _MapRect(MapData(y, x).TipNo), GraphicsUnit.Pixel)
　　　　　　Next
　　　　Next
　　End Sub
End Class