0 Members and 1 Guest are viewing this topic.
rbrazCBM 128 Posts: 186(21/4/06 15:29)Reply  Bitmap Text + Bitmap Loader-------------------------------------------------------------------------------- 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 constantsConst XRES=640            'Screen WidthConst YRES=480            'Screen HeightConst ARES=XRES * YRES        'Array Width'BitmapFont constantsConst FontW=32                         'Font WidthConst FontH=32                         'Font HeightConst FontL=64                         'Number Of letters in the font'Sub RoutinesDeclare 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()'VariablesDim Shared Buffer(ARES) as integer             'Tinyptc bufferDim Shared BitmapFont( FontW, FontH, FontL ) as integer  'Font buffer'Bitmap (256 color palette) loader variablesReDim Shared img_buffer(1) as ubyte            'Bitmap Image bufferDim Shared img_r(256), img_g(256), img_b(256) as ubyte   'RGB color palette bufferDim Shared img_w, img_h as short              'Image Width / Height'FPS CounterDim Shared iFPS, bSettime,iSecStart,iFrameCount,iFrameStart as integer'Image file nameDim file_name as stringfile_name="Media\Tilerred.bmp"'Load our bitmap fontLoadAnimImage( file_name,FontW,FontH )   'Open TinyPTC windowIf( ptc_open( "Bitmap Text + Font Loader", XRES, YRES ) = 0 ) Then   End -1 End if'Main LoopWhile 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 windowptc_close()'Draw text on screenSub 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   NextEnd Sub'Load frame imagesSub 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 BufferSub 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   Nextend 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_hEnd SubSub ClearScreen()    Dim i as integer   for i = 0 to ARES     Buffer(i) = 0   nextEnd SubSub 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
jimshawxZX SPECTRUM Posts: 37(22/4/06 3:01)Reply  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 decoderoption 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 Integerdim buffer(640*480) as uintegerloadtexture("monkeys.bmp", @buffer(0))ptc_open("Bitmap Test", 640,480)while inkey$ <> chr$(27)     ptc_update @buffer(0)wendptc_close()endtype MYHEADER    bmpi as BITMAPINFO    masks(3) as RGBQUADend 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 1end function
Clyde Radcliffe  Fuzzy Wuzzy Posts: 18271(22/4/06 9:38)Reply  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 Â
jimshawxZX SPECTRUM Posts: 38(22/4/06 11:47)Reply  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 ezSupporter  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!)
rbrazCBM 128 Posts: 190(22/4/06 17:41)Reply  Re: resource loading-------------------------------------------------------------------------------- Nice one Jim  Yeah, to load it from resource it should be something like this:Quote:--------------------------------------------------------------------------------#define bmp1 115bmp = cast(HBITMAP, LoadImage(GetModuleHandle(NULL),MAKEINTRESOURCE(bmp1), IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION))--------------------------------------------------------------------------------Quote:--------------------------------------------------------------------------------Resource.rc filebmp1 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
jimshawxZX SPECTRUM Posts: 39(23/4/06 2:51)Reply  load resources-------------------------------------------------------------------------------- The problem is your .rc file doesn't know the value of bmp1. You need to add#define bmp1 115to the .rc file too.Works fine after that.Jim
Clyde Radcliffe  Fuzzy Wuzzy Posts: 18286(23/4/06 13:57)Reply  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
rbrazCBM 128 Posts: 192(23/4/06 17:18)Reply  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.hAnd 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 Integerdim buffer(640*480) as uintegerloadtexture(@buffer(0))ptc_open("Bitmap Test", 640,480)while inkey$ <> chr$(27)     ptc_update @buffer(0)wendptc_close()endtype MYHEADER    bmpi as BITMAPINFO    masks(3) as RGBQUADend 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 1end function-------------------- resource.rc -------------------------------- #define bmp1 115bmp1 BITMAP C:\FreeBasic\Examples\Media\image.bmp-------------------- Compile.bat --------------------------------fbc Examples\LoadTexture.bas Examples\Resource.rc -s guipause
Clyde Radcliffe  Fuzzy Wuzzy Posts: 18290(23/4/06 19:15)Reply  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.
jimshawxZX SPECTRUM Posts: 40(23/4/06 23:47)Reply  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
