Changing Avatar

[bplus]

I get an idea in my head and I got to play with it...

Code: (Select All)

Option _Explicit
_Title "Changing Avatar" 'b+ need to keep total bytes below 1MB
Const xmax = 300 ' screen width
Const ymax = 300 ' screen height
Screen _NewImage(xmax, ymax, 32)
_Delay .25 ' wait for screen to load
_ScreenMove _Middle ' center in screen
ReDim As Long i1, i2, j1, j2, x, y
ReDim As _Unsigned Long c1, c2
ReDim f
i1 = _LoadImage("phoenix100.png") ' Wikimedia commons Public Domain
'  https://commons.wikimedia.org/w/index.php?search=Phoenix+art+images&title=Special:MediaSearch&go=Go&type=image
i2 = _LoadImage("qb64.png")
j1 = _NewImage(xmax, ymax, 32)
j2 = _NewImage(xmax, ymax, 32)
_PutImage , i1, j1
_PutImage , i2, j2
_FreeImage i1
_FreeImage i2
_PutImage , j1, 0
restart:
_PutImage , j1, 0
For f = 0 To 1.01 Step .01
    Cls
    For y = 0 To ymax
        For x = 0 To xmax
            _Source j1
            c1 = Point(x, y)
            _Source j2
            c2 = Point(x, y)
            PSet (x, y), Ink~&(c1, c2, f)
        Next
    Next
    _Display
    _Limit 20
Next
_PutImage , j2, 0
For f = 1 To 0 Step -.01
    Cls
    For y = 0 To ymax
        For x = 0 To xmax
            _Source j1
            c1 = Point(x, y)
            _Source j2
            c2 = Point(x, y)
            PSet (x, y), Ink~&(c1, c2, f)
        Next
    Next
    _Display
    _Limit 20
Next
GoTo restart

Function Ink~& (c1 As _Unsigned Long, c2 As _Unsigned Long, fr##)
    Dim R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
End Function

Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
    outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub

zip contains 2 images, the source and a Windows compiled exe