VB写的图片浏览怎么实现鼠标托动看图片

iori8421 2006-06-25 11:15:45
现在我加的滚动条来调整看超过大小的图片.想加个鼠标直接托动就可以看图片任意位置的功能.不知道应该怎么加

我的代码
Private Sub Command21_Click()
On Error GoTo ErrExit
Form3.Caption = Label29.Caption
Form3.Picture2.Left = 0
Form3.Picture2.Top = 0
Form3.Picture2.Width = Form3.Picture1.Width
Form3.Picture2.Height = Form3.Picture1.Height
Form3.VScroll1.Min = 0
Form3.HScroll1.Min = 0
Form3.HScroll1.Min = 0
Form3.VScroll1.Max = Form3.Picture2.Height - Form3.Picture1.Height
Form3.HScroll1.Max = Form3.Picture2.Width - Form3.Picture1.Width
If Form3.HScroll1.Max < 0 Then Form3.HScroll1.Enabled = False
If Form3.VScroll1.Max < 0 Then Form3.VScroll1.Enabled = False
Form3.Picture2.Picture = LoadPicture(App.Path + "\Map\" + Label29.Caption + ".jpg")
Form3.VScroll1.Min = 0
Form3.HScroll1.Min = 0
Form3.VScroll1.Max = Form3.Picture2.Height - Form3.Picture1.Height
Form3.HScroll1.Max = Form3.Picture2.Width - Form3.Picture1.Width
If Form3.HScroll1.Max < 0 Then Form3.HScroll1.Enabled = False
If Form3.VScroll1.Max < 0 Then Form3.VScroll1.Enabled = False
ErrExit:
End Sub


form 3 中 加一个picbox1 ,一个picbox2 auto属性为true!
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub

Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub

...全文
134 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
清晨曦月 2006-06-25
  • 打赏
  • 举报
回复
'1.程式名称:像ACDSee一样用滑鼠拖曳大于表单的图片 (图形置中版)
'2.开发日期:08/31/1999
'3.开发环境:Visual Basic 5.0 中文专业版 + SP3
'4.作者姓名:宋世杰 (小翰,Jaric)
'5.作者信箱:jaric@tacocity.com.tw
'6.作者网址:http://fly.to/jaric 或 http://tacocity.com.tw/jaric
'7.网址名称:Visual Basic 实战网
'8.注意事项:您可以任意散布本程式,但是请勿将以上说明删除,谢谢!
' 如果本程式经过您的修改,可以在下方加入您的个人资讯。
Option Explicit
Private gX As Long, gY As Long

Private Sub Form_Load()
Image1 = LoadPicture("C:\Documents and Settings\All Users\Documents\My Pictures\示例图片\Blue hills.bmp") '这个路径可能要改
FitForm Image1
End Sub

Private Sub Form_Resize()
Call CenterImage(Image1)
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
gX = X
gY = Y
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Button = vbLeftButton Then Exit Sub
Dim dx As Long, dy As Long, ax As Long, ay As Long, t As Long, l As Long, tt As Long, ll As Long
With Image1
dy = Y - gY
dx = X - gX
ll = .Left
tt = .Top
l = Abs(ll)
t = Abs(tt)
ax = (.Width - l - ScaleWidth)
ay = (.Height - t - ScaleHeight)
If ll > 0 Then
dx = 0
Else
If dx < 0 Then
If Abs(dx) > ax Then dx = -ax
Else
If dx > l Then dx = l
End If
End If
If tt > 0 Then
dy = 0
Else
If dy < 0 Then
If Abs(dy) > ay Then dy = -ay
Else
If dy > t Then dy = t
End If
End If
.Move ll + dx, tt + dy
End With
End Sub

Private Sub CenterImage(dest As Image)
dest.Move (ScaleWidth - dest.Width) / 2, (ScaleHeight - dest.Height) / 2
End Sub

Private Sub FitForm(dest As Image)
Width = dest.Width + Width - ScaleWidth
Height = dest.Height + Height - ScaleHeight
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
End Sub

lsftest 2006-06-25
  • 打赏
  • 举报
回复
在mousedown且mousemove的时候自己计算好显示区域再显示。。

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