Transparent Overlay

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Transparent Overlay

Post by MrSwiss »

Hi all,

below a example showing, how a once drawn image, can be used as overlay.
The base of the trick is *transparency* of the image, used as overlay.

The example also shows, how to create an *endless* image of a Brick:
- endless refers to: can be endlessly put along itself, creating a whole Wall.

TransparentOverlay.bas:

Code: Select all

' TranparentOverlay.bas -- 2017-05-14, by MrSwiss
'
' compile with: -s GUI
'
'#Include "GFX_MATH.bi"  ' see: https://freebasic.net/forum/viewtopic.php?f=7&t=25635
Const As Single Pi = 4f * Atn(1f)
Const As Single d2r = Pi / 180f

#Define RAD(d)          ( d * d2r )
#Define LRange(l, h)    ( CLng(Rnd() * (h - l) + l) )
' above is taken out of: GFX_MATH.bi

Declare Sub BuildBrickImage(ByVal As Any Ptr, ByVal As ULong=0)
Declare Sub BuildSmileyImage(ByVal As Any Ptr, ByVal As ULong, ByVal As ULong=0, ByVal As ULong )

' ===== MAIN =====
Randomize(Timer, 3)
ScreenRes(651, 481, 32)

Dim As ULong    x, y, w = 321, h = w, ctrx = 160, r = 150, clr = &hff5f5f5f
Dim As Any Ptr  img = ImageCreate(50, 30, &hffbf3f00)   ' orangey bg (brick color)
Dim As Any Ptr  smiley = ImageCreate(w, h)              ' transparent bg (default)
Dim As Boolean  sf = TRUE   ' smiley flag (aka, switch: TRUE = ON, FALSE = OFF)

BuildBrickImage(img, clr)   ' clr = mortar color fg (line color)
BuildSmileyImage(smiley, ctrx,, r)

Do
    ScreenLock                                  ' prevent flickering
    For v As UInteger = 0 To 480-30 Step 30     ' vertical stepping
        For h As UInteger = 0 To 650-50 Step 50 ' horizontal stepping
            Put (h, v), img, PSet               ' bricks to screen (build wall)
        Next 'h
    Next
    x = LRange(10, 320) : y = LRange(10, 150)   ' randomize smiley's positioning
    If sf Then Put (x, y), smiley, Trans        ' smiley ON/OFF (transparent overlay)
    ScreenUnLock                                ' prevent flickering end

    Sleep 333, 1 : sf = Not sf                  ' give user time to see | flip the switch
Loop Until Len(InKey())                         ' quit on user action, keyboard/mouse
' clean up ...
ImageDestroy(img) : img = 0                     ' clear memory, re-set pointer
ImageDestroy(smiley) : smiley = 0               ' as above
' ===== END-MAIN =====
' imlement declared sub's ...
Sub BuildBrickImage(ByVal i As Any Ptr, ByVal clr As ULong=0)
    ' top half
    Line i, ( 0,  0)-(49, 14), clr, B           ' whole top half block dark grey
    Line i, ( 0,  1)-(49,  1), clr              ' horiz. top line (dbl. thick)
    ' center part
    Line i, ( 0, 15)-(49, 15), clr              ' horiz. center line (dbl. thick)
    ' bottom half
    Line i, (24, 15)-(24, 29), clr              ' vertical line center
    Line i, (25, 15)-(25, 29), clr              ' vertical line center (dbl. thick)
End Sub

Sub BuildSmileyImage(ByVal i As Any Ptr, ByVal xc As ULong, _
                     ByVal yc As ULong=0, ByVal rd As ULong )
    If yc = 0 Then yc = xc  ' default: assume a square
    Circle i, (xc, yc), rd, &hffffdf00,,,, F                ' smiley face yellow filled
    Circle i, (xc, yc), rd, &hff000000                      ' smiley face border black
    Circle i, (xc-50, yc-30), rd \ 6, &hff000000            ' left eye border black
    Circle i, (xc-50, yc-30), rd \ 6 - 1, &hff00ff,,,, F    ' left eye fill transparent
    Circle i, (xc+50, yc-30), rd \ 6, &hff000000            ' right eye border black
    Circle i, (xc+50, yc-30), rd \ 6 - 1, &hff00ff,,,, F    ' right eye fill transparent
    Circle i, (xc, yc+25), rd \ 2, &hff000000, RAD(200), RAD(340)   ' mouth lower shape
    Circle i, (xc, yc-80), rd, &hff000000, RAD(242), RAD(298)       ' mouth upper shape
    Paint i, (xc, yc+90), &hff00ff, &hff000000              ' mouth fill transparent
