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