Palette Finder (ANY Bitmap Image!)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

A little program which reads a bitmap image file, and generates a table and graphical representation of all the colours within the image.

It works very well and has helped me out a few times ;D.

Information is printed on screen AND saved in the pal.bmp and pal.txt files.

You can specify how large the squares of colour are. The text table lists the colour values as uinteger and as hex.

You must specify a valid bitmap file in the command prompt, or you can simply drag a bitmap image onto the compiled program.

No external libraries necessary, just compile the code (preferably with the -s gui parameter).

Code: Select all

#include "file.bi"
#include "windows.bi"

'functions from my personal library, ported over
function getbmpwidth(byval bitmapFile as string) as long
	dim as long bmpwidth
	dim as integer fileno = freefile
	if open(bitmapFile for binary access read as #fileno) <> 0 then return -1
	get #fileno, 19, bmpwidth
	close #fileno: return bmpwidth
end function
function getbmpheight(byval bitmapFile as string) as long
	dim as long bmpheight
	dim as integer fileno = freefile
	if open(bitmapFile for binary access read as #fileno) <> 0 then return -1
	get #fileno, 23, bmpheight
	close #fileno: return bmpheight
end function
function getimage(byval pathOfBitmap as string) as any ptr
	dim ret as any ptr = imagecreate(getbmpwidth(pathOfBitmap), getbmpheight(pathOfBitmap))
	bload pathOfBitmap, ret
	return ret
end function

if fileexists(command(1)) = 0 then
	MessageBox(0, "Please pass a bitmap image path to the command-line!", "Error!", MB_ICONERROR)
	system
endif
if getbmpwidth(command(1)) = 0 or getbmpheight(command(1)) = 0 then
	MessageBox(0, "The file provided was not a valid bitmap file!", "Error!", MB_ICONERROR)
	system
endif
screenres 400, 400, 32
dim as ulong ptr imgptr = getimage(command(1))
redim as ulong colours(1 to 1)

for y as ulongint = 0 to getbmpheight(command(1))-1
	for x as ulongint = 0 to getbmpwidth(command(1))-1
		dim as ulong col = point(x, y, imgptr)
		for i as ulongint = 1 to ubound(colours)
			if colours(i) = col then exit for
			if colours(i) <> col and i = ubound(colours) then
				redim preserve colours(1 to ubound(colours)+1)
				colours(ubound(colours)) = col
			endif
		next
	next
next

for i as ulongint = 1 to ubound(colours)
	print colours(i) & " = " & hex(colours(i))
next

open "pal.txt" for output as #1
for i as ulongint = 1 to ubound(colours)
	print #1, colours(i) & " = " & hex(colours(i))
next
close #1

sleep

dim as ubyte coloursize
do
	cls
	input "How big should the squares of colour be?", coloursize
loop while coloursize = 0

cls

dim as ulong ptr pal = imagecreate(coloursize*ubound(colours), coloursize)

for i as ulongint = 1 to ubound(colours)
	line pal, (coloursize*(i-1), 0)-((coloursize*i)-1, coloursize-1), colours(i), BF
next

put (0, 0), pal, pset
bsave "pal.bmp", pal

sleep
system
I had written this a while back, and I thought it would be useful for some people/developers (in the general sense).

Note: strangely I compile on Windows 10 and UAC automatically is enabled for the resulting program. No idea why.
vdecampo
Posts: 2992
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:

Re: Palette Finder (ANY Bitmap Image!)

Post by vdecampo »

Palette information is stored right after the BITMAPINFO header. You could just read that table directly.
-Vince
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

vdecampo wrote:Palette information is stored right after the BITMAPINFO header. You could just read that table directly.
-Vince
Oh, wow... :( Didn't know that lol. I'll look into updating the program relatively soon.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Palette Finder (ANY Bitmap Image!)

Post by badidea »

datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

Thanks for the link!
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Palette Finder (ANY Bitmap Image!)

Post by MrSwiss »

@datwill310,

you are using multiple Functions, to obtain width and height of a BMP file.
Since opening/reading/closing a file, is comparatively slow, why not doing
it, all in one (returning a Type instead of a single variable):

Code: Select all

' Using_BMP_HeaderInfo.bas -- 2017-03-18, by MrSwiss

'Type BMP_Header         ' BMP version 4
'    As UShort   id      ' should be "BM": (&h42, &h4D)
'    As ULong    lenBMP  ' file size
'    As UShort   uu1     ' unused &h0000
'    As UShort   uu2     ' unused &h0000
'    As ULong    doffs   ' offset of pixel-data
'    ' DIB_Header start
'    As ULong    dhsize  ' DIB header size 108 bytes
'    As ULong    pwidth  ' width in pixels
'    As ULong    pheight ' height in pixels
'    As UShort   planes  ' num bit planes
'    As UShort   bpp     ' bits per pixel
'    '... just the top ... from: https://en.wikipedia.org/wiki/BMP_file_format - Example 2
'End Type

Type BMPSize
    As ULong Wid
    As ULong hei
    As ULong siz
    Declare Function Get_(ByVal BMP_File As String) As BMPSize 
End Type

'function using above type
Function BMPsize.Get_(ByVal BMP_File As String) As BMPSize
    Dim as BMPSize  size                ' contains 3 x ULong
    Dim as UShort   fileno = FreeFile, id

    If Open(BMP_File For Binary Access Read As #fileno) <> 0 Then Return size ' error: file open
    Get #fileno,  1, id                 ' &h4D42 = "BM" = BMP id
    If id <> &h4D42 Then Return size    ' error: not a BMP
    Get #fileno,  3, size.siz           ' file size
    Get #fileno, 19, size.Wid           ' width in pixels
    Get #fileno, 23, size.hei           ' height in pixels
    Close #fileno                       ' close file
    Return size                         ' return results
End Function
' end of type ...

' screen constants
Const w = 640, h = 480, cd = 32 : Const As ULong transp = &h00FF00FF
' ===== MAIN =====
ScreenRes(w, h, cd)
Width w \ 8, h \ 16

' define your own path and file below ...
Dim As String   FileName = "c:\dev-tools\ffoutput\bmp\testcircles.bmp"
Dim As BMPSize  IMGsiz = IMGsiz.Get_(FileName)

With IMGsiz
    If .Wid AndAlso .hei AndAlso .siz Then
        Dim As Any Ptr pIMG = ImageCreate(.wid, .hei, transp, cd)
        BLoad(FileName, pIMG) : Put (10, 10), pIMG, Alpha
        ImageDestroy(pIMG) : pIMG = 0   ' clean up, release mem, set ptr = 0
    EndIf
    Locate 27, 2 : Print "IMG width : "; .Wid
    Locate 27,26 : Print "IMG height: "; .hei
    Locate 27,51 : Print "IMG file size: "; .siz
End With
Locate 29, 2 : Print "any key press --> EXIT ";

Sleep
' ===== MAIN ===== ' ----- EOF ----- 
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

MrSwiss wrote:@datwill310,

you are using multiple Functions, to obtain width and height of a BMP file.
Since opening/reading/closing a file, is comparatively slow, why not doing
it, all in one (returning a Type instead of a single variable):

Code: Select all

' Using_BMP_HeaderInfo.bas -- 2017-03-18, by MrSwiss

'Type BMP_Header         ' BMP version 4
'    As UShort   id      ' should be "BM": (&h42, &h4D)
'    As ULong    lenBMP  ' file size
'    As UShort   uu1     ' unused &h0000
'    As UShort   uu2     ' unused &h0000
'    As ULong    doffs   ' offset of pixel-data
'    ' DIB_Header start
'    As ULong    dhsize  ' DIB header size 108 bytes
'    As ULong    pwidth  ' width in pixels
'    As ULong    pheight ' height in pixels
'    As UShort   planes  ' num bit planes
'    As UShort   bpp     ' bits per pixel
'    '... just the top ... from: https://en.wikipedia.org/wiki/BMP_file_format - Example 2
'End Type

Type BMPSize
    As ULong Wid
    As ULong hei
    As ULong siz
    Declare Function Get_(ByVal BMP_File As String) As BMPSize 
End Type

'function using above type
Function BMPsize.Get_(ByVal BMP_File As String) As BMPSize
    Dim as BMPSize  size                ' contains 3 x ULong
    Dim as UShort   fileno = FreeFile, id

    If Open(BMP_File For Binary Access Read As #fileno) <> 0 Then Return size ' error: file open
    Get #fileno,  1, id                 ' &h4D42 = "BM" = BMP id
    If id <> &h4D42 Then Return size    ' error: not a BMP
    Get #fileno,  3, size.siz           ' file size
    Get #fileno, 19, size.Wid           ' width in pixels
    Get #fileno, 23, size.hei           ' height in pixels
    Close #fileno                       ' close file
    Return size                         ' return results
End Function
' end of type ...

' screen constants
Const w = 640, h = 480, cd = 32 : Const As ULong transp = &h00FF00FF
' ===== MAIN =====
ScreenRes(w, h, cd)
Width w \ 8, h \ 16

' define your own path and file below ...
Dim As String   FileName = "c:\dev-tools\ffoutput\bmp\testcircles.bmp"
Dim As BMPSize  IMGsiz = IMGsiz.Get_(FileName)

With IMGsiz
    If .Wid AndAlso .hei AndAlso .siz Then
        Dim As Any Ptr pIMG = ImageCreate(.wid, .hei, transp, cd)
        BLoad(FileName, pIMG) : Put (10, 10), pIMG, Alpha
        ImageDestroy(pIMG) : pIMG = 0   ' clean up, release mem, set ptr = 0
    EndIf
    Locate 27, 2 : Print "IMG width : "; .Wid
    Locate 27,26 : Print "IMG height: "; .hei
    Locate 27,51 : Print "IMG file size: "; .siz
End With
Locate 29, 2 : Print "any key press --> EXIT ";

Sleep
' ===== MAIN ===== ' ----- EOF ----- 
Using a type to represent two values seems a bit of complexity for nothing to me, but if I were to load a lot from the header, then your idea is good *thumbs_up*.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Palette Finder (ANY Bitmap Image!)

Post by MrSwiss »

datwill310 wrote:Using a type to represent two values seems a bit of complexity for nothing to me ...
Well, I'd say, less so, than using two Functions ... (twice file Open/file Read/file Close???).
On top of it: a file check, for opening the correct type of file ... (for free!).
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

MrSwiss wrote:
datwill310 wrote:Using a type to represent two values seems a bit of complexity for nothing to me ...
Well, I'd say, less so, than using two Functions ... (twice file Open/file Read/file Close???).
On top of it: a file check, for opening the correct type of file ... (for free!).
I guess ;D it's quite simple though.
Aethelstan
Posts: 19
Joined: Feb 22, 2017 18:34

Re: Palette Finder (ANY Bitmap Image!)

Post by Aethelstan »

vdecampo wrote:Palette information is stored right after the BITMAPINFO header. You could just read that table directly.
-Vince
According to Wikipedia:
https://en.wikipedia.org/wiki/BMP_file_format wrote: Color table is normally not used when the pixels are in the 16-bit per pixel (16bpp) format (and higher); there are normally no color table entries in those bitmap image files. However, the Microsoft documentation (on the MSDN web site as of Nov. 16, 2010[15]) specifies that for 16bpp (and higher), the color table can be present to store a list of colors intended for optimization on devices with limited color display capability, while it also specifies, that in such cases, no indexed palette entries are present in this Color Table.
So, if I understand correctly, sometimes it will be neccessary to count the number of unique colors used if there is no such information already written in the bmp file.
datwill310 wrote:Using a type to represent two values seems a bit of complexity for nothing to me ...
If using types seems too complex (I was afraid of them at first, too), you can also pass variables to functions by reference; this way more than one value can be returned from the function (or even from subroutine). Here is an example:

Code: Select all

Function GetBmpDimensions(ByVal bitmapFile As String, ByRef bmpwidth As Long, ByRef bmpheight As Long) As Long
	Dim As Integer fileno=FreeFile
   If Open(bitmapFile For Binary Access Read As #fileno) <> 0 Then Return -1
   Get #fileno, 19, bmpwidth
   Get #fileno, 23, bmpheight
   Close #fileno: Return 0	
End Function

function getimage(byval pathOfBitmap as string) as any Ptr
	Dim As Long bmpheight, bmpwidth
	If GetBmpDimensions(pathOfBitmap, bmpwidth, bmpheight)=0 Then
   	dim ret as any ptr = imagecreate(bmpwidth, bmpheight)
   	BLoad pathOfBitmap, ret
   	Return ret
   Else
   	Return 0
	EndIf		
end function
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Palette Finder (ANY Bitmap Image!)

Post by dodicat »

To get the width and height of a bitmap into one entity, the two values can be concatenated.
THUS:

Code: Select all


function GetSize(BMP as string) as long
    #define mk(a,b) a or b shl 16
    dim as short a,b,n=freefile
 If Open(BMP For Binary Access Read As #n) = 0 Then 
    Get #n, 19, a          ' width 
    Get #n, 23, b          ' height 
    Close #n                 
    Return mk(a,b) ' concatenate
    end if
end function

#define WidthOf(x)  loword(x)
#define HeightOf(x) hiword(x)


var s= GetSize("    .bmp") '< --  your bitmap here

print "Width  ";WidthOf(s)
print "Height ";HeightOf(s)

sleep

 
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

Aethelstan wrote:
datwill310 wrote:Using a type to represent two values seems a bit of complexity for nothing to me ...
If using types seems too complex (I was afraid of them at first, too), you can also pass variables to functions by reference; this way more than one value can be returned from the function (or even from subroutine).
I can handle structures fine. I just think that there's more work for the programmer:

Code: Select all

type STRUCT
    as ulong w
    as ulong h
end type
dim as STRUCT imgdim
GetBitmapDimensions(imgdim)
ImageCreate(imgdim.w, imgdim.h)
Less complex:

Code: Select all

dim as ulong w, h
GetBitmapDimensions(w, h)
ImageCreate(w, h)
Even less complex:

Code: Select all

ImageCreate(GetBitmapWidth(img), GetBitmapHeight(img))
This is my reasoning behind my two functions: simplicity of code.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Palette Finder (ANY Bitmap Image!)

Post by MrSwiss »

datwill310 wrote:Even less complex:

ImageCreate(GetBitmapWidth(img), GetBitmapHeight(img))

This is my reasoning behind my two functions: simplicity of code.
Sorry, your comparison is flawed, because of:

function getimage(byval pathOfBitmap as string) as any Ptr [Aethelstan]
(btw: I'd call it LoadBmpImage(), or similar, to better reflect it's purpose.)

does exactly the same (calling GetBmpDimensions() from within) ... all, with only 1 parameter.
That's one for simplicity ...
datwill310
Posts: 355
Joined: May 29, 2015 20:37

Re: Palette Finder (ANY Bitmap Image!)

Post by datwill310 »

MrSwiss wrote:
datwill310 wrote:Even less complex:

ImageCreate(GetBitmapWidth(img), GetBitmapHeight(img))

This is my reasoning behind my two functions: simplicity of code.
Sorry, your comparison is flawed, because of:

function getimage(byval pathOfBitmap as string) as any Ptr [Aethelstan]
(btw: I'd call it LoadBmpImage(), or similar, to better reflect it's purpose.)

does exactly the same (calling GetBmpDimensions() from within) ... all, with only 1 parameter.
That's one for simplicity ...
No dude, you're getting it wrong. I'm calling the Fb function ImageCreate. My getimage function calls my dimension retrieval functions within. I don't use any other format simply because their libraries are so hard to implement in FB.
In my examples I was showing only dimension retrieval, not actually loading the image. I may want to only get dimensions of an image in certain situations. It's simpler to me as a programmer to just write the two functions out in one line than for me to take several lines to declare data I wont necessarily need anywhere else in the program.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Palette Finder (ANY Bitmap Image!)

Post by MrSwiss »

datwill310 wrote:I may want to only get dimensions of an image in certain situations.
Just give me one viable sample, of that ...
Post Reply