vb双缓冲问题
我在对话框上加了几条Line控件，然后在对话框上画图，已经采用了缓冲dc来画了，而且，基本上0.5秒才重画一次，第一次重画时闪烁不算严重，第二次闪烁就很明显了。
下面是完整代码（分模块和窗体） ：
Private Sub Form_Load()
Dim mRGN As Long, Cnt As Long, mBrush As Long
mDC = CreateCompatibleDC(GetDC(0))
mBitmap = CreateCompatibleBitmap(GetDC(0), Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
SelectObject mDC, mBitmap
SetBkMode mDC, TRANSPARENT
SetRect R, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY
FillRect mDC, R, GetSysColorBrush(COLOR_WINDOW)
DeleteObject SelectObject(mDC, CreateMyFont(1, 0))
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Timer1.Enabled = True Then Exit Sub
Dim i As Long, j As Long
i = (x - (x Mod 1000)) / 1000
j = (y - (y Mod 1000)) / 1000
Debug.Print arr(i, j)
If arr(i, j) = 0 Then Exit Sub
drops = drops - 1
Label1.Caption = drops
arr(i, j) = arr(i, j) + 1
calcDC
Me.Refresh
check
Timer1.Enabled = True
End Sub
Private Sub Form_Paint()
BitBlt Me.hdc, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, mDC, 0, 0, vbSrcCopy
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteDC mDC
DeleteObject mBitmap
End Sub
'打开游戏
Private Sub OPEN_Click()
Open App.Path & "\save.db" For Binary As #1
For i = 0 To 5
For j = 0 To 5
Get #1, , arr(i, j)
Next j
Next i
Close 1#
calcDC
Me.Refresh
End Sub
'保存游戏
Private Sub SAVE_Click()
Open App.Path & "\save.db" For Binary As #1
For i = 0 To 5
For j = 0 To 5
Put #1, , arr(i, j)
Next j
Next i
Close 1#
End Sub
'开始游戏
Private Sub START_Click()
drops = 15
newgame
End Sub
Private Sub Timer1_Timer()
check
End Sub
'撤销
Private Sub UNDO_Click()
End Sub
'重做
Private Sub REDO_Click()
End Sub
Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long
'Create a specified font
CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 288), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function
Sub check()
Dim str As String
Dim i As Long, j As Long
Dim isdone As Boolean
stack_h = 0
isdone = True
For i = 0 To 5
For j = 0 To 5
If arr(i, j) > 4 Then
arr(i, j) = 0
stack(stack_h).x = i
stack(stack_h).y = j
stack_h = stack_h + 1
End If
Next j
Next i
Dim a As Long, b As Long
For i = 0 To stack_h - 1
a = stack(i).x
b = stack(i).y
'左边
a = a - 1
Do While a >= 0
If arr(a, b) = 0 Then
a = a - 1
Else
arr(a, b) = arr(a, b) + 1
Exit Do
End If
Loop
a = stack(i).x + 1
'右边
Do While a < 6
If arr(a, b) = 0 Then
a = a + 1
Else
arr(a, b) = arr(a, b) + 1
Exit Do
End If
Loop
a = stack(i).x
b = stack(i).y - 1
'上边
Do While b >= 0
If arr(a, b) = 0 Then
b = b - 1
Else
arr(a, b) = arr(a, b) + 1
Exit Do
End If
Loop
a = stack(i).x
b = stack(i).y + 1
'下边
Do While b < 6
If arr(a, b) = 0 Then
b = b + 1
Else
arr(a, b) = arr(a, b) + 1
Exit Do
End If
Loop
Next i
'检查下一秒还有没有需要爆的？，没有就停止计时器
For i = 0 To 5
For j = 0 To 5
If arr(i, j) > 4 Then
isdone = False
End If
Next j
Next i
If isdone = True Then Timer1.Enabled = False
'检查是否完成本局了？
isdone = True
For i = 0 To 5
For j = 0 To 5
If arr(i, j) > 0 Then
isdone = False
End If
Next j
Next i
If isdone = True Then
MsgBox "本局完成，加一水滴，开始下一局"
drops = drops + 1
newgame
End If
calcDC
Me.Refresh
End Sub
Sub newgame()
FillRect mDC, R, GetSysColorBrush(COLOR_WINDOW)
Randomize
Dim str As String
Dim i As Long, j As Long
For i = 0 To 5
For j = 0 To 5
arr(i, j) = Rnd * 4
str = arr(i, j)
If str <> "0" Then
Call TextOut(mDC, 67 * i + 20, 67 * j, str, LenB(str) - 1)
End If
Next j
Next i
calcDC
Me.Refresh
End Sub
Sub calcDC()
FillRect mDC, R, GetSysColorBrush(COLOR_WINDOW)
Dim str As String
Dim i As Long, j As Long
For i = 0 To 5
For j = 0 To 5
'arr(i, j) = Rnd * 4
str = arr(i, j)
If str <> "0" Then
Call TextOut(mDC, 67 * i + 20, 67 * j, str, LenB(str) - 1)
End If
Next j
Next i
End Sub
模块：
Public arr(6, 6) As Integer
Public mDC As Long, mBitmap As Long
Public R As RECT
Public drops As Long
Public stack_h As Long
Public stack(10) As POINT
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator 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 CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINT
x As Long
y As Long
End Type
Public Const TRANSPARENT = 1
Public Const OPAQUE = 2
Public Const COLOR_WINDOW = 5
Public Const vbSrcCopy = &HCC0020
[解决办法]
这个例子可以绘制出平滑曲线
[解决办法]
关键在于你是用Me.Refresh来刷新窗口，包括窗体上的所有控件都会被刷新，当然也包括背景啦。
所以会闪烁。
你可以不要用line 控件，直接用代码画在mDc上，然后需要刷新的时候直接用
BitBlt me.hdc,0,0,width,height,mDC,0,0,SrcCopy
