Posted by Kevin Wilson on November 06, 2001 at 10:06:55:
In Reply to: resize image (size+width and height) posted by sam sam on October 24, 2001 at 11:32:07:
>hi,
>how can i resize an image by script.
>ie: i have a file size=1mb width=1024 pix height=....
>i want to make size=100k for example width=120 height=100.
>in other word create a thumbnail.
>thanks
This can be done by calling the StretchBlt Win32 API. I'm building this functionality into the new release of the modBitmap.bas module. However, I'm not sure if I want to charge people for it or not due to the amount of work I've been putting into it and all that it does.
Anyways, here's a function I wrote to resize Bitmaps (PictureBox.Picture.Handle) (StdPicture.Handle):
' Type - GetObjectAPI.lpObject
Public Type BITMAP
bmType As Long 'LONG
bmWidth As Long 'LONG
bmHeight As Long 'LONG
bmWidthBytes As Long 'LONG
bmPlanes As Integer 'WORD
bmBitsPixel As Integer 'WORD
BMBits As Long 'LPVOID
End Type
' Constants - SetStretchBltMode.iStretchMode
Public Const BLACKONWHITE = 1
Public Const WHITEONBLACK = 2
Public Const COLORONCOLOR = 3
Public Const HALFTONE = 4
Public Const MAXSTRETCHBLTMODE = 4
Public Const STRETCH_ANDSCANS = BLACKONWHITE
Public Const STRETCH_ORSCANS = WHITEONBLACK
Public Const STRETCH_DELETESCANS = COLORONCOLOR
Public Const STRETCH_HALFTONE = HALFTONE
Public Declare Function GetObjectAPI Lib "GDI32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "USER32" () As Long
Public Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Public Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hGDIObj As Long) As Long
Public Declare Function SetStretchBltMode Lib "GDI32" (ByVal hDC As Long, ByVal iStretchMode As Long) As Long
Public Declare Function StretchBlt Lib "GDI32" (ByVal hDC_Destination As Long, ByVal X_Dest As Long, ByVal Y_Dest As Long, ByVal New_Width As Long, ByVal New_Height As Long, ByVal hDC_Source As Long, ByVal X_Src As Long, ByVal Y_Src As Long, ByVal Orig_Width As Long, ByVal Orig_Height As Long, ByVal RasterOperation As Long) As Long
Public Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Public Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "GDI32" (ByVal hGDIObj As Long) As Long
'========================================================================================================
'
' ResizeBitmap
'
' This function takes the specified BITMAP object and resizes it to the specified dimentions. It will
' then return the resized BITMAP directly, or return it within a memory Device Context (DC) object
' along with the DC's previous BITMAP object so that it can be selected back into the DC before deleting
' the DC.
'
' * WARNING : If this function returns just a BITMAP object, it is the responsability of the caller
' to clean up that BITMAP objects via the DeleteObject API.
' If this function returns the BITMAP contained within a DC object, it is the
' responsibility of the caller to cleanup returned DC object by selecting the previous
' BITMAP back into the DC, then deleting the DC, then deleting the BITMAP that the DC held.
'
' Parameter: Use:
' --------------------------------------------------
' hBITMAP Specifies the BITMAP object to resize
' lngNewHeight Specifies the newly resized BITMAP's height (in pixels)
' lngNewWidth Specifies the newly resized BITMAP's width (in pixels)
' blnReturnBitmap If TRUE, the resized BITMAP will be returned alone... not contained within
' a memory Device Context (DC). If FALSE, a memory DC will be returned with
' the newly resized BITMAP contained within it, along with a handle to the
' BITMAP that the DC previously contained.
' Return_hBITMAP If the "blnReturnBitmap" parameter is set to TRUE, this parameter returns a
' handle to the newly resized BITMAP.
' Return_hDC If the "blnReturnBitmap" parameter is set to FALSE, this parameter returns a
' handle to a memory DC object that contains the resized BITMAP.
' Return_hDcPrevBitmap If the "blnReturnBitamp" parameter is set to FALSE, this parameter returns a
' handle to the BITMAP object that the DC returned in the "Return_hDC" parameter
' previously contained. This BITMAP must be selected back into the DC before the
' returned DC is deleted.
'
' Return:
' -------
' If the function succeeds, the return is TRUE
' If the function fails, the return is FALSE
'
'========================================================================================================
Public Function ResizeBitmap(ByVal hBITMAP As Long, ByVal lngNewHeight As Long, ByVal lngNewWidth As Long, ByVal blnReturnBitmap As Boolean, Optional ByRef Return_hBITMAP As Long, Optional ByRef Return_hDC As Long, Optional ByRef Return_hDcPrevBitmap As Long) As Boolean
Dim BMP As BITMAP
Dim hDC_Scr As Long
Dim hDC_Old As Long
Dim hDC_New As Long
Dim hBMP_New As Long
Dim hBMP_NewPrev As Long
Dim hBMP_OldPrev As Long
Dim lngHeight As Long
Dim lngWidth As Long
' Clear return variables
If Return_hBITMAP <> 0 Then
DeleteObject Return_hBITMAP
Return_hBITMAP = 0
End If
If Return_hDcPrevBitmap <> 0 Then
DeleteObject Return_hDcPrevBitmap
Return_hDcPrevBitmap = 0
End If
If Return_hDC <> 0 Then
DeleteDC Return_hDC
Return_hDC = 0
End If
' Validate parameters
If hBITMAP = 0 Then Exit Function
If lngNewHeight < 1 Then Exit Function
If lngNewWidth < 1 Then Exit Function
' Check if the bitmap is valid, then get the bitmap's dimentions
If GetObjectAPI(hBITMAP, Len(BMP), BMP) = 0 Then Exit Function
lngHeight = BMP.bmHeight
lngWidth = BMP.bmWidth
' Get a Device Context (DC) handle from the desktop
hDC_Scr = GetDC(GetDesktopWindow)
If hDC_Scr = 0 Then Exit Function
' Create the DC to work with the bitmaps
hDC_New = CreateCompatibleDC(hDC_Scr)
If hDC_New = 0 Then GoTo CleanUp
hDC_Old = CreateCompatibleDC(hDC_Scr)
If hDC_Old = 0 Then GoTo CleanUp
' Create a bitmap to resize the new DC and draw the new picture on
hBMP_New = CreateCompatibleBitmap(hDC_Scr, lngNewWidth, lngNewHeight)
If hBMP_New = 0 Then GoTo CleanUp
' Insert the BITMAP's into the DC's
hBMP_NewPrev = SelectObject(hDC_New, hBMP_New)
hBMP_OldPrev = SelectObject(hDC_Old, hBITMAP)
' Prepare the new DC for correct BITMAP stretch
If SetStretchBltMode(hDC_New, STRETCH_DELETESCANS) = 0 Then GoTo CleanUp
' Stretch the original BITMAP into the new DC
If StretchBlt(hDC_New, 0, 0, lngNewWidth, lngNewHeight, hDC_Old, 0, 0, lngWidth, lngHeight, SRCCOPY) = 0 Then GoTo CleanUp
' If the user wants the DC returned, do so with the new BITMAP within it
If blnReturnBitmap = False Then
Return_hDC = hDC_New
Return_hDcPrevBitmap = hBMP_NewPrev
hBMP_NewPrev = 0
hDC_New = 0
' If the user just wants the BITMAP returned, take the BITMAP out of the DC, then destroy the DC
Else
Return_hBITMAP = SelectObject(hDC_New, hBMP_NewPrev)
DeleteDC hDC_New
hDC_New = 0
End If
ResizeBitmap = True
CleanUp:
If hDC_Scr <> 0 Then
ReleaseDC GetDesktopWindow, hDC_Scr
hDC_Scr = 0
End If
If hDC_New <> 0 Then
If hBMP_New <> 0 Then DeleteObject SelectObject(hDC_New, hBMP_NewPrev)
DeleteDC hDC_New
hBMP_NewPrev = 0
hDC_New = 0
End If
If hDC_Old <> 0 Then
SelectObject hDC_Old, hBMP_OldPrev
DeleteDC hDC_Old
hBMP_OldPrev = 0
hDC_Old = 0
End If
End Function