🎄teratailクリスマスプレゼントキャンペーン2024🎄』開催中!

\teratail特別グッズやAmazonギフトカード最大2,000円分が当たる!/

詳細はこちら
VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Visual Studio

Microsoft Visual StudioはMicrosoftによる統合開発環境(IDE)です。多種多様なプログラミング言語に対応しています。

VB.NET

Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

Q&A

解決済

1回答

1117閲覧

対象のセルと同じX/Y軸・数字の背景色(エフェクト)を変えたい。

anpan___

総合スコア28

VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Visual Studio

Microsoft Visual StudioはMicrosoftによる統合開発環境(IDE)です。多種多様なプログラミング言語に対応しています。

VB.NET

Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

0グッド

0クリップ

投稿2019/12/06 04:10

編集2019/12/06 05:29

現在VBで数独を作成させてもらっております。
その中で、フォーカスのあるマスの色を変化させるようにしておりますが、追加して

【フォーカス中のセルと】
・同じ数字の枠を赤で囲む
・同じX/Y軸また、3×3のマスの背景色をうっすら変える

を行いたいと考えています。

今回詰まっているのは、上記の両点において、
フォーカス中の枠にだけしか、行いたいエフェクトが反映されないことです。
また、3×3のマスを取得する処理の作り方にも悩んでおります。

一つ目の問題に関しては、デバッグを行ったところ正常に分岐分には入り、DrawRectangleとFillRectangleは処理されております。

フォーカスのあるマス以外にもこの変化をつけようと思った場合どのようにすればよろしいでしょうか。
ご教授いただければ幸いです。

VB

1lass Form1 2 Dim S As New Source 3 4 5 Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 6 Me.KeyPreview = True 7 End Sub 8 9 Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint 10 11 S.Draw(e.Graphics) 12 13 End Sub 14 15 Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Click 16 'マウスの座標をPictureBox1のコントロール座標に変換する。 17 Dim Pos As Point = PictureBox1.PointToClient(Cursor.Position) 18 Dim ThisCell As Cell 19 20 ThisCell = S.CellFromPoint(Pos.X, Pos.Y) 21 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Focus() 22 23 PictureBox1.Invalidate() 24 End Sub 25 26 Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown 27 Dim Pos As Point = PictureBox1.PointToClient(Cursor.Position) 28 Dim ThisCell As Cell 29 ThisCell = S.CellFromPoint(Pos.X, Pos.Y) 30 Select Case e.KeyCode 31 Case Keys.D1, Keys.NumPad1 32 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._1 33 Case Keys.D2, Keys.NumPad2 34 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._2 35 Case Keys.D3, Keys.NumPad3 36 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._3 37 Case Keys.D4, Keys.NumPad4 38 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._4 39 Case Keys.D5, Keys.NumPad5 40 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._5 41 Case Keys.D6, Keys.NumPad6 42 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._6 43 Case Keys.D7, Keys.NumPad7 44 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._7 45 Case Keys.D8, Keys.NumPad8 46 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._8 47 Case Keys.D9, Keys.NumPad9 48 S.Cells(ThisCell.Position.X, ThisCell.Position.Y).Status = CellStatus._9 49 End Select 50 PictureBox1.Invalidate() 51 End Sub 52End 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

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 b = New SolidBrush(Color.AntiqueWhite) 49 Dim CellRect As Rectangle 50 51 'オレンジ枠に余裕を持たせる 52 CellRect = Me.Rectangle 53 CellRect.Inflate(-2, -2) 54 Dim fnt As New Font("MS UI Gothic", 40) 55 56 57 'フォーカスのある枠をオレンジで囲む 58 If Me.Focused Then 59 g.DrawRectangle(oPen, CellRect) 60 If S.Cells(Position.X, Position.Y).Status <> Nothing Then 61 For X = 0 To Source.XCount - 1 62 For Y = 0 To Source.YCount - 1 63 If S.Cells(Position.X, Position.Y).Status = S.Cells(X, Y).Status Then 64 g.DrawRectangle(rPen, CellRect) 65 End If 66 If Position.X = X Then 67 g.FillRectangle(b, CellRect) 68 ElseIf Position.Y = Y Then 69 g.DrawRectangle(rPen, CellRect) 70 End If 71 Next 72 Next 73 End If 74 End If 75 76 'CellStatusによって表示を変更 77 Select Case Me.Status 78 Case CellStatus._1 79 g.DrawString(1, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 80 Case CellStatus._2 81 g.DrawString(2, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 82 Case CellStatus._3 83 g.DrawString(3, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 84 Case CellStatus._4 85 g.DrawString(4, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 86 Case CellStatus._5 87 g.DrawString(5, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 88 Case CellStatus._6 89 g.DrawString(6, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 90 Case CellStatus._7 91 g.DrawString(7, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 92 Case CellStatus._8 93 g.DrawString(8, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 94 Case CellStatus._9 95 g.DrawString(9, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 96 Case CellStatus.Nothing 97 g.DrawString(Nothing, fnt, Brushes.Black, Rectangle.X, Rectangle.Y) 98 End Select 99 100 101 End Sub 102End Class

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kenshirou

