トップ > 逆引きで学ぶ ユーザーフォーム&コントロール > 追加章 遊ぶ!楽しむ!ユーザーフォーム > T-09 数当てゲーム「ヒット・アンド・ブロー」を作る!

T-09 数当てゲーム「ヒット・アンド・ブロー」を作る!2022.05.09

次の書籍の第1章~5章を公開しています。
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」

目次  前頁   次頁  索引

今回は、ユーザーフォームで数当てゲームのヒット・アンド・ブローを作ります。
Wikipedia:マスターマインド

このゲームはルールが簡潔で、またユーザーのボタン操作に伴い処理を実行する仕組みのため、フォームで作りやすいゲームです。


【ルール】
ランダムに決められた4桁の数を当てます。
重複する数字は使われていません。
10回のチャレンジ中で数字をあてると成功です。

ユーザーが操作パネルから数字を4つ選び「入力完了」ボタンを押すと、数字がチェックされ結果が[Hit数]-[Blow数]で表示されます。その結果から数を推測します。
Hit・・・数字は含まれ桁の位置も同じ
Blow・・・数字は含まれるが桁の位置は異なる

【動画】


このような動作の実現にはいくつかの方法が考えられますが、最も簡単だと思われる方法で実装します。

サンプルファイル ダウンロード


準備 1

ユーザーフォームを挿入し、次のコントロールを追加します。

■Labelコントロール
 役割:見出し・説明表示
 オブジェクト名:Label1
 個数:1


■Labelコントロール
 役割:操作パネル
 オブジェクト名:FCells_(行番号)_(列番号)
 個数:12
 幅:30(ポイント)
 高さ:30(ポイント)
 BackColor:&H00FFFFFF&
 BackStyle:1 - fmBackStyleOpaque
 BorderStyle:1 - fmBorderStyleSingle
 Font:サイズ 数字:20 テキスト:10
 TextAlign:2 - fmTextAlignCenter


※Labelコントロールのテキスト垂直位置設定
TextAlignプロパティは、ラベルの水平位置(左揃え・中央揃え・右揃え)を設定するプロパティです。ラベルには垂直位置(上下中央揃え)を設定するプロパティはありませんが、少しの工夫で実現可能です。
1.Pictureプロパティに透明gif画像を設定
2.PicturePositionプロパティを「12 - fmPicturePositionCenter」に設定
これでラベルの中心にテキストが配置されます。
操作パネルの「Clear」に、この設定をしています。

透明gif画像サンプル ダウンロード


■Labelコントロール
 役割:イベント感知用 (操作パネル全体に重なるように被せます)
 オブジェクト名:Label_Main
 個数:1
 幅:90
 高さ:120
 BackStyle:0 - fmBackStyleTransparent
 BorderStyle:0 - fmBorderStyleNone


■Labelコントロール
 役割:数値入力用
 オブジェクト名:Number0~9
 個数:10
 幅:42
 高さ:18
 BackStyle:1 - fmBackStyleOpaque
 BackColor:Number0:&H00C0FFFF& Number1~9:&H8000000F&
 BorderStyle:1 - fmBorderStyleSingle


■Labelコントロール
 役割:Hit-Blow結果表示用
 オブジェクト名:Result0~9
 個数:10
 幅:42
 高さ:18
 Caption:-
 BackStyle:1 - fmBackStyleOpaque
 BackColor:&H8000000F&
 BorderStyle:0 - fmBorderStyleNone


■CommandButtonコントロール
 役割:数字チェックトリガー
 オブジェクト名:CommandButton1
 個数:1


準備 2

格子状に配置したLabelコントロールにオブジェクト名を設定します。
後の処理がしやすいように、名前に行列番号を入れておきます。
※マクロでまとめてオブジェクト名を設定する方法はこちらをご覧ください
【例】FCells_2_3 共通ベース名:「FCells_」 行番号:2 列番号:3


イベント感知用のLabelコントロールを一番手前にします。
感知用Labelが一番手前でない場合は、感知用Labelを選択した状態で、メニューバーの「書式」→「順序」→「最前面へ移動」を選択します。


サンプルコード

フォームモジュールに記述します。

'フォーム上にセルに見立てたラベルを格子状に配置しています
'そのラベル群を便宜上フォームセルと呼びます
Option Explicit

'定数
Private Const FCW As Single = 30 'フォーム上のセル幅
Private Const FCH As Single = 30 'フォーム上のセル高さ
Private Const FCN As String = "FCells_" 'フォーム上のセルのベース名

'変数
Private strNumber  As String '4桁ランダム数値
Private sinTimer   As Single '開始時間格納用
Private lngInputC  As Long   '入力回数
Private strAddress As String '色変更セルアドレス

