图片上下移动控制

cyerp 2018-01-15 06:46:39

P1.pictureBox P2.pictureBox
P2放在在P1的上面，P2的图片长度比P1大，鼠标左键P2图片可上下移动图片。

问题：怎样控制不让P2移动不超过P1的边框？
如图：

Dim Y1 As Single, Y2 As Single

Private Sub p2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Y1 = Y
End If
End Sub

Private Sub p2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Y2 = Y
P2.Top = P2.Top + Y2 - Y1
End If

End Sub

...全文

549 9 打赏收藏转发到动态举报

写回复

用AI写文章

9 条回复

切换为时间正序

请发表友善的回复…

发表回复

hongss 2018-01-16

打赏
举报

引用 4 楼 zhao4zhong1 的回复:

“多一少一”问题占程序员常犯错误的10%以上！避免“多一少一”问题的方法之一是将比如<10甚至<5的数代入程序片断，掰手指头心算验证一下程序到底应该写为 x、x-1、x+1中的哪个？ <、<=、==、>、>=中的哪个？

很多就在这临界的位置出错。。。吃了几次亏了~~~

舉杯邀明月 2018-01-16

打赏
举报

顺便说一下，既然是“小图片框包含大图片框”，那么上面的代码就不存在“边框影响”的问题。

舉杯邀明月 2018-01-16

打赏
举报

上面的代码，是我看错了，是“把小图片限制在大图片之内移动”的代码。在3楼回复之后，才发现：　原来楼主的是“小图片框中放入大图片”。

但已经无法再回复修正内容了。　按楼主的需求，代码如下：

Option Explicit

Private msMinX As Single
Private msMinY As Single
Private msFcx  As Single
Private msFcy  As Single
 
Private Sub Form_Load()
   msMinX = P1.ScaleWidth - P2.Width
   msMinY = P1.ScaleHeight - P2.Height
End Sub
 
Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If (1 = Button) Then
      msFcx = X
      msFcy = Y
   End If
End Sub
 
Private Sub P2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim cx As Single, cy As Single
 
   If (1 = Button) Then
      cx = X + P2.Left - msFcx
      cy = Y + P2.Top - msFcy
      If (0 < cx) Then
         cx = 0:  msFcx = X - P2.Left
      Else
         If (cx < msMinX) Then cx = msMinX:  msFcx = X
      End If
      If (0 < cy) Then
         cy = 0:  msFcy = Y - P2.Top
      Else
         If (cy < msMinY) Then cy = msMinY:  msFcy = Y
      End If
      Call P2.Move(cx, cy)
   End If
End Sub

赵4老师 2018-01-16

打赏
举报

“多一少一”问题占程序员常犯错误的10%以上！避免“多一少一”问题的方法之一是将比如<10甚至<5的数代入程序片断，掰手指头心算验证一下程序到底应该写为 x、x-1、x+1中的哪个？ <、<=、==、>、>=中的哪个？

赵4老师 2018-01-16

打赏
举报

