mod_ijl_jpg.bas

打印预览程序

Rem    JPGThumbWidth       OUT:    JFIF embedded thumbnail width [0-255].
Rem    JPGThumbHeight      OUT:    JFIF embedded thumbnail height [0-255].
Rem
Rem    cconversion_reqd    OUT:    If color conversion done on decode, TRUE.
Rem    upsampling_reqd     OUT:    If upsampling done on decode, TRUE.
Rem    jquality            IN:     [0-100] where highest quality is 100.
Rem
Rem    jprops              "Low-Level" IJL data structure.
Rem
Rem//////////////////////////////////////////////////////////////////////////
Rem

Public Type JPEG_CORE_PROPERTIES
  UseJPEGPROPERTIES As Long               ' default = 0
    
  ' DIB specific I/O data specifiers.
  DIBBytes          As Long               ' default = NULL
  DIBWidth          As Long               ' default = 0
  DIBHeight         As Long               ' default = 0
  DIBPadBytes       As Long               ' default = 0
  DIBChannels       As Long               ' default = 3
  DIBColor          As IJL_COLOR          ' default = IJL_BGR
  DIBSubsampling    As IJL_DIBSUBSAMPLING ' default = IJL_NONE
    
  ' JPEG specific I/O data specifiers.
  JPGFile           As Long               ' default = NULL
  JPGBytes          As Long               ' default = NULL
  JPGSizeBytes      As Long               ' default = 0
  JPGWidth          As Long               ' default = 0
  JPGHeight         As Long               ' default = 0
  JPGChannels       As Long               ' default = 3
  JPGColor          As IJL_COLOR          ' default = IJL_YCBCR
  JPGSubsampling    As IJL_JPGSUBSAMPLING ' 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
  
  ' IJL use 8 byte pack structures
  pad0              As Byte
  pad1              As Byte
  pad2              As Byte
  pad3              As Byte
  
  ' Low-level properties.
  jprops            As JPEG_PROPERTIES
End Type


Rem
Rem//////////////////////////////////////////////////////////////////////////
Rem  Name:        IJLERR
Rem
Rem  Purpose:     Listing of possible "error" codes returned by the IJL.
Rem
Rem               See the Developer's Guide for details on appropriate usage.
Rem
Rem  Context:     Used for error checking.
Rem
Rem//////////////////////////////////////////////////////////////////////////
Rem

Public 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_INVLAID_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_BUFFER_TOO_SMALL = -28
  IJL_UNSUPPORTED_FRAME = -29
  IJL_ERR_COM_BUFFER = -30
  IJL_RESERVED = -99
End Enum

Public Enum ERGBCompression
  BI_RGB = 0&
  BI_RLE4 = 2&
  BI_RLE8 = 1&
  DIB_RGB_COLORS = 0 '  color table in RGBs
End Enum


Public Declare Function ijlInit Lib "ijl15.dll" (ByRef jcprops As JPEG_CORE_PROPERTIES) As IJLERR
Public Declare Function ijlFree Lib "ijl15.dll" (ByRef jcprops As JPEG_CORE_PROPERTIES) As IJLERR
Public Declare Function ijlRead Lib "ijl15.dll" (ByRef jcprops As JPEG_CORE_PROPERTIES, ByVal iotype As IJLIOTYPE) As IJLERR
Public Declare Function ijlWrite Lib "ijl15.dll" (ByRef jcprops As JPEG_CORE_PROPERTIES, ByVal iotype As IJLIOTYPE) As IJLERR
Public Declare Function ijlGetLibVersion Lib "ijl15.dll" () As Long 'pointer to IJLibVersion...
Public Declare Function ijlErrorStr Lib "ijl15.dll" (code As IJLERR) As Long 'pointer to C-style string

Rem
Rem
Rem
Rem               INTEL CORPORATION PROPRIETARY INFORMATION
Rem  This software is supplied under the terms of a license agreement or
Rem  nondisclosure agreement with Intel Corporation and may not be copied
Rem  or disclosed except in accordance with the terms of that agreement.
Rem      Copyright (c) 1998 Intel Corporation. All Rights Reserved.
Rem
Rem
Rem  File:
Rem    helpers.bas
Rem
Rem  Purpose:
Rem    Helper functions
Rem


Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpvDest As Long, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Sub SavePictureAsJPG(Image1 As PictureBox, NAMEFILE As String)
    
    Dim jDIB As cDIBSection
  ' obtain picture from handle
    Set jDIB = New cDIBSection
    jDIB.CreateFromPicture Image1.Picture
  ' save it
    If SaveJPG(jDIB, NAMEFILE) = False Then
      MsgBox "Failed to save picture."
    End If
  ' clean up
    jDIB.CleanUp
    Set jDIB = Nothing
