Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Emboss_test4

Uploader:MitgliedEternal_Pain
Datum/Zeit:19.02.2014 14:58:40

Const as Single  Deg2Rad   = ATN(1)/45

Type tmap
    as Integer   Width
    as Integer   Height
    as ubyte ptr map
End Type

Type tLight
    as Integer W 'Winkel
    as Integer H 'Höhe
    as Integer S 'Specular
End Type

Function EmbossLight(byref map as tmap ptr,byval Light as tLight) as Integer
    Dim as ubyte ptr lightmap = callocate(map->Width*map->Height)
    Dim as Integer   pix(0 to 4), nZ'pixel
    Dim as Single    pLRad          'Azimut des Lichtes
    Dim as Single    pZRad          'Höhenwinkel
    Dim as Single    pX             'Höhenwinkel bei 0 grd
    Dim as Single    pY             'Höhenwinkel bei 90 grd
    Dim as Single    lx, ly, ls, lw = Light.W*Deg2Rad

    For y as Integer = 0 to map->Height-1
    For x as Integer = 0 to map->Width-1
        pix(0) = map->map[x+(y*map->Width)]
        If pix(0) = 0 Then Continue For
        If (x-1 >          -1) Then pix(1) = map->map[(x-1)+(y*map->Width)]-Light.H Else pix(1) = -Light.H 'l
        If (x+1 <  map->Width) Then pix(2) = map->map[(x+1)+(y*map->Width)]-Light.H Else pix(2) = -Light.H 'r
        If (y-1 >          -1) Then pix(3) = map->map[x+((y-1)*map->Width)]-Light.H Else pix(3) = -Light.H 'o
        If (y+1 < map->Height) Then pix(4) = map->map[x+((y+1)*map->Width)]-Light.H Else pix(4) = -Light.H 'u

        nZ    = Light.H

        lx    = x+cos(lw)
        ly    = y+sin(lw)
        pX    = (pix(2)-pix(1))
        pY    = (pix(4)-pix(3))

        If pX<>0 orelse pY<>0 Then
            pLRad = atan2(ly-y,lx-x)
            pZRad = atan2(y-(y+pY),x-(x+pX))
            ls    = sin(pLRad-pZRad)
            nZ   += nZ*ls
            If nZ>Light.H Then nZ *= ((Light.S/255)+1)
        End If

        If (nZ <   1) Then nZ =   1
        If (nZ > 255) Then nZ = 255
        lightmap[x+(y*map->Width)]=nZ
    Next x
    Next y

    'smooth
    For y as Integer = 0 to map->Height-1
    For x as Integer = 0 to map->Width-1
        pix(0) = lightmap[x+(y*map->Width)]
        if pix(0)=0 Then continue for
        If (x-1 >          -1) Then pix(1) = lightmap[(x-1)+(y*map->Width)] Else pix(1) = (0) 'l
        If (x+1 <  map->Width) Then pix(2) = lightmap[(x+1)+(y*map->Width)] Else pix(2) = (0) 'r
        If (y-1 >          -1) Then pix(3) = lightmap[x+((y-1)*map->Width)] Else pix(3) = (0) 'o
        If (y+1 < map->Height) Then pix(4) = lightmap[x+((y+1)*map->Width)] Else pix(4) = (0) 'u

        nZ = ((pix(0)*2)+pix(1)+pix(2)+pix(3)+pix(4))/6
        lightmap[x+(y*map->Width)]=nZ
    Next x
    Next y

    'testzeichnen
    For y as Integer = 0 to map->Height-1
    For x as Integer = 0 to map->Width-1
        'If map->map[x+(y*map->Width)] Then
            nZ = lightmap[x+(y*map->Width)]
            If nZ Then pset(x,y),rgb(nZ,nZ,nZ)
        'End If
    Next x
    Next y

    deallocate(lightmap)
    return 0
End Function

Screenres 640,480,32
Dim as ubyte  z
Dim as tmap   testmap
Dim as tlight testlight

testmap.Width  = 640
testmap.Height = 480
testmap.map    = callocate(640*480)

Dim as any ptr zimage = Imagecreate(640,480,0)
BLoad "light_test.bmp",zimage

For y as Integer = 0 to 479
For x as Integer = 0 to 639
    z = point(x,y,zimage) and &hFF
    testmap.map[x+(y*testmap.Width)] = z
    pset(x,y),rgb(z,z,z)
Next x
Next y
sleep 1000
Dim w as single
Do
    w += 11.25
    if w > 359 then w-=360
    screenlock
        cls
        line(0,0)-(499,99),&h333388,bf
        EmbossLight(@testmap,type(w,90,0))
        line(250,50)-(250+(cos((w-90)*Deg2Rad)*100),50+(sin((w-90)*Deg2Rad)*100)),&hFF8800
        locate 1,1:?w
    screenunlock

    sleep 50
Loop until multikey(&h01)


sleep
deallocate(testmap.map)
imagedestroy(zimage)