Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
ConvertBMP2FRM
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 19.02.2014 16:38:28 |
'convert frame.bmp to frame.frm
Declare Function Encode Alias "fb_hEncode" (ByVal lpIn As Any Ptr, ByVal asize As Integer, ByVal lpOut As Any Ptr, ByRef out_size AS Integer ) As Integer
#Define framepath (exepath & "\frm\")
Sub ConvertFrame(byval framename as String)
Dim as String framefile
Dim as any ptr frmBMP
Dim as Integer ff = Freefile, frmWidth, frmHeight
Dim as Integer za, f, r, g, b
Dim as ubyte ptr framemap, tempmap
Dim as Integer mapLen,tmpLen
framefile = framepath+framename
Open framefile+".bmp" for Binary as #ff
Get #ff, 19, frmWidth
Get #ff, 23, frmHeight
Close #ff
mapLen = frmWidth*frmHeight
tmpLen = mapLen
frmBMP = ImageCreate(frmWidth,frmHeight)
framemap = callocate(mapLen)
tempmap = callocate(mapLen)
BLoad framefile+".bmp",frmBMP
For y as Integer = 0 to frmHeight-1
For x as Integer = 0 to frmWidth-1
f = point(x,y,frmBMP)
r = LoByte(HiWord(f))
g = HiByte(LoWord(f))
b = LoByte(LoWord(f))
za = int((r+g+b)/3)
framemap[x+(y*frmWidth)]=za
Next x
Next y
imagedestroy(frmBMP)
Encode(framemap, mapLen, tempmap, tmpLen)
ff = FreeFile
?mapLen,tmpLen
Open framefile+".frm" for Binary as #ff
put #ff,,"FRM" 'header string (3byte)
put #ff,,frmWidth 'Width as Integer (4byte)
put #ff,,frmHeight 'Height as Integer (4byte)
put #ff,,*tempmap,tmpLen
Close #ff
deallocate framemap
deallocate tempmap
End Sub
'*****************************************************
screenres 640,480,32',,0
ConvertFrame("text")'bmpfile ohne .bmp