VB中如何用滚动条控制图片的缩放？

Question

如题所述

Answer 1

要注意保持原图片的宽窄比，否则会失真！给你段相对完整的代码。
步骤1：
新建一窗体，添加一按钮组【Command1(0)】、【Command1(1)】、【Command1(2)】，一个对话框【CommonDialog1】（COMDLG32.OCX）以及一个图片框【Picture1】。
步骤2：粘贴以下代码：
步骤3：运行

Option Explicit

Private MyPic As IPictureDisp
Private BS As Double
Private YD As Boolean
Private MX1 As Single '鼠标拖动图片参数
Private MY1 As Single
Private MX2 As Single
Private MY2 As Single

Private Sub mDrawPicture()
Picture1.Cls
Picture1.PaintPicture MyPic, MX1, MY1, 800 * BS, 600 * BS, 0, 0, 800, 600
End Sub

Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
mLoadPicture '加载图片
Case 1
mDingLiangSuoFang 0.2 '递增 0.2
Case 2
mDingLiangSuoFang -0.2 '递减 0.2
End Select
End Sub

Private Sub mDingLiangSuoFang(ZL As Single)
If ZL > 0 Then
BS = IIf(BS + ZL > 8, 8, BS + ZL)
Else
BS = IIf(BS + ZL < 0.01, 0.01, BS + ZL)
End If
MX1 = MX1 + ZL
MY1 = MY1 + ZL
HScroll1.Value = BS * 100
End Sub

Private Sub mLoadPicture()

CommonDialog1.CancelError = True
On Error GoTo ErrLoadPicture
CommonDialog1.Filter = "All Picture Files (*.BMP)|*.BMP|All Picture Files (*.JPG)|*.JPG|All Picture Files (*.Gig)|*.Gif|"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
Set MyPic = LoadPicture(CommonDialog1.FileName)
BS = 1
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
mDrawPicture
mChuShiHua True
On Error GoTo 0
Exit Sub

ErrLoadPicture:
If Err.Number <> 32755 Then MsgBox Err.Description '按了取消按钮 ''''''''''

End Sub

Private Sub Form_Load()
Me.Caption = "用滚动条或按钮缩放图片"
mChuShiHua False
Command1(0).Caption = "导入图片"
Command1(1).Caption = "放大"
Command1(2).Caption = "缩小"
End Sub

Private Sub mChuShiHua(FS As Boolean)
HScroll1.Enabled = FS
Command1(1).Enabled = FS
Command1(2).Enabled = FS
If HScroll1.LargeChange <> 10 Then HScroll1.LargeChange = 10
If HScroll1.SmallChange <> 1 Then HScroll1.SmallChange = 1
If HScroll1.Max <> 800 Then HScroll1.Max = 800 '原图的八倍
If HScroll1.Min <> 1 Then HScroll1.Min = 1
HScroll1.Value = 100

End Sub

Private Sub Form_Resize()
Command1(0).Move 200, 200, 1500, 400
Command1(1).Move 1728, 200, 1500, 400
Command1(2).Move 3226, 200, 1500, 400
HScroll1.Move 4725, 200, Me.ScaleWidth - HScroll1.Left - 200, 400
Picture1.Move 200, 800, Me.ScaleWidth - 400, Me.ScaleHeight - 1200
End Sub

Private Sub HScroll1_Change()
BS = HScroll1.Value / 100
If HScroll1.Enabled = True Then mDrawPicture
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
Screen.MousePointer = 15
YD = True
MX2 = X
MY2 = Y
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If YD = False Then Exit Sub
MX1 = MX1 + (X - MX2)
MY1 = MY1 + (Y - MY2)
MX2 = X
MY2 = Y
mDrawPicture
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Screen.MousePointer <> 0 Then Screen.MousePointer = 0
If YD = True Then YD = False
End Sub

Answer 2

加个picture控件，水平滚动条
Dim tempx, tempy

Private Sub Command1_Click()
File1.Path = Text1
File1.Pattern = "*.jpg;*.bmp"
End Sub

Private Sub File1_Click()
a = File1.Path & "\" & File1.FileName
Picture1.Picture = LoadPicture(a)
tempx = Picture1.Width
tempy = Picture1.Height
End Sub

Private Sub HScroll1_Change()
Picture1.Picture = LoadPicture("")
Call daxiao(HScroll1.Value, HScroll1.Value)
Picture1.Width = HScroll1.Value + tempx
Picture1.Height = HScroll1.Value + tempy
End Sub

Private Sub daxiao(x As Double, y As Double)
With LoadPicture(File1.Path & "\" & File1.FileName)
.Render Picture1.hDC, 0, 0, y, x, 0, .Height, .Width, -.Height, 0
End With
End Sub本回答被提问者采纳

Answer 3

Private Sub HScroll1_Change()
Picture1.Height = HScroll1.Value
Picture1.Width = HScroll1.Value
End Sub