End Sub
' ------ EOF -----
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Transparent Overlay

Post by MrSwiss »

A updated version (of above):
- it uses a third image (wall) and a Sub to build it.
- should speed up things (no more For..Next loops in MAIN-code)

Code: Select all

' TranparentOverlay2.bas -- 2017-05-14, by MrSwiss, ver. 2
'
' compile with: -s GUI
'
#Include "GFX_MATH.bi"  ' see: https://freebasic.net/forum/viewtopic.php?f=7&t=25635

Declare Sub BuildBrickImg(ByVal As Any Ptr, ByVal As ULong=0)
Declare Sub BuildWallImg(ByVal As Any Ptr, ByVal As ULong, ByVal As ULong, ByVal As Any Ptr, ByVal As ULong, ByVal As ULong)
Declare Sub BuildSmileyImg(ByVal As Any Ptr, ByVal As ULong, ByVal As ULong=0, ByVal As ULong )

' ===== MAIN =====
'Randomize(Timer, 3) -- now in GFX_MATH.bi
ScreenRes(650, 480, 32)

Dim As ULong    x, y, w = 321, h = w, ctrx = 160, r = 150, clr = &hff5f5f5f
Dim As Any Ptr  brick = ImageCreate(50, 30, &hffbf3f00) ' orangey bg (brick color)
Dim As Any Ptr  smiley = ImageCreate(w, h)              ' transparent bg (default)
Dim As Any Ptr  wall = ImageCreate(651, 481)            ' full screen size
Dim As Boolean  sf = TRUE   ' smiley flag (aka, switch: TRUE = ON, FALSE = OFF)

BuildBrickImg(brick, clr)   ' clr = mortar color fg (line color)
BuildWallImg(brick, 50, 30, wall, 650, 480)     ' build wall using brick ...
BuildSmileyImg(smiley, ctrx,, r)

Do
    x = LRange(10, 320) : y = LRange(10, 150)   ' randomize smiley's positioning
    ScreenLock                                  ' prevent flickering
    Put (0, 0), wall, PSet                      ' set bg image (brick wall)
    If sf Then Put (x, y), smiley, Trans        ' smiley ON/OFF (transparent overlay)
    ScreenUnLock                                ' prevent flickering end

    Sleep 333, 1 : sf = Not sf                  ' give user time to see | flip the switch
Loop Until Len(InKey())                         ' quit on user action, keyboard/mouse
' clean up ...
ImageDestroy(brick) : brick = 0                 ' clear memory, re-set pointer
ImageDestroy(smiley) : smiley = 0               ' as above
ImageDestroy(wall) : wall = 0                   ' as above
' ===== END-MAIN =====
' imlement declared sub's ...
Sub BuildBrickImg ( ByVal i As Any Ptr, _
                    ByVal clr As ULong = 0 )
    ' top half
    Line i, ( 0,  0)-(49, 14), clr, B           ' whole top half block dark grey
    Line i, ( 0,  1)-(49,  1), clr              ' horiz. top line (dbl. thick)
    ' center part
    Line i, ( 0, 15)-(49, 15), clr              ' horiz. center line (dbl. thick)
    ' bottom half
    Line i, (24, 15)-(24, 29), clr              ' vertical line center
    Line i, (25, 15)-(25, 29), clr              ' vertical line center (dbl. thick)
End Sub

Sub BuildWallImg  ( ByVal pSrc As Any Ptr, _
                    ByVal srcW As ULong, _
                    ByVal srcH As ULong, _
                    ByVal pTrg As Any Ptr, _
                    ByVal trgW As ULong, _
                    ByVal trgH As ULong )
    ' generate a new img, using another img as source (building block)
    For v As UInteger = 0 To trgH-srcH Step srcH        ' vertical stepping
        For h As UInteger = 0 To trgW-srcW Step srcW    ' horizontal stepping
            Put pTrg, (h, v), pSrc, PSet                ' bricks to wall (build wall)
        Next
    Next
End Sub

