Search Tools Links Login

Drag with the Mouse an Image Larger than Its Container


This code shows how to scroll with the mouse a large image that is contained in a small container.

Original Author: Aldo Vargas

Assumptions

This example needs that you place a PictureBox and an Image in a form.

Code

Option Explicit
Dim px As Long, py As Long
Dim gapx As Long, gapy As Long
Private Sub Form_Load()
Set Image1.Container = Picture1
Image1.Stretch = True
Image1.Picture = LoadPicture("C:WindowsBubbles.bmp")
Picture1.Move 60, 60, 6000, 4000
Image1.Move -1000, -1000, 10000, 10000
Me.Move Screen.Width 2 - 3100, Screen.Height 2 - 2250, 6200, 4500
End Sub
Private Sub image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
px = X
py = Y
gapx = Picture1.Width - Image1.Width
gapy = Picture1.Height - Image1.Height
Image1.MousePointer = 15
End Sub
Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim deltax As Long, deltay As Long
If Button = vbLeftButton Then
  X = CLng(X)
  Y = CLng(Y)
  If Abs(X - px) < 30 Then
  ElseIf X < px Then
   deltax = Abs(X - px)
   If Image1.Left - deltax >= gapx Then
    Image1.Left = Image1.Left - deltax
   ElseIf gapx <= 0 Then
    Image1.Left = gapx
   Else
    Image1.Left = 0
   End If
   px = X + deltax
  ElseIf X > px Then
   deltax = Abs(X - px)
   If Image1.Left + deltax <= 0 Then
    Image1.Left = Image1.Left + deltax
   Else
    Image1.Left = 0
   End If
   px = X - deltax
  End If
  If Abs(Y - py) < 30 Then
  ElseIf Y < py Then
   deltay = Abs(Y - py)
   If Image1.Top - deltay >= gapy Then
    Image1.Top = Image1.Top - deltay
   ElseIf gapy <= 0 Then
    Image1.Top = gapy
   Else
    Image1.Top = 0
   End If
   py = Y + deltay
  ElseIf Y > py Then
   deltay = Abs(Y - py)
   If Image1.Top + deltay <= 0 Then
    Image1.Top = Image1.Top + deltay
   Else
    Image1.Top = 0
   End If
   py = Y - deltay
  End If
End If
End Sub
Private Sub image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.MousePointer = 0
End Sub

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 85 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.