' FreeBASIC code using FBgfx library
' Welcome screen for "Retrocoders Community" with rainbow colors
#Include "fbgfx.bi"
SCREENRES 800, 600, 32
width 800\ 8 , 600 \ 16
Dim As Integer gfx_w, gfx_h
Const As Integer BLACK = &H000000
Const As Integer RED = &HFF0000
Const As Integer ORANGE = &HFF7F00
Const As Integer YELLOW = &HFFFF00
Const As Integer GREEN = &H00FF00
Const As Integer BLUE = &H0000FF
Const As Integer INDIGO = &H4B0082
Const As Integer VIOLET = &H9400D3
' Function to draw a filled rectangle with the specified color
Sub DrawRect(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color1 As Integer)
line (x1, y1) - (x2, y2), color1 , bf
line (x1, y1) - (x2, y2), color1, b
End Sub
sub center(row as long, s as string)
locate row, (loword(width) - len(s) ) shr 1 : print s
end sub
' Get the width and height of the graphics window
gfx_w = 800
gfx_h = 600
' Clear the graphics window to black
color ,BLACK
cls
' Draw the rainbow rectangles
DrawRect(0, 0, gfx_w \ 7, gfx_h, RED)
DrawRect(gfx_w \ 7, 0, 2 * gfx_w \ 7, gfx_h, ORANGE)
DrawRect(2 * gfx_w \ 7, 0, 3 * gfx_w \ 7, gfx_h, YELLOW)
DrawRect(3 * gfx_w \ 7, 0, 4 * gfx_w \ 7, gfx_h, GREEN)
DrawRect(4 * gfx_w \ 7, 0, 5 * gfx_w \ 7, gfx_h, BLUE)
DrawRect(5 * gfx_w \ 7, 0, 6 * gfx_w \ 7, gfx_h, INDIGO)
DrawRect(6 * gfx_w \ 7, 0, gfx_w, gfx_h, VIOLET)
' Draw the "Retrocoders Community" text in white
color &HFFFFFF
center 15, "Retrocoders Community"
' Wait for the user to close the graphics window
Do
Sleep(10)
Loop Until INKEY = CHR(13)
welcome_fbgfx.png
now using FBTrueType Lib
' FreeBASIC code using FBgfx library
' Welcome screen for "Retrocoders Community" with rainbow colors
#Include "fbgfx.bi"
#include "FBTrueType.bi"
SCREENRES 800, 600, 32
width 800\ 8 , 600 \ 16
Dim As Integer gfx_w, gfx_h
Const As Integer BLACK = &H000000
Const As Integer RED = &HFF0000
Const As Integer ORANGE = &HFF7F00
Const As Integer YELLOW = &HFFFF00
Const As Integer GREEN = &H00FF00
Const As Integer BLUE = &H0000FF
Const As Integer INDIGO = &H4B0082
Const As Integer VIOLET = &H9400D3
const fontfile = "./fonts/tahoma.ttf"
' Function to draw a filled rectangle with the specified color
Sub DrawRect(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color1 As Integer)
line (x1, y1) - (x2, y2), color1 , bf
line (x1, y1) - (x2, y2), color1, b
End Sub
sub center(row as long, s as string)
locate row, (loword(width) - len(s) ) shr 1 : print s
end sub
' load the font
var font = FontLoad(fontfile)
if font<0 then
print "error: loading: " & fontfile & " " & ErrorText(font)
beep : sleep : end 1
end if
' Get the width and height of the graphics window
gfx_w = 800
gfx_h = 600
' Clear the graphics window to black
color ,BLACK
cls
' Draw the rainbow rectangles
DrawRect(0, 0, gfx_w \ 7, gfx_h, RED)
DrawRect(gfx_w \ 7, 0, 2 * gfx_w \ 7, gfx_h, ORANGE)
DrawRect(2 * gfx_w \ 7, 0, 3 * gfx_w \ 7, gfx_h, YELLOW)
DrawRect(3 * gfx_w \ 7, 0, 4 * gfx_w \ 7, gfx_h, GREEN)
DrawRect(4 * gfx_w \ 7, 0, 5 * gfx_w \ 7, gfx_h, BLUE)
DrawRect(5 * gfx_w \ 7, 0, 6 * gfx_w \ 7, gfx_h, INDIGO)
DrawRect(6 * gfx_w \ 7, 0, gfx_w, gfx_h, VIOLET)
' Draw the "Retrocoders Community" text in white
'color &HFFFFFF
'center 15, "Retrocoders Community"
TTPrint font,150,250, "Retrocoders Community",BLUE,35
' Wait for the user to close the graphics window
Do
Sleep(10)
Loop Until INKEY = CHR(13)
welcome_fbgfx-2.png
Project DropBoc Link: https://www.dropbox.com/s/dq45a0wnmpz7bv1/WELCOME.zip?dl=0 (https://www.dropbox.com/s/dq45a0wnmpz7bv1/WELCOME.zip?dl=0)
and here is with a red heart in center:
' FreeBASIC code using FBgfx library
' Welcome screen for "Retrocoders Community" with rainbow colors
#Include "fbgfx.bi"
#include "FBTrueType.bi"
SCREENRES 800, 600, 32
width 800\ 8 , 600 \ 16
Dim As Integer gfx_w, gfx_h
Dim As Double x, y, angle
Const As Integer BLACK = &H000000
Const As Integer RED = &HFF0000
Const As Integer ORANGE = &HFF7F00
Const As Integer YELLOW = &HFFFF00
Const As Integer GREEN = &H00FF00
Const As Integer BLUE = &H0000FF
Const As Integer INDIGO = &H4B0082
Const As Integer VIOLET = &H9400D3
const fontfile = "./fonts/tahoma.ttf"
' Function to draw a filled rectangle with the specified color
Sub DrawRect(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color1 As Integer)
line (x1, y1) - (x2, y2), color1 , bf
line (x1, y1) - (x2, y2), color1, b
End Sub
sub center(row as long, s as string)
locate row, (loword(width) - len(s) ) shr 1 : print s
end sub
' load the font
var font = FontLoad(fontfile)
if font<0 then
print "error: loading: " & fontfile & " " & ErrorText(font)
beep : sleep : end 1
end if
' Get the width and height of the graphics window
gfx_w = 800
gfx_h = 600
' Clear the graphics window to black
color ,BLACK
cls
' Draw the rainbow rectangles
DrawRect(0, 0, gfx_w \ 7, gfx_h, RED)
DrawRect(gfx_w \ 7, 0, 2 * gfx_w \ 7, gfx_h, ORANGE)
DrawRect(2 * gfx_w \ 7, 0, 3 * gfx_w \ 7, gfx_h, YELLOW)
DrawRect(3 * gfx_w \ 7, 0, 4 * gfx_w \ 7, gfx_h, GREEN)
DrawRect(4 * gfx_w \ 7, 0, 5 * gfx_w \ 7, gfx_h, BLUE)
DrawRect(5 * gfx_w \ 7, 0, 6 * gfx_w \ 7, gfx_h, INDIGO)
DrawRect(6 * gfx_w \ 7, 0, gfx_w, gfx_h, VIOLET)
For angle = 0 To 360 Step 0.1
x = 16 * (Sin(angle))^3
y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
x = 400 + 10 * x
y = 300 - 10 * y
PSet (x, y), RGB(255, 0, 0)
Next angle
TTPrint font,150,250, "Retrocoders Community",BLUE,35
' Wait for the user to close the graphics window
Do
Sleep(10)
Loop Until INKEY = CHR(13)
welcome-fbgfx-heart.png
Here is another fbgfx example:
#include "fbgfx.bi"
Dim As Double x, y, angle
ScreenRes 800, 600, 32
For angle = 0 To 360 Step 0.1
x = 16 * (Sin(angle))^3
y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
x = 400 + 10 * x
y = 300 - 10 * y
PSet (x, y), RGB(255, 0, 0)
Next angle
Sleep
End
heart-fbfgx.png
G'day G'day! :D
fbgfx lib is freebasic built-in graphic screen library that comes with freebasic compiler...
don't know if that helps or not...
here another heart fbgfx example:
#include "fbgfx.bi"
Dim As Double x, y, angle
ScreenRes 800, 600, 32,,fb.gfx_alpha_primitives
For angle = 0 To 360 Step 1/8
x = 16 * (Sin(angle))^3
y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
x = 400 + 10 * x
y = 300 - 10 * y
var iX = cint(int(x)), iY=cint(int(y))
var fX = x-iX, fY = y-iY
pset (iX , iY ), RGBA(255, 0, 0, (1-fX)*(1-fY)*255)
pset (iX+1, iY ), RGBA(255, 0, 0, ( fX)*(1-fY)*255)
pset (iX , iY+1), RGBA(255, 0, 0, (1-fX)*( fY)*255)
pset (iX+1, iY+1), RGBA(255, 0, 0, ( fX)*( fY)*255)
Next angle
Sleep
End
here is a heart filling up on fbgfx graphic screen
#include "fbgfx.bi"
Dim As Double x, y, angle
ScreenRes 800, 600, 32,,fb.gfx_alpha_primitives
line(0,0)-(800,600),rgb(0,64,128),bf
for S as double = (16*255)/256 to 0 step -1/32
For angle = 0 To 3.1415 Step 1/256
x = 16 * (Sin(angle))^3
y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
x = S * x : y = S * y
var iX = cint(int(x)), iY=cint(int(y))
var fX = x-iX, fY = y-iY
'dim as long iG=sqr(x*x+y*y)*.1,iR=128+S*8,iB=64-S*4
dim as long iR=abs(X\2)+128,iB=16+angle*64,iG=abs(Y)*.9
const iAlpha = 128
pset ((400+iX) , (300-iY) ), RGBA(iR, iG, iB, (1-fX)*(1-fY)*iAlpha)
pset ((400+iX)+1, (300-iY) ), RGBA(iR, iG, iB, ( fX)*(1-fY)*iAlpha)
pset ((400+iX) , (300-iY)-1), RGBA(iR, iG, iB, (1-fX)*( fY)*iAlpha)
pset ((400+iX)+1, (300-iY)-1), RGBA(iR, iG, iB, ( fX)*( fY)*iAlpha)
pset ((400-iX) , (300-iY) ), RGBA(iR, iG, iB, (1-fX)*(1-fY)*iAlpha)
pset ((400-iX)-1, (300-iY) ), RGBA(iR, iG, iB, ( fX)*(1-fY)*iAlpha)
pset ((400-iX) , (300-iY)-1), RGBA(iR, iG, iB, (1-fX)*( fY)*iAlpha)
pset ((400-iX)-1, (300-iY)-1), RGBA(iR, iG, iB, ( fX)*( fY)*iAlpha)
Next angle
sleep 30
next S
Sleep
End
full_heart_fbgfx.png
Hi CharlieJV... :D
It's beautiful! Just like the one in freebasic I love it... thanks for sharing... you are one busy bee... :)