Sub BuildSmileyImg( ByVal i As Any Ptr, _
                    ByVal xc As ULong, _
                    ByVal yc As ULong = 0, _
                    ByVal rd As ULong )
    If yc = 0 Then yc = xc  ' default: assume a square
    Circle i, (xc, yc), rd, &hffffdf00,,,, F                ' smiley face yellow filled
    Circle i, (xc, yc), rd, &hff000000                      ' smiley face border black
    Circle i, (xc-50, yc-30), rd \ 6, &hff000000            ' left eye border black
    Circle i, (xc-50, yc-30), rd \ 6 - 1, &hff00ff,,,, F    ' left eye fill transparent
    Circle i, (xc+50, yc-30), rd \ 6, &hff000000            ' right eye border black
    Circle i, (xc+50, yc-30), rd \ 6 - 1, &hff00ff,,,, F    ' right eye fill transparent
    Circle i, (xc, yc+25), rd \ 2, &hff000000, RAD(200), RAD(340)   ' mouth lower shape
    Circle i, (xc, yc-80), rd, &hff000000, RAD(242), RAD(298)       ' mouth upper shape
    Paint i, (xc, yc+90), &hff00ff, &hff000000              ' mouth fill transparent
End Sub
' ------ EOF -----
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Transparent Overlay

Post by D.J.Peters »

Using PUT with TRANS isn't any trick it's only spam for #Include "GFX_MATH.bi" ;-)
Last edited by D.J.Peters on May 14, 2017 23:01, edited 1 time in total.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Transparent Overlay

Post by MrSwiss »

lol - but the *endless* Brick is one ...
and, the macros, generating a random position is another ...
(while maintaining a border, of at least 10 pixels, to the window's edges)
mrminecrafttnt
Posts: 131
Joined: Feb 11, 2013 12:23

Re: Transparent Overlay

Post by mrminecrafttnt »

This is transperent :)

Code: Select all

' TranparentOverlay.bas -- 2017-05-14, by MrSwiss
'
' compile with: -s GUI
'
'#Include "GFX_MATH.bi"  ' see: https://freebasic.net/forum/viewtopic.php?f=7&t=25635
Const As Single Pi = 4f * Atn(1f)
Const As Single d2r = Pi / 180f

#Define RAD(d)          ( d * d2r )
#Define LRange(l, h)    ( CLng(Rnd() * (h - l) + l) )
' above is taken out of: GFX_MATH.bi

Declare Sub BuildBrickImage(ByVal As Any Ptr, ByVal As ULong=0)
Declare Sub BuildSmileyImage(ByVal As Any Ptr, ByVal As ULong, ByVal As ULong=0, ByVal As ULong )

' ===== MAIN =====
Randomize(Timer, 3)
ScreenRes(651, 481, 32)

Dim As ULong    x, y, w = 321, h = w, ctrx = 160, r = 150, clr = &hff5f5f5f
Dim As Any Ptr  img = ImageCreate(50, 30, &hffbf3f00)   ' orangey bg (brick color)
Dim As Any Ptr  smiley = ImageCreate(w, h)              ' transparent bg (default)
Dim As Boolean  sf = TRUE   ' smiley flag (aka, switch: TRUE = ON, FALSE = OFF)

BuildBrickImage(img, clr)   ' clr = mortar color fg (line color)
BuildSmileyImage(smiley, ctrx,, r)

Do
    ScreenLock                                  ' prevent flickering
    For v As UInteger = 0 To 480-30 Step 30     ' vertical stepping
        For h As UInteger = 0 To 650-50 Step 50 ' horizontal stepping
            Put (h, v), img, PSet               ' bricks to screen (build wall)
        Next 'h
    Next
    x = LRange(10, 320) : y = LRange(10, 150)   ' randomize smiley's positioning
    If sf Then Put (x, y), smiley, alpha ,75        ' smiley ON/OFF (transparent overlay)
    ScreenUnLock                                ' prevent flickering end

    Sleep 333, 1 : sf = Not sf                  ' give user time to see | flip the switch
Loop Until Len(InKey())                         ' quit on user action, keyboard/mouse
' clean up ...
ImageDestroy(img) : img = 0                     ' clear memory, re-set pointer
ImageDestroy(smiley) : smiley = 0               ' as above
' ===== END-MAIN =====
' imlement declared sub's ...
Sub BuildBrickImage(ByVal i As Any Ptr, ByVal clr As ULong=0)
    ' top half
    Line i, ( 0,  0)-(49, 14), clr, B           ' whole top half block dark grey
    Line i, ( 0,  1)-(49,  1), clr              ' horiz. top line (dbl. thick)
    ' center part
    Line i, ( 0, 15)-(49, 15), clr              ' horiz. center line (dbl. thick)
    ' bottom half
    Line i, (24, 15)-(24, 29), clr              ' vertical line center
    Line i, (25, 15)-(25, 29), clr              ' vertical line center (dbl. thick)
