Dim drv As String

Private Declare Function StretchBlt Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal nSrcWidth As Long, _
ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long

Private Sub Dir1_Change()
File1.path = Dir1.path
End Sub

Private Sub Dir1_Click()
With Dir1
.path = .List(.ListIndex)
End With
End Sub

Private Sub Dir1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With Dir1
.ToolTipText = .List(.ListIndex)
End With
End Sub

Private Sub Drive1_Change()
On Error GoTo Err
Dir1.path = Drive1
Exit Sub
Err:
Drive1 = drv
End Sub

Private Sub File1_Click()
Set pic.Picture = Nothing
Set p.Picture = Nothing
Dim path As String
Dim x As Single
Dim blnW As Boolean
If pic.Width > pic.Height Then
x = pic.Width / pic.Height
blnW = True
Else
x = pic.Height / pic.Width
blnW = False
End If

path = Dir1.path
If Right(path, 1) <> "\" Then path = path & "\"
pic.Picture = LoadPicture(path & File1.FileName)
pic.Refresh: DoEvents
If blnW Then
x = p.Height / x: DoEvents
StretchBlt p.hdc, 0, 0, p.Width, Int(x), pic.hdc, 0, 0, pic.Width, pic.Height, vbSrcCopy
Else
x = p.Width / x: DoEvents
StretchBlt p.hdc, 0, 0, Int(x), p.Height, pic.hdc, 0, 0, pic.Width, pic.Height, vbSrcCopy
End If
p.Refresh
End Sub

Private Sub Form_Load()
drv = Drive1
End Sub

问题是出现的缩略图是油彩一样，怎样让它不失真？

其實用PAINPICTURE就可以叻 不必這么痲煩`

写个代码吧,我不会用PAINPICTURE,谢谢

p2.PaintPicture p1.Picture, 0, 0, p2.ScaleWidth, p2.ScaleHeight

搞定了,其实自己试一下就知道了,呵呵,

那個``對象瀏覽器裏麵有詳細的使用方法``

我都是直接拿来用,写不出就问,段懒人很省心的,呵呵

又改了下,按比例显示:
Dim xy As Single
xy = p1.ScaleHeight / p1.ScaleWidth
If xy > 1 Then '高大于宽
p2.Width = p2.Height * xy
Else
p2.Width = p2.Height / xy
End If
p2.PaintPicture p1.Picture, 0, 0, p2.ScaleWidth, p2.ScaleHeight

谢谢你呀,有你这样的好人在,我们有福了,呵呵