| 投稿日 | ： 2006/10/30(Mon) 17:38 |
| 投稿者 | ： Edward |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^2: ラバーバンドの応用（質問内容を簡素にしました） |
PictureCopy()の中でMouseMoveの度に.Refreshを呼ぶのではなく
Picture1_MouseUpで一回呼ぶだけにしたらちらつかなくなりましたね。
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_Mode = False
Call PictureCopy(Picture1, 2)
Picture1.Refresh 'ここに移動
Call PictureCopy(Picture1, 3)
End Sub
Private Sub PictureCopy(Pic1 As PictureBox, WorkNo As Integer)
Dim Ret As Long
With Pic1
If WorkNo = 1 Then
g_hMemoryDC = CreateCompatibleDC(.hdc)
g_hBitmap = CreateCompatibleBitmap(.hdc, .ScaleWidth, .ScaleHeight)
g_hOldBitmap = SelectObject(g_hMemoryDC, g_hBitmap)
BitBlt g_hMemoryDC, 0&, 0&, .ScaleWidth, .ScaleHeight, .hdc, 0&, 0&, SRCCOPY
ElseIf WorkNo = 2 Then
Ret = SetStretchBltMode(.hdc, STRETCH_DELETESCANS)
StretchBlt .hdc, 0&, 0&, .ScaleWidth, .ScaleHeight, g_hMemoryDC, 0&, 0&, .ScaleWidth, .ScaleHeight, SRCCOPY
Ret = SetStretchBltMode(.hdc, Ret)
' .Refresh 'コメントアウト
ElseIf WorkNo = 3 Then
DeleteDC g_hMemoryDC
DeleteObject g_hBitmap
End If
End With
End Sub