End Sub

Sub BuildSmileyImage(ByVal i As Any Ptr, ByVal xc As ULong, _
                     ByVal yc As ULong=0, ByVal rd As ULong )
    If yc = 0 Then yc = xc  ' default: assume a square
    Circle i, (xc, yc), rd, &hffffdf00,,,, F                ' smiley face yellow filled
    Circle i, (xc, yc), rd, &hff000000                      ' smiley face border black
    Circle i, (xc-50, yc-30), rd \ 6, &hff000000            ' left eye border black
    Circle i, (xc-50, yc-30), rd \ 6 - 1, &hff00ff,,,, F    ' left eye fill transparent
    Circle i, (xc+50, yc-30), rd \ 6, &hff000000            ' right eye border black
    Circle i, (xc+50, yc-30), rd \ 6 - 1, &hff00ff,,,, F    ' right eye fill transparent
    Circle i, (xc, yc+25), rd \ 2, &hff000000, RAD(200), RAD(340)   ' mouth lower shape
    Circle i, (xc, yc-80), rd, &hff000000, RAD(242), RAD(298)       ' mouth upper shape
    Paint i, (xc, yc+90), &hff00ff, &hff000000              ' mouth fill transparent
End Sub
' ------ EOF -----
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Transparent Overlay

Post by dodicat »

Did this a while back.
But made the Yin see-through for the thread.
(Big yin taking the little ones walkies)

Code: Select all

Dim Shared As Integer xres,yres,size
Dim Shared As Single spread=25,scale=.76,sizeX=400,sizeY=300,depth=10
Const pie=4*Atn(1)
Screenres 800,600,32,,64
Screeninfo xres,yres
Dim As Ulong Ptr im=Imagecreate(xres,yres)
Dim As Ulong Ptr pi
Imageinfo im,,,,,pi,size
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Sub YinYang(xpos As long,ypos As long,size As long,c1 As Ulong=8,c2 As Ulong=12,an As Single)
    #macro rotate(px,py,a,rotx,roty)
    rotx=(Cos(a*.0174533)*(px-xpos)-Sin(a*.0174533)*(py-ypos)) +xpos
    roty=(Sin(a*.0174533)*(px-xpos)+Cos(a*.0174533)*(py-ypos)) +ypos
    #endmacro
    Dim As Single rx,ry,tempx1,tempy1,tempx2,tempy2
    Circle (xpos, ypos), size,c2
    Var yps1=ypos+size,yps2=ypos-size
    Var xps1=xpos+size/2,xps2=xpos-size/2
    Var yps3=ypos-size/2,yps4=ypos+size/2
    rotate(xpos,yps1,an,rx,ry)
    tempx1=rx:tempy1=ry
    rotate(xpos,yps2,an,rx,ry)
    tempx2=rx:tempy2=ry
    Line (tempx1, tempy1)-( tempx2,tempy2),c2
    rotate(xps1,ypos,an,rx,ry)
    tempx1=rx:tempy1=ry
    rotate(xps2,ypos,an,rx,ry)
    tempx2=rx:tempy2=ry
    Paint(tempx1,tempy1),c2
    Paint(tempx2,tempy2),c1,c2
    rotate(xpos,yps3,an,rx,ry)
    tempx1=rx:tempy1=ry
    rotate(xpos,yps4,an,rx,ry)
    tempx2=rx:tempy2=ry
    Circle (tempx1,tempy1), size/2,c2,,,,f
    Circle (tempx2,tempy2), size/2,c1,,,,f
    Circle (tempx1,tempy1), size/6,c1,,,,f
    Circle (tempx2,tempy2), size/6,c2,,,,f
End Sub

