DOes anybody know what's wrong in my code ???
->sometimes, the gflResize bug without returning the GflError, just exit the application.
->this app is used to resize pictures from a folder.
Here is the code:
Code: Select all
If Len(src.text) = 0 Or Len(dest.text) = 0 Then Exit Sub
Dim GflBitmap As GFL_BITMAP
Dim GflTempBitmap As GFL_BITMAP, whiteBitmap As GFL_BITMAP
Dim GflLoadParams As GFL_LOAD_PARAMS
Dim GflSaveParams As GFL_SAVE_PARAMS
Dim GflInfo As GFL_FILE_INFORMATION
Dim GflColor As GFL_COLOR
Dim PtrBitmap As Long, ptrTempBitmap As Long, whitePtr As Long
Dim gflError As GFL_ERROR
Dim Error As Integer
Dim XOffset As Double, YOffset As Double
Dim File As String, FileDest As String
Dim gflRect As GFL_RECT, gflTempRect As GFL_RECT
Dim Color As GFL_COLOR
Dim NewWidth As Long
Dim NewHeight As Long
Dim QualiteResize As Long
Dim CompressionJPEG As Integer
Dim ratio As Double
gflLibraryInit 'Initialize the library
gflGetDefaultLoadParams GflLoadParams 'Gets default parameters for loading
gflEnableLZW True 'Activate the LZW compression
With GflLoadParams
.Flags = GFL_LOAD_SKIP_ALPHA Or GFL_LOAD_BY_EXTENSION_ONLY
.Origin = GFL_BOTTOM_LEFT 'Origin is bottom-left
.ColorModel = GFL_BGR 'Component order like DIB
.LinePadding = 4 'Line padding on 4 bytes (32bits)
End With
gflGetDefaultSaveParams GflSaveParams
With GflSaveParams
.Flags = GFL_SAVE_REPLACE_EXTENSION
' prend les infos du format jpg
.FormatIndex = gflGetFormatIndexByName("jpeg")
.Quality = 100
.Progressive = True
End With
gflRect.x = 0
gflRect.y = 0
gflRect.h = 150
gflRect.w = 150
gflTempRect.x = 0
gflTempRect.y = 0
' Chargement de l'image
GflColor.Red = 255
GflColor.Blue = 255
GflColor.Green = 255
ptrTempBitmap = gflAllockBitmap(GFL_BGR, 150, 150, 4, GflColor)
Error = gflLoadBitmap(App.Path & "\white.bmp", whitePtr, GflLoadParams, GflInfo)
Error = Error + gflLoadBitmap(App.Path & "\white.bmp", ptrTempBitmap, GflLoadParams, GflInfo)
If Error = GFL_NO_ERROR Then
extGetGflBitmapFromPtr whitePtr, whiteBitmap
extGetGflBitmapFromPtr ptrTempBitmap, GflTempBitmap
Else
Exit Sub
End If
File1.Path = Dir1.Path
lbCount.Caption = "/" & File1.ListCount
Timer1.Enabled = True
For i = 0 To File1.ListCount - 1
lbCurrent.Caption = i + 1
PGbar.Value = (i / (File1.ListCount - 1)) * 100
redimImg.Refresh
File = src & "\" & File1.List(i)
FileDest = dest & "\" & File1.List(i)
Error = gflLoadBitmap(File, PtrBitmap, GflLoadParams, GflInfo)
If Error = GFL_NO_ERROR Then
extGetGflBitmapFromPtr PtrBitmap, GflBitmap
ratio = 1
gflBitblt whiteBitmap, gflRect, GflTempBitmap, 0, 0
' Changement si image en mode portrait
XOffset = 0
YOffset = 0
If GflBitmap.Height > GflBitmap.Width Then
ratio = 150 / GflBitmap.Height
NewHeight = GflBitmap.Height * ratio
NewWidth = GflBitmap.Width * ratio
XOffset = CDbl(150 - NewWidth) / 2#
Else
ratio = 150 / GflBitmap.Width
NewHeight = GflBitmap.Height * ratio
NewWidth = GflBitmap.Width * ratio
YOffset = CDbl(150 - NewHeight) / 2#
End If
gflTempRect.w = NewWidth
gflTempRect.h = NewHeight
' ---------- on resize l'image ----------------------------
[b]Error = gflResize(GflBitmap, PtrBitmap, NewWidth, NewHeight, GFL_RESIZE_BILINEAR, 0)[/b]
'Error = gflResizeCanvas(GflBitmap, PtrBitmap, NewWidth, NewHeight, 0, GflColor)
If Error = GFL_NO_ERROR Then 'Si aucune erreur
extGetGflBitmapFromPtr PtrBitmap, GflBitmap 'Get the picture data
gflBitblt GflBitmap, gflTempRect, GflTempBitmap, CInt(XOffset), CInt(YOffset)
Error = GFL_NO_ERROR
If Error = GFL_NO_ERROR Then 'Si aucune erreur
Error = gflSaveBitmap(FileDest, GflTempBitmap, GflSaveParams)
gflFreeBitmap GflBitmap 'Libère la mémoire
End If
End If
End If
Next i
Timer1.Enabled = False
MsgBox "terminé", vbOKOnly, "Redimensionner"
PGbar.Value = 0
Fin:
If Error <> GFL_NO_ERROR Then MsgBox extGetStr(gflGetErrorString(Error)), vbOKOnly, "Erreur"
gflLibraryExit
