5
\$\begingroup\$

After working on the project for 15 hours of I had my layout set 1 row and 1 column per square, no problem. Then I decided that I needed each square to have multiple rows. I would have never guessed that it would take almost 6 hours to work this out.

The reason that I changed the layout

I had most of the logic worked. When the cell is clicked all the moves for each piece (except casling and en passant). I know which piece could move where and identified any threats to a piece.

At this point I started writing the mechanism that would create and parse chess notations for the moves. Then it hit me. My logic was flawed! Well kinda, there was, however, an better way to load the board into the gaming engine than to read the chessboard range. Using the Chess Notation Log to power the Model. This would allow players to import, export and recreate games from their logs.

I already had a Chess Notation Log table but was going to displaying it in a listbox because the row heights were too tall. That is what made me decide to have multiple rows per square.

Previous layout

Old chessboard layout

New layout

New chessboard layout

Adjusting the row heights and column widths

This code (based of of Tom Urtis post) took most of the time.

Private Sub FitColumnsToRangeHeight(ByRef Target As Range, ByVal RowHeight As Double)
 Const Precision As Double = 0.1
 With Target
 .RowHeight = RowHeight
 Do While .Width < .Height
 .ColumnWidth = .ColumnWidth + Precision
 DoEvents
 Loop
 Do While .Width > .Height
 .ColumnWidth = .ColumnWidth - Precision
 DoEvents
 Loop
 End With
End Sub

Code

Option Explicit
Public Enum PieceType
 King
 Queen
 Rook
 Bishop
 Knight
 Pawn
End Enum
Public Enum PieceColor
 Black = 9818
 White = 9812
End Enum
Public Sub CreateChessBoard()
 Application.ScreenUpdating = False
 Const RowHeight As Double = 15, RowsPerSquare As Long = 4
 Const TopLeftAddress = "B3"
 Dim Squares As Range
 Rem Reset ActiveWorksheet
 Cells.Delete
 With Range(TopLeftAddress).Resize(8 * RowsPerSquare, 9).Offset(0, -1).EntireColumn
 .VerticalAlignment = xlCenter
 .HorizontalAlignment = xlCenter
 End With
 Set Squares = Range(TopLeftAddress).Resize(8 * RowsPerSquare, 8)
 FitColumnsToRangeHeight Squares, RowHeight
 Squares.BorderAround xlSolid, xlMedium
 Dim r As Long, c As Long, n As Long
 For n = 1 To 8
 r = (n - 1) * RowsPerSquare + 1
 For c = 1 To 8
 With Squares.Cells(r, c).Resize(RowsPerSquare)
 .Merge
 .Interior.Color = IIf((n + c) Mod 2 = 0, xlNone, vbCyan)
 .Name = "_" & Chr(64 + c) & (9 - n)
 End With
 Next
 With Squares.Cells(r, 0).Resize(RowsPerSquare)
 .Merge
 .Value = Array(8, 7, 6, 5, 4, 3, 2, 1)(n - 1)
 .Font.Size = 18
 End With
 Next
 For c = 1 To 8
 With Squares(Squares.Count + c).Resize(2)
 .Merge
 End With
 Next
 With Squares
 .Font.Size = 36
 End With
 With Squares.Rows(Squares.Rows.Count + 1)
 .Font.Size = 20
 .Value = Array("A", "B", "C", "D", "E", "F", "G", "H")
 End With
 With Squares
 .Rows(1).Value = Array(ChrW(Black + Rook), ChrW(Black + Knight), ChrW(Black + Bishop), ChrW(Black + Queen), ChrW(Black + King), ChrW(Black + Bishop), ChrW(Black + Knight), ChrW(Black + Rook))
 .Rows(RowsPerSquare + 1).Value = Array(ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn))
 .Rows(RowsPerSquare * 6 + 1).Value = Array(ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn))
 .Rows(RowsPerSquare * 7 + 1).Value = Array(ChrW(White + Rook), ChrW(White + Knight), ChrW(White + Bishop), ChrW(White + Queen), ChrW(White + King), ChrW(White + Bishop), ChrW(White + Knight), ChrW(White + Rook))
 End With
End Sub
Private Sub FitColumnsToRangeHeight(ByRef Target As Range, ByVal RowHeight As Double)
 Const Precision As Double = 0.1
 With Target
 .RowHeight = RowHeight
 Do While .Width < .Height
 .ColumnWidth = .ColumnWidth + Precision
 DoEvents
 Loop
 Do While .Width > .Height
 .ColumnWidth = .ColumnWidth - Precision
 DoEvents
 Loop
 End With
End Sub

Why write a Chess game

I was inspired to write this after watching a weekly live YouTube stream where the hosts is working out the code, while interacting with the chat. What a phenomenal idea.

I would love to make some training videos but to code a project like this live! Geez, how would I explain scraping 15 hours of work...."This is known as the Waterfall technique....", lol.

Questions

I didn't need this to be pretty, just accurate. So I only have few questions.

  • It would be interesting to see another way to write FitColumnsToRangeHeight()
  • Color scheme suggestions

I'll have plenty of questions later on. Particularly, when I move on to writing the AI(s). I will probably base them off of Matt's Battle IStrategy. We'll see.

Mast
13.8k12 gold badges55 silver badges127 bronze badges
asked Dec 6, 2019 at 11:37
\$\endgroup\$

1 Answer 1

3
\$\begingroup\$

Iteratively incrementing/decrementing a width until you get it just right seems slow and inefficient to me.

Instead, my approach is just to measure the conversion factor, and then use that measurement to set the width in one go. This is way, way faster.

Public Function WidthPerColumnWidth(r As Range) As Double
 WidthPerColumnWidth = (r.ColumnWidth * r.Columns.Count) / r.Width
End Function
Public Sub FitColumnsToRangeHeight(ByRef Target As Range, ByVal RowHeight As Double)
 With Target
 .RowHeight = RowHeight
 .ColumnWidth = WidthPerColumnWidth(Target) * RowHeight * (.Rows.Count / .Columns.Count)
 End With
End Sub

Since the conversion factor is dependent on the size of zero on the default (normal) font (see the docs), we could also determine the conversion factor based on a single cell (say A1), and cache that, if we expect no changes to the default style while the code is running.

Public Function WidthPerColumnWidth() As Double
 Static ConversionFactor As Double
 If ConversionFactor = 0 Then
 With Range("A1")
 ConversionFactor = .ColumnWidth / .Width
 End With
 End If
 WidthPerColumnWidth = ConversionFactor
End Function
answered Dec 6, 2019 at 12:07
\$\endgroup\$
5
  • \$\begingroup\$ I used similar code to create the first layout. It makes almost perfectly square cells but that is not what I want. My code will make the entire range square. For example: if you have a range of 100 Rows by 10 Columns, each column width will = the height of 10 cells. \$\endgroup\$ Commented Dec 6, 2019 at 20:04
  • \$\begingroup\$ @TinMan Ah, see the edit, I misunderstood the function \$\endgroup\$ Commented Dec 6, 2019 at 20:11
  • \$\begingroup\$ It wasn't to hours after I got it working before I understood how it works!! I should have provided a more detailed explanation for it. \$\endgroup\$ Commented Dec 6, 2019 at 20:14
  • \$\begingroup\$ Btw, since you're making a chess board, you don't need code to adjust FitColumnsToRangeHeight for an unequal amount of borders, right? \$\endgroup\$ Commented Dec 6, 2019 at 20:20
  • \$\begingroup\$ I wanted to code it so I could easily experiment with different themes, row heights and rows to columns ratios. \$\endgroup\$ Commented Dec 6, 2019 at 20:28

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.