Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Rbz on May 04, 2006
-
rbraz
CBM 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 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  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
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 Â
jimshawx
ZX 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!)
rbraz
CBM 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 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  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
 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
 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
 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
 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
PS.: Yeah, just from the ether  :D
-
What a real top topic.
Cheers all,
Clyde.