Main Menu

hex grid images

Started by Alex777, March 19, 2006, 08:24:05 AM

Previous topic - Next topic

Alex777

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: [Select]
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



tomazmb

Hello,

It's working very well. Thank you Alex777 for your effort.

Have a nice day,

Tomaz
My computer specification:

AMD Athlon 64 2800+
MB ASUS K8V Socket 754 VIA K8T800
SB Audigy 2
3 GB RAM DDR 400 MHz PQI
AGP NVIDIA GeForce 7600GT 256 MB-Club 3D
Windows XP Pro SP2
DirectX 9.0c

Alex777

Thanks, Tomaz!  Actually, I had to correct a bug and have reposted it, so if you need to use it you should d/l again.