Question

这段代码为什么不能用？

关于鼠标响应事件的
Option Explicit
Private Const MERGEPAINT = &HBB0226
Private Const SRCAND = &H8800C6
Private Const SRCCOPY = &HCC0020
Private 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
Private OldX As Single
Private OldY As Single
Private CurX As Single
Private CurY As Single
Private PicWid As Single
Private PicHgt As Single
Private Xmax As Single
Private Ymax As Single
Private NewX As Single
Private NewY As Single
Private Dx As Single
Private Dy As Single
Private DistToMove As Single
Private Const MOVE_OFFSET = 10

Private Sub Command1_Click()
Form2.Show
End
End Sub

Private Sub Form_Load()
Width = (Width - ScaleWidth) + picCanvas.Width
Height = (Height - ScaleHeight) + picCanvas.Height
PicWid = pic1.ScaleWidth
PicHgt = pic1.ScaleHeight
Xmax = picCanvas.ScaleWidth - PicWid
Ymax = picCanvas.ScaleHeight - PicHgt
OldX = 30
OldY = 30
CurX = 30
CurY = 30
DrawPicture
End Sub

Private Sub DrawPicture()
BitBlt picCanvas.hDC, -OldX, OldY, PicWid, picHidden.hDC, -OldX, OldY, SRCCOPY
OldX = CurX
OldY = CurY
BitBlt picCanvas.hDC, -CurX, CurY, PicWid, pic1Mask.hDC, 0, 0, MERGEPAINT
BitBlt picCanvas.hDC, -CurX, CurY, PicWid, pic1.hDC, 0, 0, SRCAND
picCanves.Refresh
End Sub
Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dist As Single
NewX = X - PicWid / 2
NewY = Y - PicHgt / 2
If NewX < 0 Then NewX = 0
If NewX > Xmax Then NewX = Xmax
If NewY < 0 Then NewY = 0
If NewY > Ymax Then NewY = Ymax
Dx = NewX - CurX
Dy = NewY - CurY
DistToMove = Sqr(Dx * Dx + Dy * Dy)
Dx = Dx / DistToMove * Move - OFFSET
Dy = Dy / DistToMove * Move - OFFSET
Termove.Enabled = True

End Sub

Private Sub Termove_Timer()
DistToMove = DistToMove - Move - OFFSET
If DistToMove <= 0 Then
CurX = NewX
CurY = NewY
Termove.Enabled = False
Else
CurX = CurX + Dx
CurY = CurY + Dy
End If
DrawPicture

End Sub
它说没有ScaleWidth

Answer 1

调试你的代码,有几处错误:
1)下面代码中少PicHgt值
Private Sub DrawPicture()
BitBlt picCanvas.hDC, -OldX, OldY, PicWid, picHidden.hDC, -OldX, OldY, SRCCOPY
OldX = CurX
OldY = CurY
BitBlt picCanvas.hDC, -CurX, CurY, PicWid, pic1Mask.hDC, 0, 0, MERGEPAINT
BitBlt picCanvas.hDC, -CurX, CurY, PicWid, pic1.hDC, 0, 0, SRCAND
picCanves.Refresh
End Sub
拟改为:
Private Sub DrawPicture()
BitBlt picCanvas.hDC, -OldX, OldY, picwid, PicHgt, picHidden.hDC, -OldX, OldY, vbSrcCopy
OldX = CurX
OldY = CurY
BitBlt picCanvas.hDC, -CurX, CurY, picwid, PicHgt, pic1Mask.hDC, 0, 0, MERGEPAINT
BitBlt picCanvas.hDC, -CurX, CurY, picwid, PicHgt, Pic1.hDC, 0, 0, SRCAND
picCanves.Refresh
End Sub
2)
Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dist As Single
NewX = X - PicWid / 2
NewY = Y - PicHgt / 2
If NewX < 0 Then NewX = 0
If NewX > Xmax Then NewX = Xmax
If NewY < 0 Then NewY = 0
If NewY > Ymax Then NewY = Ymax
Dx = NewX - CurX
Dy = NewY - CurY
DistToMove = Sqr(Dx * Dx + Dy * Dy)
Dx = Dx / DistToMove - OFFSET '* Move 有误
Dy = Dy / DistToMove - OFFSET '* Move 有误
Termove.Enabled = True
End Sub

3)
Private Sub Termove_Timer()
DistToMove = DistToMove - OFFSET '- Move 有误
If DistToMove <= 0 Then
CurX = NewX
CurY = NewY
Termove.Enabled = False
Else
CurX = CurX + Dx
CurY = CurY + Dy
End If
DrawPicture

End Sub