数独で３×３のセルが取得できない

VB.NETで数独を作成させてもらっています。
現在の悩みは下記のとおりです。
・数独でフォーカスのあるセルが所属する３×３のグループに着色
・そのメソッドを利用して入力値の被りがないかをチェックしたい

作成している数独の画像を添付します。

現在は{0,0}の座標にフォーカスがあるので、緑で塗られている範囲のグループを取得する必要があります。

下記のコードを先日教えていただきました。こちらを用いて試したのですが、うまく動作させることができておりません。

vb
1'(4,4)が属する3x3のマスの全座標を取得
2    '取得できるデータ：Arr = {[3,3],[4,3],[5,3],[3,4],[4,4],[5,4],[3,5],[4,5],[5,5]}
3    Dim Arr As Integer(,) = SameGroup(4, 4)
4
5    '入力座標が属する3x3のマスを取得 @変更
6    Public Function SameGroup(ByVal x As Integer, ByVal y As Integer) As Integer(,)
7        Dim AreaX As Integer '3x3を特定する
8        Dim AreaY As Integer '3x3を特定する
9
10        Dim Arr(8, 1) As Integer '結果を格納（例：{[3,3][3,4][5,3]...}）
11
12        AreaX = x / 3 'x方向を3分割した時の位置（0~2）
13        AreaY = y / 3 'y方向を3分割した時の位置（0~2）
14
15        Dim count As Integer = 0
16        For xx = 0 To 2 Step 1
17            For yy = 0 To 2 Step 1
18                Arr(count, 0) = AreaX * 3 + xx
19                Arr(count, 1) = AreaY * 3 + yy
20                count += 1
21            Next
22        Next
23
24        Return Arr
25    End Function
26

また参考までに現在自分が作成しているコードを下記に添付させていただきます。

vb
1Public Class Cell
2    Public Status As CellStatus
3    Public S As Source
4    Public Position As Point '論理位置
5    Public Rectangle As Rectangle '物理位置
6    Public Focused As Boolean
7
8
9    '■コンストラクタ
10    Public Sub New(ByVal S As Source, ByVal Position As Point)
11
12        Me.S = S
13        Me.Position = Position
14
15        '物理位置を求める。
16        Dim Rect As New Rectangle
17
18        '論理位置から物理位置を求めます。
19        Rect.X = Position.X * Source.CellSize
20        Rect.Y = Position.Y * Source.CellSize
21        Rect.Width = Source.CellSize
22        Rect.Height = Source.CellSize
23
24        Me.Rectangle = Rect
25    End Sub
26
27    '■Focus
28    Public Sub Focus()
29
30        Dim X As Integer
31        Dim Y As Integer
32
33        '同じグリッドに属する自分以外のセルを非アクティブにする。
34        For X = 0 To source.XCount - 1
35            For Y = 0 To source.YCount - 1
36                S.Cells(X, Y).Focused = False
37            Next
38        Next
39
40        '自分自身をアクティブにする。
41        Me.Focused = True
42
43    End Sub
44
45    Public Sub Draw(ByVal g As Graphics)
46        Dim oPen As New Pen(Color.Orange, 3)
47        Dim rPen As New Pen(Color.Red, 2)
48        Dim blue = New SolidBrush(Color.AntiqueWhite)
49        Dim pink = New SolidBrush(Color.Pink)
50        Dim CellRect As Rectangle
51
52        'オレンジ枠に余裕を持たせる
53        CellRect = Me.Rectangle
54        CellRect.Inflate(-2, -2)
55        Dim fnt As New Font("MS UI Gothic", 40)
56        Dim CellRectNotFocus As Rectangle ' フォーカス外のマス
57
58
59        'フォーカスのある枠をオレンジで囲む
60        If Me.Focused Then
61            g.DrawRectangle(oPen, CellRect) 'オレンジ色の枠描画
62            If S.Cells(Position.X, Position.Y).Status <> Nothing Then
63                For X = 0 To Source.XCount - 1
64                    For Y = 0 To Source.YCount - 1
65                        CellRectNotFocus = S.Cells(X, Y).Rectangle
66                        CellRectNotFocus.Inflate(-3, -3)
67
68                        If Position.X = X And Position.Y = Y Then 'フォーカスセルの場合（条件追加）
69                            g.FillRectangle(pink, CellRectNotFocus) 'マスをピンクで塗る
70                        ElseIf Position.X = X Then
71                            g.FillRectangle(blue, CellRectNotFocus)
72                            Call InputNumber(g, X, Y) '数字入力
73                        ElseIf Position.Y = Y Then
74                            g.FillRectangle(blue, CellRectNotFocus)
75                            Call InputNumber(g, X, Y) '数字入力
76                        End If
77                        If S.Cells(Position.X, Position.Y).Status = S.Cells(X, Y).Status Then
78                            g.DrawRectangle(rPen, CellRectNotFocus) '赤色の枠描画
79                        End If
80                    Next
81                Next
82            End If
83        End If
84
85        'CellStatusによって表示を変更
86        Select Case Me.Status
87      ＿＿＿＿＿＿＿＿＿＿＿＿中略＿＿＿＿＿＿＿＿＿＿＿
88
89    'cell(X,Y)のマスに数字を描画する
90    Public Sub InputNumber(ByVal g As Graphics, ByVal X As Integer, ByVal Y As Integer)
91        Dim fnt As New Font("MS UI Gothic", 40)
92
93        Dim CellX As Integer = S.Cells(X, Y).Rectangle.X
94        Dim CellY As Integer = S.Cells(X, Y).Rectangle.Y
95        'CellStatusによって表示を変更
96        Select Case S.Cells(X, Y).Status
97
98   ＿＿＿＿＿＿＿＿＿＿中略＿＿＿＿＿＿＿＿＿＿＿＿
99
100        End Select
101    End Sub
102End Class

