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

运行效果图：

代码如下：

'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)
  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

本文地址：http://com.8s8s.com/it/it44612.htm