Hey Guys another question. I have spent all day on it so sorry to pester you all again.
I have a Bitmap that i wish to convert to grey scale.
I got the code for conversion from the Poffs. but im alittle stuck on a few things.
I think my problem is trying to get the bitmap pixel data in the right format.
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#INCLUDE "CONSOLE.INC"
Function hexify(data_in As string) export As string
Dim i As Long
Dim hex_result As string
hex_result = ""
For i = 1 to len(data_in)
hex_result = hex_result + hex$(asc(mid$(data_in, i, 1)), 2) + " "
next i
hex_result = rtrim$(hex_result)
Function = hex_result
End Function
FUNCTION Rgb2Gray??? (BYVAL colorRGB???) EXPORT
Red? = (colorRGB??? AND &H000000FF???) * .3
SHIFT RIGHT colorRGB???, 8
Green? = (colorRGB??? AND &H000000FF???) * .59
SHIFT RIGHT colorRGB???, 8
Blue? = (colorRGB??? AND &H000000FF???) * .11
Gray? = Red? + Green? + Blue?
FUNCTION = RGB(Gray?, Gray?, Gray?)
END Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$BmpFile = "c:\diagnos.bmp"'"C:\MyBmp.Bmp"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FUNCTION PBMAIN
Dim FILENUM As LONG
Dim BUFFER As String
Dim TEMP As String
Dim Size1 As long
INITCONSOLE
FILENUM = FreeFile
Dim filenum2 As long
filenum2 = FreeFile
Kill "gray.bmp"
Open "gray.bmp" For binary As filenum2
Open $BMPFILE For BINARY As FILENUM
Seek filenum, 1
'header
GET$ FILENUM, 2,BUFFER
STDOUTLN "Ident :" +BUFFER
GET$ FILENUM, 4,TEMP
Size1 = cvdwd((temp))
STDOUTLN "length :" +format$(cvdwd((temp) ))
GET$ FILENUM, 4,TEMP
STDOUTLN "Id :" +format$(cvdwd((temp) ))
GET$ FILENUM, 4,BUFFER
STDOUTLN "-------> offset :" +format$(cvdwd((BUFFER) ))
GET$ FILENUM, 4,BUFFER
Seek filenum ,1
get$ filenum, cvdwd(BUFFER)+14,temp
put$ FILENUM2, temp
Dim i As long
Dim egg As long
For i = 0 To LOF(filenum)
get$ filenum, 3, buffer
If buffer = "" Then Exit
egg = Rgb2Gray??? (cvdwd(BUFFER))
put$ filenum2, mkdwd$(egg)
Next
Close FILENUM
END FUNCTION ' (PBMAIN)
Ok finally managed this....
code below, not the best looking but in a rush.... This converts a bitmap into grey scale.
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#INCLUDE "CONSOLE.INC"
FUNCTION Rgb2Gray??? (BYVAL colorRGB???) EXPORT
Red? = (colorRGB??? AND &H000000FF???) * .3
SHIFT RIGHT colorRGB???, 8
Green? = (colorRGB??? AND &H000000FF???) * .59
SHIFT RIGHT colorRGB???, 8
Blue? = (colorRGB??? AND &H000000FF???) * .11
Gray? = Red? + Green? + Blue?
FUNCTION = RGB(Gray?, Gray?, Gray?)
END Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$BmpFile = "c:\diagnos.bmp"'"C:\MyBmp.Bmp"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FUNCTION PBMAIN
Dim FILENUM As LONG
Dim BUFFER As String
Dim TEMP As String
Dim Size1 As long
Dim bmp As String
bmp = command$
If command$ = "" Then
bmp = $BmpFile
End If
INITCONSOLE
FILENUM = FreeFile
Dim filenum2 As long
filenum2 = FreeFile
Kill "gray.bmp"
Open "gray.bmp" For binary As filenum2
Open bmp For BINARY As FILENUM
Dim number As long
Seek filenum, 1
'header
GET$ FILENUM, 2,BUFFER
put$ FILENUM2, BUFFER
STDOUTLN "Ident :" +BUFFER
'total length
GET$ FILENUM, 4,TEMP
put$ FILENUM2, temp
Size1 = cvdwd((temp))
STDOUTLN "length :" +format$(cvdwd((temp) ))
'image ID
GET$ FILENUM, 4,TEMP
put$ FILENUM2, temp
STDOUTLN "Id :" +format$(cvdwd((temp) ))
'off set
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
STDOUTLN "-------> offset :" +format$(cvdwd((BUFFER) ))
'size of data header
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'width of pixels
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'height
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'num oclour planes
GET$ FILENUM, 2,BUFFER
put$ FILENUM2, buffer
'num bits per pixel
GET$ FILENUM, 2,BUFFER
number = (cvdwd(buffer)/ 8)
put$ FILENUM2, buffer
MsgBox STR$(NUMBER)
'encoding
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'size of pixel ddata
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'p[ixedl per metre
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'resoution height
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'num of colours
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
'num of om,porteant Colours
GET$ FILENUM, 4,BUFFER
put$ FILENUM2, buffer
Dim i As long
Dim egg As dword
If NUMBER =0 Then NUMBER = 1
For i = 0 To LOF(filenum)
get$ filenum, number, buffer
If buffer = "" Then Exit
egg= cvdwd(buffer)
egg = Rgb2Gray??? (cvdwd(BUFFER))
put$ filenum2, mid$(mkdwd$(egg),1,number)
'MsgBox mkdwd$(egg)
Next
shellExecute(0, "open","gray.bmp","","",0)
Close FILENUM
END FUNCTION
a bitmap 256 bit and above.
does odd things with 16 bit and mono
Paul.