picture scrolling

[aley]

چگونه میتوانم یک تصویر را با اسکرول بار پیمایش کنم؟

[Pouria.NET]

با این کد در Vb 6.0
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmmain
BorderStyle = 1 'Fixed Single
Caption = "Picture Scrolling"
ClientHeight = 8115
ClientLeft = 45
ClientTop = 735
ClientWidth = 8430
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 8115
ScaleWidth = 8430
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame1
Caption = "Enter your desired X, Y"
Height = 1095
Left = 360
TabIndex = 8
Top = 6360
Width = 4935
Begin VB.TextBox txty
Height = 375
Left = 1560
TabIndex = 2
Text = "5000"
Top = 360
Width = 1215
End
Begin VB.TextBox txtx
Height = 375
Left = 120
TabIndex = 1
Text = "5000"
Top = 360
Width = 1215
End
Begin VB.CommandButton cmdgo
Caption = "&Go"
Default = -1 'True
Height = 375
Left = 3120
TabIndex = 0
Top = 360
Width = 1335
End
End
Begin MSComctlLib.StatusBar stb
Align = 2 'Align Bottom
Height = 495
Left = 0
TabIndex = 7
Top = 7620
Width = 8430
_ExtentX = 14870
_ExtentY = 873
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 6
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Object.Width = 2117
MinWidth = 2117
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Object.Width = 2117
MinWidth = 2117
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
EndProperty
BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Object.Width = 2117
MinWidth = 2117
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.VScrollBar vsb
Height = 5895
LargeChange = 1000
Left = 8040
Max = 16468
SmallChange = 500
TabIndex = 5
Top = 0
Width = 375
End
Begin VB.HScrollBar hsb
Height = 375
LargeChange = 1000
Left = 0
Max = 21773
SmallChange = 500
TabIndex = 4
Top = 5880
Width = 8055
End
Begin VB.PictureBox pic
Height = 5895
Left = 0
MouseIcon = "Form1.frx":2312
Picture = "Form1.frx":2754
ScaleHeight = 5835
ScaleWidth = 7995
TabIndex = 3
Top = 0
Width = 8055
End
Begin VB.Label lbl
Caption = "Label1"
Height = 255
Left = 3000
TabIndex = 6
Top = 5400
Width = 1455
End
Begin VB.Menu mnufile
Caption = "File"
Begin VB.Menu mnufileopen
Caption = "Open Image"
Enabled = 0 'False
End
Begin VB.Menu sep1
Caption = "-"
End
Begin VB.Menu mnufileexit
Caption = "Exit"
End
End
Begin VB.Menu mnuhelpscrolling
Caption = "Help"
Begin VB.Menu mnuhelpscrollig
Caption = "About Scrolling pic"
End
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Rem this code is written by pouria Amirian
Dim picwidth As Long
Dim picheight As Long
Dim picturewidth As Long
Dim pictureheight As Long
Private Sub cmdgo_Click()
If (IsNumeric((txtx)) And IsNumeric((txty))) Then
If ((Val(txtx.Text) - picwidth / 2 > 0) And (Val(txty.Text) - picheight / 2) > 0 And (Val(txtx) < hsb.Max + picwidth / 2) And (Val(txty) < vsb.Max + picheight / 2)) Then
hsb.Value = Val(txtx.Text) - picwidth / 2
vsb.Value = Val(txty.Text) - picheight / 2
pic.DrawWidth = 20
pic.PSet (Val(txtx.Text), Val(txty)), vbWhite
pic.DrawWidth = 2
pic.PSet (Val(txtx.Text), Val(txty)), vbBlack
Else
MsgBox "You must enter X between (" & Str(Int(picwidth / 2) + 1) & " , " & Str(25690) & _
")" & " and Y Between (" & Str(Int(picheight / 2) + 1) & " , " & Str(Int(vsb.Max + picheight / 2) + 1) & ")", , "Limitation"
End If
Else
MsgBox "You must enter number in these boxes", vbOKOnly, "Attention"
End If
End Sub
Private Sub Form_Load()
picwidth = pic.Width
picheight = pic.Height
pictureheight = pic.Picture.Height
picturewidth = pic.Picture.Width
stb.Panels(1).Text = "Value of bars"
stb.Panels(2).Text = "0"
stb.Panels(3).Text = "0"
stb.Panels(4).Text = "Pointer X,Y"
End Sub

Private Sub hsb_Change()
pic.Left = -hsb.Value
pic.Width = picwidth + hsb.Value
stb.Panels(2).Text = hsb.Value
End Sub
Private Sub hsb_Scroll()
pic.Left = -hsb.Value
pic.Width = picwidth + hsb.Value
stb.Panels(2).Text = hsb.Value
End Sub
Private Sub mnufileexit_Click()
Unload Me
End
End Sub
Private Sub mnuhelpscrollig_Click()
frmabout.Show vbModal
End Sub

Private Sub pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
stb.Panels(5).Text = X
stb.Panels(6).Text = Y
End Sub
Private Sub vsb_Change()
pic.Top = -vsb.Value
pic.Height = picheight + vsb.Value
stb.Panels(3).Text = vsb.Value
End Sub
Private Sub vsb_Scroll()
pic.Top = -vsb.Value
pic.Height = picheight + vsb.Value
stb.Panels(3).Text = vsb.Value
End Sub