'■ラベルイベント(Label_Main) '+++ Clickイベント +++ Private Sub Label_Main_Click() If strAddress = "" Then Exit Sub Dim strValue As String strValue = Controls(strAddress).Caption With Controls("Number" & lngInputC) If Left$(strValue, 1) = "C" Then 'クリア .Caption = "" ElseIf Left$(strValue, 1) = "B" Then 'バックスペース If .Caption = "" Then Exit Sub .Caption = Left$(.Caption, Len(.Caption) - 1) Else If Len(.Caption) = 4 Then Exit Sub '4つ以上の入力回避 If 0 < InStr(1, .Caption, strValue) Then '同じ数字チェック MsgBox "同じ数字は2回使用できません", vbInformation Exit Sub End If .Caption = .Caption & strValue End If End With End Sub
'+++ MouseMoveイベント +++ Private Sub Label_Main_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) If strAddress <> "" Then Controls(strAddress).BackColor = &HFFFFFF Dim strRow As String Dim strColumn As String strRow = CStr((Y \ FCH) + 1) 'マウス位置よりフォームセルの行を取得 strColumn = CStr((X \ FCW) + 1) 'マウス位置よりフォームセルの列を取得 strAddress = FCN & strRow & "_" & strColumn Controls(strAddress).BackColor = &HC0FFFF 'セルの色を変更 End Sub
'■フォームイベント(UserForm) '+++ Initializeイベント +++ Private Sub UserForm_Initialize() Dim c As Long Dim n As Long Dim bolN(9) As Boolean Randomize Do '重複のないランダムな4桁を生成 n = Int(Rnd() * 10) If Not bolN(n) Then bolN(n) = True strNumber = strNumber & CStr(n) c = c + 1 If c = 4 Then Exit Do End If Loop sinTimer = Timer '開始時間格納 End Sub
'+++ MouseMoveイベント +++ Private Sub UserForm_MouseMove(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, _ ByVal Y As Single) If strAddress <> "" Then Controls(strAddress).BackColor = &HFFFFFF strAddress = "" End If End Sub
'■コマンドボタンイベント(CommandButton1) '+++ Clickイベント +++ Private Sub CommandButton1_Click() With Controls("Number" & lngInputC) If Len(.Caption) <> 4 Then MsgBox "数字を4つ選択してください", vbInformation: Exit Sub End If .BackColor = &H8000000F If .Caption = strNumber Then '正解 Dim strTime As String strTime = CStr(Int((Timer - sinTimer) * 100) / 100) MsgBox "おめでとう!!" & vbLf & "所用時間:" & strTime & "秒", _ vbInformation, "正解" GoTo FIN End If Controls("Result" & lngInputC).Caption = Hit_Blow(strNumber, .Caption) End With lngInputC = lngInputC + 1 If lngInputC = 10 Then MsgBox "残念・・・" & vbLf & "正解は" & strNumber, vbExclamation, "OUT" GoTo FIN End If Controls("Number" & lngInputC).BackColor = &HC0FFFF Exit Sub FIN: Unload Me End Sub
'■関数 '+++ hit-blow関数 +++++++++++ 'hitとblowを文字列で返す '【引数】 ' n1:比較元ナンバー ' n2:ユーザー入力ナンバー '++++++++++++++++++++++++++++ Private Function Hit_Blow(ByVal n1 As String, ByVal n2 As String) As String Dim i As Long Dim lngHit As Long Dim lngBlow As Long For i = 1 To Len(n2) If InStr(1, n1, Mid$(n2, i, 1)) = i Then '桁の位置・数字ともに同じ lngHit = lngHit + 1 ElseIf 0 < InStr(1, n1, Mid$(n2, i, 1)) Then '数字は含まれる lngBlow = lngBlow + 1 End If Next Hit_Blow = CStr(lngHit) & "-" & CStr(lngBlow) End Function

簡単な解説

イベント感知用のLabelコントロールを、格子状のフォームセル(操作パネル)にぴったりと被せ、処理を実行しています。
LabelコントロールのMouseMoveイベントは、そのラベル上のX位置・Y位置を取得できるため、その位置によりラベル下のセルを特定しています。

フォームセルの名前に行列番号を入れることで、処理の簡素化を図っています。
フォームセルの色が変更された状態で、マウスポインタがLabelコントロール以外に移動する場合に備え、フォームのMouseMoveイベントにも色を戻す処理を加えています。

■フォーム構成
フォームで使用しているコントロールは、1つのCommadnButton以外はLabelコントロールです。
操作パネルにあたる格子状に配置した12個のLabelに被せるイベント感知用のLabelが、ユーザー操作を受け取ります。


■イベント
【ラベル】Label_Main
MouseMoveイベント
MouseMoveイベントで、疑似セルの行列を取得し変数strAddressに該当コントロール名として格納しています。
Clickイベント
Clickイベントでは、変数strAddressでコントロールを指定し、Caption(見出し)を取得しています。取得した値を元に、入力欄(Number0~9)への数字の追加や削除を行い、また数字の場合は重複チェックも行っています。

【フォーム】UserForm
Initializeイベント
Initializeイベントでは、重複のないランダムの4桁の数を生成しています。あわせて開始時間を格納しています。
MouseMoveイベント
MouseMoveイベントは、操作パネルで色が変更されていた場合、白に戻します。

【コマンドボタン】CommandButton1
Clickイベント
入力欄の数字をチェックし、結果欄(Result0~9)への表示や、正解・失敗の場合のメッセージ表示を行います。

■関数
数字のチェックはオリジナル関数Hit_Blowで行っています。
引数n2の数字を先頭から1つずつ順に取り出し、引数n1に含まれるか、含まれる場合に位置は一致するかを確認しています。
含まれて位置が一致する場合は、lngHitに加算し、含まれて位置が一致しない場合はlngBlowに加算します。
戻り値は、lngHitとlngBlowをハイフンで繋げ文字列で返しています。


書籍紹介140以上のサンプルファイル付き!

知りたいがすぐわかる! やりたいがすぐできる!
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」(Kindle版)
ユーザーフォームを扱えると、VBAでできることが大きく広がります!
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。

■ 購入:amazon

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.