如何自动缩小图片的象素？

LiaoCheng 2002-04-26 02:42:09

我的一个image或picture为指定的大小如：210*160象素
但是图片的大小并不所有都一样的，我想在load图片的时候通过语句控制
使图片自动缩小的指定的大小(210*160)，请问我应该怎么做？
我的图片格式是jpg的,bmp也可以。先谢谢啦!!!

...全文

205 10 打赏收藏转发到动态举报

写回复

用AI写文章

10 条回复

切换为时间正序

请发表友善的回复…

发表回复

LiaoCheng 2002-04-26

打赏
举报

多谢各位的参与，这几天较忙，五一前结账

505 2002-04-26

打赏
举报

BitBlt不能缩放图像，如果一定要用API，请参考StretchDIBits

StretchDIBits

VB声明
Declare Function StretchDIBits Lib "gdi32" Alias "StretchDIBits" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
说明
将一幅与设备无关位图的全部或部分数据直接复制到指定的设备场景。这个函数在设备场景中定义了一个目标矩形，用于接收位图数据。它也在DIB中定义了一个源矩形，以便从中提取数据。根据设备场景的StretchBlt模式（由SetStretchBltMode函数决定），源矩形会根据需要调整，以便符合目标矩形的要求
返回值
Long，如函数执行成功，返回欲复制的扫描线的数量；如返回常数GDI_ERROR，表示出错
参数表
参数类型及说明
hdc Long，一个设备场景的句柄。该场景用于接收位图数据
x,y Long，用逻辑坐标表示的目标矩形的起点
dx,dy Long，目标矩形的宽度及高度，以逻辑坐标表示
SrcX,SrcY Long，用设备坐标表示的源矩形在DIB中的起点
wSrcWidth,wSrcHeight Long，源矩形的宽度与高度，用设备坐标表示。如其中有一个参数的符号（指正负号）与对应的目标参数不符，位图就会在对应的轴上作镜像转换
lpBits Any，指向一个缓冲区的指针。这个缓冲区包含了以DIB格式描述的位图数据；这种格式是由lpBitsInfo指定的
lpBitsInfo BITMAPINFO，对lpBits DIB的格式和颜色进行描述的一个结构
wUsage Long，下述常数之一
DIB_PAL_COLORS 颜色表是一个整数数组，其中包含了与目前选入hdc设备场景的调色板相关的索引
DIB_RGB_COLORS 颜色表包含了RG颜色
dwRop Long，欲进行的光栅运算

gump2000 2002-04-26

打赏
举报

或者您可以参考以下贴子

http://www.csdn.net/expert/topic/617/617248.xml?temp=.4064142

gump2000 2002-04-26

打赏
举报

Const RC_PALETTE As Long = &H100
Const SIZEPALETTE As Long = 104
Const RASTERCAPS As Long = 38
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Private Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CreateCompatibleDC 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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID

'Fill GUID info
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

'Fill picture info
With Pic
.Size = Len(Pic) ' Length of structure
.Type = vbPicTypeBitmap ' Type of Picture (bitmap)
.hBmp = hBmp ' Handle to bitmap
.hPal = hPal ' Handle to palette (may be null)
End With

'Create the picture
R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

'Return the new picture
Set CreateBitmapPicture = IPic
End Function
Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long
Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long
Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE

'Create a compatible device context
hDCMemory = CreateCompatibleDC(hDCSrc)
'Create a compatible bitmap
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
'Select the compatible bitmap into our compatible device context
hBmpPrev = SelectObject(hDCMemory, hBmp)

'Raster capabilities?
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
'Does our picture use a palette?
HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette
'What's the size of that palette?
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
'Set the palette version
LogPal.palVersion = &H300
'Number of palette entries
LogPal.palNumEntries = 256
'Retrieve the system palette entries
R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
'Create the palette
hPal = CreatePalette(LogPal)
'Select the palette
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
'Realize the palette
R = RealizePalette(hDCMemory)
End If

'Copy the source image to our compatible device context
R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)

'Restore the old bitmap
hBmp = SelectObject(hDCMemory, hBmpPrev)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
'Select the palette
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If

'Delete our memory DC
R = DeleteDC(hDCMemory)

Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)
End Function
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Create a picture object from the screen
Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
End Sub