Monochrome picture 
Author Message
 Monochrome picture

Hi All,

    I've got a picture property on my activex, sometimes I need to show it
in monochrome, any idea?

    Thanks in advance, Saeid

--

S.Azish, Development Manager
System Advance Ltd.
64 ST MARKS ROAD
ENFIELD, LONDON, UK
EN1 1BB
Tel.: (+44)-020 8364 5600
Fax: (+44)-020 8342 0034



Sat, 02 Apr 2005 19:25:09 GMT  
 Monochrome picture

Quote:
>     I've got a picture property on my activex, sometimes I need to show it
> in monochrome, any idea?

Create a 1-Bit DIB and blit your image to it which will map the original
colours to the DIB's colours then blit back to the screen:

'***
Private Declare Function CreateDIBSection1 Lib "gdi32" _
    Alias "CreateDIBSection" (ByVal hdc As Long, _
    pBitmapInfo As BITMAPINFO1, ByVal un As Long, _
    ByVal lplpVoid As Long, ByVal handle As Long, _
    ByVal dw As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
    (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal hSrcDC As Long, ByVal xSrc As Long, _
    ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
    (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" _
    (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Type BITMAPINFOHEADER '40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPel{*filter*}eter As Long
    biYPel{*filter*}eter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO1
    bmiHeader As BITMAPINFOHEADER
    bmiColors(1) As RGBQUAD
End Type

Private Sub Form_Load()
    Dim DeskWnd As Long, DeskDC As Long
    Dim MyDC As Long
    Dim MyDIB As Long, OldDIB As Long
    Dim DIBInf As BITMAPINFO1

    'Persist drawing
    Picture1.AutoRedraw = True

    'Create DC based on desktop DC
    DeskWnd = GetDesktopWindow()
    DeskDC = GetDC(DeskWnd)
    MyDC = CreateCompatibleDC(DeskDC)
    ReleaseDC DeskWnd, DeskDC

    'Validate DC
    If (MyDC = 0) Then Exit Sub

    'Set DIB information
    With DIBInf
        With .bmiHeader 'Same size as picture
            .biWidth = Picture1.ScaleX( _
                Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
            .biHeight = Picture1.ScaleY( _
                Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
            .biBitCount = 1
            .biPlanes = 1
            .biClrUsed = 2
            .biClrImportant = 2
            .biSize = Len(DIBInf.bmiHeader)
        End With

        ' Palette is Black ...
        With .bmiColors(0)
            .rgbRed = &H0
            .rgbGreen = &H0
            .rgbBlue = &H0
        End With

        ' ... and white
        With .bmiColors(1)
            .rgbRed = &HFF
            .rgbGreen = &HFF
            .rgbBlue = &HFF
        End With
    End With

    ' Create the DIBSection
    MyDIB = CreateDIBSection1(MyDC, DIBInf, 0, ByVal 0&, 0, 0)

    If (MyDIB) Then ' Validate and select DIB
        OldDIB = SelectObject(MyDC, MyDIB)

        ' Draw original picture to
        BitBlt MyDC, 0, 0, DIBInf.bmiHeader.biWidth, _
            DIBInf.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy
        BitBlt Picture1.hdc, 0, 0, DIBInf.bmiHeader.biWidth, _
            DIBInf.bmiHeader.biHeight, MyDC, 0, 0, vbSrcCopy
        SelectObject MyDC, OldDIB
        DeleteObject MyDIB
    End If

    DeleteDC MyDC

    Picture1.Refresh
End Sub
'***

This will convert the Picture1 to monochrome.  If you just want to convert
the picture to monochrome then you can create a second DC and select the
picture into that, this will also work if your image is in an StdPicture
object rather than coming from a picture box.
Hope this helps,

    Mike

 -- EDais --

 - Microsoft Visual Basic MVP -
WWW: http://www.*-*-*.com/




Sat, 02 Apr 2005 19:56:14 GMT  
 Monochrome picture
And now I'll finish commenting before I hit send.. ;)

'***
        ...
        ' Draw original picture to the monocrome DC and map to palette
        BitBlt MyDC, 0, 0, DIBInf.bmiHeader.biWidth, _
            DIBInf.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy
        ' Draw the monochome image back to the picture box
        BitBlt Picture1.hdc, 0, 0, DIBInf.bmiHeader.biWidth, _
            DIBInf.bmiHeader.biHeight, MyDC, 0, 0, vbSrcCopy

        ' Clean up DIB
        SelectObject MyDC, OldDIB
        DeleteObject MyDIB
    End If

    ' Clean up DC
    DeleteDC MyDC

    ' Redraw on screen
    Picture1.Refresh
End Sub
'***

That's better *g* - Ah, it's been a long week already!..

    Mike

 -- EDais --

 - Microsoft Visual Basic MVP -
WWW: Http://EDais.earlsoft.co.uk/




Sat, 02 Apr 2005 20:06:04 GMT  
 Monochrome picture
Quote:
>     Thanks for your pretty good sample code, I totallt figured out what's
> happening specially with your comments ;) I just want to ask something
else,
> the picture that this code snippet creates is too dark, how can we make it
> smoother. I mean something almost like disabled mode not disabled but
colors
> should be for example gray something like these pics (see attachment
please)
>     Thanks for your pretty good sample code, I totallt figured out what's
> happening specially with your comments ;) I just want to ask something
else,
> the picture that this code snippet creates is too dark, how can we make it
> smoother. I mean something almost like disabled mode not disabled but
colors
> should be for example gray something like these pics (see attachment

please)

That's greyscale, not monochrome :)
Here's the code converted to create a greyscale version instead:

'***
Private Declare Function CreateDIBSection8 Lib "gdi32" _
    Alias "CreateDIBSection" (ByVal hdc As Long, _
    pBitmapInfo As BITMAPINFO8, ByVal un As Long, _
    ByVal lplpVoid As Long, ByVal handle As Long, _
    ByVal dw As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
    (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal hSrcDC As Long, ByVal xSrc As Long, _
    ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
    (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" _
    (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Type BITMAPINFOHEADER ' 40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPel{*filter*}eter As Long
    biYPel{*filter*}eter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO8
    bmiHeader As BITMAPINFOHEADER
    bmiColors(255) As RGBQUAD
End Type

Private Sub Form_Load()
    Dim DeskWnd As Long, DeskDC As Long
    Dim MyDC As Long
    Dim MyDIB As Long, OldDIB As Long
    Dim DIBInf As BITMAPINFO8
    Dim MakePal As Long

    ' Persist drawing
    Picture1.AutoRedraw = True

    ' Create DC based on desktop DC
    DeskWnd = GetDesktopWindow()
    DeskDC = GetDC(DeskWnd)
    MyDC = CreateCompatibleDC(DeskDC)
    ReleaseDC DeskWnd, DeskDC

    ' Validate DC
    If (MyDC = 0) Then Exit Sub

    ' Set DIB information
    With DIBInf
        With .bmiHeader ' Same size as picture
            .biWidth = Picture1.ScaleX( _
                Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
            .biHeight = Picture1.ScaleY( _
                Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
            .biBitCount = 8
            .biPlanes = 1
            .biClrUsed = 256
            .biClrImportant = 256
            .biSize = Len(DIBInf.bmiHeader)
        End With

        ' Palette is Greyscale
        For MakePal = 0 To 255
            With .bmiColors(MakePal)
                .rgbRed = MakePal
                .rgbGreen = MakePal
                .rgbBlue = MakePal
            End With
        Next MakePal
    End With

    ' Create the DIBSection
    MyDIB = CreateDIBSection8(MyDC, DIBInf, 0, ByVal 0&, 0, 0)

    If (MyDIB) Then ' Validate and select DIB
        OldDIB = SelectObject(MyDC, MyDIB)

        ' Draw original picture to the greyscale DIB
        BitBlt MyDC, 0, 0, DIBInf.bmiHeader.biWidth, _
            DIBInf.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy

        ' Draw the greyscale image back to the picture box
        BitBlt Picture1.hdc, 0, 0, DIBInf.bmiHeader.biWidth, _
            DIBInf.bmiHeader.biHeight, MyDC, 0, 0, vbSrcCopy

        ' Clean up DIB
        SelectObject MyDC, OldDIB
        DeleteObject MyDIB
    End If

    ' Clean up DC
    DeleteDC MyDC

    ' Redraw on screen
    Picture1.Refresh
End Sub
'***

Hope this helps,

    Mike

 -- EDais --

 - Microsoft Visual Basic MVP -
WWW: http://www.*-*-*.com/




Sat, 02 Apr 2005 23:49:31 GMT  
 Monochrome picture

    Perfect Mate!

Saeid



Quote:
> >     Thanks for your pretty good sample code, I totallt figured out
what's
> > happening specially with your comments ;) I just want to ask something
> else,
> > the picture that this code snippet creates is too dark, how can we make
it
> > smoother. I mean something almost like disabled mode not disabled but
> colors
> > should be for example gray something like these pics (see attachment
> please)
> >     Thanks for your pretty good sample code, I totallt figured out
what's
> > happening specially with your comments ;) I just want to ask something
> else,
> > the picture that this code snippet creates is too dark, how can we make
it
> > smoother. I mean something almost like disabled mode not disabled but
> colors
> > should be for example gray something like these pics (see attachment
> please)

> That's greyscale, not monochrome :)
> Here's the code converted to create a greyscale version instead:

> '***
> Private Declare Function CreateDIBSection8 Lib "gdi32" _
>     Alias "CreateDIBSection" (ByVal hdc As Long, _
>     pBitmapInfo As BITMAPINFO8, ByVal un As Long, _
>     ByVal lplpVoid As Long, ByVal handle As Long, _
>     ByVal dw As Long) As Long
> Private Declare Function BitBlt Lib "gdi32" _
>     (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _
>     ByVal nWidth As Long, ByVal nHeight As Long, _
>     ByVal hSrcDC As Long, ByVal xSrc As Long, _
>     ByVal ySrc As Long, ByVal dwRop As Long) As Long
> Private Declare Function DeleteObject Lib "gdi32" _
>     (ByVal hObject As Long) As Long
> Private Declare Function DeleteDC Lib "gdi32" _
>     (ByVal hdc As Long) As Long
> Private Declare Function GetDesktopWindow Lib "user32" () As Long
> Private Declare Function GetDC Lib "user32" _
>     (ByVal hwnd As Long) As Long
> Private Declare Function ReleaseDC Lib "user32" _
>     (ByVal hwnd As Long, ByVal hdc As Long) As Long
> Private Declare Function CreateCompatibleDC Lib "gdi32" _
>     (ByVal hdc As Long) As Long
> Private Declare Function SelectObject Lib "gdi32" _
>     (ByVal hdc As Long, ByVal hObject As Long) As Long
> Private Declare Function SetTextColor Lib "gdi32" _
>     (ByVal hdc As Long, ByVal crColor As Long) As Long
> Private Declare Function SetBkColor Lib "gdi32" _
>     (ByVal hdc As Long, ByVal crColor As Long) As Long

> Private Type BITMAPINFOHEADER ' 40 bytes
>     biSize As Long
>     biWidth As Long
>     biHeight As Long
>     biPlanes As Integer
>     biBitCount As Integer
>     biCompression As Long
>     biSizeImage As Long
>     biXPel{*filter*}eter As Long
>     biYPel{*filter*}eter As Long
>     biClrUsed As Long
>     biClrImportant As Long
> End Type

> Private Type RGBQUAD
>     rgbBlue As Byte
>     rgbGreen As Byte
>     rgbRed As Byte
>     rgbReserved As Byte
> End Type

> Private Type BITMAPINFO8
>     bmiHeader As BITMAPINFOHEADER
>     bmiColors(255) As RGBQUAD
> End Type

> Private Sub Form_Load()
>     Dim DeskWnd As Long, DeskDC As Long
>     Dim MyDC As Long
>     Dim MyDIB As Long, OldDIB As Long
>     Dim DIBInf As BITMAPINFO8
>     Dim MakePal As Long

>     ' Persist drawing
>     Picture1.AutoRedraw = True

>     ' Create DC based on desktop DC
>     DeskWnd = GetDesktopWindow()
>     DeskDC = GetDC(DeskWnd)
>     MyDC = CreateCompatibleDC(DeskDC)
>     ReleaseDC DeskWnd, DeskDC

>     ' Validate DC
>     If (MyDC = 0) Then Exit Sub

>     ' Set DIB information
>     With DIBInf
>         With .bmiHeader ' Same size as picture
>             .biWidth = Picture1.ScaleX( _
>                 Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
>             .biHeight = Picture1.ScaleY( _
>                 Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
>             .biBitCount = 8
>             .biPlanes = 1
>             .biClrUsed = 256
>             .biClrImportant = 256
>             .biSize = Len(DIBInf.bmiHeader)
>         End With

>         ' Palette is Greyscale
>         For MakePal = 0 To 255
>             With .bmiColors(MakePal)
>                 .rgbRed = MakePal
>                 .rgbGreen = MakePal
>                 .rgbBlue = MakePal
>             End With
>         Next MakePal
>     End With

>     ' Create the DIBSection
>     MyDIB = CreateDIBSection8(MyDC, DIBInf, 0, ByVal 0&, 0, 0)

>     If (MyDIB) Then ' Validate and select DIB
>         OldDIB = SelectObject(MyDC, MyDIB)

>         ' Draw original picture to the greyscale DIB
>         BitBlt MyDC, 0, 0, DIBInf.bmiHeader.biWidth, _
>             DIBInf.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy

>         ' Draw the greyscale image back to the picture box
>         BitBlt Picture1.hdc, 0, 0, DIBInf.bmiHeader.biWidth, _
>             DIBInf.bmiHeader.biHeight, MyDC, 0, 0, vbSrcCopy

>         ' Clean up DIB
>         SelectObject MyDC, OldDIB
>         DeleteObject MyDIB
>     End If

>     ' Clean up DC
>     DeleteDC MyDC

>     ' Redraw on screen
>     Picture1.Refresh
> End Sub
> '***

> Hope this helps,

>     Mike

>  -- EDais --

>  - Microsoft Visual Basic MVP -
> WWW: http://www.*-*-*.com/





Sat, 02 Apr 2005 23:56:47 GMT  
 Monochrome picture

Quote:
>     Perfect Mate!

Welcome, give me a shout if you have any further problems.
Incidentally, it's best not to post binaries to the group in future..  It
wasn't so bad because they were compressed but modem users get quite fussy
about it so it's best to post to public web-space instead or offer to e-mail
the files anyone who's interested.

    Mike

 -- EDais --

 - Microsoft Visual Basic MVP -
WWW: Http://EDais.earlsoft.co.uk/




Sat, 02 Apr 2005 23:58:50 GMT  
 
 [ 6 post ] 

 Relevant Pages 

1. How to save Picture as monochrome BMP

2. How to convert a picture to monochrome mask

3. How to convert a picture to monochrome mask.

4. Transfer Picture box contents to a Monochrome bitmap file

5. Savepicture as monochrome?

6. Monochrome Bitmaps

7. VB5 Picturebox and SavePicture in monochrome

8. Saving monochrome BMP-File

9. VB and monochrome images

10. HELP - SetBitmapBits() and Monochrome Icons

11. Creating Monochrome Bitmaps

12. exracting information from monochrome BMP images

 

 
Powered by phpBB® Forum Software