【VB】ペントミノ２Ｄパズルを解く（８）フォームのコード

やっと Form1 のコードです。VB.Net はコントロールやイベントを他の言語に比べて簡単に使えます。呪文のような "FindViewById" とも無縁なところが筆者は気に入っています。

・クラス宣言

IDEのソリューションエクスプローラで Form1 を右クリックして "コードの表示" で自動表示されるので気にも留めませんが、クラスの名前は "Form1" です。

Public Class Form1

・State プロパティ (状態遷移)

コントロールの状態はプロパティ(State)で管理します。値を変更すると個々のコントロールの Enabled や Visible プロパティを一括して変更できるようにしています。

状態	値	入力関係のコントロール	プログレスバーとキャンセルボタン
フォーム入力時	1	Enabled = True	Visible = False
探索作業中	2	Enabled = False	Visible = True

Dim _State As Integer = 0

Public Property State As Integer
   Get
      Return _State
   End Get
   Set(value As Integer)
      _State = value
      Dim STS() As Boolean = {value = 0, value = 1, value = 2}
      With Me
         .GroupBox1.Enabled = STS(1)
         .cbx_都度確認あり.Enabled = STS(1)
         .探索開始ボタン.Enabled = STS(1)
         .ProgressBar1.Visible = STS(2)
         .キャンセルボタン.Visible = STS(2)
      End With
   End Set
End Property

'===== 例 =====
State = 1     '入力関係のコントロールは活性化、プログレスバーとキャンセルボタンは非表示にします

・フォームを開くとき

フォームのイベントは Load です。各コントロールの初期値をセットして State プロパティを 1 にします。

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
   With Me
      .rbt_10x6.Checked = True
      .State = 1
   End With
End Sub

・フォームを閉じるとき