2019/12/06 04:50

S.Cells(X, Y)のような記述がありますが、Sは何ですか? Sクラスがマス(セル)の親であれば、Sクラス内でフォーカスマス中心の3×3を調べればよいのではないでしょうか?
anpan___

2019/12/06 04:52 編集

失礼しました、その他のソースを記載しているクラスです。 そちらも追加で記載させていただきます。
guest

回答1

0

ベストアンサー

###回答
1年前までVBを触っていたので、久しぶりにデバッグ挑戦しました。
以下の画像のように動作しました。
私の環境(VB2012)で動作したコードをUPさせて頂きます。
解決しましたら、幸いです。

イメージ説明

修正箇所

変更した箇所はcell.vbの下記の場所です。
(cell.vb全部貼り付けましたので、見にくかったらすいません)
プログラム内に変更した箇所は明記しましたが、変更理由だけお伝えします。

【draw関数の中身】
変更(A)
フォーカスされているセルは塗潰し色を変えるために条件を追加しました。
変更(B)
今回、フォーカスセルのX方向、Y方向の色が変わらなかったのは、
CellRect(フォーカスセル)に対して、塗っていたからです。
そのため、CellRectNotFocusを定義しました。
変更(C)
draw関数の最後のselect文で各セルの数字を入力していますが、
既に数字入力が終わっているセルに対して、セルの色を塗る場合
があるため、セルに色を塗った箇所は再度、数字を入力する必要があった。

変更(D)
この箇所はフォーカスセルと同じ数字のセルは赤枠で囲むロジックですが、
場所を移動しました。
セルを塗りつぶす前に枠を描画すると、枠も塗りつぶされてしまうため。

【InputNumber関数を追加】
変更(E)
数字を再入力するための関数を作りました。
関数の内容はdraw関数の最後のselect文と同じです。
draw関数の最後のselect文はフォーカスセルに対して、数字を入力
していますが、inputNumber関数は入力したいセルに対して、
数値を入力します。

