Attribute VB_Name = "modJPEG" Option Explicit '============================================================================================================= ' ' modJPEG Module ' -------------- ' ' Created By : vbAccelerator (Steve McMahon) ' ' Modified By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Updated : July 24, 2001 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : cJPEG.cls by vbAccelerator (formerly cDIBSection.cls) ' IJL10.DLL (Intel) ' ' Description : This module is intended as an easy interface to Intel's IJL (Intel JPG Library) for use ' in Visual Basic 5.0 / 6.0 ' ' NOTE : The JPEG_Show function is used to display the loaded JPEG. However, if you set the ' AutoRedraw property of the object showing the picture to TRUE, the picture will not correctly ' be displayed. And if you set the AutoRedraw property to FALSE and then minimize the form ' it's in or put another window infront of it... then bring the focus back to the form ' containing the picture, the picture disapears. THE WORK AROUND is to put the JPEG_Show in ' the Paint event of the object containing the picture. ' '------------------------------------------------------------------------------------------------------------- ' vbAccelerator Copyright© 1999 by Steve McMahon (http://vbaccelerator.com) ' IJL10.DLL Copyright© 1999 by Intel ' ' IMPORTANT : Intel is not responsible for any errors in this code, and should not be mentioned in any Help, ' About, or support in any product using the Intel library ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= Public Const GMEM_DDESHARE = &H2000 Public Const GMEM_DISCARDABLE = &H100 Public Const GMEM_DISCARDED = &H4000 Public Const GMEM_FIXED = &H0 Public Const GMEM_INVALID_HANDLE = &H8000 Public Const GMEM_LOCKCOUNT = &HFF Public Const GMEM_MODIFY = &H80 Public Const GMEM_MOVEABLE = &H2 Public Const GMEM_NOCOMPACT = &H10 Public Const GMEM_NODISCARD = &H20 Public Const GMEM_NOT_BANKED = &H1000 Public Const GMEM_NOTIFY = &H4000 Public Const GMEM_SHARE = &H2000 Public Const GMEM_VALID_FLAGS = &H7F72 Public Const GMEM_ZEROINIT = &H40 Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT) Private Enum IJLERR ' The following "error" values indicate an "OK" condition. IJL_OK = 0 IJL_INTERRUPT_OK = 1 IJL_ROI_OK = 2 ' The following "error" values indicate an error has occurred. IJL_EXCEPTION_DETECTED = -1 IJL_INVALID_ENCODER = -2 IJL_UNSUPPORTED_SUBSAMPLING = -3 IJL_UNSUPPORTED_BYTES_PER_PIXEL = -4 IJL_MEMORY_ERROR = -5 IJL_BAD_HUFFMAN_TABLE = -6 IJL_BAD_QUANT_TABLE = -7 IJL_INVALID_JPEG_PROPERTIES = -8 IJL_ERR_FILECLOSE = -9 IJL_INVALID_FILENAME = -10 IJL_ERROR_EOF = -11 IJL_PROG_NOT_SUPPORTED = -12 IJL_ERR_NOT_JPEG = -13 IJL_ERR_COMP = -14 IJL_ERR_SOF = -15 IJL_ERR_DNL = -16 IJL_ERR_NO_HUF = -17 IJL_ERR_NO_QUAN = -18 IJL_ERR_NO_FRAME = -19 IJL_ERR_MULT_FRAME = -20 IJL_ERR_DATA = -21 IJL_ERR_NO_IMAGE = -22 IJL_FILE_ERROR = -23 IJL_INTERNAL_ERROR = -24 IJL_BAD_RST_MARKER = -25 IJL_THUMBNAIL_DIB_TOO_SMALL = -26 IJL_THUMBNAIL_DIB_WRONG_COLOR = -27 IJL_RESERVED = -99 End Enum Private Enum IJLIOTYPE IJL_SETUP = -1& ' Read JPEG parameters (i.e., height, width, channels, sampling, etc.) from a JPEG bit stream. IJL_JFILE_READPARAMS = 0& IJL_JBUFF_READPARAMS = 1& ' Read a JPEG Interchange Format image. IJL_JFILE_READWHOLEIMAGE = 2& IJL_JBUFF_READWHOLEIMAGE = 3& ' Read JPEG tables from a JPEG Abbreviated Format bit stream. IJL_JFILE_READHEADER = 4& IJL_JBUFF_READHEADER = 5& ' Read image info from a JPEG Abbreviated Format bit stream. IJL_JFILE_READENTROPY = 6& IJL_JBUFF_READENTROPY = 7& ' Write an entire JFIF bit stream. IJL_JFILE_WRITEWHOLEIMAGE = 8& IJL_JBUFF_WRITEWHOLEIMAGE = 9& ' Write a JPEG Abbreviated Format bit stream. IJL_JFILE_WRITEHEADER = 10& IJL_JBUFF_WRITEHEADER = 11& ' Write image info to a JPEG Abbreviated Format bit stream. IJL_JFILE_WRITEENTROPY = 12& IJL_JBUFF_WRITEENTROPY = 13& '-------- Scaled Decoding Options -------- ' Reads a JPEG image scaled to 1/2 size. IJL_JFILE_READONEHALF = 14& IJL_JBUFF_READONEHALF = 15& ' Reads a JPEG image scaled to 1/4 size. IJL_JFILE_READONEQUARTER = 16& IJL_JBUFF_READONEQUARTER = 17& ' Reads a JPEG image scaled to 1/8 size. IJL_JFILE_READONEEIGHTH = 18& IJL_JBUFF_READONEEIGHTH = 19& ' Reads an embedded thumbnail from a JFIF bit stream. IJL_JFILE_READTHUMBNAIL = 20& IJL_JBUFF_READTHUMBNAIL = 21& End Enum Private Type JPEG_CORE_PROPERTIES_VB UseJPEGPROPERTIES As Long ' default = 0 ' DIB specific I/O data specifiers DIBBytes As Long ' default = NULL 4 DIBWidth As Long ' default = 0 8 DIBHeight As Long ' default = 0 12 DIBPadBytes As Long ' default = 0 16 DIBChannels As Long ' default = 3 20 DIBColor As Long ' default = IJL_BGR 24 DIBSubsampling As Long ' default = IJL_NONE 28 ' JPEG specific I/O data specifiers JPGFile As Long ' LPTSTR JPGFile 32 default = NULL JPGBytes As Long ' default = NULL 36 JPGSizeBytes As Long ' default = 0 40 JPGWidth As Long ' default = 0 44 JPGHeight As Long ' default = 0 48 JPGChannels As Long ' default = 3 JPGColor As Long ' default = IJL_YCBCR JPGSubsampling As Long ' default = IJL_411 JPGThumbWidth As Long ' default = 0 JPGThumbHeight As Long ' default = 0 ' JPEG conversion properties cConversion_Reqd As Long ' default = TRUE upSampling_Reqd As Long ' default = TRUE jQuality As Long ' default = 75 : 100 is my preferred quality setting. ' Low level properties - 20,000 bytes. If the whole structure is written ' out then VB fails with an obscure error message "Too Many Local Variables"! ' These all default if they are not otherwise specified so there is no trouble jProps(0 To 19999) As Byte End Type Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "KERNEL32" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "KERNEL32" (ByVal hMem As Long) As Long Private Declare Function ijlInit Lib "IJL10.DLL" (jcprops As Any) As Long Private Declare Function ijlFree Lib "IJL10.DLL" (jcprops As Any) As Long Private Declare Function ijlRead Lib "IJL10.DLL" (jcprops As Any, ByVal ioType As Long) As Long Private Declare Function ijlWrite Lib "IJL10.DLL" (jcprops As Any, ByVal ioType As Long) As Long Private Declare Function ijlGetLibVersion Lib "IJL10.DLL" () As Long Private Declare Function ijlGetErrorString Lib "IJL10.DLL" (ByVal code As Long) As Long '=================================================================================== ' Function that loads the specified JPG file into the variable specified '----------------------------------------------------------------------------------- ' ' Example Use: ' ------------ ' ' Dim cJPEGPicture As New cJPEG ' Dim lngErrNum As Long ' Dim strErrDesc As String ' If JPEG_Load(cJPEGPicture, App.Path & "\Test.jpg", lngErrNum, strErrDesc) Then ' If JPEG_Show(Picture1, cJPEGPicture, lngErrNum, strErrDesc) = False Then ' MsgBox "The following error occured while trying to display the JPEG file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " Error Displaying JPEG" ' End If ' Else ' MsgBox "The following error occured while trying to load the JPEG file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " Error Loading JPEG" ' End If ' '=================================================================================== Public Function JPEG_Load(ByRef Return_cJPEG As cJPEG, _ ByVal FilePath As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheJPEG As JPEG_CORE_PROPERTIES_VB Dim TheFile() As Byte Dim ThePointer As Long Dim TheWidth As Long Dim TheHeight As Long ' Clear return variables Set Return_cJPEG = Nothing Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the file specified exists If Dir(FilePath) = "" Then Return_ErrNum = -1 Return_ErrDesc = "The specified JPEG file to load was not found." Exit Function End If ' Initialize the variable ReturnValue = ijlInit(TheJPEG) If ReturnValue = IJL_OK Then Set Return_cJPEG = New cJPEG Return_cJPEG.PictureLoaded = False ' Write the filename to the jcprops.JPGFile member TheFile = StrConv(FilePath, vbFromUnicode) ReDim Preserve TheFile(0 To UBound(TheFile) + 1) As Byte TheFile(UBound(TheFile)) = 0 ThePointer = VarPtr(TheFile(0)) CopyMemory TheJPEG.JPGFile, ThePointer, 4 ' Read the JPEG file parameters ReturnValue = ijlRead(TheJPEG, IJL_JFILE_READPARAMS) If ReturnValue <> IJL_OK Then Return_ErrNum = ReturnValue Return_ErrDesc = "ijlRead Error - " & JPEG_ErrorMsg(ReturnValue) Else ' Get the JPGWidth & JPGHeight member values TheWidth = TheJPEG.JPGWidth TheHeight = TheJPEG.JPGHeight ' Create a buffer of sufficient size to hold the image: If Return_cJPEG.Create(TheWidth, TheHeight) Then ' Store DIBWidth TheJPEG.DIBWidth = TheWidth ' Very important - tell IJL how many bytes extra there ' are on each DIB scan line to pad to 32 bit boundaries: TheJPEG.DIBPadBytes = Return_cJPEG.BytesPerScanLine - TheWidth * 3 ' Store DIBHeight TheJPEG.DIBHeight = -TheHeight ' Store Channels TheJPEG.DIBChannels = 3& ' Store DIBBytes (pointer to uncompressed JPG data) TheJPEG.DIBBytes = Return_cJPEG.DIBSectionBitsPtr ' Now decompress the JPG into the DIBSection ReturnValue = ijlRead(TheJPEG, IJL_JFILE_READWHOLEIMAGE) If ReturnValue = IJL_OK Then ' Process complete. Return_cJPEG now contains the uncompressed JPG. Return_cJPEG.PictureLoaded = True JPEG_Load = True Else Return_ErrNum = ReturnValue Return_ErrDesc = "ijlRead Error - " & JPEG_ErrorMsg(ReturnValue) End If Else Return_ErrNum = -1 Return_ErrDesc = "'cJPEG.Create' method failed to create the picture." End If End If ' Ensure we have freed memory ijlFree TheJPEG Else Return_ErrNum = ReturnValue Return_ErrDesc = "Failed to initialise the IJL library - " & JPEG_ErrorMsg(ReturnValue) End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Err.Number = 0 Or Err.Number = 20 Then Resume Next End Function '=================================================================================== ' Function that saves the loaded JPG file out to the specified file '----------------------------------------------------------------------------------- ' ' Example Use: ' ------------ ' ' Dim cJPG As New cJPEG ' Dim lngErrNum As Long ' dim strErrDesc As String ' cJPG.CreateFromPicture Picture1.Picture ' If JPEG_Save(cJPG, App.Path & "\Test.jpg", 85, True, lngErrNum, strErrDesc) = False Then ' MsgBox "The following error occured while trying to save the JPEG file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " Error Saving JPEG" ' End If ' '=================================================================================== Public Function JPEG_Save(ByRef cJPEG_Source As cJPEG, _ ByVal FilePath As String, _ Optional ByVal SaveQuality As Long = 100, _ Optional ByVal PromptToOverwrite As Boolean = False, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error Resume Next Dim TheJPEG As JPEG_CORE_PROPERTIES_VB Dim MyAnswer As VbMsgBoxResult Dim ReturnValue As Long Dim TheFile() As Byte Dim ThePointer As Long ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Check if there's a JPG file loaded to display If cJPEG_Source.PictureLoaded = False Then Return_ErrNum = -1 Return_ErrDesc = "No picture loaded to save." Exit Function End If ' If the file already exists, prompt to overwrite it If Dir(FilePath) <> "" Then If PromptToOverwrite = True Then MyAnswer = MsgBox(FilePath & Chr(13) & "This file already exists." & Chr(13) & Chr(13) & "Replace existing file?", vbYesNo + vbExclamation, " Confirm File Overwrite") If MyAnswer <> vbYes Then JPEG_Save = True Exit Function End If End If End If ' Make sure that the file does not exist If Dir(FilePath) <> "" Then Kill FilePath On Error GoTo ErrorTrap ' Make sure that the save quality is not set to an invalid value If SaveQuality < 1 Then SaveQuality = 1 ElseIf SaveQuality > 100 Then SaveQuality = 100 End If ' Initialize the variable passed ReturnValue = ijlInit(TheJPEG) If ReturnValue = IJL_OK Then '------------- Set up the DIB information ------------ ' Store DIBWidth TheJPEG.DIBWidth = cJPEG_Source.Width ' Store DIBHeight TheJPEG.DIBHeight = -cJPEG_Source.Height ' Store DIBBytes (pointer to uncompressed JPG data) TheJPEG.DIBBytes = cJPEG_Source.DIBSectionBitsPtr ' VERY IMPORTANT: Tell IJL how many bytes extra there are on each DIB scan line to pad to 32 bit boundaries TheJPEG.DIBPadBytes = cJPEG_Source.BytesPerScanLine - cJPEG_Source.Width * 3 '------------ Set up the JPEG information ------------- ' Store JPGFile TheFile = StrConv(FilePath, vbFromUnicode) ReDim Preserve TheFile(0 To UBound(TheFile) + 1) As Byte TheFile(UBound(TheFile)) = 0 ThePointer = VarPtr(TheFile(0)) CopyMemory TheJPEG.JPGFile, ThePointer, 4 ' Store JPGWidth & JPGHeight member values TheJPEG.JPGWidth = cJPEG_Source.Width TheJPEG.JPGHeight = cJPEG_Source.Height ' Set the quality & compression to save TheJPEG.jQuality = SaveQuality ' Write the image ReturnValue = ijlWrite(TheJPEG, IJL_JFILE_WRITEWHOLEIMAGE) If ReturnValue = IJL_OK Then JPEG_Save = True Else Return_ErrNum = ReturnValue Return_ErrDesc = "ijlWrite Error - " & JPEG_ErrorMsg(ReturnValue) End If ' Ensure we have freed memory ijlFree TheJPEG Else Return_ErrNum = ReturnValue Return_ErrDesc = "Failed to initialise the IJL library - " & JPEG_ErrorMsg(ReturnValue) End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Err.Number = 0 Or Err.Number = 20 Then Resume Next End Function '=================================================================================== ' This function takes a given object and displays the loaded JPEG picture in it. ' NOTE : This will only work with objects that have the "hDC" property like ' Form, PictureBox, Printer, Property Page, UserControl, UserDocument, etc. '----------------------------------------------------------------------------------- ' ' Example Use: ' ------------ ' ' Dim lngErrNum As Long ' Dim strErrDesc As String ' If JPEG_Show(Picture1, cJPEGPicture, lngErrNum, strErrDesc) = False Then ' MsgBox "The following error occured while trying to display the JPEG file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " Error Displaying JPEG" ' End If ' '=================================================================================== Public Function JPEG_Show(ByRef DisplayObject As Object, _ ByRef JPEGVariable As cJPEG, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Clear return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Check if there's a JPG file loaded to display If JPEGVariable.PictureLoaded = False Then Return_ErrNum = -1 Return_ErrDesc = "No picture loaded to show" Exit Function End If ' Clear the display area before displaying it DisplayObject.Cls ' Paint the picture on the display area JPEGVariable.PaintPicture DisplayObject.hDC JPEG_Show = True Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Err.Number = 0 Or Err.Number = 20 Then Resume Next End Function Public Function JPEG_ErrorMsg(ByVal lngErrorCode As Long) As String On Error Resume Next Select Case lngErrorCode Case IJL_OK, IJL_INTERRUPT_OK, IJL_ROI_OK: JPEG_ErrorMsg = "" '"Operation completed successfully" Case IJL_EXCEPTION_DETECTED: JPEG_ErrorMsg = "Exception detected" Case IJL_INVALID_ENCODER: JPEG_ErrorMsg = "Invalid encoder" Case IJL_UNSUPPORTED_SUBSAMPLING: JPEG_ErrorMsg = "Unsupported subsampling" Case IJL_UNSUPPORTED_BYTES_PER_PIXEL: JPEG_ErrorMsg = "Unsupported bytes per pixel" Case IJL_MEMORY_ERROR: JPEG_ErrorMsg = "Memory Error" Case IJL_BAD_HUFFMAN_TABLE: JPEG_ErrorMsg = "Bad huffman table" Case IJL_BAD_QUANT_TABLE: JPEG_ErrorMsg = "Bad quant table" Case IJL_INVALID_JPEG_PROPERTIES: JPEG_ErrorMsg = "Invalid JPEG properties specified" Case IJL_ERR_FILECLOSE: JPEG_ErrorMsg = "An error occored while closing the file" Case IJL_INVALID_FILENAME: JPEG_ErrorMsg = "Invalid file name" Case IJL_ERROR_EOF: JPEG_ErrorMsg = "EOF Error" Case IJL_PROG_NOT_SUPPORTED: JPEG_ErrorMsg = "Prog Not Supported" Case IJL_ERR_NOT_JPEG: JPEG_ErrorMsg = "Error - NOT JPEG" Case IJL_ERR_COMP: JPEG_ErrorMsg = "Error - COMP" Case IJL_ERR_SOF: JPEG_ErrorMsg = "Error - SOF" Case IJL_ERR_DNL: JPEG_ErrorMsg = "Error - DNL" Case IJL_ERR_NO_HUF: JPEG_ErrorMsg = "Error - NO HUF" Case IJL_ERR_NO_QUAN: JPEG_ErrorMsg = "Error - NO QUAN" Case IJL_ERR_NO_FRAME: JPEG_ErrorMsg = "Error - NO FRAME" Case IJL_ERR_MULT_FRAME: JPEG_ErrorMsg = "Error - MULT FRAME" Case IJL_ERR_DATA: JPEG_ErrorMsg = "Error - DATA" Case IJL_ERR_NO_IMAGE: JPEG_ErrorMsg = "Error - NO IMAGE" Case IJL_FILE_ERROR: JPEG_ErrorMsg = "File Error" Case IJL_INTERNAL_ERROR: JPEG_ErrorMsg = "Internal Error" Case IJL_BAD_RST_MARKER: JPEG_ErrorMsg = "Bad RST Marker" Case IJL_THUMBNAIL_DIB_TOO_SMALL: JPEG_ErrorMsg = "Thumbnail - DIB Too Small" Case IJL_THUMBNAIL_DIB_WRONG_COLOR: JPEG_ErrorMsg = "Thumbnail - DIB Wrong Color" Case IJL_RESERVED: JPEG_ErrorMsg = "Reserved" Case Else: JPEG_ErrorMsg = "Unknown Error" End Select End Function