プログラムの概要
其の昔、一世を風靡し世界中に愛好家 の居るパズルゲーム『倉庫番』で有る。 荷物（蛸）を押して（引く事は出来な い）、所定の場所（壺）に納める単純明 快な物で有る。 猶、一度クリアした面は、自由に再度 プレイする事が出来るが、新たな面に は、前の面をクリアしないと進む事は 出来ない。 一般的に、実用プログラムに比較する とゲームプログラムは、高度なテクニ ックを要求される事が多い。 此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を 目的として居る。 制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。 此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。倉庫番
VB 2005 ○63 □ アプリケーション画面のデザイン（標準コントロールの利用） □ プログラムの動作原理（イベント駆動型のプログラム） □ プログラムの構成要素（オブジェクトとプロパティ） □ 値の代入（変数、オブジェクトのプロパティ） □ グラフィックスの利用（Graphics オブジェクト） □ 条件に応じた処理（If 文の利用） □ 自動的に行われる処理（タイマーの利用） 今回の課題項目（リストボックスの下に、ボタン2 個とラベル 1 個が有る） コントロールの種類 プロパティ プロパティの設定値 フォーム Name sokoban FormBorderStyle FixedSingle MaximizeBox False Size 975, 674 StartPosition CenterScreen Text 倉庫番 ピクチャボックス１ Name picStage BackColor Black Size 1601, 1601
オ
オ
ブ
ブ
ジ
ジ
ェ
ェ
ク
ク
ト
ト
・
・
プ
プ
ロ
ロ
パ
パ
テ
テ
ィ
ィ
一
一
覧
覧
ピクチャボックス１ ピクチャボックス２ ラベル１ パネル テキストボックス ボタン１ ボタン２ ボタン３ リストボックス セーブファイルダイアログ オープンファイルダイアログコントロールの種類 プロパティ プロパティの設定値 パネル Name pnlMenu BackColor White Location 643, 3 Size 325, 349 ピクチャボックス２ Name picLogo Image sokoban.gif テキストボックス Name txtStage Font ＭＳ 明朝、１２、太字 ReadOnly True TextAlign Center ボタン１ Name cmdStage Image combo.gif Text 空白 ボタン２ Name btnMove0 Enabled False Image ARW01LT.ICO Text 空白 ボタン３ Name btnMove1 Enabled False Image ARW01RT.ICO Text 空白 ラベル１ Name lblStage AutoSize False BorderStyle FixedSingle Font ＭＳ 明朝、１６、太字 Text 第100 面 TextAlign MiddleCenter リストボックス Name lstStage Font ＭＳ 明朝、１２、標準 オープンファイルダイアログ Name cdlLoadOpen DefaultExt txt Filter データファイル(*.txt)|*.txt| 総てのファイル(*.*)|*.* Title 任意ステージの読込 セーブファイルダイアログ Name cdlFileSave DefaultExt txt Filter データファイル(*.txt)|*.txt| 総てのファイル(*.*)|*.* Title 倉庫番ステージデータの保存
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
プ
' ステージグループ番号の取得 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 End If ' コンボボックス（ステージグループ）の設定 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 End If Next J Next 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 End If Next I If lstStage.SelectedIndex < 0 Then lstStage.SelectedIndex = 0 SG = Integer.Parse(lstStage.SelectedItem.ToString()) End If Call SetCombo() ' ゲームの初期化 InitFlag = False Call GameInit() End Sub ' フォームが閉じられ様と仕た時の処理
Private Sub sokoban_FormClosing(ByVal sender As Object, _
Dim F As String = SD & "screen.tmp" If File.Exists(F) Then File.Delete(F) End Sub
' ボタン（コンボボックス）がクリックされた時の処理
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 End If picStage.Focus() End Sub ' リストボックス（ステージグループ）がクリックされた時の処理
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() End Sub ' キー入力が為された時の処理
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
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 End If Case Keys.F1 ' メニューの表示・非表示 If pnlMenu.Visible Then pnlMenu.Visible = False Else pnlMenu.Visible = True End If 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) End If
If BD(X2, Y2) = 2 Then Gb.DrawImage(Bm(5), X2 * 32, Y2 * 32) Else Gb.DrawImage(Bm(7), X2 * 32, Y2 * 32) End If Px += Dx : Py += Dy Gf.Clear(Color.Transparent) Gf.DrawImage(Bm(Dr), Px * 32, Py * 32) Call ScrollStage(Dr) End If 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 End If
End If Next Next
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 End If
lblStage.Text = "第" & ST.ToString() & "面" Call DispStage()
If ST > 1 Then btnMove0.Enabled = True End If
End Sub
' コンボボックス風リストを設定するジェネラルプロシージャ 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 End If Loop Sr.Close() End Using
txtStage.Text = lstStage.SelectedItem.ToString() & S End Sub
' ゲームを初期化するジェネラルプロシージャ 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 End If
Using Br As BinaryReader = _
New BinaryReader(File.Open(F, FileMode.Open, FileAccess.Read)) Try For I As Integer = 0 To SG CL = Br.ReadInt32() Next 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()
End Using End If ST = CL
lblStage.Text = "第" & ST.ToString() & "面" ' ステージ移動の設定 If CL > 1 Then btnMove0.Enabled = True Else btnMove0.Enabled = False End If ' ゲームの開始 Call DispStage() Me.KeyPreview = True GameFlag = True End Sub ' ステージを表示するジェネラルプロシージャ
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 End If
If Not File.Exists(F) Then MessageBox.Show( _
"Not Exist!!", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If 'データの読込と画面の描画 For I As Integer = 0 To 49 For J As Integer = 0 To 49 BD(I, J) = 0 Next Next
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
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 Next R += 1 Loop Sr.Close() End Using picStage.Refresh()
lblStage.Text = "第" & ST.ToString() & "面" End Sub
' 画面をスクロールするジェネラルプロシージャ 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 End If Case 0 ' 下 If Py > Sy + 14 AndAlso Py < 45 Then Sy += 1 : picStage.Top = -Sy * 32 End If Case 2 ' 右 If Px > Sx + 24 AndAlso Px < 45 Then Sx += 1 : picStage.Left = -Sx * 32 End If Case 3 ' 左 If Px > 4 AndAlso Px < Sx + 5 Then Sx -= 1 : picStage.Left = -Sx * 32 End If
End Select End Sub
' 解答を求めるジェネラルプロシージャ（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 Next T = T.Trim() Sw.WriteLine(T) Loop Sw.Close() End Using Sr.Close() End Using
Shell(SD & "", AppWinStyle.NormalFocus) End Sub
