将一个图片按比例缩放显示在一个Frame中

tzlink

'Form1.frm
  VERSION 5.00
  Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  Begin VB.Form Form1
  Caption = "Form1"
  ClientHeight = 5010
  ClientLeft = 60
  ClientTop = 345
  ClientWidth = 7800
  LinkTopic = "Form1"
  ScaleHeight = 334
  ScaleMode = 3 'Pixel
  ScaleWidth = 520
  StartUpPosition = 3 '窗口缺省
  Begin MSComDlg.CommonDialog CommonDialog1
  Left = 4635

  Top = 3120
  _ExtentX = 847
  _ExtentY = 847
  _Version = 393216
  End
  Begin VB.Frame Frame1
  Caption = "Frame1"
  Height = 3000
  Left = 4500
  TabIndex = 2
  Top = 30
  Width = 3180
  Begin VB.PictureBox Picture2
  Appearance = 0 'Flat
  ForeColor = &H80000008&
  Height = 2625
  Left = 120
  ScaleHeight = 173
  ScaleMode = 3 'Pixel
  ScaleWidth = 194
  TabIndex = 3
  Top = 255
  Width = 2940
  Begin VB.Image Image1
  Height = 1575
  Left = 465
  Top = 390
  Width = 1965
  End
  End
  End
  Begin VB.CommandButton Command1
  Caption = "&Load Picture"
  Height = 330
  Left = 5400
  TabIndex = 0

  Top = 3150
  Width = 1425
  End
  Begin VB.PictureBox Picture1
  Appearance = 0 'Flat
  AutoSize = -1 'True
  BorderStyle = 0 'None
  ForeColor = &H80000008&
  Height = 4425
  Left = 60
  ScaleHeight = 4425
  ScaleWidth = 4380
  TabIndex = 1
  Top = 105
  Width = 4380
  End
  End
  Attribute VB_Name = "Form1"
  Attribute VB_GlobalNameSpace = False
  Attribute VB_Creatable = False
  Attribute VB_PredeclaredId = True
  Attribute VB_Exposed = False
  Option Explicit
   
  Dim ReturnHeight As Long, ReturnWidth As Long
   
  Private Sub Command1_Click()
  Dim BigWidth As Long, BigHeight As Long
  Dim StretchWidth As Long, StretchHeight As Long
  CommonDialog1.Filter = "jpeg文件|*.jpg|gif文件|*.gif|所有文件|*.*"

  CommonDialog1.ShowOpen
  If CommonDialog1.FileName <> "" Then
  Picture1.Picture = LoadPicture(CommonDialog1.FileName)
   
  BigWidth = Picture1.Width
  BigHeight = Picture1.Height
  StretchWidth = Picture2.ScaleWidth
  StretchHeight = Picture2.ScaleHeight
   
  StretchImage BigWidth, BigHeight, StretchWidth, StretchHeight, True
   
  Image1.Stretch = True
  Image1.Width = ReturnWidth
  Image1.Height = ReturnHeight
   
  Image1.Left = (Picture2.ScaleWidth - Image1.Width) / 2
  Image1.Top = (Picture2.ScaleHeight - Image1.Height) / 2
  Image1.Picture = LoadPicture(CommonDialog1.FileName)
  End If
  End Sub
   
  Private Sub StretchImage(OriginalWidth As Long, OriginalHeight As Long, StretchWidth As Long, StretchHeight As Long, Optional Flag As Boolean = False) Www@Chinaz@com
  If (OriginalWidth >= StretchWidth Or OriginalHeight > StretchHeight) Or Flag = True Then '需要缩放
  If OriginalWidth / OriginalHeight >= StretchWidth / StretchHeight Then
  ReturnWidth = StretchWidth
  ReturnHeight = StretchWidth / OriginalWidth * OriginalHeight
  Else
  ReturnHeight = StretchHeight
  ReturnWidth = StretchHeight / OriginalHeight * OriginalWidth
  End If
  Else
  ReturnHeight = OriginalHeight
  ReturnWidth = OriginalWidth
  End If
  End Sub