VB 怎样给从内存中bitblt出来的线条赋予各种颜色?
通过CreatePen的方法,从内存中bitblt出来后发现只有前两项属性起作用,颜色却没有发生改变,求解决办法~~ 把代码附上来 hPen1 = CreatePen(0, 2, vbRed)SelectObject lngMemoryDC, hPen1
MoveToEx lngMemoryDC, lngX, dblY, ByVal 0&
lngX = lngX + 1
dblY = (0.45 * H * Sin(K * lngX) + 0.5 * H)
lngP = LineTo(lngMemoryDC, lngX, dblY)
If lngX <= L Then
lngP = BitBlt(Picture2.hdc, 0, 0, L, H, lngMemoryDC, 0, 0, SRCCOPY) '将内存位图中的图形拷贝到窗体上显示
Else
lngP = BitBlt(Picture2.hdc, 0, 0, L, H, lngMemoryDC, lngX - L, 0, SRCCOPY) '将内存位图中的图形拷贝到窗体上显示
End If
DeleteObject hPen1 DC用什么创建的，是CreateCompatibleDC吗？
颜色肯定起作用的，我估计你的代码应该有什么问题，最主要的是，创建笔后，要选人内存设备缓冲区
是的
代码有问题的话,为什么前两项属性起作用了呢? 你的lngMemoryDC这个内存设备场景句柄是依据什么要创建的？
Picture1.ForeColor = vbBlue
lngMemoryDC = CreateCompatibleDC(Picture1.hdc) '创建一个与窗体相兼容的设备场景
lngBMPHandle = CreateCompatibleBitmap(lngMemoryDC, DC_L * L, H) '在内存中创建与窗体同样大小的位图
lngP = SelectObject(lngMemoryDC, lngBMPHandle) '将位图选入刚才创建的设备场景中
lngBrushHandle = CreateSolidBrush(RGB(255, 255, 255)) '用白色创建一个实色画刷
hRgn = CreateRectRgn(0, 0, DC_L * L, H) '创建一个与窗体同样大小的矩形区域
lngP = FillRgn(lngMemoryDC, hRgn, lngBrushHandle) '用创建的画刷对该区域进行填充
lngPen = CreatePen(0, 2, Picture1.ForeColor)
lngP = SelectObject(lngMemoryDC, lngPen)
这样的话不是把picture里的整个前景色都变成blue了么?
我需要在一个picture里弄出不同的颜色~~ 应该不能用CreateCompatibleDC
尝试用CreateDC
一样不行呐~~~ 使用CreateCompatibleBitmap创建DC的位图内存似乎不能正常工作，原因不祥
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type BITMAPINFOHEADER ' 40 bytes
biSize As Long '传递给相关API调用的BitmapInfoHeader的字节数
biWidth As Long '位图宽度（点数）
biHeight As Long '位图高度（点数）
biPlanes As Integer '颜色平面数（因为GDI总是使用一个颜色面，所以总是设置为1
biBitCount As Integer '每点颜色使用的位数
biCompression As Long '存储位图的压缩方式: 'BI_RGB 无压缩RGB格式
'BI_RLE8
'BI_RLE4
'BI_BITFIELDS
'BI_JPEG
biSizeImage As Long '位图数据的总字节数，可用式子计算：(((biWidth * biBitCount) + &H1F) And Not &H1F&) \ &H8
biXPelsPerMeter As Long 'X轴每米点数： (GetDeviceCaps(hDC, HORZRES) / GetDeviceCaps(hDC, HORZSIZE)) * 1000
biYPelsPerMeter As Long 'Y轴每米点数： (GetDeviceCaps(hDC, VERTRES) / GetDeviceCaps(hDC, VERTSIZE)) * 1000
'hDC可用使用屏幕DC：hDC = CreateCompatibleDC(0&)
biClrUsed As Long '调色板使用的颜色数
biClrImportant As Long 'Specifies the number of color indexes that are required for displaying the bitmap. If this value is zero, all colors are required.
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject 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 LineTo Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hDC As Long, ByVal nMapMode As Long) As Long
Private Declare Function GetMapMode Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DPtoLP Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFOHEADER, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Const HORZRES = 8 ' Horizontal width in pixels
Private Const VERTRES = 10 ' Vertical width in pixels
Private Const HORZSIZE = 4 ' Horizontal size in millimeters
Private Const VERTSIZE = 6 ' Vertical size in millimeters
Private Sub Command1_Click()
Dim P As POINTAPI
Dim hPen1 As Long
Dim hMemDC As Long
Dim hBmp As Long
Dim hBrush As Long
Dim i As Long
Dim pBitmap As Long
With Picture2
hMemDC = CreateCompatibleDC(.hDC) '创建一个与窗体相兼容的设备场景
' hBmp = CreateCompatibleBitmap(hMemDC, .ScaleWidth, .ScaleHeight) '使用该函数创建DC内存不能正常工作，原因不祥
hBmp = CreateDIB(hMemDC, .ScaleWidth, .ScaleHeight, pBitmap)
Call SelectObject(hMemDC, hBmp) '将位图选入刚才创建的设备场景中
hPen1 = CreatePen(vbSolid, 2, RGB(255, 0, 255))
hPen1 = SelectObject(hMemDC, hPen1)
MoveToEx hMemDC, 10, 10, P
LineTo hMemDC, 100, 100
' Picture1.Line (10, 10)-(100, 100)
BitBlt .hDC, 0, 0, .ScaleWidth, .ScaleHeight, hMemDC, 0, 0, vbSrcCopy '将内存位图中的图形拷贝到窗体上显示
hPen1 = SelectObject(hMemDC, hPen1)
DeleteObject hPen1
SelectObject hMemDC, hBrush
DeleteDC hMemDC
End With
End Sub
Public Function CreateDIB(hMemDC As Long, ByVal mWidth As Long, ByVal mHeight As Long, pBitmap As Long, Optional mInitColor As Long = 0) As Long
'创建或者改变当前的DIB对象
Dim bmpHeader As BITMAPINFOHEADER
With bmpHeader
.biSize = Len(bmpHeader)
.biWidth = mWidth
.biHeight = mHeight
.biPlanes = 1
.biBitCount = 24
m_WidthBytes = (((.biWidth * .biBitCount) + &H1F) And &HFFFFFFE0) \ &H8
.biSizeImage = .biHeight * m_WidthBytes ' ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
.biXPelsPerMeter = (GetDeviceCaps(hMemDC, HORZRES) / GetDeviceCaps(hMemDC, HORZSIZE)) * 1000 '点数/毫米 *1000=点数/米
.biYPelsPerMeter = (GetDeviceCaps(hMemDC, VERTRES) / GetDeviceCaps(hMemDC, VERTSIZE)) * 1000
.biClrUsed = 0
.biClrImportant = 0
End With
CreateDIB = CreateDIBSection(hMemDC, bmpHeader, 0, pBitmap, 0, 0)
End Function
搞明白怎么回事了
Private Sub Command1_Click()
Dim P As POINTAPI
Dim hPen1 As Long
Dim hMemDC As Long
Dim hBmp As Long
Dim hBrush As Long
Dim i As Long
Dim pBitmap As Long
With Picture2
hMemDC = CreateCompatibleDC(.hDC) '创建一个与窗体相兼容的设备场景
hBmp = CreateCompatibleBitmap(.hDC, .ScaleWidth, .ScaleHeight)
Call SelectObject(hMemDC, hBmp) '将位图选入刚才创建的设备场景中
hPen1 = CreatePen(vbSolid, 2, RGB(255, 0, 255))
hPen1 = SelectObject(hMemDC, hPen1)
MoveToEx hMemDC, 10, 10, P
LineTo hMemDC, 100, 100
' Picture1.Line (10, 10)-(100, 100)
BitBlt .hDC, 0, 0, .ScaleWidth, .ScaleHeight, hMemDC, 0, 0, vbSrcCopy '将内存位图中的图形拷贝到窗体上显示
hPen1 = SelectObject(hMemDC, hPen1)
DeleteObject hPen1
SelectObject hMemDC, hBrush
DeleteDC hMemDC
End With
End Sub
补充：VB , API
