so yeah some demo showing alpha capabilities of freebasic...
#include "fbgfx.bi"
type Pixel
B as ubyte
G as ubyte
R as ubyte
A as ubyte
end type
sub OutlineText( pTarget as any ptr = 0 , iX as long , iY as long , sText as string , iFore as ulong , iBorder as ulong = rgb(0,0,0) )
for iNY as long = -1 to 1
for iNX as long = -1 to 1
draw string pTarget,(iX+iNX,iY+iNY),sText,iBorder
next iNX
next iNY
draw string pTarget,(iX,iY),sText,iFore
end sub
sub DrawMouse( pTarget as any ptr = 0 , iX as long , iY as long , iFill as ulong , iBorder as ulong )
line pTarget, (iX+ 0,iY+ 0)-(iX+35,iY+32),iBorder
line pTarget,-(iX+22,iY+37),iBorder : line pTarget,-(iX+28,iY+52),iBorder
line pTarget,-(iX+22,iY+55),iBorder : line pTarget,-(iX+13,iY+40),iBorder
line pTarget,-(iX+ 1,iY+49),iBorder : line pTarget,-(iX+ 0,iY+ 0),iBorder
if iFill <> rgb(255,0,255) then paint pTarget,(iX+18,iY+30),iFill,iBorder
end sub
#define AlphaEnable() Screencontrol( fb.SET_ALPHA_PRIMITIVES , 1 )
#define AlphaDisable() Screencontrol( fb.SET_ALPHA_PRIMITIVES , 0 )
'create screen with alha primitives capability
screenres 640,480,32,2,fb.GFX_ALPHA_PRIMITIVES or fb.GFX_HIGH_PRIORITY
width 640\8,480\16 'font size 8x16
'disable alpha primitives until we need it
AlphaDisable()
dim as fb.image ptr pAlpha8 = ImageCreate(320,240,,8) '8bpp image (alpha part)
dim as fb.image ptr pImage = ImageCreate(320,240) 'image block
dim as fb.image ptr pBack = ImageCreate(640,480,rgb(0,0,0)) 'generated background
dim as fb.image ptr pBack2 = ImageCreate(640,480,rgb(0,0,0)) 'generated background
dim as fb.image ptr pCursor = ImageCreate(36,60,rgba(0,0,0,0))'mouse cursor
dim as fb.image ptr pCursor8= ImageCreate(36,60,&hFFFFFF,8) 'mouse cursor (8bpp as alpha)
'generate cursor
scope
var iBorder = rgb(255,255,254) , iFill = rgba(0,0,1,0)
DrawMouse pCursor ,0,0,iFill,iBorder
DrawMouse pCursor8,0,0,iFill,iBorder
end scope
'draw strings all over the screen
for N as long = 0 to 199
var iC=rgb(192+rnd*63,192+rnd*63,192+rnd*63)
OutlineText pBack,rnd*640-(6*8),rnd*480,"Hello World!",iC,iC and &hFF7F7F7F
next N
put pBack2,(0,0),pBack,pset
'blur/dither background as effect
for Y as long = -2 to 2 step 2
for X as long = -2 to 2 step 2
put pBack,(X,Y),pBack,alpha,128 'dither blur
next X
next Y
'enable alpha primitives temporally
AlphaEnable()
'generate random 32bpp image
for N as long = 0 to 999
circle pImage,(rnd*320,rnd*240),rnd*64,rgba(rnd*192,rnd*192,rnd*192,128),,,,f
next N
'and now can disable it again
AlphaDisable()
dim as long iAlpha,iPage
setmouse ,,0
WindowTitle("Alpha Examples")
do
dim as integer MX,MY
var iShow = (GetMouse(MX,MY)=0)
iAlpha = iAlpha+3 'back and forth -255 to 255
if iAlpha > 255 then iAlpha -= 511 'back to -255
iPage xor= 1 '1 <-> 0
screenset iPage,iPage xor 1
put (0,0),pBack,pset
'generate 8bpp image with a radius fading alpha
for N as integer = 383 to 0 step -1
var iCircleAlpha = (iAlpha\2+cint(N/1.5)) and &hF0
circle pAlpha8,(160,120),N,iCircleAlpha,,,,f
next N
'put the 8bpp image as alpha into the 32bpp image
'BUG: FBGFX? if i dont enable Alpha here... it permanently disable primitive alpha...
AlphaEnable() : put pImage,(0,0),pAlpha8,alpha : AlphaDisable()
'draw on the screen on the left top with alpha
if iShow then AlphaEnable() : put pImage,(MX,MY),pCursor8,alpha : AlphaDisable()
put(0,0),pImage,alpha
OutlineText ,4,2,"Alpha from 8bpp image",rgb(255,255,255)
'draw on the screen on the right top WITHOUT alpha
if iShow then put pImage,(MX-320,MY),pCursor8,alpha
put(320,0),pImage,pset
OutlineText ,324,2,"regular put",rgb(255,255,255)
'draw on the screen on the left bottom with fixed alpha
if iShow then AlphaEnable():put pImage,(MX,MY-240),pCursor8,alpha:AlphaDisable()
put(0,240),pImage,alpha,abs(iAlpha)
OutlineText ,4,242,"fixed alpha " & abs(iAlpha),rgb(255,255,255)
'changing alpha of each pixel to random
var pPix = cast(Pixel ptr,pImage+1) 'point to the alpha of the first pixel
for Y as long = 0 to 239
for X as long = 0 to 319
pPix[X].A = rnd*255 'sets random alpha
next X
cast(ubyte ptr,pPix) += pImage->Pitch 'advance to next row
next Y
'blur alpha (right side)
var iPixPit = (pImage->Pitch)\sizeof(pixel), iL=1+cint(abs(iAlpha)*(158/255))
pPix = cast(Pixel ptr,pImage+1)
for Y as long = 1 to 239
cast(ubyte ptr,pPix) += pImage->Pitch
for X as long = iL to iL+158
pPix[X].A = (pPix[X].A + pPix[X-1].A + pPix[X-iPixPit].A + pPix[X-iPixPit+1].A)\4
next X
next Y
'draw on the screen with (right bottom) modified random alpha
if iShow then AlphaEnable():put pImage,(MX-320,MY-240),pCursor8,alpha:AlphaDisable()
put(320,240),pImage,alpha
OutlineText ,324,242,"random blurred alpha",rgb(255,255,255)
line(320+iL,240)-step(158,239),rgb(128,128,128),b
line(320,0)-(320,479),rgb(255,255,255)
line(0,240)-(639,240),rgb(255,255,255)
'just the borders with alpha... (trans could be used here i guess)
if iShow then Put(MX,MY),pCursor,alpha
sleep 15,1
loop until len(inkey)
'only cursor as alpha :)
WindowTitle("Only Alpha Cursor")
'255 alpha area (to erase cursor)
line pAlpha8,(0,0)-(35,59),-1,bf
AlphaEnable()
do
dim as integer MX,MY
var iShow = (GetMouse(MX,MY)=0)
iPage xor= 1 '1 <-> 0
screenset iPage,iPage xor 1
'partially show unblurred background
put ( 0, 0),pBack2,alpha,16
'draw mouse on alpha and then the alpha on the screen
if iShow then put pBack,(MX,MY),pCursor8,alpha
put (0,0),pBack,alpha
if iShow then
DrawMouse ,MX,MY,rgb(255,0,255),rgba(255,255,255,16)
put pBack,(MX,MY),pAlpha8,(0,0)-(35,59),alpha
end if
sleep 15,1
loop until len(inkey)
hi mysoft thanks for posting this example :)
here is how it looks like:
(https://i.imgur.com/MvnhbtB.png)