vb
1Public Class Source
2
3    Public Const CellSize As Integer = 50 'セルのサイズ
4    Public Const XCount As Integer = 9 '盤の横方向のセル数
5    Public Const YCount As Integer = 9 '盤の縦方向のセル数
6    Dim aCell(XCount - 1, YCount - 1) As Cell '全セルを表す配列
7
8    Public Sub New()
9
10        Dim X As Integer
11        Dim Y As Integer
12
13        For X = 0 To XCount - 1
14            For Y = 0 To YCount - 1
15                aCell(X, Y) = New Cell(Me, New Point(X, Y))
16            Next
17        Next
18
19    End Sub
20
21    Public Sub Draw(ByVal g As Graphics)
22
23        Dim X As Integer
24        Dim Y As Integer
25        Dim aPen As New Pen(Color.Gray, 2)
26        Dim bPen As New Pen(Color.Black, 3)
27
28        '四角形
29        g.FillRectangle(Brushes.White, 0, 0, XCount * CellSize, YCount * CellSize)
30
31        '縦線
32        For X = 0 To XCount
33            If X Mod 3 = 0 Then
34                g.DrawLine(bPen, X * CellSize, 0, X * CellSize, YCount * CellSize)
35            Else
36                g.DrawLine(aPen, X * CellSize, 0, X * CellSize, YCount * CellSize)
37            End If
38
39        Next
40
41        '横線
42        For Y = 0 To YCount
43            If Y Mod 3 = 0 Then
44                g.DrawLine(bPen, 0, Y * CellSize, XCount * CellSize, Y * CellSize)
45            Else
46                g.DrawLine(aPen, 0, Y * CellSize, XCount * CellSize, Y * CellSize)
47            End If
48
49        Next
50
51        For Y = 0 To YCount - 1
52            For X = -0 To XCount - 1
53                Cells(X, Y).Draw(g)
54            Next
55        Next
56    End Sub
57
58    Public Property Cells(ByVal X As Integer, ByVal Y As Integer) As Cell
59        Get
60            Return aCell(X, Y)
61        End Get
62        Set(ByVal value As Cell)
63            aCell(X, Y) = value
64        End Set
65    End Property
66
67    Public Function CellFromPoint(ByVal X As Integer, ByVal Y As Integer) As Cell
68
69        Dim ThisCell As Cell
70
71        If X < 0 OrElse X >= XCount * CellSize Then
72            Return Nothing
73        End If
74
75        If Y < 0 OrElse Y >= YCount * CellSize Then
76            Return Nothing
77        End If
78
79        ThisCell = Cells(X \ CellSize, Y \ CellSize)
80
81        Return ThisCell
82
83    End Function
84End Class

m.ts10806

2019/12/11 04:11

VBAは本件とはどのような関係があるのでしょうか

2KOH

2019/12/11 05:41

この質問は、300行近いコードを読んで理解した上で、・数独でフォーカスのあるセルが所属する３×３のグループに着色・そのメソッドを利用して入力値の被りがないかをチェックしたいを実装するための方法を無償で教えてくれ、ということでしょうか？

anpan___

2019/12/11 06:21

