http://www.sendspace.com/file/xsnw7r
its a 800x600x24 bitmap = 1.3mb
you can check it wherever you want... or maybe in freebasic with
Code: Select all
screenres 800,600,32
bload "image.bmp"
sleepCode: Select all
#include "fbgfx.bi"
declare sub Blur(WHERE as any ptr)
#define Cvt(WHAT) ((WHAT and &h00030303) shl 6)
screenres 800,600,32,,fb.gfx_high_priority
dim as any ptr IMG = ImageCreate(800,600)
dim PIX as integer ptr,BT as double
' bload the bitmap and clear alpha
bload "image.bmp",IMG:PIX = IMG+sizeof(fb.image)
for D as integer=1 to 800*600:*PIX or= &hFF202020: PIX += 1:next D
screenlock:put(0,0),IMG,pset:Blur(screenptr):screenunlock
' do the magic
PIX = IMG+sizeof(fb.image)
for D as integer = 1 to 800*600
if (*PIX and &HFF000000) then *PIX = Cvt(*PIX)
PIX += 1
next D
Blur(IMG+sizeof(fb.image))
' wait key
do
BT xor= 1:sleep 300,1
if BT then WindowTitle ("PRESS A KEY TO CONTINUE!") else WindowTitle ("")
if BT then if inkey$ <> "" then exit do
loop
' alpha effect
BT = timer
for D as integer = 0 to 39
put(0,0),IMG,alpha,1.15^D
while (timer-BT) < 1/15
sleep 1
wend
BT += 1/15
next D
WindowTitle ("Press any key to finish")
sleep
' blur to raise image quality
sub Blur(WHERE as any ptr)
dim as ubyte ptr PIX
dim as integer TMP
PIX = WHERE
for D as integer = 1 to 800*598*4
TMP = *PIX+PIX[4]+PIX[3200]+PIX[3204]
TMP += PIX[8]+PIX[3208]+PIX[6400]+PIX[6404]
*PIX = (TMP shr 3)
PIX += 1
next D
end subno? oh then... try changing the #define there (line 5) for...
Code: Select all
#define Cvt(WHAT) ((WHAT and &h000C0C0C) shl 4)haaa! there it goes again...
want another one??
well maybe then let's try something different
try this one:
Code: Select all
#include "fbgfx.bi"
screenres 800,600,32,,fb.gfx_high_priority or fb.gfx_alpha_primitives
declare sub Blur(WHERE as any ptr)
dim as uinteger ptr PIX
dim as ubyte TST,BITS
dim as uinteger PTX,PTZ
dim as string NNM = chr$(118,105,100,101,111,46,119,109,118)
dim as double BT
dim as string TT
' bload the image
bload "image.bmp"
' *** extract magic ***
open NNM for binary as #1
open cons for output as #99
PIX = screenptr: BITS = 0: TST = 0
for Y as integer = 1 to 600
screenlock
for X as integer = 1 to 800
PTX = (*PIX and &h303030)
*PIX and= (not &h303030)
TST shr= 2: TST or= ((PTX shr 14) and &hC0)
PTX shl= 8
BITS = (BITS+1) and 3
if BITS = 0 then put #1,,TST
TST shr= 2: TST or= ((PTX shr 14) and &hC0)
PTX shl= 8
BITS = (BITS+1) and 3
if BITS = 0 then put #1,,TST
TST shr= 2: TST or= ((PTX shr 14) and &hC0)
BITS = (BITS+1) and 3
if BITS = 0 then put #1,,TST
PIX += 1
next X
screenunlock
sleep 1
next Y
close
' blur fade!
BT = timer
var BUF = imagecreate(800,600)
BITS = 0:TST = 0
for C as integer = 0 to 128
screenlock
line(0,596)-(799,599),rgb(0,0,0),bf:line(796,0)-(799,599),rgb(0,0,0),bf
line(0,0)-(799,4),rgb(0,0,0),bf:line(0,0)-(4,599),rgb(0,0,0),bf
Blur(screenptr)
line(0,0)-(799,599),rgba(0,0,0,TST/8),bf
BITS xor= 1: TST += 1
if BITS then
get(0,0)-(799,599),BUF
put(1,1),BUF,pset
end if
screenunlock
while (timer-BT) < 1/10
sleep 1
wend
BT += 1/10
next C
shell NNM
' blur to raise image quality
sub Blur(WHERE as any ptr)
dim as ubyte ptr PIX
dim as integer TMP
PIX = WHERE
for D as integer = 1 to 800*598*4
TMP = *PIX+PIX[4]+PIX[3200]+PIX[3204]
*PIX = TMP/3.94
PIX += 1
next D
end subps: if you're a linux user... than you probabily need to execute the file manually after executing the last one... but enjoy the fade/blur effect too :P
subliminar .bmp ftw! xD