Public Class Cell Public Status As CellStatus Public S As Source Public Position As Point '論理位置 Public Rectangle As Rectangle '物理位置 Public Focused As Boolean '■コンストラクタ Public Sub New(ByVal S As Source, ByVal Position As Point) Me.S = S Me.Position = Position '物理位置を求める。 Dim Rect As New Rectangle '論理位置から物理位置を求めます。 Rect.X = Position.X * Source.CellSize Rect.Y = Position.Y * Source.CellSize Rect.Width = Source.CellSize Rect.Height = Source.CellSize Me.Rectangle = Rect End Sub '■Focus Public Sub Focus() Dim X As Integer Dim Y As Integer '同じグリッドに属する自分以外のセルを非アクティブにする。 For X = 0 To source.XCount - 1 For Y = 0 To source.YCount - 1 S.Cells(X, Y).Focused = False Next Next '自分自身をアクティブにする。 Me.Focused = True End Sub Public Sub Draw(ByVal g As Graphics) Dim oPen As New Pen(Color.Orange, 3) Dim rPen As New Pen(Color.Red, 2) 'Dim b = New SolidBrush(Color.AntiqueWhite) Dim blue = New SolidBrush(Color.Blue) Dim yel = New SolidBrush(Color.Yellow) '@変更 Dim pink = New SolidBrush(Color.Pink) '@変更 Dim CellRect As Rectangle 'オレンジ枠に余裕を持たせる CellRect = Me.Rectangle CellRect.Inflate(-2, -2) Dim fnt As New Font("MS UI Gothic", 40) Dim CellRectNotFocus As Rectangle '@変更 フォーカス外のマス 'フォーカスのある枠をオレンジで囲む 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 CellRectNotFocus = S.Cells(X, Y).Rectangle '@変更 CellRectNotFocus.Inflate(-3, -3) '@変更 If Position.X = X And Position.Y = Y Then '@変更(A) フォーカスセルの場合(条件追加) g.FillRectangle(pink, CellRectNotFocus) '@変更 マスをピンクで塗る ElseIf Position.X = X Then 'g.FillRectangle(b, CellRect) g.FillRectangle(blue, CellRectNotFocus) '@変更(B) マスを青色で塗る Call InputNumber(g, X, Y) '@変更(C) 数字入力 ElseIf Position.Y = Y Then 'g.DrawRectangle(rPen, CellRect) g.FillRectangle(yel, CellRectNotFocus) '@変更 'マスを黄色で塗る Call InputNumber(g, X, Y) '@変更 数字入力 End If '@変更(D) 場所移動 If S.Cells(Position.X, Position.Y).Status = S.Cells(X, Y).Status Then 'g.DrawRectangle(rPen, CellRect) g.DrawRectangle(rPen, CellRectNotFocus) '@変更 赤色の枠描画 End If Next Next End If End If 'CellStatusによって表示を変更 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 'cell(X,Y)のマスに数字を描画する @変更(E) Public Sub InputNumber(ByVal g As Graphics, ByVal X As Integer, ByVal Y As Integer) Dim fnt As New Font("MS UI Gothic", 40) Dim CellX As Integer = S.Cells(X, Y).Rectangle.X Dim CellY As Integer = S.Cells(X, Y).Rectangle.Y 'CellStatusによって表示を変更 Select Case S.Cells(X, Y).Status Case CellStatus._1 g.DrawString(1, fnt, Brushes.Black, CellX, CellY) Case CellStatus._2 g.DrawString(2, fnt, Brushes.Black, CellX, CellY) Case CellStatus._3 g.DrawString(3, fnt, Brushes.Black, CellX, CellY) Case CellStatus._4 g.DrawString(4, fnt, Brushes.Black, CellX, CellY) Case CellStatus._5 g.DrawString(5, fnt, Brushes.Black, CellX, CellY) Case CellStatus._6 g.DrawString(6, fnt, Brushes.Black, CellX, CellY) Case CellStatus._7 g.DrawString(7, fnt, Brushes.Black, CellX, CellY) Case CellStatus._8 g.DrawString(8, fnt, Brushes.Black, CellX, CellY) Case CellStatus._9 g.DrawString(9, fnt, Brushes.Black, CellX, CellY) Case CellStatus.Nothing g.DrawString(Nothing, fnt, Brushes.Black, CellX, CellY) End Select End Sub End Class

3x3のマスの取得

3x3のマスの取得は下記のように入力座標と同じグループのセルを取得できると思います。(9個の座標)
※グループと言っているのは盤面を9分割(3x3)にグループ分
けする意味です。

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

###補足
CellStatusの構造体ファイルは下記のように書いています。

Public Enum CellStatus [Nothing] 'なし _1 _2 _3 _4 _5 _6 _7 _8 _9 End Enum

以上。

投稿2019/12/06 12:03

KazuSaka

総合スコア640

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

anpan___

2019/12/10 05:06

ご回答ありがとうございました! 一日かけ理解と実装を行いました。 丁寧に教えていただきあことにありがとうございます。 とてもためになりました! まだ、「3x3のマスの取得」のメソッドをうまく利用できておらず、3x3の部分は着色できておりませんが、引き続き解決に向け努力します。 本当にありがとうございました。
KazuSaka

2019/12/10 05:19

実装できたみたいで良かったです。 頑張ってください!!
anpan___

2019/12/10 06:23

ありがとうございます!! 「3x3のマスの取得」についてまだ少し理解しきれておらず、実装が間に合っておりませんので、もしかしたらまた別の投稿にて、質問させていただくかもしれません・・・。 せっかくご丁寧に教えていただいたにもかかわらず理解が及ばず申し訳ありません(´;ω;`) 頑張ってやっていきます!
KazuSaka

2019/12/10 06:49

不明点あったら、聞いてもらって大丈夫ですので。 別の投稿でまた見かけたら、お手伝いしますので(^▽^)/
anpan___

2019/12/10 06:50

ご親切にありがとうございます!(´;ω;`) その時はどうぞよろしくお願いします。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.36%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問