End Sub

Public Function ShowErrorMsg(ByVal context As String, ByVal code As IJLERR)
  Dim message As String
  
  message = "IJL ERROR: [" & code & "]" & " - " & context
  
  Call MsgBox(message, vbExclamation, "Intel(R) JPEG Library")

End Function


Public Function ConvertFromRGBA(ByVal rgba As Long)

End Function


Public Function LoadJPG(ByRef cDib As cDIBSection, ByVal sFile As String, ByVal jpg_scale As Long) As Boolean
  Dim jerr As IJLERR
  Dim jcprops As JPEG_CORE_PROPERTIES
  Dim aFile As String
  Dim lJPGWidth As Long
  Dim lJPGHeight As Long
  Dim nChannels As Long

  cDib.CleanUp
  
  jerr = ijlInit(jcprops)
  If jerr = IJL_OK Then
      
    ' Write the filename to the jcprops.JPGFile member:
    aFile = StrConv(sFile, vbFromUnicode)
      
    jcprops.JPGFile = StrPtr(aFile)
      
    ' Read the JPEG file parameters:
    jerr = ijlRead(jcprops, IJL_JFILE_READPARAMS)
    If jerr <> IJL_OK Then
      ' Throw error
      Call ShowErrorMsg("FAILED TO READ IMAGE PARAMS", jerr)
    Else
      ' Get the JPGWidth ...
      lJPGWidth = jcprops.JPGWidth
      ' .. & JPGHeight member values:
      lJPGHeight = jcprops.JPGHeight
      
      Select Case jpg_scale
        Case 1
        Case 2
          lJPGWidth = (lJPGWidth + 1) / 2
          lJPGHeight = (lJPGHeight + 1) / 2
            
        Case 4
          lJPGWidth = (lJPGWidth + 3) / 4
          lJPGHeight = (lJPGHeight + 3) / 4
        Case 8
          lJPGWidth = (lJPGWidth + 7) / 8
          lJPGHeight = (lJPGHeight + 7) / 8
      End Select
            
      If jcprops.JPGChannels = 1 Then
        jcprops.JPGColor = IJL_G
        jcprops.DIBColor = IJL_BGR
        nChannels = 3
      ElseIf jcprops.JPGChannels = 3 Then
        jcprops.JPGColor = IJL_YCBCR
        jcprops.DIBColor = IJL_BGR
        nChannels = 3
      ElseIf jcprops.JPGChannels = 4 Then
        jcprops.JPGColor = IJL_YCBCRA_FPX
        jcprops.DIBColor = IJL_RGBA_FPX
        nChannels = 4
      End If
         
      ' Create a buffer of sufficient size to hold the image:
      If cDib.Create(lJPGWidth, lJPGHeight, nChannels) Then
        ' Store DIBWidth:
        jcprops.DIBWidth = lJPGWidth
        ' Store DIBHeight:
        jcprops.DIBHeight = -lJPGHeight
        ' Store Channels:
        jcprops.DIBChannels = nChannels
            
        ' Store DIBBytes (pointer to uncompressed JPG data):
        jcprops.DIBBytes = cDib.DIBSectionBitsPtr
        ' specify align for DIB
        jcprops.DIBPadBytes = IJL_DIB_PAD_BYTES(jcprops.DIBWidth, jcprops.DIBChannels)

        Select Case jpg_scale
          Case 1
            ' Now decompress the JPG into the DIBSection:
            jerr = ijlRead(jcprops, IJL_JFILE_READWHOLEIMAGE)
          Case 2
            ' Now decompress the JPG into the DIBSection:
            jerr = ijlRead(jcprops, IJL_JFILE_READONEHALF)
          Case 4
            ' Now decompress the JPG into the DIBSection:
            jerr = ijlRead(jcprops, IJL_JFILE_READONEQUARTER)
          Case 8
            ' Now decompress the JPG into the DIBSection:
            jerr = ijlRead(jcprops, IJL_JFILE_READONEEIGHTH)
        End Select
            
            
        If jerr = IJL_OK Then
          ' convert from IJL_RGBA_FPX to BGRA
          If jcprops.DIBColor = IJL_RGBA_FPX Then
            Call ConvertFromRGBA(jcprops.DIBBytes)
          End If
          ' cDib now contains the uncompressed JPG.
          LoadJPG = True
        Else
          ' Throw error:
          Call ShowErrorMsg("FAILED TO READ IMAGE DATA " & "(" & sFile & ")", jerr)
        End If
      Else
        ' failed to create the DIB...
      End If
    End If
                        
    ' Ensure we have freed memory:
    jerr = ijlFree(jcprops)
  
  Else
    ' Throw error:
    Call ShowErrorMsg("Failed to initialise the IJL library: ", jerr)
  End If
   
