Hi all,

The following simple test code takes a snapshot of the desktop screen, produces a BMP image in memory , retrieves all the pixels in the BMP ,replace the white pixels with green pixels and finally copy the altered BMP back to the screen using the SetDIBitsToDevice GDI API.

Problem:

Although the code works, the resulting text is blurred/reddish.

Question:
Is there a way of getting a smooth text ?


I have also used the TransparentBlt API in another code but I i get the same text-blurring problem.

Code:
Option Explicit

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
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

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

Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Declare   Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare   Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare   Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare   Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Declare   Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare   Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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
Declare   Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare   Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare   Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Declare   Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long


Const DIB_RGB_COLORS = 0
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Const SRCCOPY = &HCC0020
Const CAPTUREBLT = &H40000000
Const BI_RGB = 0&


Function getScreenBMP(hdcSrc As Long) As Long

    Dim nScreenWidth As Long, nScreenHeight As Long
    Dim hCaptureDC  As Long, hBitmap As Long, hOld As Long
    
    nScreenWidth = GetSystemMetrics(SM_CXSCREEN)
    nScreenHeight = GetSystemMetrics(SM_CYSCREEN)
    ' // Create compatible DC, create a compatible bitmap and copy the screen using BitBlt()
    hCaptureDC = CreateCompatibleDC(hdcSrc)
    hBitmap = CreateCompatibleBitmap(hdcSrc, nScreenWidth, nScreenHeight)
    hOld = SelectObject(hCaptureDC, hBitmap)
    'Make a copy of the screen
    'TODO: take subset
    Call BitBlt(hCaptureDC, 0, 0, nScreenWidth, nScreenHeight, hdcSrc, 0, 0, SRCCOPY Or CAPTUREBLT)
    Call SelectObject(hCaptureDC, hOld) ' // always select the previously selected object once done
    Call DeleteDC(hCaptureDC)
    getScreenBMP = hBitmap
End Function



Sub testMain()

    Dim myBMInfo As BITMAPINFO
    Dim lpPixels() As RGBQUAD
    Dim hdc As Long, hBitmap As Long
    
    hdc = GetDC(0)
    hBitmap = getScreenBMP(hdc)
    
    myBMInfo.bmiHeader.biSize = LenB(myBMInfo.bmiHeader)
    ' // Get the BITMAPINFO structure from the bitmap
    Call GetDIBits(hdc, hBitmap, 0, 0, vbNull, myBMInfo, DIB_RGB_COLORS)
    ' // create the bitmap buffer
    ' ReDim lpPixels(myBMInfo.bmiHeader.biSizeImage / 4)
    ReDim lpPixels(myBMInfo.bmiHeader.biWidth, myBMInfo.bmiHeader.biHeight)
    
    ' // Better do this here - the original bitmap might have BI_BITFILEDS, which makes it
    ' // necessary to read the color table - you might not want this.
    myBMInfo.bmiHeader.biCompression = BI_RGB
    
    ' // get the actual bitmap buffer
   Call GetDIBits(hdc, hBitmap, 0, myBMInfo.bmiHeader.biHeight, lpPixels(1, 1), myBMInfo, DIB_RGB_COLORS)
    
    Dim x As Long, y As Long

    '// replace white pixels with green pixels
      For x = 0 To myBMInfo.bmiHeader.biWidth
          For y = 0 To myBMInfo.bmiHeader.biHeight
          If lpPixels(x, y).rgbGreen = 255 And lpPixels(x, y).rgbBlue = 255 And lpPixels(x, y).rgbRed = 255 Then
                lpPixels(x, y).rgbGreen = 255: lpPixels(x, y).rgbBlue = 0: lpPixels(x, y).rgbRed = 0
          End If
          Next y
      Next x

    SetDIBitsToDevice hdc, 0, 0, myBMInfo.bmiHeader.biWidth, myBMInfo.bmiHeader.biHeight, 0, 0, 0, myBMInfo.bmiHeader.biHeight, lpPixels(1, 1), myBMInfo, DIB_RGB_COLORS

    Call DeleteObject(hBitmap)
    Call ReleaseDC(vbNull, hdc)

End Sub


This is what I get : (Notice the blurred text)




Also, Does the GDI+ provide a better alternative ?

Regards.