hex grid images

This simple routine will create an image of a hex grid and save it to disk as a Windows bitmap. The file will be saved in the program's folder under the name "HexGrid.bmp". You can specify hexes of any size, with any number of rows and columns, in either horizontal or vertical orientation. You can choose to show the hex numbering, which will be in "xxyy" format starting with hex 0101 in the top left (the classic board war game format). The image will contain black hex outlines and numbering on a white background. The program has virtually no error-checking and is offered "as is".

PlayBASIC Code:

Constant white = RGB(255, 255, 255)
Constant black = RGB(8, 8, 8)

OpenScreen 500, 180, 16, 1
CenterScreen
TitleScreen "Draw Hex Grid"
RenderToScreen
Cls white
Ink black
ScreenFont = GetFreeFont()
LoadFont "Arial", ScreenFont, 21, 0
SetFont ScreenFont
 
; get parameters from user:
request$ = "length in pixels of 1 hex side:  "
answer$ = GetInputLine(30, 30, request$)
HexSide# = Val(answer$)

; horizontal orientation = flat hex sides are vertical
; vertical orientation = flat hex sides are horizontal
request$ = "hex orientation (H or V):  "
answer$ = GetInputLine(30, 50, request$)
HexOrientation$ = Lower$(answer$)

; the following refers to a FULL row or column, i.e., one which is not offset
;    from the map edge
request$ = "no. of hexes in 1 row:  "
answer$ = GetInputLine(30, 70, request$)
NumHexesInRow = Val(answer$)

request$ = "no. of hexes in 1 column:  "
answer$ = GetInputLine(30, 90, request$)
NumHexesInColumn = Val(answer$)

request$ = "show hex numbering (Y or N):  "
answer$ = GetInputLine(30, 110, request$)
HexNumbering$ = Lower$(answer$)

; ------------------------------------------------------------------------------

Cls white
CenterText GetScreenWidth() / 2, 65, "Working ..."
Sync

hexnumFont = GetFreeFont()
LoadFont "Arial", hexnumFont, 12, 0
SetFont hexnumFont

HexApothem# = Cos(30) * HexSide#
HexCutoff# = Sin(30) * HexSide#

RemStart
NOTE that for a regular hexagon created by CreateConvexShape the GetShapeVertexX,Y
commands produce the HexCutoff# & HexApothem# respectively.  That is the position
of the upper right vertex in relation to the center on a Cartesian grid.
The convex shape's handle is its center.
RemEnd

HexShape = GetFreeShape()
CreateConvexShape HexShape, HexSide#, 6

If HexOrientation$ = "h"
; HORIZONTAL ORIENTATION:
; PB draws hexes in Vertical Orientation
    RotateShape HexShape, 90, 1
    
   x = NumHexesInRow * (HexApothem# * 2) + 1
   y = NumHexesInColumn * (HexSide# + HexCutoff#) + HexCutoff# + 1
   CreateImage 1, x, y
   RenderToImage 1
   DrawGFXImmediate
   Cls white
   
   startX# = HexApothem#
   startY# = HexCutoff# + HexSide# / 2
   OffsetY# = HexCutoff# + HexSide#

   col = 1 : row = 1 : hexnum = 101
   Repeat
     If Even(row)
        ; remember - the shape's handle is its center
        OffsetX# = HexApothem#
    Else
             OffsetX# = 0
       EndIf
      x# = startX# + (col - 1) * (HexApothem# * 2) + OffsetX#
      y# = startY# + (row - 1) * OffsetY#
  DrawShape HexShape, x#, y#, 1
  If HexNumbering$ = "y"
     CenterText x#, y# - HexApothem# / 1.5, Digits$(hexnum, 4)
  EndIf
  Inc col : hexnum = hexnum + 100
  If (col > NumHexesInRow) Or (Even(row) And col = NumHexesInRow)
  ; every second row has 1 less hex
     col = 1 : hexnum = 100 + row
     Inc row : Inc hexnum
  EndIf
     Until row > NumHexesInColumn

Else
; vertical orientation
   
   x = NumHexesInRow * (HexSide# + HexCutoff#) + HexCutoff# + 1
   y = NumHexesInColumn * (HexApothem# * 2) + 1
   CreateImage 1, x, y
   RenderToImage 1
   DrawGFXImmediate
   Cls white
   
   startX# = HexCutoff# + HexSide# / 2
   startY# = HexApothem#
   OffsetX# = HexCutoff# + HexSide#

   col = 1 : row = 1 : hexnum = 101
   Repeat
    If Even(col)
       OffsetY# = HexApothem#
    Else
       OffsetY# = 0
    EndIf
    x# = startX# + (col - 1) * OffsetX#
    y# = startY# + (row - 1) * (HexApothem# * 2) + OffsetY#
  DrawShape HexShape, x#, y#, 1
  If HexNumbering$ = "y"
     CenterText x#, y# - HexApothem# / 1.5, Digits$(hexnum, 4)
  EndIf
  Inc row : hexnum = hexnum + 1
  If (row > NumHexesInColumn) Or (Even(col) And row = NumHexesInColumn)
  ; every second column has 1 less hex
     row = 1 : hexnum = col * 100 + 1
     Inc col : hexnum = hexnum + 100
  EndIf
   Until col > NumHexesInRow

EndIf

f$ = CurrentDir$() + "\HexGrid.bmp"
Save_Image_As_BitMap(f$, 1) 

RenderToScreen
Cls white
Ink black
SetFont ScreenFont
Text 30, 30, "Done."
Text 30, 60, "The blank hex grid is saved in"
Text 30, 90, CurrentDir$() + "\HexGrid.bmp"
Sync

WaitAllInput Off, 7, On

Login required to view complete source code