End Function


Public Function SaveJPG(ByRef cDib As cDIBSection, ByVal sFile As String) As Boolean
  Dim jerr As IJLERR
  Dim jcprops As JPEG_CORE_PROPERTIES
  Dim aFile As String
  Dim lPtr As Long
   
 jerr = ijlInit(jcprops)
 If jerr = IJL_OK Then
   ' Set up the DIB information:
   
   ' DIB width
   jcprops.DIBWidth = cDib.dib_width
   ' DIB height
   jcprops.DIBHeight = -cDib.dib_height
   ' DIB number of channels
   jcprops.DIBChannels = cDib.dib_channels
   ' DIB color space
   If jcprops.DIBChannels = 3 Then
     jcprops.DIBColor = IJL_BGR
     jcprops.JPGColor = IJL_YCBCR
     jcprops.JPGChannels = 3
     jcprops.JPGSubsampling = IJL_411
   Else
     jcprops.DIBColor = IJL_RGBA_FPX
     jcprops.JPGColor = IJL_YCBCRA_FPX
     jcprops.JPGChannels = 4
     jcprops.JPGSubsampling = IJL_4114
   End If
   ' DIBBytes (pointer to uncompressed RGB data):
   jcprops.DIBBytes = cDib.DIBSectionBitsPtr
   ' DIBPadBytes
   jcprops.DIBPadBytes = IJL_DIB_PAD_BYTES(jcprops.DIBWidth, jcprops.DIBChannels)

   ' Set up the JPEG information:
      
    aFile = StrConv(sFile, vbFromUnicode)
      
   ' JPEG filename
    jcprops.JPGFile = StrPtr(aFile)
      
   ' JPG width
   jcprops.JPGWidth = cDib.dib_width
   ' JPG height
   jcprops.JPGHeight = cDib.dib_height
   ' JPEG quality
   jcprops.jquality = 75

   ' Encode the image into file
   jerr = ijlWrite(jcprops, IJL_JFILE_WRITEWHOLEIMAGE)
   If jerr = IJL_OK Then
     SaveJPG = True
   Else
     ' Throw error
     Call ShowErrorMsg("Failed to save to JPG", jerr)
   End If
      
   ' Ensure we have freed memory:
   Call ijlFree(jcprops)
 
 Else
   ' Throw error:
   Call ShowErrorMsg("Failed to initialise the IJL library", jerr)
 
 End If
   
End Function

Rem
Rem//////////////////////////////////////////////////////////////////////////
Rem  Name:        IJL_DIB_PAD_BYTES
Rem
Rem  Purpose:     Calculate number of bytes to pad DIB line.
Rem
Rem//////////////////////////////////////////////////////////////////////////
Rem

Public Function IJL_DIB_PAD_BYTES(ByVal width As Long, ByVal nChannels As Long) As Long
Dim IJL_DIB_ALIGN As Long
Dim IJL_DIB_UWIDTH As Long
Dim IJL_DIB_AWIDTH As Long

  IJL_DIB_ALIGN = 3
  IJL_DIB_UWIDTH = width * nChannels
  IJL_DIB_AWIDTH = (IJL_DIB_UWIDTH + IJL_DIB_ALIGN) And (Not (IJL_DIB_ALIGN))
  
  IJL_DIB_PAD_BYTES = IJL_DIB_AWIDTH - IJL_DIB_UWIDTH

End Function