还是那个问题，把100*100的图片改成120*120的图片，但是，不能让用户看到这个过程。

[hotenM]

前些天有个高手告诉我说

Private Sub Command2_Click()
Dim w As Integer, h As Integer
Picture1.Picture = LoadPicture("g:\gg-manhuabao.jpg")
w = Picture1.Width
h = Picture1.Height


Picture2.Width = w * 1.2
Picture2.Height = h * 1.2

StretchBlt Picture2.hdc, 0, 0, w * 1.2, h * 1.2, Picture1.hdc, 0, 0, w, h, vbSrcCopy


SavePicture Picture2.Image, "g:\gg-manhuabao41.jpg"

End Sub

用这个方法，确实不错

但是有一个问题，里面用到几个可视化控件，我的应用中，要把一张图片改变成很多不同的规格，而这个过程是不要用户看到的。
我曾经想过把FORM隐藏起来，但是试过之后发现上面的方法是基于屏幕COPY的

如果隐藏，就得不到想要的效果了。

不知道哪位高手有什么好的建议，在后台就能完成这种转化呢？

[zhixin1007]

办法是有，但不是好办法，你不是只要放大图片么，有很多种放大的算法，直接基于BMP文件格式的。你要不要试试，我可以提供相关资料

[rainstormmaster]

将picture2的可见属性设为false，autoredraw属性设为true（或者用内存设备场景）
Private Sub Command2_Click()
Dim w As Integer, h As Integer'最好定义为long，加快速度
Picture1.Picture = LoadPicture("g:\gg-manhuabao.jpg")
w = Picture1.Width
h = Picture1.Height


Picture2.Width = w * 1.2
Picture2.Height = h * 1.2

StretchBlt Picture2.hdc, 0, 0, w * 1.2, h * 1.2, Picture1.hdc, 0, 0, w, h, vbSrcCopy


SavePicture Picture2.Image, "g:\gg-manhuabao41.jpg"'注意这局，尽管扩展名为jpg，可实际是bmp文件格式的

End Sub

[hotenM]

二楼这方面的资料吗？
[e-mail]
三楼的方法可以解决 PIC2看不见，但是 pic1还是必须得显示出来啊

而且我的窗口特别小，可能就只有pic1那么小，根本没地方放PIC2

[hotenM]

除非重叠在PIC1上

[rainstormmaster]

这个和pic2的位置有关系吗，你的pic1是显示还是不显示？

[hotenM]

我所有的东西都不想显示

只想把一幅图给变大了或者变小了

[rainstormmaster]

经测试，即使pic2把pic1完全覆盖，也可以保存成功

[hotenM]

楼上的谢谢啊
不过我连PIC1也不想看到

[tanta]

干脆把他们都放到一个新的窗体中吧。。。

[rainstormmaster]

明白了，那就根据bmp的文件格式写

[hotenM]

有资料吗？

[Dublue]

办法是有滴：放置一个隐藏的pic或image控件作为临时存放地，变幻在这里进行，然后将图片赋给你的picture显示

[rainstormmaster]

'窗体上一个按钮
'保存图象部分是周跃林的代码
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0
Private Type BITMAPFILEHEADER
bfType(0 To 1) As Byte
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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
Const SRCCOPY = &HCC0020
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Const OBJ_BITMAP = 7
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


Public Function SaveBMP(ByVal hdc As Long, FileName As String) As Boolean
Dim hBitmap As Long
hBitmap = GetCurrentObject(hdc, OBJ_BITMAP) '取得位图
If hBitmap = 0 Then Exit Function
Dim bm As BITMAP
If GetObject(hBitmap, Len(bm), bm) = 0 Then Exit Function '得到位图信息
Dim bmih As BITMAPINFOHEADER
bmih.biSize = Len(bmih)
bmih.biWidth = bm.bmWidth
bmih.biHeight = bm.bmHeight
bmih.biBitCount = 24
bmih.biPlanes = 1
bmih.biSizeImage = ((bmih.biWidth * 3 + 3) And &H7FFFFFFC) * bmih.biHeight '计算大小
ReDim MapData(1 To bmih.biSizeImage) As Byte
If GetDIBits(hdc, hBitmap, 0, bmih.biHeight, MapData(1), bmih, DIB_RGB_COLORS) = 0 Then Exit Function '取得位图数据
Dim hF As Integer
hF = FreeFile(1)
On Error Resume Next
Open FileName For Binary As hF
If Err.Number Then hF = -1
On Error GoTo 0
If hF = -1 Then Exit Function
Dim bmfh As BITMAPFILEHEADER
bmfh.bfType(0) = Asc("B")
bmfh.bfType(1) = Asc("M")
bmfh.bfOffBits = Len(bmfh) + Len(bmih)
Put hF, , bmfh
Put hF, , bmih
Put hF, , MapData
Close hF
SaveBMP = True
End Function

Public Sub mSavePic(ByVal infile As String, ByVal FileName As String, ByVal bs As Double)
On Error Resume Next
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As New StdPicture
Dim hDc5 As Long, i As Long
Dim hBitmap As Long
Dim hDstDc As Long
Set pic = LoadPicture(infile) '读取图形档
hDc5 = CreateCompatibleDC(0) '建立Memory DC
i = SelectObject(hDc5, pic.Handle) '在该memoryDC上放上bitmap图
Dim mbm As BITMAP
Call GetObject(pic.Handle, Len(mbm), mbm)
'i = GetMenuCheckMarkDimensions '取得SetMenuItemBitmaps 所需Bitmap大小
dstWidth = mbm.bmWidth * bs
dstHeight = mbm.bmHeight * bs
'建一个大小为dstWidh * dstHeight大小的Bitmap
hBitmap = CreateCompatibleBitmap(Me.hdc, dstWidth, dstHeight)
hDstDc = CreateCompatibleDC(Me.hdc) '建memory dc
'设该memory dc的绘图区大小=该bitmap大小，且在该memory dc上的绘图便是在
'该bitmap图上画图
SelectObject hDstDc, hBitmap
srcHeight = Me.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Me.ScaleX(pic.Width, vbHimetric, vbPixels)
Call StretchBlt(hDstDc, 0, 0, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
SaveBMP hDstDc, FileName
Call DeleteDC(hDc5)
Call DeleteDC(hDstDc)
End Sub

Private Sub Command1_Click()
'将图片"d:\mc\mmc1.jpg"放大0.9倍后另存为"d:\mc\mc22.bmp"
mSavePic "d:\mc\mmc1.jpg", "d:\mc\mc22.bmp", 0.9
End Sub

[hotenM]

我试一下 FIRST再次感谢楼上的大哥