フォームのイベントは FormClosing です。State プロパティが 2 のときは、探索作業中にキャンセルボタンを押したりしてここに来たことが考えられるので「中止しますか？」とユーザーに確認します。State プロパティが 1 のときはそのままクローズします。

Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
   If Me.State = 2 Then
      If MsgBox("中止しますか？", MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
         DEF.CancelFlag = True
      End If
      e.Cancel = True
   End If
End Sub

・キャンセルボタンを押したとき

フォームのイベントは Click です。キャンセルボタンを押したときにいきなり「中止しますか？」と確認してはいけません。フォーム右上の［×］やタスクバーで閉じる場合もあるので、キャンセルボタンではフォームを閉じるイベントを発生させて、他の閉じる機能と同じように「フォームを閉じるとき」に管理を任せるべきです。

Private Sub キャンセルボタン_Click(sender As Object, e As EventArgs) Handles キャンセルボタン.Click
   Me.Close()
End Sub

・探索開始ボタンを押したとき

ここからがパズルを解く部分です。

Private Sub 探索開始ボタン_Click(sender As Object, e As EventArgs) Handles 探索開始ボタン.Click

'(1) State変更と DEF.CancelFlag の準備
     Me.State = 2
     DEF.CancelFlag = False

'(2) ボードの用意
     Dim board As Board
     Select Case True
        Case rbt_10x6.Checked
           board = New Board(10, 6)
        Case rbt_12x5.Checked
           board = New Board(12, 5)
        Case rbt_15x4.Checked
           board = New Board(15, 4)
        Case Else
           board = New Board(20, 3)
     End Select
     リストビュー初期化(board)

'(3) 部品棚を作成
     Dim shelves = New List(Of Shelf)
     DEF.部品棚作成(shelves)

'(4) プログレスバーを初期化
     With Me.ProgressBar1
        .Maximum = shelves.Sum(Function(s) s.Pieces.Count)
        .Minimum = 0
        .Value = 0
     End With

'(6) 探索実行
     Dim startTime = Now
     DEF.SolutionNo = 0
     board.Solution = New List(Of Placement)
     nextSearch(board, shelves, New Coord(0, 0))
     Dim endTime = Now

'(7) 結果表示と終了
     If Not DEF.CancelFlag Then
        With ProgressBar1
           .Value = .Maximum
        End With
        MsgBox("探索終了" & vbCrLf & vbCrLf & DEF.経過時間(startTime, endTime))
     End If
     Me.State = 1
     Me.Close()

End Sub

(1) State変更と DEF.CancelFlag の準備

State を 2 に変更してコントロールのプロパティを「探索作業中」モードに切り替えます。同時に DEF.CancelFlag に初期値を与えて準備します。

(2) ボードの用意

ラジオボタンの選択にしたがってボードのサイズを設定し、リストビューを初期化します（別メソッド）。

(3) 部品棚を作成

インスタンス作成後、DEFクラスのメソッドで部品棚を作成します。

(4) プログレスバーを初期化

部品棚の中の部品数は合計57個あります。それを Maximum にして Value は探索中の部品がコレクション全体の何番目であるかを示すことにしました（Value の計算は後述）。

(5) 探索実行

ここがメインです。DEF.SolutionNo は解のカウンターです。探索の本体は nextSearch メソッドです（後述）。前後に経過時間を測るために時刻の取得を挟みます。

(6) 結果表示と終了

途中でキャンセルしなければ終了メッセージを表示し、ユーザー確認後フォームを閉じます。途中キャンセルのときはメッセージを表示しないでそのままフォームを閉じます。

・メソッド：nextSearch（再帰）

「探索開始ボタン_Click」から呼ばれる探索の本体部分です。指定の座標位置以降で部品を置くことができる場所を探します。部品が置けたら完成を判定、すべての部品が置けたらパズルの完成です。そうでなければ再帰して次に置く部品を探します。置いた部品数は board.PlacedPieceCount にカウントされます。解は Shelves の各 Shelf 内の PlacedPiece と PlacedCoord に記録しているので完成したものはここからリストビューに表示させます。

Private Sub nextSearch(board As Board, shelves As List(Of Shelf), coord As Coord)

   If board.PlacedPieceCount = 1 Then
      プログレスバー表示(board.PlacedFirstPiece, shelves)
   End If
   Application.DoEvents()
   If DEF.CancelFlag Then
      Exit Sub
   End If

   coord = board.nextBlankCell(coord)

   For Each shelf In shelves
      If shelf.PlacedPiece Is Nothing Then
         For Each piece In shelf.Pieces
            If board.canPlace(piece, coord) Then
               shelf.PlacedPiece = piece
               shelf.PlacedCoord = coord
               board.placePiece(shelf)

               '完成判定
               If board.PlacedPieceCount = shelves.Count Then
                  DEF.SolutionNo += 1
                  リストビュー完成表示(board, shelves)
               Else
                  nextSearch(board, shelves, coord)       '再帰
               End If

               board.removePiece(shelf)
               shelf.PlacedPiece = Nothing
               shelf.PlacedCoord = Nothing
            End If
         Next
      End If
   Next

End Sub

・メソッド：リストビュー初期化

解を表示するリストビューを整形します。列数は解Noの表示用に1列余分に取ります。列幅は解No用の列は普通ですが、残りはセルが正方形に見えるように狭く(30px)しています。行数は盤面の行数と同じです。UserItemStyleForSubitems プロパティは False にするとセルごとに背景色を変更できるのでこのプログラムでは必須の設定です。

Private Sub リストビュー初期化(board As Board)
   With LV1
      .View = View.Details
      .Font = New Font(.Font.Name, 18)
      .Clear()
      '列追加
      .Columns.Add("", 70)    '解Noの表示列
      For Col = 0 To board.Width - 1
         .Columns.Add("", 30)
      Next
      'フォームの横幅変更
      Me.Width = board.Width * 30 + 200    '200はおおよその数値
      '行追加
      For Row = 0 To board.Height - 1
         .Items.Add("")
         .Items(Row).UseItemStyleForSubItems = False
         For Col = 0 To board.Width - 1
            .Items(Row).SubItems.Add("")
         Next
      Next
      .Refresh()
   End With
End Sub

・メソッド：リストビュー完成表示

完成した解をリストビューに表示するメソッドです。解は shelves の各Shelf にあるのでそれをリストビューに転記します。［都度確認あり］のときは「都度確認メソッド」を実行します。

Private Sub リストビュー完成表示(board As Board, shelves As List(Of Shelf))
   With LV1
      .Items(0).SubItems(0).Text = CStr(DEF.SolutionNo)
      For Each shelf In shelves
         Dim piece = shelf.PlacedPiece
         For i = 0 To piece.Size - 1
            Dim Col = shelf.PlacedCoord.X + piece.Coords(i).X + 1
            Dim Row = shelf.PlacedCoord.Y + piece.Coords(i).Y
            With .Items(Row).SubItems(Col)
               .Text = shelf.Name
               .BackColor = shelf.Color
               .ForeColor = Color.White
            End With
         Next
      Next
      '.Refresh()
      If cbx_都度確認あり.Checked Then
         都度確認()
      End If
   End With
End Sub

・メソッド：都度確認

都度確認の継続とプログラムのキャンセルを訊くようにしています。

Private Sub 都度確認()
   Dim result = MsgBox("完成！！ (" & DEF.SolutionNo & ")" & vbCrLf & vbCrLf &
                       "都度確認を続けますか？", vbYesNoCancel)
   Select Case result
      Case vbYes
            'Continue
      Case vbNo
         cbx_都度確認あり.Checked = False
      Case vbCancel
         キャンセルボタン.PerformClick()
   End Select
End Sub

・メソッド：プログレスバー表示

プログレスバーの値(Value)の計算は、解の最初の部品（board.PlacedFirstPiece）が部品棚のすべての部品の何番目になるのかを計算しています。

Private Sub プログレスバー表示(piece As Piece, shelves As List(Of Shelf))
   Dim val = 0
   For Each shelf In shelves
      If shelf.Pieces.Contains(piece) Then
         val += shelf.Pieces.IndexOf(piece) + 1
         Exit For
      Else
         val += shelf.Pieces.Count
      End If
   Next
   Me.ProgressBar1.Value = val
End Sub

以上でクラスからフォームまで、すべてのコードを作り終えました。
実際にプログラムを動かして確認してください。

Imports System.Reflection

Public Class Form1
   'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
   'Z
   'Z                Ｆｏｒｍ１
   'Z
   'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
#Region "State(状態遷移)"

   Dim _State As Integer = 0

   Public Property State As Integer
      Get
         Return _State
      End Get
      Set(value As Integer)
         _State = value
         Dim STS() As Boolean = {value = 0, value = 1, value = 2}
         With Me
            .GroupBox1.Enabled = STS(1)
            .cbx_都度確認あり.Enabled = STS(1)
            .探索開始ボタン.Enabled = STS(1)
            .ProgressBar1.Visible = STS(2)
            .キャンセルボタン.Visible = STS(2)
         End With
      End Set
   End Property

#End Region

   '****************************************
   '*          フォームを開くとき
   '****************************************
   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
      EnableDoubleBuffering(LV1)
      With Me
         .rbt_10x6.Checked = True
         .State = 1
      End With
   End Sub

   Public Shared Sub EnableDoubleBuffering(control As Control)
      control.GetType().InvokeMember(
        "DoubleBuffered",
        BindingFlags.NonPublic Or BindingFlags.Instance Or BindingFlags.SetProperty,
        Nothing,
        control,
        New Object() {True})
   End Sub

   '****************************************
   '*         フォームを閉じるとき
   '****************************************
   Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
      If Me.State = 2 Then
         If MsgBox("中止しますか？", MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
            DEF.CancelFlag = True
         End If
         e.Cancel = True
      End If
   End Sub

   Private Sub キャンセルボタン_Click(sender As Object, e As EventArgs) Handles キャンセルボタン.Click
      Me.Close()
   End Sub

   '****************************************
   '*      探索開始ボタンをクリック
   '****************************************
   Private Sub 探索開始ボタン_Click(sender As Object, e As EventArgs) Handles 探索開始ボタン.Click

      Me.State = 2

      DEF.CancelFlag = False

      Dim board As Board
      Select Case True
         Case rbt_10x6.Checked
            board = New Board(10, 6)
         Case rbt_12x5.Checked
            board = New Board(12, 5)
         Case rbt_15x4.Checked
            board = New Board(15, 4)
         Case Else
            board = New Board(20, 3)
      End Select
      リストビュー初期化(board)

      Dim shelves = New List(Of Shelf)
      DEF.部品棚作成(shelves)

      With Me.ProgressBar1
         .Maximum = shelves.Sum(Function(s) s.Pieces.Count)
         .Minimum = 0
         .Value = 0
      End With

      Dim startTime = Now
      DEF.SolutionNo = 0
      nextSearch(board, shelves, New Coord(0, 0))
      Dim endTime = Now

      If Not DEF.CancelFlag Then
         With ProgressBar1
            .Value = .Maximum
         End With
         MsgBox("探索終了" & vbCrLf & vbCrLf & DEF.経過時間(startTime, endTime))
      End If

      Me.State = 1
      Me.Close()

   End Sub

   '****************************
   '*        nextSearch           次を探す(再帰)
   '****************************
   Private Sub nextSearch(board As Board, shelves As List(Of Shelf), coord As Coord)

      If board.PlacedPieceCount = 1 Then
         プログレスバー表示(board.PlacedFirstPiece, shelves)
      End If
      Application.DoEvents()
      If DEF.CancelFlag Then
         Exit Sub
      End If

      coord = board.nextBlankCell(coord)

      For Each shelf In shelves
         If shelf.PlacedPiece Is Nothing Then
            For Each piece In shelf.Pieces
               If board.canPlace(piece, coord) Then
                  shelf.PlacedPiece = piece
                  shelf.PlacedCoord = coord
                  board.placePiece(shelf)

                  '完成判定
                  If board.PlacedPieceCount = shelves.Count Then
                     DEF.SolutionNo += 1
                     リストビュー完成表示(board, shelves)
                  Else
                     nextSearch(board, shelves, coord)       '再帰
                  End If

                  board.removePiece(shelf)
                  shelf.PlacedPiece = Nothing
                  shelf.PlacedCoord = Nothing
               End If
            Next
         End If
      Next

   End Sub

   '****************************
   '*     リストビュー関係
   '****************************
   Private Sub リストビュー初期化(board As Board)
      With LV1
         .View = View.Details
         .Font = New Font(.Font.Name, 18)
         .Clear()
         '列追加
         .Columns.Add("", 70)
         For Col = 0 To board.Width - 1
            .Columns.Add("", 30)
         Next
         'フォームの横幅変更
         Me.Width = board.Width * 30 + 200
         '行追加
         For Row = 0 To board.Height - 1
            .Items.Add("")
            .Items(Row).UseItemStyleForSubItems = False
            For Col = 0 To board.Width - 1
               .Items(Row).SubItems.Add("")
            Next
         Next
         .Refresh()
      End With
   End Sub

   Private Sub リストビュー完成表示(board As Board, shelves As List(Of Shelf))
      With LV1
         .Items(0).SubItems(0).Text = CStr(DEF.SolutionNo)
         For Each shelf In shelves
            Dim piece = shelf.PlacedPiece
            For i = 0 To piece.Size - 1
               Dim Col = shelf.PlacedCoord.X + piece.Coords(i).X + 1
               Dim Row = shelf.PlacedCoord.Y + piece.Coords(i).Y
               With .Items(Row).SubItems(Col)
                  .Text = shelf.Name
                  .BackColor = shelf.Color
                  .ForeColor = Color.White
               End With
            Next
         Next
         '.Refresh()
         If cbx_都度確認あり.Checked Then
            都度確認()
         End If
      End With
   End Sub

   Private Sub 都度確認()
      Dim result = MsgBox("完成！！ (" & DEF.SolutionNo & ")" & vbCrLf & vbCrLf &
                          "都度確認を続けますか？", vbYesNoCancel)
      Select Case result
         Case vbYes
               'Continue
         Case vbNo
            cbx_都度確認あり.Checked = False
         Case vbCancel
            キャンセルボタン.PerformClick()
      End Select
   End Sub

   Private Sub プログレスバー表示(piece As Piece, shelves As List(Of Shelf))
      Dim val = 0
      For Each shelf In shelves
         If shelf.Pieces.Contains(piece) Then
            val += shelf.Pieces.IndexOf(piece) + 1
            Exit For
         Else
            val += shelf.Pieces.Count
         End If
      Next
      Me.ProgressBar1.Value = val
   End Sub

End Class