更改 GDI 笔在我的 VB6 绘制线代码中不起作用

问题描述 投票：0回答：1

我正在尝试使用 createPen/SelectObject GDI 函数在 VB6 简单程序中更改 DC 笔。

该程序是一个vb6形式，带有Picture1图片框控件。它等待用户在 pictureBox 内部单击以绘制带有 2 条线的黑色背景（一条水平线和一条垂直线，在鼠标 X,Y 位置相交）。

当我使用 GetStockObject(WHITE_PEN) 函数时，程序会以白色绘制 2 条线，如下代码所示：

SelectObject lMemoryDC, GetStockObject(WHITE_PEN)

但是当我使用以下代码时：

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

它没有绘制任何两条线，至少我在最终结果中没有看到它们，我只看到黑色背景色。

这是我的代码：

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

谢谢你

vb6 gdi graphics2d
1个回答
0
投票

您在单色中使用 lMemBitMap = CreateCompatibleBitmap(lMemoryDC, Picture1.ScaleWidth, Picture1.ScaleHeight)

参见https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-create兼容位图

关于管理颜色，这是我发现的：

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

案例12就是你所需要的

马里奥。

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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.