怎么先在内存DC中绘图,然后再将bitblt到Form上
如何先在内存DC中绘图,然后再将bitblt到Form上?
需是在form上画线。但直接画时是先清屏再画,有闪烁。因此想先在内存DC中画好,再用bitblt在form中显示。但发现根本没用:
代码如下:
测试程序是将FORM1 BITBLT到内存DC,再在内存DC上画一条线,然后再将内存DC BITBLT到FORM2中。
在项目中建立两个FORM,FORM1上有个command1按钮。以及一个MUDULE。
Private Sub Form_Load()
Form2.Show '程序启动时显示FORM2
End Sub
Private Sub Command1_Click()
Dim i As Long
Dim p As Long
Dim a As POINTAPI
dcs = CreateCompatibleDC(Form1.hdc) '根据FORM1创建内存DC
dcpic = CreateCompatibleBitmap(Form1.hdc, Form1.Width, Form1.Height) '建立与FORM1大小一样的位图区
SelectObject dcs, dcpic
BitBlt dcs, 0, 0, Form1.Width, Form1.Height, Form1.hdc, 0, 0, &HCC0020 'SRCCOPY 将FORM1图像映射到内存DC
p = CreatePen(PS_SOLID, 5, RGB(0, 255, 0)) ' 设置画笔大小和颜色
old = SelectObject(dcs, p)
drawdcline dcs, 0, 0, Form1.Width, Form1.Height '在内存DC上画一个对角斜线
BitBlt Form2.hdc, 0, 0, Form1.Width, Form1.Height, dcs, 0, 0, &HCC0020 'SRCCOPY 将画好的内存DC映射到FORM2上
End Sub
module中的内容:
Public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public 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
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public dcs As Long
Public dcpic As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Const PS_SOLID = 0
Public Sub drawdcline(hdc As Long, startpx As Long, startpy As Long, endpx As Long, endpy As Long) ', pen As Long, cc As Long)
Dim old As Long
Dim p As Long
Dim a As POINTAPI
MoveToEx hdc, startpx / Screen.TwipsPerPixelX, startpy / Screen.TwipsPerPixelX, a
LineTo hdc, endpx / Screen.TwipsPerPixelX, endpy / Screen.TwipsPerPixelX
End Sub
但是问题是点击command1后,FORM2没有任何反映。
请问,问题出在那里呢?
谢谢!
------解决方案--------------------
Private Sub Form_Load()
Me.ScaleMode = vbPixels '设置scalemode,下同
Form2.ScaleMode = vbPixels
Form2.Show '程序启动时显示FORM2
End Sub
Private Sub Command1_Click()
Dim i As Long
Dim p As Long
Dim a As POINTAPI
dcs = CreateCompatibleDC(Form1.hdc) '根据FORM1创建内存DC
dcpic = CreateCompatibleBitmap(Form1.hdc, Form1.ScaleWidth, Form1.ScaleHeight) '建立与FORM1大小一样的位图区
SelectObject dcs, dcpic
BitBlt dcs, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, Form1.hdc, 0, 0, &HCC0020 'SRCCOPY 将FORM1图像映射到内存DC
p = CreatePen(PS_SOLID, 5, RGB(0, 255, 0)) ' 设置画笔大小和颜色
old = SelectObject(dcs, p)
drawdcline dcs, 0, 0, Form1.Width, Form1.Height '在内存DC上画一个对角斜线
BitBlt Form2.hdc, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, dcs, 0, 0, &HCC0020 'SRCCOPY 将画好的内存DC映射到FORM2上
End Sub
'说明:要设置窗体的scalemode,在用绘图API中form的尺寸用ScaleWidth和scaleHeight
需是在form上画线。但直接画时是先清屏再画,有闪烁。因此想先在内存DC中画好,再用bitblt在form中显示。但发现根本没用:
代码如下:
测试程序是将FORM1 BITBLT到内存DC,再在内存DC上画一条线,然后再将内存DC BITBLT到FORM2中。
在项目中建立两个FORM,FORM1上有个command1按钮。以及一个MUDULE。
Private Sub Form_Load()
Form2.Show '程序启动时显示FORM2
End Sub
Private Sub Command1_Click()
Dim i As Long
Dim p As Long
Dim a As POINTAPI
dcs = CreateCompatibleDC(Form1.hdc) '根据FORM1创建内存DC
dcpic = CreateCompatibleBitmap(Form1.hdc, Form1.Width, Form1.Height) '建立与FORM1大小一样的位图区
SelectObject dcs, dcpic
BitBlt dcs, 0, 0, Form1.Width, Form1.Height, Form1.hdc, 0, 0, &HCC0020 'SRCCOPY 将FORM1图像映射到内存DC
p = CreatePen(PS_SOLID, 5, RGB(0, 255, 0)) ' 设置画笔大小和颜色
old = SelectObject(dcs, p)
drawdcline dcs, 0, 0, Form1.Width, Form1.Height '在内存DC上画一个对角斜线
BitBlt Form2.hdc, 0, 0, Form1.Width, Form1.Height, dcs, 0, 0, &HCC0020 'SRCCOPY 将画好的内存DC映射到FORM2上
End Sub
module中的内容:
Public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public 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
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public dcs As Long
Public dcpic As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Const PS_SOLID = 0
Public Sub drawdcline(hdc As Long, startpx As Long, startpy As Long, endpx As Long, endpy As Long) ', pen As Long, cc As Long)
Dim old As Long
Dim p As Long
Dim a As POINTAPI
MoveToEx hdc, startpx / Screen.TwipsPerPixelX, startpy / Screen.TwipsPerPixelX, a
LineTo hdc, endpx / Screen.TwipsPerPixelX, endpy / Screen.TwipsPerPixelX
End Sub
但是问题是点击command1后,FORM2没有任何反映。
请问,问题出在那里呢?
谢谢!
------解决方案--------------------
Private Sub Form_Load()
Me.ScaleMode = vbPixels '设置scalemode,下同
Form2.ScaleMode = vbPixels
Form2.Show '程序启动时显示FORM2
End Sub
Private Sub Command1_Click()
Dim i As Long
Dim p As Long
Dim a As POINTAPI
dcs = CreateCompatibleDC(Form1.hdc) '根据FORM1创建内存DC
dcpic = CreateCompatibleBitmap(Form1.hdc, Form1.ScaleWidth, Form1.ScaleHeight) '建立与FORM1大小一样的位图区
SelectObject dcs, dcpic
BitBlt dcs, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, Form1.hdc, 0, 0, &HCC0020 'SRCCOPY 将FORM1图像映射到内存DC
p = CreatePen(PS_SOLID, 5, RGB(0, 255, 0)) ' 设置画笔大小和颜色
old = SelectObject(dcs, p)
drawdcline dcs, 0, 0, Form1.Width, Form1.Height '在内存DC上画一个对角斜线
BitBlt Form2.hdc, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, dcs, 0, 0, &HCC0020 'SRCCOPY 将画好的内存DC映射到FORM2上
End Sub
'说明:要设置窗体的scalemode,在用绘图API中form的尺寸用ScaleWidth和scaleHeight