之前麻烦司仪给我看下代码,结果司仪测试正常。
在另一台电脑重写,也成功了?!
找了一下原因,发现很奇葩……
l = CreatePen(2, 1, vbBlack)
这句代码成功在黑色背景画出白色虚线?!
l = CreatePen(2, 1, vbWhite)
反而这句画出的是白色实线?!
不…并不是颜色相反…
l = CreatePen(2, 1, RGB(255, 255, 254))
直到这种情况了,还是白色…无语了…
我也不知道是我的代码有问题还是其原来的BUG,所以附上全部代码:
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function Arc Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (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 DeleteDC Lib "gdi32.dll" (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 Const SRCCOPY As Long = &HCC0020
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = 3
Dim l As Long, MainDC As Long, LhBMP As Long
MainDC = CreateCompatibleDC(Me.hdc)
LhBMP = CreateCompatibleBitmap(MainDC, 400, 250)
SelectObject MainDC, LhBMP
l = CreatePen(2, 1, RGB(255, 255, 254))
SelectObject MainDC, l
Arc MainDC, 110, 20, 310, 220, 100, 70, 100, 170
BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MainDC, 0, 0, SRCCOPY
DeleteObject l
DeleteObject LhBMP
DeleteDC MainDC
End Sub
在另一台电脑重写,也成功了?!
找了一下原因,发现很奇葩……
l = CreatePen(2, 1, vbBlack)
这句代码成功在黑色背景画出白色虚线?!
l = CreatePen(2, 1, vbWhite)
反而这句画出的是白色实线?!
不…并不是颜色相反…
l = CreatePen(2, 1, RGB(255, 255, 254))
直到这种情况了,还是白色…无语了…
我也不知道是我的代码有问题还是其原来的BUG,所以附上全部代码:
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function Arc Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (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 DeleteDC Lib "gdi32.dll" (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 Const SRCCOPY As Long = &HCC0020
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = 3
Dim l As Long, MainDC As Long, LhBMP As Long
MainDC = CreateCompatibleDC(Me.hdc)
LhBMP = CreateCompatibleBitmap(MainDC, 400, 250)
SelectObject MainDC, LhBMP
l = CreatePen(2, 1, RGB(255, 255, 254))
SelectObject MainDC, l
Arc MainDC, 110, 20, 310, 220, 100, 70, 100, 170
BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MainDC, 0, 0, SRCCOPY
DeleteObject l
DeleteObject LhBMP
DeleteDC MainDC
End Sub
![](http://h.hiphotos.bdimg.com/album/s%3D1100%3Bq%3D90/sign=d3486c6e1f950a7b71354ac53ae159a8/48540923dd54564e0d18d361b1de9c82d1584f6c.jpg?v=tbs)