Sub Tree(x1 As Single,y1 As Single,size As Single,angle As Single,depth As Single,colb As Ulong=0,colL As Ulong=0,im As Any Ptr=0)
    #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    Var x2=x1-.25*size*Cos(angle*.01745329)
    Var y2=y1-.25*size*Sin(angle*.01745329)
    Static As long count,fx,fy,sz,z
    If count=0 Then  fx=x1:fy=y1:sz=size:z=2^(depth+1)-1
    Line im,(x1,y1)-(x2,y2),colb
    If count=0 Then  fx=x2:fy=y2:sz=size
    count=count+1
    If count>z Then count=0
    If incircle(fx,fy,(.45*sz),x2,y2)=0 Then Circle im,(x2,y2),.01*sz,colL 
    If depth>0 Then
        Tree(x2, y2, size * Scale, angle - Spread, depth - 1,colB,colL,im)
        Tree(x2, y2, size * Scale, angle + Spread, depth - 1,colB,colL,im)
    End If
End Sub


Sub drawwalltoimage(Byref im As Ulong Ptr)
    Randomize 1
    for z as long=0 to yres/2+5
        var r=map(0,(yres/2+5),z,0,250)
        var g=map(0,(yres/2+5),z,0,250)
        var b=map(0,(yres/2+5),z,200,250)
        line im,(0,z)-(xres,z),rgb(r,g,b)
        next z
    Tree(200,300,200,80,12,Rgb(200,100,0),Rgb(0,100,0),im)
    Tree(700,300,100,100,12,Rgb(100,50,0),Rgb(0,90,0),im)
    Dim As long bw=xres/20,bh=xres/40,k=bw/4
    For y As long=yres/2 To yres Step bh
        For x As long=-bw To xres Step bw
            Line im,(x+k,y)-Step(bw,bh),Rgb(200,100+(Rnd*15-Rnd*15),0),bf
            Line im,(x+k,y)-Step(bw,bh),Rgb(200,200,200),b
        Next x
        k=-k
    Next y
    dim as single s=0
    For x As Single=s To 1.99*pie Step .01
        Var xpos=map(s,1.9*pie,x,0,xres)
        Var ypos=map(-1,1,Cos(x),(yres-5),(yres-30))
        If x=s Then Pset im,(xpos,ypos) Else Line im,-(xpos,ypos),Rgb(0,100,0)
    Next x
    Paint im,(1,yres-1),Rgb(0,100,0),Rgb(0,100,0)
End Sub

Function Regulate(Byval MyFps As long,Byref fps As long=0) As long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

#macro Sweep(p)
For z As long=0 To (size)\4
    Swap p[z],p[z+1]
Next z
#endmacro
'=====================================================
drawWallToImage(im)

Dim As Single a,rad=yres/6,k,k2
dim as long fps
Do
    a+=1
    sweep(pi)
    If a Mod xres=0 Then Paint im,(0,0),Rgb(0,0,0):DrawWallToImage(im)
    Screenlock
    Cls
    Put(0,0),im,trans
    draw string(20,20),"FPS " &fps
    Var xpos=map(0,xres,a,0,2*pie)
    Var ypos=map(-1,1,Sin(xpos),5,30)
    For n As long=1 To 8 Step 2
        If n=1 Then k=265:k2=ypos Else k=0 :k2=0
        Yinyang(200*Sqr(n),k+yres/2-rad/n-n/4+k2,rad/n,Rgba(30*n,0,0,100),Rgb(255-30*n,255,255),n*a)
    Next n
    Screenunlock
    Sleep regulate(175,fps),1
Loop Until Len(Inkey)
Sleep
Imagedestroy im

  
UEZ
Posts: 974
Joined: May 05, 2017 19:59
Location: Germany

Re: Transparent Overlay

Post by UEZ »

An example of a rotating earth mapped transparent cloud texture on it using GDIPlus -> thus windows os only. ¯\_(ツ)_/¯

Download: http://www.mediafire.com/file/o6gdy9wye ... -03-19.zip

Preview:
Image

Unfortunately GDIPlus lib is slow but it looks nice. ^^
Last edited by UEZ on Jan 06, 2018 16:30, edited 1 time in total.
thesanman112
Posts: 538
Joined: Jul 15, 2005 4:13

Re: Transparent Overlay

Post by thesanman112 »

UEZ, was the demo done with fb?
UEZ
Posts: 974
Joined: May 05, 2017 19:59
Location: Germany

Re: Transparent Overlay

Post by UEZ »

@thesanman112: if you mean the screenshot -> it was taken from the AutoIt version (which should be the same). But the "demo" in the Zip archieve is the FB version.
Post Reply