添加两个Picture控件,先载入Picture2,然后根据Picture1的大小自动调整显示。
代码如下:
Private Sub Form_Load()
Picture1.AutoRedraw = True '重绘图片
Picture1.AutoSize = False '图片框大小不变
Picture1.Visible = True
'Picture1.BackColor = RGB(255, 255, 255) '设置图片框背景颜色
Picture2.AutoSize = True 'Picture2自动缩放以适应图片,不可见
Picture2.Visible = False
End Sub
Private Sub Command1_Click()
Picture2.Picture = LoadPicture("C:\2.jpg") '图片加载到Pic2
If Picture2.ScaleWidth > Picture2.ScaleHeight Then
imageWidth = Picture1.ScaleWidth
imageHeight = Picture1.ScaleHeight * Picture2.ScaleHeight / Picture2.ScaleWidth
Else
imageWidth = Picture1.ScaleWidth * Picture2.ScaleWidth / Picture2.ScaleHeight
imageHeight = Picture1.ScaleHeight
End If
Picture1.Cls
Picture1.PaintPicture Picture2, (Picture1.ScaleWidth - imageWidth) / 2, (Picture1.ScaleHeight - imageHeight) / 2, imageWidth, imageHeight, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight
End Sub
效果(由于图片小,于是调整后上下空出来了):
主要是坐标的换算,将picturebox的坐标与shape的坐标一致,如此只要用鼠标调节shape大小来调节picture的大小调整相片。
Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height
Picture1.PaintPicture Picture2, 0, 0, Picture1.Width, Picture1.Height, 0, 0, Picture2.Width, Picture2.Height