Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Roly on May 17, 2006
-
Original post from Rbraz, taken from the ezboard forum
Here is a code to load your bitmap (256 color palette) font image and display it on screen, without any "dll".
This will help a lot of people, who are trying to code your first demo in FreeBasic.
Click here to get the source code + font example
'-------------------------
' .: Bitmap Text :.
' +
' .: Font Loader :.
'
' Using Bitmap 256 color
' palette image
'
' Whithout "DLL"s !!!
'
'-------------------------
' by Rbraz 2006
'-------------------------
Option Explicit
'Windowed
#define PTC_WIN
'-------------------------------------
' Includes.
'-------------------------------------
#Include Once "tinyptc.bi"
'Screen constants
Const XRES=640 'Screen Width
Const YRES=480 'Screen Height
Const ARES=XRES * YRES 'Array Width
'BitmapFont constants
Const FontW=32 'Font Width
Const FontH=32 'Font Height
Const FontL=64 'Number Of letters in the font
'Sub Routines
Declare Sub Draw_Text(byval message as string, byval xpos as integer, byval ypos as integer, byval inc as integer)
Declare Sub LoadAnimImage( stringFilename As string, byval FrameW, byval FrameH )
Declare Sub DrawImage(byval xpos as integer, byval ypos as integer, byval character as integer, _
byval FrameW as integer, byval FrameH as integer)
Declare Sub Load_Bitmap(byval filename as string)
Declare Sub ClearScreen()
Declare Sub FPS_Count()
'Variables
Dim Shared Buffer(ARES) as integer 'Tinyptc buffer
Dim Shared BitmapFont( FontW, FontH, FontL ) as integer 'Font buffer
'Bitmap (256 color palette) loader variables
ReDim Shared img_buffer(1) as ubyte 'Bitmap Image buffer
Dim Shared img_r(256), img_g(256), img_b(256) as ubyte 'RGB color palette buffer
Dim Shared img_w, img_h as short 'Image Width / Height
'FPS Counter
Dim Shared iFPS, bSettime,iSecStart,iFrameCount,iFrameStart as integer
'Image file name
Dim file_name as string
file_name="Media\Tilerred.bmp"
'Load our bitmap font
LoadAnimImage( file_name,FontW,FontH )
'Open TinyPTC window
If( ptc_open( "Bitmap Text + Font Loader", XRES, YRES ) = 0 ) Then
End -1
End if
'Main Loop
While Inkey$() <> Chr$( 27 )
ClearScreen()
Draw_Text("FPS : "& iFPS,10,10,FontW)
Draw_Text("BITMAP TEXT",132,150,FontW)
Draw_Text("+",290,190,FontW)
Draw_Text("FONT LOADER",132,230,FontW)
Draw_Text("BY RBRAZ - 2006",90,320,FontW)
FPS_Count()
Ptc_Update @Buffer(0)
Wend
'Close TinyPTC window
ptc_close()
'Draw text on screen
Sub Draw_Text(byval message as string, byval xpos as integer, byval ypos as integer, byval inc as integer)
Dim a,i as integer
Dim character as integer
Dim char as string
Dim alphatab as string
For a=1 To Len(message)
char = Mid$(message,a,1)
character = Asc(char)-32 'Make sure that your font are into this range
If (character>-1) And (character<FontL) then
DrawImage(xpos,ypos,character,FontW,FontH)
End If
xpos=xpos+inc
Next
End Sub
'Load frame images
Sub LoadAnimImage( Filename As string, _
byval FrameW, byval FrameH )
Dim intX, intY, FrameWidth, FrameHeight, FrameNum
Dim rect_x1, rect_x2, rect_y1, rect_y2, a, b
Dim pixel
'Load bitmap 256 color palette
Load_Bitmap(Filename)
FrameWidth = img_w/FrameW
FrameHeight = img_h/FrameH
FrameNum = 0
rect_x1 = 0
rect_x2 = FrameW
rect_y1 = 0
rect_y2 = FrameH
For b = 0 to FrameHeight-1
For a = 0 to FrameWidth-1
For intY = rect_y1 to rect_y2-1
For intX = rect_x1 to rect_x2-1
pixel= img_buffer( intX + ( intY * img_w ) )
BitmapFont( intX Mod FrameW, intY Mod FrameH, FrameNum ) = (img_r(pixel) Shl 16) Or (img_g(pixel) Shl 8 ) Or img_b(pixel)
Next
Next
rect_x1 = rect_x2
rect_x2 = rect_x2 + FrameW
FrameNum = FrameNum + 1
Next
rect_x1 = 0
rect_x2 = FrameW
rect_y1 = rect_y2
rect_y2 = rect_y2 + FrameH
Next
End Sub
'Draw image into Buffer
Sub DrawImage(byval xpos as integer, byval ypos as integer, byval character as integer, _
byval FrameW as integer, byval FrameH as integer)
Dim intX, intY As integer
For intY=0 to FrameH-1
For intX=0 to FrameW-1
if (xpos+intX) < (XRES - 1) and (xpos+intX) > 0 then
Buffer( ((intY+ypos) * XRES) + (intX+xpos)) = BitmapFont(intX, intY, character)
end if
Next
Next
end sub
'----------------------------------------
' For 256 color palette image only
'----------------------------------------
Sub Load_Bitmap(byval filename as string)
Dim i,j,n,k,l,cnt as integer
Dim Bmp_len, file as integer
Dim byt as ubyte
file = FreeFile
OPEN filename FOR BINARY AS #file
Get #file,19,img_w ' bmp width
Get #file,23,img_h ' bmp height
Bmp_len = img_w * img_h ' Bmp size
ReDim img_buffer(Bmp_len)
Dim temp(Bmp_len)
'Color palette
cnt = 55
For i = 0 To 255
Get #file,cnt,byt
img_b(i) = byt
cnt+=1
Get #file,cnt,byt
img_g(i) = byt
cnt+=1
Get #file,cnt,byt
img_r(i) = byt
cnt+=2
Next
'Image pixels
cnt = 1079
For i = 0 To Bmp_len-1
Get #file,cnt,byt
img_buffer(i) = byt
cnt+=1
Next
Close #file
For i = -(Bmp_len-1) To 0
temp(j) = img_buffer(Abs(i))
j = j + 1
Next
'Flip image
Do
For j = 0 To img_w
k = (j + (n * img_w))
l = ((img_w - j) + (n * img_w))
img_buffer(l) = temp(k)
Next
n = n + 1
Loop Until n = img_h
End Sub
Sub ClearScreen()
Dim i as integer
for i = 0 to ARES
Buffer(i) = 0
next
End Sub
Sub FPS_Count()
If bSettime = 1 then
iSecStart = Timer() * 1000.0
iFrameStart = iFrameCount
bSettime = 0
EndIf
If (Timer()*1000.0) >= iSecStart + 1000 then
iFPS = iFrameCount - iFrameStart
bSettime = 1
EndIf
iFrameCount = iFrameCount + 1
End Sub
jimshawx
ZX SPECTRUM
Posts: 37
(22/4/06 3:01)
Reply | Edit | Del New Post bmp loader Here's a little present. It should load any BMP file of any format into a 32bit texture. It uses Windows API and so it is very small.
' Jim's bmp decoder
option explicit
#define PTC_WIN
#include once "tinyptc.bi"
#include once "windows.bi"
#include once "crt.bi"
declare function LoadTexture(fname as string, byval tex as uinteger ptr) as Integer
dim buffer(640*480) as uinteger
loadtexture("monkeys.bmp", @buffer(0))
ptc_open("Bitmap Test", 640,480)
while inkey$ <> chr$(27)
ptc_update @buffer(0)
wend
ptc_close()
end
type MYHEADER
bmpi as BITMAPINFO
masks(3) as RGBQUAD
end type
function LoadTexture(fname as string, byval tex as uinteger ptr) as Integer
dim as HBITMAP bmp
dim as HDC hdc
DIM header AS MYHEADER
memset(@header.bmpi, 0, sizeof(header.bmpi))
header.bmpi.bmiHeader.biSize = sizeof(BITMAPINFOHEADER)
bmp = cast(HBITMAP, LoadImage(NULL, fname, IMAGE_BITMAP, 0,0, LR_LOADFROMFILE))
hdc = GetDC(NULL)
GetDIBits(hdc, bmp, 0,0, NULL, @header.bmpi, 0)
header.bmpi.bmiHeader.biBitCount = 32
GetDIBits(hdc, bmp, 0, header.bmpi.bmiHeader.biHeight, tex, @header.bmpi, DIB_RGB_COLORS)
ReleaseDC(NULL, hdc)
rem only need this bit to flip it upside down
dim line0 as uinteger ptr
dim lineN as uinteger ptr
lineN = tex+(header.bmpi.bmiHeader.biHeight-1)*header.bmpi.bmiHeader.biWidth
line0 = tex
dim as uinteger tmpln(1024)
dim y as integer
for y = 0 TO (header.bmpi.bmiHeader.biHeight/2)-1
memcpy(@tmpln(0), line0, header.bmpi.bmiHeader.biWidth * sizeof(uinteger))
memcpy(line0, lineN, header.bmpi.bmiHeader.biWidth * sizeof(uinteger))
memcpy(lineN, @tmpln(0), header.bmpi.bmiHeader.biWidth * sizeof(uinteger))
line0 = line0 + header.bmpi.bmiHeader.biWidth
lineN = lineN - header.bmpi.bmiHeader.biWidth
next
return 1
end function
Jim
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18271
(22/4/06 9:38)
Reply | Edit | Del
New Post Re: bmp loader Cool nice work there dudes.
Im trying to add bmps / pngs as a resource to the exe. So everythings more compact. Dont suppose you've sussed a solution out for that?
One again welldone,
Cheers - Clyde :)
jimshawx
ZX SPECTRUM
Posts: 38
(22/4/06 11:47)
Reply | Edit | Del New Post resource loading It's a one-line change to make my example load bmp from resources, once you work out how to get them in. Shame Windows doesn't have any real image format support to draw on. Everyone uses jpeg6b and libpng libaries for image formats.
Jim
5H0CKW4VE
*Administrator*
Posts: 8016
(22/4/06 13:53)
Reply | Edit | Del
ezSupporter
New Post Re: resource loading Thanks guys, I am sure these listings will be a huge help to people writing thier first FB stuff :)
¤´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´ (¸.·`¤... SHOCKWAVE / DBF...¤
VISIT DARK BIT FACTORY INTERACTIVE! (please!)
rbraz
CBM 128
Posts: 190
(22/4/06 17:41)
Reply | Edit | Del
New Post Re: resource loading Nice one Jim :)
Yeah, to load it from resource it should be something like this:
Quote:
#define bmp1 115
bmp = cast(HBITMAP, LoadImage(GetModuleHandle(NULL),MAKEINTRESOURCE(bmp1), IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION))
Quote:
Resource.rc file
bmp1 BITMAP "Image.bmp"
Quote:
And compile with:
fbc Examples\LoadTexture.bas Examples\Resource.rc
But it doesn't work :( (Works fine in C++). Maybe there be an another way to do that...
Edited by: rbraz at: 22/4/06 17:49
jimshawx
ZX SPECTRUM
Posts: 39
(23/4/06 2:51)
Reply | Edit | Del New Post load resources The problem is your .rc file doesn't know the value of bmp1. You need to add
#define bmp1 115
to the .rc file too.
Works fine after that.
Jim
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18286
(23/4/06 13:57)
Reply | Edit | Del
New Post Re: load resources Im a tad confused with what 115 means and does.
Dont suppose you could knock up a listing of what to do for using resources please dudes?
And does that program also load in as anim images / tilesets?
Cheers and many thanks,
Clyde :)
Edited by: Clyde Radcliffe at: 23/4/06 13:58
rbraz
CBM 128
Posts: 192
(23/4/06 17:18)
Reply | Edit | Del
New Post Re: load resources Now it works fine Jim, thanks!
Just forgot when I create a resource file in C, i need to include the resource.h
And noticed that I need to remove quotes " " from the resouce file name.
To work you must run the compiled version (exe), doesn't work from IDE :(
----------------------Load Texture.bas ----------------------------------
' Jim's bmp decoder
'
' Added Loading from Resource
'
option explicit
#define PTC_WIN
#include once "tinyptc.bi"
#include once "windows.bi"
#include once "crt.bi"
declare function LoadTexture(byval tex as uinteger ptr) as Integer
dim buffer(640*480) as uinteger
loadtexture(@buffer(0))
ptc_open("Bitmap Test", 640,480)
while inkey$ <> chr$(27)
ptc_update @buffer(0)
wend
ptc_close()
end
type MYHEADER
bmpi as BITMAPINFO
masks(3) as RGBQUAD
end type
function LoadTexture(byval tex as uinteger ptr) as Integer
dim as HBITMAP bmp
DIM header AS MYHEADER
#define bmp1 115
memset(@header.bmpi, 0, sizeof(header.bmpi))
header.bmpi.bmiHeader.biSize = sizeof(BITMAPINFOHEADER)
bmp = cast(HBITMAP, LoadImage(GetModuleHandle(NULL),MAKEINTRESOURCE(bmp1), IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION))
GetDIBits(GetDC(NULL), bmp, 0,0, NULL, @header.bmpi, 0)
header.bmpi.bmiHeader.biBitCount = 32
GetDIBits(GetDC(NULL), bmp, 0, header.bmpi.bmiHeader.biHeight, tex, @header.bmpi, DIB_RGB_COLORS)
rem only need this bit to flip it upside down
dim line0 as uinteger ptr
dim lineN as uinteger ptr
lineN = tex+(header.bmpi.bmiHeader.biHeight-1)*header.bmpi.bmiHeader.biWidth
line0 = tex
dim as uinteger tmpln(1024)
dim y as integer
for y = 0 TO (header.bmpi.bmiHeader.biHeight/2)-1
memcpy(@tmpln(0), line0, header.bmpi.bmiHeader.biWidth * sizeof(uinteger))
memcpy(line0, lineN, header.bmpi.bmiHeader.biWidth * sizeof(uinteger))
memcpy(lineN, @tmpln(0), header.bmpi.bmiHeader.biWidth * sizeof(uinteger))
line0 = line0 + header.bmpi.bmiHeader.biWidth
lineN = lineN - header.bmpi.bmiHeader.biWidth
next
return 1
end function
-------------------- resource.rc --------------------------------
#define bmp1 115
bmp1 BITMAP C:\FreeBasic\Examples\Media\image.bmp
-------------------- Compile.bat --------------------------------
fbc Examples\LoadTexture.bas Examples\Resource.rc -s gui
pause
Clyde Radcliffe
Fuzzy Wuzzy
Posts: 18290
(23/4/06 19:15)
Reply | Edit | Del
New Post Re: load resources Not yet tried all this out yet. Cool stuff dudes.
But what I'll tell you about getting it working in FBIDE, is that so long as you've got it associated with your .bas source code, if you double click from where the program listing is in Windows explorer, resources will work that way. And for some bug with FBIDE, not from opening up with it.
jimshawx
ZX SPECTRUM
Posts: 40
(23/4/06 23:47)
Reply | Edit | Del
New Post Re: load resources 115 is just a number. Every resource needs a unique number, that's all. Valid numbers are 0 to 32767, or possibly 65535. I suspect Rbraz just plucked that one out of the ether.
You could change the function to pass in the resource number.
Jim
-
Would this work with a bin2bas bmp include?
If so, how would that be achieved?
Thanks in advance,
Clyde.
-
Easier to use the Direct3DX one I posted elsewhere and change it to use D3DXLoadSurfaceFromFileInMemory.
LoadImage doesn't work from memory, only from resources.
rbz's one could be changed, but it only handles uncompressed 8bit bmp.
Jim