fhex ... a Filled Hex

[James D Jarvis]

a little routine and associated demo for drawing a filled hex.

Code: (Select All)

'Fhex
'by James D. Jarvis August 19,2023
'draw a filled hex
'demo code
Screen _NewImage(500, 500, 32)
rr = 200
For d = 1 To 10
    fcirc 250, 250, rr, _RGB32(200, 200, 0)
    fhex 250, 250, rr, _RGB32(200, 100, 100)
    rr = rr * .86
Next d
For a = 60 To 360 Step 60
    ang_line 250, 250, 200, a, _RGB32(250, 0, 0)
Next a
 
hx = 60: hy = 60: hl = 12
fhex hx, hy, hl, _RGB32(100, 100, 100)
For ha = 30 To 390 Step 60
    hx = 60 + (hl * 1.9) * Cos(0.01745329 * ha)
    hy = 60 + (hl * 1.9) * Sin(0.01745329 * ha)
    fhex hx, hy, hl, _RGB32(ha / 2, ha / 2, ha / 20)
Next ha
 
Sub fhex (cx As Long, cy As Long, r, klr As _Unsigned Long)
    'draw a hex to radius r filled with color klr centeted on cx,cy
    rcheck = ((r * .867) * (r * .867))
    For dY = -r To r
        If dY * dY < rcheck Then
            dx = r - Abs(dY / _Pi * 1.81)
            Line (cx - dx, dY + cy)-(cx + dx, dY + cy), klr, BF
        End If
    Next dY
End Sub
 
 
'ang_line and fcirc included for demo not needed for fhex itself
Sub ang_line (sx, sy, lnth, ang, klr As _Unsigned Long)
    'draw a line lnth units long from sx,sy at anlge ang measures in degrees, 0 deg is out along X axis
    nx = sx + lnth * Cos(0.01745329 * ang)
    ny = sy + lnth * Sin(0.01745329 * ang)
    Line (sx, sy)-(nx, ny), klr
 
End Sub
Sub fcirc (CX As Long, CY As Long, R, klr As _Unsigned Long)
    'draw a filled circle with the quickest filled circle routine in qb64, not my development
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0
    If subRadius = 0 Then PSet (CX, CY): Exit Sub
    Line (CX - X, CY)-(CX + X, CY), klr, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), klr, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF
    Wend
End Sub

[CharlieJV]

I'm always looking for programs to test BAM in general and QB64PE compatibility.  Thanks!

• Run the program
  
• View the source code
  

[James D Jarvis]

I'm always looking for programs to test BAM in general and QB64PE compatibility.  Thanks!

• Run the program
  
• View the source code
  

You are most welcome. I always like seeing what others get up to with code I share.