关于LoadPicture函数的问题

[emit]

我想把gif的图型文件加载到VB中来用LoadPicture函数即可，但是加载进来的图片大小不是很理想，我想问的是
1、能不能通过VB代码来调整要加载的gif图片大小？
2、如果第1种想法行不通的话，还有没有其它的函数能实现我想要的这种功能？

[SoHo_Andy]

“图片大小不是很理想”

此话怎讲？怎样算理想？

”我想要的这种功能“

你要什么功能？

[jiaojianmeng]

api函数StretchBlt就可以实现放缩功能
picturebox 的paintpicture 也可以！

[emit]

TO SoHo_Andy(冰):是这样的，我在窗体上放一个Image控件，这个Image控件能随窗体的大小而自动调整,而Image里的gif格式的图片却只能保持它原来的大小，不能随窗体的大小变动而自由缩放,我想要的是它能自由缩放这样的效果

[flyingscv]

stretch=true

[emit]

用stretch=true效果不好，不过jiaojianmeng提到了用API函数，可我不会用啊

[AresChen]

stretch=true对于image控件来讲只能作到将图片按照image的高宽比例去画，所以很容易造成失真，需要在必要是重新调整image的高宽比例，程序如下，在一个form上放上一个image，取名为image1，在放一副图片，并设置stretch为true。
Private Sub Form_resize()
Dim r As Single

With Image1
.Top = 0
.Left = 0
.Width = Me.Width
.Height = Me.Height

r = .Picture.Height / .Picture.Width
If .Height / .Width - r > 0.001 Then
.Height = .Width * r
Else
.Width = .Height / r
End If
End With
End Sub
然后你可以进一步扩展，比如窗体大于图片的时候，不对图片进行放大等，还有就是对top和left在调整一下，以及在考虑进去form的border的宽度，可以简单实现一个图形浏览的程序，当然效率和可以查看的种类是无法和acdsee相比的。

[flyingscv]

stretch一般用于适用原始大小，不太使用很正常:)

你用paintpicture不就行了

[busisoft]

如果要想图片适应控件的大小可以用image，picturebox只能适应图片的大小

[jiaojianmeng]

放大缩小翻转 BitMap图

来源:cww

一般来说我们会使用PaintPicture来完成，而这个方法和StretchBlt的使用很类似，在
此提出两种不同的方式来达放大缩小翻转图形，使用API的DrawBitMap只能使用BitMap图
，而没有API的PaintPicture则无此限制，但DrawBitMap在处理大的图形时，可能较快
些吧。

StretchBlt 其定义如下：
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

hdc 待绘图的hDc
x, y 待绘图目标的起点座标
nWidth, nHeight 绘图的长宽(by Pixels)
hSrcDc 来源Dc
xSrc, ySrc 来源图的起点座标
nSrcWidth, nSrcHeight 来源图的长宽
dwRop 绘图的方式

由以上的叁数，我们知道事实上可以取来源图的一部份(方形区域)来缩放，而目的绘图
区呢，它可以指定从某个起始座标开始画(不一定 (0,0) )，而nWidth与nHeight控制图
的缩放，例如说nWidth = CLng(1.5 * nSrcWidth), nHeight = CLng(nSrcHeight * 1.5)
那代表比原图放大1.5倍，如果nWidth = -1 * nSrcWidth 表该图会左右相反，而
nHeight = -1 * nSrcHeight 时则会有上正颠倒的图出现。以下提供一个副程式，该副
程式简化了StretchBlt，允许我们画一个图於Form/PictureBox的左上角，并可以放大
缩小或翻转。

DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)

该副程式中
hDst 是待绘图的物件(可以为Form或PictureBox)
xRate 宽度缩放比例
rRate 长度缩放比例
FileName 图形档名


'以下在.Bas
Option Explicit
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

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Const SRCCOPY = &HCC0020

Public Sub DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim hDc5 As Long, i As Long

Set pic = LoadPicture(FileName) '读取图形档

hDc5 = CreateCompatibleDC(0) '建立Memory DC
i = SelectObject(hDc5, pic.Handle) '在该memoryDC上放上bitmap图

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.ScaleX(pic.Width, vbHimetric, vbPixels)

dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
Call StretchBlt(Dst.hdc, x, y, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
Call DeleteDC(hDc5)
End Sub


Public Sub DrawPicture(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim i As Long

Set pic = LoadPicture(FileName) '读取图形档

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.ScaleX(pic.Width, vbHimetric, vbPixels)

dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
Dst.ScaleMode = 3
Dst.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeight

End Sub


'以下在Form需两个command button一个PictureBox
Private Sub Command1_Click()
Call DrawBitMap(Me, 1.5, -1.5, "c:\windows\circles.bmp") '放大1.5倍并上下翻转
End Sub

Private Sub Command2_Click()
Call DrawBitMap(Picture1, 1.5, -1.5, "c:\windows\client.ico") '放大1.5倍并上下翻转
End Sub

[yassee]

感谢楼主，感谢AresChen(AresChen) ，我刚好要用！

[kmzs]

往上画不就行了