VB代码片段

窗体上放置一个按钮button1,一个图片框picture1和一个图象框image1
image1是放在picture1中的.实现了图片拖放平移的功能,今天朋友要我帮他解决,也就即刻写了这么一段

' 拖动标志
Dim bEnDrag As Boolean
' 当前鼠标位置
Dim curX As Long
Dim curY As Long

Private Sub Command1_Click()
    '加载新图片
    Image1.Picture = LoadPicture(App.Path & "/71.jpg")
End Sub

Private Sub Form_Load()
    '初始化控件
    Image1.Left = 0
    Image1.Top = 0
    bEnDrag = False

End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ' 拖放开始
    bEnDrag = True
    curX = X
    curY = Y
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ' On Error Resume Next
    If bEnDrag Then
   
        Dim newX As Long, newY As Long
       
        ' 先算出要拖放的新位置
        newX = Image1.Left + X - curX
        newY = Image1.Top + Y - curY
       
        ' 判断边界防止图片出界(左上角位置)
        If newY > 0 Then newY = 0
        If newX > 0 Then newX = 0


         ' 判断边界防止图片出界(右边位置)
        If Image1.Width > Picture1.Width Then
            If newX < -(Image1.Width - Picture1.Width) Then
                newX = -(Image1.Width - Picture1.Width)
            End If
        Else
            newX = 0
        End If

        ' 判断边界防止图片出界(底部边位置)
        If Image1.Height > Picture1.Height Then
            If newY < -(Image1.Height - Picture1.Height) Then
                newY = -(Image1.Height - Picture1.Height)
            End If
        Else
            newY = 0
        End If

        ' 给图片设置新的位置
        Image1.Left = newX
        Image1.Top = newY
        
    End If
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '拖放结束
    bEnDrag = False
End Sub

  • 1
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值