Scroll Bar 控件方案：创建可滚动的图形视口除了 PictureBox 控件之外，也可用水平、垂直滚动条创建可滚动的图形视口应用程序。当所包含的图形超过控件范围时，单独一个 PictureBox 控件无法实现滚动功能─ 因为 PictureBox 控件不能自动添加滚动条。应用程序使用两个图片框。称第一个为平稳的父 PictureBox 控件。称第二个为子 PictureBox 控件，它包含在父图片框中。子图片框中包含图形图象，可用滚动条控件在父图片框中移动子图片框。图 7.25 在设计时添加滚动条控件如图 7.28 所示，先创建一个新工程，然后在窗体上绘制两个图片框、一个水平滚动条和一个垂直滚动条。这里，用窗体的 Form_Load 事件设置比例模型，在父图片框中调整子图片框的大小，水平、垂直滚动条将定位并调整它们的大小，然后加载位图图形。将下列代码添加到窗体的 Form_Load 事件过程中： Private Sub Form_Load() '设置 ScaleMode 为像素。 Form1.ScaleMode = vbPixels Picture1.ScaleMode = vbPixels '将 Autosize 设置为 True，以使 Picture2 的边界 '扩展到实际的位图大小。 Picture2.AutoSize = True '将每个图片框的 BorderStyle 属性设置为 None。 Picture1.BorderStyle = 0 Picture2.BorderStyle = 0 '加载位图。 Picture2.Picture = _ LoadPicture("c:\Windows\Winlogo.bmp") '初始化两个图片框的位置。 Picture1.Move 0, 0, ScaleWidth - VScroll1.Width, _ ScaleHeight - HScroll1.Height Picture2.Move 0, 0 '将水平滚动条定位。 HScroll1.Top = Picture1.Height HScroll1.Left = 0 HScroll1.Width = Picture1.Width '将垂直滚动条定位。 VScroll1.Top = 0 VScroll1.Left = Picture1.Width VScroll1.Height = Picture1.Height '设置滚动条的 Max 属性。 HScroll1.Max = Picture2.Width - Picture1.Width VScroll1.Max = Picture2.Height - Picture1.Height '判断子图片框是否将充满屏幕。 '若如此，则无需使用滚动条。 VScroll1.Visible = (Picture1.Height < _ Picture2.Height) HScroll1.Visible = (Picture1.Width < _ Picture2.Width) End Sub 水平和垂直滚动条的 Change 事件用来在父图片框中上、下、左、右移动子图片框。请将下列代码添加到两个滚动条控件的 Change 事件中： Private Sub HScroll1_Change() Picture2.Left = -HScroll1.Value End Sub Private Sub VScroll1_Change() Picture2.Top = -VScroll1.Value End Sub 将子图片框的 Left 和 Top 属性分别设置成水平和垂直滚动条数值的负值，这样，当上、下、左、右滚动时，图形可正确地移动。运行时，显示的图形如图 7.26 所示。图 7.26 运行时滚动位图运行时调整窗体大小在上例中，窗体的初始大小限制图形的可视大小。在运行时当用户调整窗体大小时，为了调整图形视口应用程序的大小，可将下列代码添加到窗体的 Form_Resize 事件过程中： Private Sub Form_Resize() '调整窗体大小时，改变 Picture1 '的尺寸。 Picture1.Height = Form1.Height Picture1.Width = Form1.Width '重新初始化图片和滚动条的 '位置。 Picture1.Move 0, 0, ScaleWidth - VScroll1.Width, _ ScaleHeight - HScroll1.Height Picture2.Move 0, 0 HScroll1.Top = Picture1.Height HScroll1.Left = 0 HScroll1.Width = Picture1.Width VScroll1.Top = 0 VScroll1.Left = Picture1.Width VScroll1.Height = Picture1.Height HScroll1.Max = Picture2.Width - Picture1.Width VScroll1.Max = Picture2.Height - Picture1.Width '检查是否需要滚动条。 VScroll1.Visible = (Picture1.Height < _ Picture2.Height) HScroll1.Visible = (Picture1.Width < _ Picture2.Width) End Sub

xzjxucxx 2018-01-16

打赏
举报

控制一下边界就是了

舉杯邀明月 2018-01-15

打赏
举报

小小的修正：

Private Sub P2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim cx As Single, cy As Single

   If (1 = Button) Then
      cx = X + P2.Left - msFcx
      cy = Y + P2.Top - msFcy
      If (0 > cx) Then
         cx = 0:  msFcx = X
      Else
         If (cx > msMaxX) Then cx = msMaxX:  msFcx = X
      End If
      If (0 > cy) Then
         cy = 0:  msFcy = Y
      Else
         If (cy > msMaxY) Then cy = msMaxY:  msFcy = Y
      End If
      Call P2.Move(cx, cy)
   End If
End Sub

舉杯邀明月 2018-01-15

打赏
举报

刚才看到，msMcx和msMcy 这两个变量没用使用（暂时忽略了“边框线宽度”的影响，感觉还是可以接受的）。上面代码的第6、第7、第17、第18　这四行，可以删除。

舉杯邀明月 2018-01-15

打赏
举报

如果没有特别的要求，把P2放在P1里面吧（就是“画P2”时，先把鼠标移到P1里面，再画控件P2）。这样处理起来简单点。

Option Explicit

Private msMaxX As Single
Private msMaxY As Single
Private msMcx  As Single
Private msMcy  As Single
Private msFcx  As Single
Private msFcy  As Single

Private Sub Form_Load()
   msMaxX = P1.ScaleWidth - P2.Width
   msMaxY = P1.ScaleHeight - P2.Height
End Sub

Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If (1 = Button) Then
      msMcx = X
      msMcy = Y
      msFcx = X
      msFcy = Y
   End If
End Sub

Private Sub P2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim cx As Single, cy As Single

   If (1 = Button) Then
      cx = X + P2.Left - msFcx
      cy = Y + P2.Top - msFcy
      If (0 > cx) Then
         cx = 0:  msFcx = X - P2.Left
      Else
         If (cx > msMaxX) Then cx = msMaxX:  msFcx = X
      End If
      If (0 > cy) Then
         cy = 0:  msFcy = Y - P2.Top
      Else
         If (cy > msMaxY) Then cy = msMaxY:  msFcy = Y
      End If
      Call P2.Move(cx, cy)
   End If
End Sub