关于VB的绘图闪烁

twinsant124 2002-11-07 01:07:32

问题描述：我要自己画图表控件，公司决定采用VB，在绘图过程中
我们要做如下的动作：
'擦除
o.Cls
'绘制
o.Draw

问题是：如何消除闪烁？

我知道有两种方法：
1。XOR擦除
2。双缓冲

但VB中的XOR好像不起作用？
而VB实现双缓冲好像也是比较麻烦的事：（

不知那位高手有更好的解决方法，或者有免费的VB双缓冲绘图控件？

...全文

336 16 打赏收藏转发到动态举报

写回复

用AI写文章

16 条回复

切换为时间正序

请发表友善的回复…

发表回复

twinsant124 2002-11-11

打赏
举报

to jamesfay(James Fay):
你的提议好像可以，测试中...

其实我以前用过另一种双缓冲方法：

Option Explicit

Dim i As Integer

Private Sub Form_Click()
Picture1_Click
End Sub

Private Sub Form_Load()
' Set AutoRedraw to True.
Picture1.AutoRedraw = True
i = 1
End Sub

Private Sub Form_Resize()
Picture1.Move 0, 0, frmMain.Width - 1, frmMain.Height - 1
Picture2.Move 0, 0, frmMain.Width - 1, frmMain.Height - 1
End Sub

Private Sub Picture1_Click()
Dim file As String
Dim img As Image

Picture1.Cls

i = i + 1
If (i > 8) Then
i = 1
End If

file = "F:\Program Files\Microsoft Visual Studio\Common\Graphics\Icons\Elements\MOON0" & i & ".ico"

'Set Picture1.Picture = LoadPicture(file)

' Declare variables.
Dim PW, PH
' Set FillStyle to Solid.
Picture1.FillStyle = vbFSSolid
' Choose random color.
Picture1.FillColor = QBColor(Int(Rnd * 15))
PW = Picture1.ScaleWidth ' Set ScaleWidth.
PH = Picture1.ScaleHeight ' Set ScaleHeight.
' Draw a circle in random location.
Picture1.Circle (Int(Rnd * PW), Int(Rnd * PH)), 250
End Sub

Private Sub Picture2_Click()
' Copy Image to Picture2.
Picture2.Picture = Picture1.Image
End Sub

Private Sub Timer1_Timer()
Picture1_Click

'copy
Picture2.Picture = Picture1.Image
End Sub

当窗口最大化时，有Bug：慢啊～～

twinsant124 2002-11-11

打赏
举报

给大家个俺写的例子，把你们的想法在这个例子里用一用，其实计算机很简单，写写代码，看看结果，就知道自己的想法可行不可行了：）

'frmMain.frm
Option Explicit

Dim cB As New cBall
Dim PenColor As Long

Private Sub Form_Load()
cB.Desk = Me
cB.Timer = tmr
cB.Go

PenColor = QBColor(10)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Debug.Print "Draw"
Circle (20, 20), 20, PenColor
Else
Debug.Print "Earse"
Circle (20, 20), 20, Me.BackColor
End If
End Sub

'cBall.cls
Option Explicit

Private m_pForm As Form
Private WithEvents m_Timer As Timer

Private m_bRun As Boolean
Private m_x As Single
Private m_y As Single
Private m_dx As Single
Private m_dy As Single

Public Property Let Desk(pForm As Form)
Set m_pForm = pForm
End Property

Public Property Let Timer(tmr As Timer)
Set m_Timer = tmr
End Property

Public Sub Draw()
pDraw m_pForm.ForeColor
End Sub

Public Sub Move()
m_x = m_x + m_dx

' Collision x
If m_x > m_pForm.ScaleLeft + m_pForm.ScaleWidth Then
m_dx = -m_dx
End If

If m_x < 0 Then
m_dx = -m_dx
End If

m_y = m_y + m_dy

' Collision y
If m_y > m_pForm.ScaleTop + m_pForm.ScaleHeight Then
m_dy = -m_dy
End If

If m_y < 0 Then
m_dy = -m_dy
End If
End Sub

Public Sub Earse()
pDraw m_pForm.BackColor
'm_pForm.Cls
End Sub

Public Sub Go()
m_bRun = True
End Sub

Private Sub Class_Initialize()
m_bRun = False
m_x = 10
m_y = 10
m_dx = 2
m_dy = 2
End Sub

Private Sub m_Timer_Timer()
If m_bRun Then
Earse
Move
Draw
End If
End Sub

Private Sub pDraw(color As Long)
On Error GoTo pDrawError
m_pForm.FillStyle = vbFSSolid
m_pForm.FillColor = color
m_pForm.Circle (m_x, m_y), 10, color
Exit Sub
pDrawError:
Debug.Print "cBall.pDraw: " + Err.Description
End Sub

twinsant124 2002-11-11

打赏
举报

to AutoDraw的同志们：
试试下列代码，看看闪不：
Option Explicit

Private Sub Draw()
Me.Circle (10, 10), 10
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.AutoRedraw = False
Me.Cls
Draw
Me.AutoRedraw = True
End Sub