m.ts10806様大変失礼いたしました。自分の知識不足により、VBAのことが理解できていない状態で、「ＶＢ系は載せておいたほうがいろんな人が見てくれる」という浅はかな考えで記載してしまっておりました。調べたところ、Microsoft社のOfficeシリーズで使うようですね・・・。知識の疎さによりこのような修正依頼をいただいてしまいました。誠に申し訳ございません。

m.ts10806

2019/12/11 06:25

タグにマウスあてたりタグ一覧やタグのページにいけばなんのタグなのか簡易説明でますよ。

anpan___

2019/12/11 06:31

m.ts10806様はい。ご指摘ありがとうございます。一度確認させていただいたところ簡単な説明で見ることができました。この度はご指導いただきありがとうございました！以後同じことがないようにきをつけます。

anpan___

2019/12/11 06:37

2KOH様長いコードを載せてしまって誠に申し訳ございません。こちらは自分の記載不足ですが「参考までに」という意味合いで記載させていただいております。以前逆のパターンで、コードも載せておらず具体性もなく、何の質問をしたいのか分からないといわれたからです。完全に自分の説明力のなさ、というよりは理解ができていなかったので招いてしまった事態です。その事態を避けるために、念のためにコードは記載させていただきました。ご理解いただけますと幸いです。実装するための方法を無償で教えてくれ、ということでしょうか？＞＞＞このサイトはあくま有償利用されることはないはずです。こちらの投稿により、そう思わせてしまったのは大変申し訳ございませんが、めんどくさいと思う方はこのコードを見ないと思います。つまりは、質問の仕方、回答の有無は自由だと思います。ですので、もしお力添えしてくださる親切な方がいた時のために、理解力の乏しいこちらの考えを漏れなく、伝えたいという思いで記載させていただいております。とはいえ、そのようにとらえられてしまう可能性があるのも事実です。すぐに「参考までに記載した」と追加させていただきます。また、要点の部分だけまとめれるように努力いたします。ご指摘ありがとうございました。

YAmaGNZ

2019/12/11 06:55

「下記のコードを先日教えていただきました。こちらを用いて試したのですが、うまく動作させることができておりません。」どううまく動作させることが出来ないのか説明できませんか？例えばエラーが出るとか、このような入力で呼んだときにこういう結果が返ってくるはずだが、こういう結果が返ってくるなど具体的に説明してください。これが動けば所属する３マスが判定できるということですよね？というか、指定マスのX座標、Y座標（マス換算）を３で割った商がそのブロックじゃないの？

2KOH

2019/12/11 07:08

> 以前逆のパターンで、コードも載せておらず具体性もなく、何の質問をしたいのか分からないといわれたからです。コードを載せたところで、必ずしも具体性のある何を質問したいのか分かるような質問になるわけではありません。他にも言いたいことはいくつかあるのですが、これ以上付き合う気はないので、上記の一点だけ指摘しておきます。

行動規範の内容に同意します

回答3件

ベストアンサー

最後．．．

###Form1.vbの変更点
数字入力されるマスはフォーカスセルに変更。
フォーカスセルの情報をForm1.vbで保持されるように、ThisCell変数をクラス変数にしました。
フォーカスセルがない場合は、数字入力されないようにしてます。

修正した所は[変更][削除]とコメントしときましたので。


Public Class Form1
    Dim S As New Source
    Dim ThisCell As Cell '[変更]

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.KeyPreview = True
    End Sub

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint

        S.Draw(e.Graphics)

    End Sub

    Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Click
        'マウスの座標をPictureBox1のコントロール座標に変換する。
        Dim Pos As Point = PictureBox1.PointToClient(Cursor.Position)
        'Dim ThisCell As Cell '[削除]フォーカスセルを記憶するため、Form内で使える変数にする

        ThisCell = S.CellFromPoint(Pos.X, Pos.Y)
        S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Focus()

        PictureBox1.Invalidate()  'コントロールの再描画
    End Sub

    Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        Dim Pos As Point = PictureBox1.PointToClient(Cursor.Position)
        'Dim ThisCell As Cell '[削除]
        '[追加]フォーカスセルがない場合は入力をキャンセル
        'ピクチャボックスがクリックされるまで、ThisCellはNothing
        If ThisCell Is Nothing Then
            Return
        End If

        Select Case e.KeyCode
            Case Keys.D1, Keys.NumPad1
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._1
            Case Keys.D2, Keys.NumPad2
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._2
            Case Keys.D3, Keys.NumPad3
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._3
            Case Keys.D4, Keys.NumPad4
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._4
            Case Keys.D5, Keys.NumPad5
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._5
            Case Keys.D6, Keys.NumPad6
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._6
            Case Keys.D7, Keys.NumPad7
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._7
            Case Keys.D8, Keys.NumPad8
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._8
            Case Keys.D9, Keys.NumPad9
                S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._9
        End Select
        PictureBox1.Invalidate()
    End Sub
