Changing the GDI Pen won't work in my VB6 draw lines code

Question

I am trying to use the createPen/SelectObject GDI functions to change the DC pen in a VB6 simple program.

The program is a vb6 form with Picture1 pictureBox control. It waits for the user to click inside the pictureBox to draw a black background with 2 lines (one horizontal and one vertical, intersecting at the mouse X,Y location).

The program draws the 2 lines in white color when I use the GetStockObject(WHITE_PEN) function as in the following code:

SelectObject lMemoryDC, GetStockObject(WHITE_PEN)

but when I use the following code:

lPen = CreatePen(CLng(0), CLng(0), RGB(0, 250, 0))
lOldPen = SelectObject(lMemoryDC, lPen)

it does not draw any of the 2 lines, at least I don't see them in the final result, I only see the black bakground color.

Here is my code:

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Dim lMemoryDC As Long, lMemBitMap As Long, lOrigBitmap As Long
        Dim lPointAPI As POINTAPI
        Dim lPen As Long, lOldPen As Long
        Dim wid As Long
        Dim hgt As Long
        
        Picture1.AutoRedraw = True
        
        wid = Picture1.ScaleWidth
        hgt = Picture1.ScaleHeight
        'Picture1.ForeColor = vbRed
        
        lMemoryDC = CreateCompatibleDC(Picture1.hdc) '(GetDC(0))
        lMemBitMap = CreateCompatibleBitmap(lMemoryDC, Picture1.ScaleWidth, Picture1.ScaleHeight)
        lOrigBitmap = SelectObject(lMemoryDC, lMemBitMap)
        
        'Here I am creating a green color pen 
*        lPen = CreatePen(CLng(0), CLng(0), RGB(0, 250, 0))
        lOldPen = SelectObject(lMemoryDC, lPen)*
        
        Call MoveToEx(lMemoryDC, X - 100, Y, lPointAPI)
        Call LineTo(lMemoryDC, X + 100, Y)
        
        Call MoveToEx(lMemoryDC, X, Y - 100, lPointAPI)
        Call LineTo(lMemoryDC, X, Y + 100)

        SelectObject lMemoryDC, lOldPen
        DeleteObject lPen


        BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lMemoryDC, 0, 0, vbSrcCopy
        
        Picture1.Refresh
        
        'Cleanup memory
        DeleteObject lMemBitMap
        DeleteDC lMemoryDC
End Sub

Thank you

Answer 1

you are in monocrome using lMemBitMap = CreateCompatibleBitmap(lMemoryDC, Picture1.ScaleWidth, Picture1.ScaleHeight)

see https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createcompatiblebitmap

About managing colors this is what I found:

a call to GetStockObject(DC_PEN) is needed to use colors

after a called to GetStockObject(DC_PEN) the pen is set to width 1 -- case 0,9,10

after a call to GetStockObject
    a call to SelectObject(DC_PEN) is needed
    unless a preceding call to SetDCPenColor is executed
    otherwise the color is probably black

Case 12 is what you need

Mario.

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lPointAPI   As POINTAPI
Dim lMemoryDC   As Long
Dim lMemBitMap  As Long
Dim lOrigBitmap As Long
Dim lPen        As Long
Dim lOldPen     As Long
Dim wid         As Long
Dim hgt         As Long
Dim sel         As Long

Picture1.AutoRedraw = True
wid = Picture1.ScaleWidth
hgt = Picture1.ScaleHeight

' use this for 24 bit color
    lMemoryDC = CreateCompatibleDC(Me.hDC)
    lMemBitMap = CreateCompatibleBitmap(Me.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight)

' this works too
'lMemoryDC = CreateCompatibleDC(Picture1.hDC)
'lMemBitMap = CreateCompatibleBitmap(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight)
    
lOrigBitmap = SelectObject(lMemoryDC, lMemBitMap)


sel = 12

