RGB

[paulDiagnos]

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.

Code Select Expand

#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)



[paulDiagnos]

Ok finally managed this....

code below, not the best looking but in a rush.... This converts a bitmap into grey scale.

Code Select Expand

#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

[paulDiagnos]

a bitmap 256 bit and above.

does odd things with 16 bit and mono

Paul.