News:

Welcome to RetroCoders Community

Main Menu

Welcome fbgfx screen

Started by ron77, Feb 11, 2023, 03:15 PM

Previous topic - Next topic
Print
Go Down Pages1
User actions

ron77

Feb 11, 2023, 03:15 PM Last Edit: Feb 11, 2023, 03:46 PM by ron77 
' 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)

You cannot view this attachment.

ron77

#1
Feb 11, 2023, 04:06 PM Last Edit: Feb 11, 2023, 05:18 PM by ron77
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)

You cannot view this attachment.

Project DropBoc Link: 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)

You cannot view this attachment.

ron77

#2
Feb 11, 2023, 05:10 PM
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


You cannot view this attachment.

ron77

#3
Feb 11, 2023, 05:47 PM
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...

ron77

#4
Feb 11, 2023, 06:03 PM
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

ron77

#5
Feb 11, 2023, 08:01 PM Last Edit: Feb 11, 2023, 08:03 PM by ron77
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

You cannot view this attachment.

ron77

#6
Feb 11, 2023, 08:56 PM
Hi CharlieJV... :D

It's beautiful! Just like the one in freebasic I love it... thanks for sharing... you are one busy bee... :)
Print
Go Up Pages1
User actions