Select Case sel
    
    Case 0:     ' -- white, width 1
                SelectObject lMemoryDC, GetStockObject(WHITE_PEN)
                
    Case 1:     ' -- green, width 10
                SelectObject lMemoryDC, GetStockObject(DC_PEN)
                lPen = CreatePen(0, 10, RGB(0, 250, 0))
                lOldPen = SelectObject(lMemoryDC, lPen)
    
    Case 2:     ' -- green, width 10
                lPen = CreatePen(0, 10, RGB(0, 250, 0))
                SelectObject lMemoryDC, GetStockObject(DC_PEN)
                lOldPen = SelectObject(lMemoryDC, lPen)
    
    Case 3:     ' -- no effect (black color) until a SetDCPenColor call
                SelectObject lMemoryDC, GetStockObject(WHITE_PEN)
                lPen = CreatePen(0, 10, RGB(0, 250, 0))
                lOldPen = SelectObject(lMemoryDC, lPen)
                SelectObject lMemoryDC, GetStockObject(DC_PEN)
    
    Case 4:     ' -- orange, width 10
                SelectObject lMemoryDC, GetStockObject(WHITE_PEN)
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN
                lPen = CreatePen(0, 10, RGB(255, 200, 0))           ' create pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
              
    Case 5:     ' -- orange, width 10
                SelectObject lMemoryDC, GetStockObject(WHITE_PEN)
                lPen = CreatePen(0, 10, RGB(255, 200, 0))           ' create pen
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                
    Case 6:     ' -- no effect (black color) until a SetDCPenColor call
                SelectObject lMemoryDC, GetStockObject(WHITE_PEN)
                lPen = CreatePen(0, 10, RGB(255, 200, 0))           ' create pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN

    Case 7:     ' -- orange, width 10
                SelectObject lMemoryDC, GetStockObject(WHITE_PEN)
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN
                lPen = CreatePen(0, 10, RGB(255, 200, 0))           ' create pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                SetDCPenColor lMemoryDC, &H10FF10                   ' no change color
                
    Case 8:     ' -- no effect (black color) until a SetDCPenColor call
                lPen = CreatePen(0, 10, RGB(255, 255, 255))         ' create white pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN, reset width to 1
    
    Case 9:     ' -- no effect (black color) until a SetDCPenColor call
                lPen = CreatePen(0, 10, RGB(255, 255, 255))         ' create white pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                SetDCPenColor lMemoryDC, RGB(0, 255, 0)             ' color is changed
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN, reset width to 1
                
    Case 10:    ' -- orange, width 1
                lPen = CreatePen(0, 10, RGB(255, 255, 255))         ' create white pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN, reset width to 1
                SetDCPenColor lMemoryDC, RGB(255, 200, 0)           ' color is changed
    
    Case 11:    ' -- green, width 1
                lPen = CreatePen(0, 10, RGB(255, 255, 255))         ' create white pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
                SetDCPenColor lMemoryDC, RGB(255, 200, 0)           ' color is changed
                SetDCPenColor lMemoryDC, RGB(0, 255, 0)             ' color is changed
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN, reset width to 1
                
    Case 12:    ' -- green, width 1
                SelectObject lMemoryDC, GetStockObject(DC_PEN)      ' switch to DC_PEN, reset width to 1
                lPen = CreatePen(0, 0, RGB(0, 255, 0))              ' create white pen
                lOldPen = SelectObject(lMemoryDC, lPen)             ' select pen
    
End Select

Call MoveToEx(lMemoryDC, X - 100, Y, lPointAPI)
Call LineTo(lMemoryDC, X + 100, Y)
Call MoveToEx(lMemoryDC, X, Y - 100, lPointAPI)
Call LineTo(lMemoryDC, X, Y + 100)

SetDCPenColor lMemoryDC, RGB(0, 255, 255)
    
X = X + 60
Y = Y + 60
Call MoveToEx(lMemoryDC, X - 40, Y, lPointAPI)
Call LineTo(lMemoryDC, X + 40, Y)
Call MoveToEx(lMemoryDC, X, Y - 40, lPointAPI)
Call LineTo(lMemoryDC, X, Y + 40)

BitBlt Picture1.hDC, 0, 0, Picture1.ScaleWidth, _
       Picture1.ScaleHeight, lMemoryDC, 0, 0, vbSrcCopy
Picture1.Refresh

SelectObject lMemoryDC, lOldPen
DeleteObject lPen
DeleteObject lMemBitMap
DeleteDC lMemoryDC
End Sub