图片自动适应大小问题，求教

[rkdrc]

要求是这样
条件：首先有一个固定大小的picturebox控件，想在上面加载不同分辨率的图片，图片大小不一
要求：1.一个不想用控件来适应图片大小（否掉autosize），第二不想图片比例变形(否掉拉伸)
2.高度方向上必须和控件等高，长度方向上可以变小（也就是图片要全部显示出来）
3.图片要在控件中居中显示

请教怎么写或用什么函数？

[孤独剑_LPZ]

改用image控件即可,Image1.Stretch 设为True

[chinaboyzyq]

光用image.stretch=true图形会变形。

考虑把picturebox做为image的容器，然后把image按picture高度变化比例，再居中就行了。

Private Sub Command1_Click()
     Set Image1.Container = Picture1
     Image1.Stretch = False
     Image1.Picture = LoadPicture("C:\Documents and Settings\Administrator\My Documents\My Pictures\77553_1261644150946r.jpg")
     Image1.Stretch = True
     Image1.Width = Image1.Width * (Picture1.Height / Image1.Height)
     Image1.Height = Picture1.Height
     Image1.Move (Picture1.Width - Image1.Width) / 2, 0
         
End Sub

[chinaboyzyq]

另一种方法，添加image1并隐藏。

Private Sub Command2_Click()
 Image1.Visible = False
 Image1.Stretch = False
 Image1.Picture = LoadPicture("C:\Documents and Settings\Administrator\My Documents\My Pictures\2009112209293733.gif")
 Picture1.PaintPicture Image1, (Picture1.Width - Image1.Width * (Picture1.Height / Image1.Height)) / 2, 0, Image1.Width * (Picture1.Height / Image1.Height), Picture1.Height, , , Image1.Width, Image1.Height
 Image1.Picture = LoadPicture("")
End Sub

[帝企鹅已被占用]

猴哥的思路很好，明天试试。

[SYSSZ]

Option Explicit
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Dim bm As BITMAP
Dim hBmp As Long

Public Sub SameToPicture(ByRef pic As PictureBox, ByVal Ifilename As String)
pic.Picture = LoadPicture(Ifilename)
hBmp = pic.Picture.Handle
GetObject hBmp, LenB(bm), bm
pic.Width = bm.bmWidth * Screen.TwipsPerPixelX
pic.Height = bm.bmHeight * Screen.TwipsPerPixelY
End Sub
Private Sub Command1_Click()
SameToPicture Picture1, App.Path & "\" & "124.jpg"
Picture1.Move 0, 0
End Sub

[cbm6666]

呵呵....扯了老半天 条件一堆 不就是要做一个缩略图吗?

[帝企鹅已被占用]

你的图看不到。

[SYSSZ]

Public Sub SameToPic(ByRef pic As PictureBox, ByVal Ifilename As String)
pic.Picture = LoadPicture(Ifilename)
pic.PaintPicture pic.Picture, 0, 0, pic.Width, pic.Height, 0, 0
End Sub

[cbm6666]

1.得知图片宽高
2.调整大小, 以固定的PictureBox为准, 使用PaintPicture重画宽高不超过PictureBox,要先计算宽高比例,宽高以何者较长为准, 依比例计算出新的图片的宽度与高度.
3.新图片在PictureBox居中, 计算新的图像的Left与Top

[SYSSZ]

5楼代码贴错了,8楼代码是对的,可使图片与图片框一样大.

[cbm6666]

8F 代码将会使图片变型, 尤其是高度大于宽度的图片.

【CBM666 的电子彩页制作系统】
http://hi.baidu.com/cbm666/blog/item/96e19b50858e436884352454.html

[rkdrc]

2楼试过了，功能没问题，但图片质量有问题（非代码问题），模糊看不清楚，用windows自带浏览器即使缩小到同样大小比这个清楚多了，不知道何故？

[舉杯邀明月]

[Quote=引用楼主 rkdrc 的回复:]
要求是这样
......
1. ..............第二不想图片比例变形(否掉拉伸)
      2.高度方向上必须和控件等高，长度方向上可以变小（也就是图片要全部显示出来）
........
请教怎么写或用什么函数？

[/Quote]

这两条自相矛盾啊！

举个简单的例子来说明：
　　比如控件长宽比是 1:1 的，加载的图片是 4:3 的。
　　如果满足“不想图片比例变形”和“高度方向上必须和控件等高”，显示出来的图片就相当于是 1.33 : 1 的，又怎么可能在 1:1 的容器中“全部显示出来”？

[舉杯邀明月]

[Quote=引用 7 楼 patrickkong 的回复:]
你的图看不到。
[/Quote]

方法啊, 方法…………

[chinaboyzyq]

再给你一种方法，只要一个picturebox（picture1）控件就可以了。

Private Sub Command3_Click()
    Dim p As Picture
    Set p = LoadPicture("C:\Documents and Settings\Administrator\My Documents\My Pictures\2009112209300545.jpg")
    Picture1.PaintPicture p, (Picture1.Width - ScaleX(p.Width) * Picture1.Height / ScaleY(p.Height)) / 2, 0, _
             ScaleX(p.Width) * (Picture1.Height / ScaleY(p.Height)), Picture1.Height, , , ScaleX(p.Width), ScaleY(p.Height)
    Set p = Nothing
    
End Sub

[badboy_2222]

问我眼就就一下