End Class

こんな感じです。

以上です。不明点あったら聞いてもらって大丈夫です。

投稿2019/12/11 12:58

KazuSaka

総合スコア640

つづき．．．

###Cell.vbの変更点
Source.vbの変更にと伴い、下記の関数やメソッドを追加しました。
(1)NumberCheck　入力数値の重複チェック
(2)DrawSameColRow　フォーカスセルの縦・横を着色
(3)DrawSameGroup　3x3エリアを着色
(4)DrawCellFrame　重複数字を赤枠にする
(5)SameGroup　フォーカスセルが属する3x3の9マスを取得

※Source.vbのdrawメソッド内を修正した事により、CellRectNotFocus変数やInputNumber関数は削除しました。

 '入力数値の重複チェック(重複あり：true 重複なし：false)
    Public Function NumberCheck(ByVal g As Graphics) As Boolean
        Dim green = New SolidBrush(Color.LightGreen)
        Dim oPen As New Pen(Color.Orange, 3)
        Dim CellRect As Rectangle
        Dim Bool As Boolean = False '重複ありなしフラグ[重複あり：true 重複なし：false]
        Dim message As String = "" '入力値エラーメッセージ
        CellRect = Me.Rectangle
        CellRect.Inflate(-3, -3)

        If S.Cells(Position.X, Position.Y).Status = Nothing Then
            Return False '（フォーカスセルは空欄のためチェックする必要なし）
        End If

        If Me.Focused Then
            '(x,y)の座標が含まれるグループの座標を取得
            Dim Arr As Integer(,) = SameGroup(Position.X, Position.Y)
            '3x3エリアで重複はないかチェック
            For i = 0 To 8
                Dim X_Pos As Integer = Arr(i, 0)
                Dim Y_Pos As Integer = Arr(i, 1)
                If Position.X <> X_Pos Or Position.Y <> Y_Pos Then 'フォーカスセルと同じ座標はスキップ
                    If S.Cells(Position.X, Position.Y).Status = S.Cells(X_Pos, Y_Pos).Status Then
                        message = "3x3マスに同じ値があります．"
                        Bool = True
                    End If
                End If
            Next
            '縦・横で重複はないかチェック
            For i = 0 To 8
                '縦方向
                If Position.Y <> i Then 'フォーカスセルと同じ座標はスキップ
                    If S.Cells(Position.X, Position.Y).Status = S.Cells(Position.X, i).Status And S.Cells(Position.X, i).Status <> Nothing Then
                        message = message + vbCrLf + "縦方向に同じ値があります．"
                        Bool = True
                    End If
                End If
                '横方向
                If Position.X <> i Then 'フォーカスセルと同じ座標はスキップ
                    If S.Cells(Position.X, Position.Y).Status = S.Cells(i, Position.Y).Status And S.Cells(i, Position.Y).Status <> Nothing Then
                        message = message + vbCrLf + "横方向に同じ値があります"
                        Bool = True
                    End If
                End If
            Next
        End If

        If message <> "" Then
            S.Cells(Position.X, Position.Y).Status = Nothing '設定値は初期化
            g.FillRectangle(green, CellRect) '緑で塗る
            g.DrawRectangle(oPen, CellRect) 'オレンジ枠
            MessageBox.Show(message, "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End If
        Return Bool
    End Function

    '//フォーカスセルの同行・同列を塗る
    Public Sub DrawSameColRow(ByVal g As Graphics)
        Dim oPen As New Pen(Color.Orange, 3)
        Dim rPen As New Pen(Color.Red, 2)
        Dim wheat = New SolidBrush(Color.Wheat)
        Dim pink = New SolidBrush(Color.Pink)
        Dim CellRect As Rectangle

        If Me.Focused Then
            For X = 0 To Source.XCount - 1
                For Y = 0 To Source.YCount - 1
                    CellRect = S.Cells(X, Y).Rectangle
                    CellRect.Inflate(-3, -3)

                    If Position.X = X And Position.Y = Y Then
                        g.FillRectangle(pink, CellRect) 'フォーカスセル（ピンク）
                    ElseIf Position.X = X Then
                        g.FillRectangle(wheat, CellRect) 'フォーカスセルの縦方向（wheat色）
                    ElseIf Position.Y = Y Then
                        g.FillRectangle(wheat, CellRect) 'フォーカスセルの横方向（wheat色）
                    End If
                Next
            Next
        End If
    End Sub

    'フォーカスセルと同じ3x3のマスを塗る
    Public Sub DrawSameGroup(ByVal g As Graphics)
        Dim green = New SolidBrush(Color.LightGreen)
        Dim CellRect As Rectangle

        CellRect = Me.Rectangle

        If Me.Focused Then
            '(x,y)の座標が含まれるグループの座標を取得（フォーカスセルを含む9つの座標）
            '2次元配列で格納. 
            '例:SameGroup(4,4)の場合：Arr = {[3,3],[4,3],[5,3],[3,4],[4,4],[5,4],[3,5],[4,5],[5,5]}
            Dim Arr As Integer(,) = SameGroup(Position.X, Position.Y)

            '上記で取得した9つの座標を塗る
            For i = 0 To 8
                Dim X_Pos As Integer = Arr(i, 0)
                Dim Y_Pos As Integer = Arr(i, 1)
                CellRect = S.Cells(X_Pos, Y_Pos).Rectangle
                CellRect.Inflate(-3, -3)
                g.FillRectangle(green, CellRect) 'フォーカスせると同じ3x3（緑色）
            Next
        End If
    End Sub

    'フォーカスセルはオレンジ、同じ数字のセルは赤線で囲む
    '該当セルに数字を入力
    Public Sub DrawCellFrame(ByVal g As Graphics)
        Dim oPen As New Pen(Color.Orange, 3)
        Dim rPen As New Pen(Color.Red, 2)
        Dim CellRect As Rectangle
        Dim fnt As New Font("MS UI Gothic", 40)

        CellRect = Me.Rectangle
        CellRect.Inflate(-3, -3)

        'フォーカスのある枠をオレンジで囲む
        If Me.Focused Then
            g.DrawRectangle(oPen, CellRect) 'フォーカスセル（オレンジ色）
            If S.Cells(Position.X, Position.Y).Status <> Nothing Then
                'フォーカスセルと同じ行・列で同じ数字は赤色で囲む
                For X = 0 To Source.XCount - 1
                    For Y = 0 To Source.YCount - 1
                        CellRect = S.Cells(X, Y).Rectangle
                        CellRect.Inflate(-3, -3)
                        If (Position.X = X And Position.Y <> Y) Or (Position.X <> X And Position.Y = Y) Then
                            If Position.X = X And Position.Y = Y Then
                                'フォーカスセルの場合、何もしない
                                'For文の外ですでにオレンジ色で塗っているため
                            ElseIf S.Cells(Position.X, Position.Y).Status = S.Cells(X, Y).Status Then
                                g.DrawRectangle(rPen, CellRect) '赤色
                            End If
                        End If
                    Next
                Next

                '3x3エリアで同じ数字は赤で囲む
                Dim Arr As Integer(,) = SameGroup(Position.X, Position.Y)
                For i = 0 To 8
                    Dim X_Pos As Integer = Arr(i, 0)
                    Dim Y_Pos As Integer = Arr(i, 1)
                    If Position.X <> X_Pos Or Position.Y <> Y_Pos Then 'フォーカスセルと同じ座標はスキップ
                        If S.Cells(Position.X, Position.Y).Status = S.Cells(X_Pos, Y_Pos).Status Then
                            CellRect = S.Cells(X_Pos, Y_Pos).Rectangle
                            CellRect.Inflate(-3, -3)
                            g.DrawRectangle(rPen, CellRect) '赤色
                        End If
                    End If
                Next
            End If
        End If

        'セルに数字を入力
        Select Case Me.Status
            Case CellStatus._1
                g.DrawString(1, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._2
                g.DrawString(2, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._3
                g.DrawString(3, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._4
                g.DrawString(4, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._5
                g.DrawString(5, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._6
                g.DrawString(6, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._7
                g.DrawString(7, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._8
                g.DrawString(8, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus._9
                g.DrawString(9, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
            Case CellStatus.Nothing
                g.DrawString(Nothing, fnt, Brushes.Black, Rectangle.X, Rectangle.Y)
        End Select
    End Sub

    '入力座標が属する3x3のマスを取得 @変更
    Public Function SameGroup(ByVal x As Integer, ByVal y As Integer) As Integer(,)
        Dim AreaX As Integer '3x3を特定する
        Dim AreaY As Integer '3x3を特定する

        Dim Arr(8, 1) As Integer '結果を格納（例：{[3,3][3,4][5,3]...}）

        AreaX = x \ 3 'x方向を3分割した時の位置
        AreaY = y \ 3 'y方向を3分割した時の位置

        Dim count As Integer = 0
        For xx = 0 To 2 Step 1
            For yy = 0 To 2 Step 1
                Arr(count, 0) = AreaX * 3 + xx
                Arr(count, 1) = AreaY * 3 + yy
                count += 1
            Next
        Next

        Return Arr
    End Function

続きあり．．．

投稿2019/12/11 12:56

KazuSaka

総合スコア640

###回答
以前、このプログラムに回答させて頂きましたので、引き続きご回答差し上げます。

以下のように直しました。
１．フォーカスセルが所属する３×３のグループに着色
➡数値の有無に関わらず、着色
２．入力値の被りがないかをチェック
➡入力値の被りをチェックする対象は3x3エリア内と縦・横方向のみ
➡入力値の被りがあったら、メッセージ出す＋フォーカスセルへの入力を中止
３．同じ数字を赤枠で囲むのも、3x3エリア内と縦・横方向のみ
➡盤面全てを対象に同じ数字を赤枠にする意味はなさそうなので．．．
４．数字入力されるマスはフォーカスセルに変更
➡既存のプログラムでは、フォーカスセルではなく、数字を入力した時のマウスの位置になっていたので．．．

以下プログラムです。

文字数制限にひっかかったので、分割します。

###Source.vbの変更点
Drawメソッドの内部を変更しました。※修正箇所は[変更][削除]とコメントしました。
【修正内容】
既存プログラムでは、Cells(X, Y).Draw(g)で｛セルの塗りつぶし、セルの枠、数字入力｝をやっていましたが、3x3のマスへの着色を盛り込むと複雑になりそうだったので、処理を下記のように分割しました。
１．フォーカスセルの同行・同列を塗る
２．フォーカスセルと同じ3x3マスを塗る
３．フォーカスセルと同じ数字は赤枠で囲む+数字入力．フォーカスセルはオレンジ枠
４．入力値のチェック（3x3エリア内、縦・横の重複チェック）

    Public Sub Draw(ByVal g As Graphics)

        Dim X As Integer
        Dim Y As Integer
        Dim aPen As New Pen(Color.Gray, 2)
        Dim bPen As New Pen(Color.Black, 3)

        '四角形
        g.FillRectangle(Brushes.White, 0, 0, XCount * CellSize, YCount * CellSize)

        '縦線
        For X = 0 To XCount
            If X Mod 3 = 0 Then
                g.DrawLine(bPen, X * CellSize, 0, X * CellSize, YCount * CellSize)
            Else
                g.DrawLine(aPen, X * CellSize, 0, X * CellSize, YCount * CellSize)
            End If

        Next

        '横線
        For Y = 0 To YCount
            If Y Mod 3 = 0 Then
                g.DrawLine(bPen, 0, Y * CellSize, XCount * CellSize, Y * CellSize)
            Else
                g.DrawLine(aPen, 0, Y * CellSize, XCount * CellSize, Y * CellSize)
            End If

        Next

        '[変更]フォーカスセルの同行・同列を塗る
        For Y = 0 To YCount - 1
            For X = 0 To XCount - 1
                Cells(X, Y).DrawSameColRow(g)
            Next
        Next

        '[変更]フォーカスセルと同じ3x3マスを塗る
        For Y = 0 To YCount - 1
            For X = 0 To XCount - 1
                Cells(X, Y).DrawSameGroup(g)
            Next
        Next

        '[変更]フォーカスセルと同じ数字は赤枠で囲む+数字入力
        For Y = 0 To YCount - 1
            For X = 0 To XCount - 1
                Cells(X, Y).DrawCellFrame(g)
            Next
        Next

        '[変更]入力値のチェック（3x3エリア内、縦・横の重複チェック）
        For Y = 0 To YCount - 1
            For X = 0 To XCount - 1
                If Cells(X, Y).NumberCheck(g) Then
                    Return
                End If
            Next
        Next

        '[削除]以下のコードは上記のように処理を分割しました。
        'For Y = 0 To YCount - 1
        '    For X = -0 To XCount - 1
        '        Cells(X, Y).Draw(g)
        '    Next
        'Next
    End Sub

続きあり．．．

投稿2019/12/11 12:53

KazuSaka

総合スコア640