7681
社区成员
请发表友善的回复…
发表回复
enmity 2001-12-17
- 打赏
- 举报
to:forest_wk
单击左边导航栏中的系统功能－》“我的帖子”，在列表中单击本帖子右边的“管理”，按照实际情况给分，在帖子顶部输入密码
单击左边导航栏中的系统功能－》“我的帖子”，在列表中单击本帖子右边的“管理”，按照实际情况给分，在帖子顶部输入密码
forest_wk 2001-12-17
- 打赏
- 举报
enmity 你好：
非常感谢你的帮助，现在我的问题已经解决了，谢谢！
我还不太知道怎么加分，请告诉我，我也想给别人加一加分，我没有找到加分的地方，清告知！谢谢！
非常感谢你的帮助，现在我的问题已经解决了，谢谢！
我还不太知道怎么加分，请告诉我，我也想给别人加一加分，我没有找到加分的地方，清告知！谢谢！
enmity 2001-12-05
- 打赏
- 举报
前面的都发送了，请查收
以后想要的，请到下面的地址下载：
http://caotang.myetang.com/temp/SAVEJPEG.zip
以后想要的，请到下面的地址下载：
http://caotang.myetang.com/temp/SAVEJPEG.zip
enmity 2001-12-05
- 打赏
- 举报
to:forest_wk
我在上面的回复中不是说过：
“以后想要的，请到下面的地址下载：
http://caotang.myetang.com/temp/SAVEJPEG.zip ”
吗？
我在上面的回复中不是说过：
“以后想要的，请到下面的地址下载：
http://caotang.myetang.com/temp/SAVEJPEG.zip ”
吗？
longjiang_m 2001-12-05
- 打赏
- 举报
解决了吗？
Option Explicit
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 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
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
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)
Public Function LoadJPG(ByRef cDib As cDIBSection, ByVal sFile As String) As Boolean
Dim tJ As JPEG_CORE_PROPERTIES_VB
Dim bFile() As Byte
Dim lR As Long
Dim lPtr As Long
Dim lJPGWidth As Long, lJPGHeight As Long
lR = ijlInit(tJ)
If lR = IJL_OK Then
' Write the filename to the jcprops.JPGFile member:
bFile = StrConv(sFile, vbFromUnicode)
ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
bFile(UBound(bFile)) = 0
lPtr = VarPtr(bFile(0))
CopyMemory tJ.JPGFile, lPtr, 4
' Read the JPEG file parameters:
lR = ijlRead(tJ, IJL_JFILE_READPARAMS)
If lR <> IJL_OK Then
' Throw error
MsgBox "Failed to read JPG", vbExclamation
Else
' Get the JPGWidth ...
lJPGWidth = tJ.JPGWidth
' .. & JPGHeight member values:
lJPGHeight = tJ.JPGHeight
' Create a buffer of sufficient size to hold the image:
If cDib.Create(lJPGWidth, lJPGHeight) Then
' Store DIBWidth:
tJ.DIBWidth = lJPGWidth
' Store DIBHeight:
tJ.DIBHeight = -lJPGHeight
' Store Channels:
tJ.DIBChannels = 3&
' Store DIBBytes (pointer to uncompressed JPG data):
tJ.DIBBytes = cDib.DIBSectionBitsPtr
' Now decompress the JPG into the DIBSection:
lR = ijlRead(tJ, IJL_JFILE_READWHOLEIMAGE)
If lR = IJL_OK Then
' That's it! cDib now contains the uncompressed JPG.
LoadJPG = True
Else
' Throw error:
MsgBox "Cannot read Image Data from file.", vbExclamation
End If
Else
' failed to create the DIB...
End If
End If
' Ensure we have freed memory:
ijlFree tJ
Else
' Throw error:
MsgBox "Failed to initialise the IJL library: " & lR, vbExclamation
End If
End Function
Public Function SaveJPG(ByRef cDib As cDIBSection, ByVal sFile As String) As Boolean
Dim tJ As JPEG_CORE_PROPERTIES_VB
Dim bFile() As Byte
Dim lPtr As Long
Dim lR As Long
lR = ijlInit(tJ)
If lR = IJL_OK Then
' Set up the DIB information:
' Store DIBWidth:
tJ.DIBWidth = cDib.width
' Store DIBHeight:
tJ.DIBHeight = -cDib.height
' Store DIBBytes (pointer to uncompressed JPG data):
tJ.DIBBytes = cDib.DIBSectionBitsPtr
' Set up the JPEG information:
' Store JPGFile:
bFile = StrConv(sFile, vbFromUnicode)
ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
bFile(UBound(bFile)) = 0
lPtr = VarPtr(bFile(0))
CopyMemory tJ.JPGFile, lPtr, 4
' Store JPGWidth:
tJ.JPGWidth = cDib.width
' .. & JPGHeight member values:
tJ.JPGHeight = cDib.height
tJ.jquality = 90
' Write the image:
lR = ijlWrite(tJ, IJL_JFILE_WRITEWHOLEIMAGE)
If lR = IJL_OK Then
SaveJPG = True
Else
' Throw error
' MsgBox "Failed to save to JPG", vbExclamation 'sgfdddddddddddddddddddddddddddddddddd
End If
' Ensure we have freed memory:
ijlFree tJ
Else
' Throw error:
MsgBox "Failed to initialise the IJL library: " & lR, vbExclamation
End If
End Function
‘=====================================================================
Private Sub Command13_Click()
'±£´æͼƬ
Dim sI As String
Dim name As String
Dim kl As String
Dim c As New cDIBSection
name = text1(1).Text
kl = text1(0).Text
c.CreateFromPicture Image3(0).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
'MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(1).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-1" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(2).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-2" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(3).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-3" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(4).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-4" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(5).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-5" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(6).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-6" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(7).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-7" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
End Sub
拷贝上就可以用了！
给分吧！
Option Explicit
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 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
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
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)
Public Function LoadJPG(ByRef cDib As cDIBSection, ByVal sFile As String) As Boolean
Dim tJ As JPEG_CORE_PROPERTIES_VB
Dim bFile() As Byte
Dim lR As Long
Dim lPtr As Long
Dim lJPGWidth As Long, lJPGHeight As Long
lR = ijlInit(tJ)
If lR = IJL_OK Then
' Write the filename to the jcprops.JPGFile member:
bFile = StrConv(sFile, vbFromUnicode)
ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
bFile(UBound(bFile)) = 0
lPtr = VarPtr(bFile(0))
CopyMemory tJ.JPGFile, lPtr, 4
' Read the JPEG file parameters:
lR = ijlRead(tJ, IJL_JFILE_READPARAMS)
If lR <> IJL_OK Then
' Throw error
MsgBox "Failed to read JPG", vbExclamation
Else
' Get the JPGWidth ...
lJPGWidth = tJ.JPGWidth
' .. & JPGHeight member values:
lJPGHeight = tJ.JPGHeight
' Create a buffer of sufficient size to hold the image:
If cDib.Create(lJPGWidth, lJPGHeight) Then
' Store DIBWidth:
tJ.DIBWidth = lJPGWidth
' Store DIBHeight:
tJ.DIBHeight = -lJPGHeight
' Store Channels:
tJ.DIBChannels = 3&
' Store DIBBytes (pointer to uncompressed JPG data):
tJ.DIBBytes = cDib.DIBSectionBitsPtr
' Now decompress the JPG into the DIBSection:
lR = ijlRead(tJ, IJL_JFILE_READWHOLEIMAGE)
If lR = IJL_OK Then
' That's it! cDib now contains the uncompressed JPG.
LoadJPG = True
Else
' Throw error:
MsgBox "Cannot read Image Data from file.", vbExclamation
End If
Else
' failed to create the DIB...
End If
End If
' Ensure we have freed memory:
ijlFree tJ
Else
' Throw error:
MsgBox "Failed to initialise the IJL library: " & lR, vbExclamation
End If
End Function
Public Function SaveJPG(ByRef cDib As cDIBSection, ByVal sFile As String) As Boolean
Dim tJ As JPEG_CORE_PROPERTIES_VB
Dim bFile() As Byte
Dim lPtr As Long
Dim lR As Long
lR = ijlInit(tJ)
If lR = IJL_OK Then
' Set up the DIB information:
' Store DIBWidth:
tJ.DIBWidth = cDib.width
' Store DIBHeight:
tJ.DIBHeight = -cDib.height
' Store DIBBytes (pointer to uncompressed JPG data):
tJ.DIBBytes = cDib.DIBSectionBitsPtr
' Set up the JPEG information:
' Store JPGFile:
bFile = StrConv(sFile, vbFromUnicode)
ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
bFile(UBound(bFile)) = 0
lPtr = VarPtr(bFile(0))
CopyMemory tJ.JPGFile, lPtr, 4
' Store JPGWidth:
tJ.JPGWidth = cDib.width
' .. & JPGHeight member values:
tJ.JPGHeight = cDib.height
tJ.jquality = 90
' Write the image:
lR = ijlWrite(tJ, IJL_JFILE_WRITEWHOLEIMAGE)
If lR = IJL_OK Then
SaveJPG = True
Else
' Throw error
' MsgBox "Failed to save to JPG", vbExclamation 'sgfdddddddddddddddddddddddddddddddddd
End If
' Ensure we have freed memory:
ijlFree tJ
Else
' Throw error:
MsgBox "Failed to initialise the IJL library: " & lR, vbExclamation
End If
End Function
‘=====================================================================
Private Sub Command13_Click()
'±£´æͼƬ
Dim sI As String
Dim name As String
Dim kl As String
Dim c As New cDIBSection
name = text1(1).Text
kl = text1(0).Text
c.CreateFromPicture Image3(0).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
'MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(1).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-1" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(2).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-2" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(3).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-3" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(4).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-4" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(5).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-5" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(6).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-6" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
c.CreateFromPicture Image3(7).Picture
sI = App.Path & "\pic\" & kl + Space(1) & name + Space(1) & "-7" & ".jpg"
If sI <> "" Then
If SaveJPG(c, sI) Then
' OK!
Else
' MsgBox "Failed to save the picture to the file: '" & sI & "'", vbExclamation
End If
End If
End Sub
拷贝上就可以用了！
给分吧！
asciiman 2001-12-05
- 打赏
- 举报
只要将BMP用SAVEPICTURE另存为GIF OR JPG就行了。
forest_wk 2001-12-05
- 打赏
- 举报
enmity(灵感之源):
你好，那请你把那个dll发到我的信箱吧！我的email是：forest_wkk@sina.com.cn 非常感谢！！
你好，那请你把那个dll发到我的信箱吧！我的email是：forest_wkk@sina.com.cn 非常感谢！！
enmity 2001-12-05
- 打赏
- 举报
to:forest_wk & j_x_y(无名)
该DLL不是本人写的，根本没有源代码，只有演示例子。
该DLL不是本人写的，根本没有源代码，只有演示例子。
j_x_y 2001-12-05
- 打赏
- 举报
enmity(灵感之源):
你好，请把你的源程序给我，也就是那个dll.非常感谢！ 信箱：lei_818@163.com
你好，请把你的源程序给我，也就是那个dll.非常感谢！ 信箱：lei_818@163.com
forest_wk 2001-12-05
- 打赏
- 举报
enmity(灵感之源):
你好，请把你的源程序给我，也就是那个dll.非常感谢！ 信箱：forest_wkk@sina.com
你好，请把你的源程序给我，也就是那个dll.非常感谢！ 信箱：forest_wkk@sina.com
enmity 2001-12-05
- 打赏
- 举报
to:forest_wk
你可以间接保存该文件（先把bmp用LoadPicture载入到PictureBox里面，再用该dll保存成jpeg）
你可以间接保存该文件（先把bmp用LoadPicture载入到PictureBox里面，再用该dll保存成jpeg）
forest_wk 2001-12-05
- 打赏
- 举报
enmity(灵感之源)：
你好，能不能把你用vb做过的图片浏览器的例子给我，也许这个要求比较过分，我只是想试试
你好，能不能把你用vb做过的图片浏览器的例子给我，也许这个要求比较过分，我只是想试试
forest_wk 2001-12-05
- 打赏
- 举报
enmity(灵感之源):
你好！很高兴你这么快就回复信息，我真是很幸运，但你的例子不能把bmp文件转换成jpeg,我不知道我下载的是不是你的例子，在你的例子里，首先是打开一个名为partybw的jpeg文件，用的语句是 If LoadJPG(m_cDib, App.Path & "\partybw.jpg") Then cmdPaint_Click ，我不知道这是不是你的例子，在这个语句里，我把partybw.jpg换成一个bmp格式的图片运行时却不行，请帮忙，我将非常感谢！在我的信箱里好像收到了你的email但都是1k大小，应该是没有收到你的例子。
你好！很高兴你这么快就回复信息，我真是很幸运，但你的例子不能把bmp文件转换成jpeg,我不知道我下载的是不是你的例子，在你的例子里，首先是打开一个名为partybw的jpeg文件，用的语句是 If LoadJPG(m_cDib, App.Path & "\partybw.jpg") Then cmdPaint_Click ，我不知道这是不是你的例子，在这个语句里，我把partybw.jpg换成一个bmp格式的图片运行时却不行，请帮忙，我将非常感谢！在我的信箱里好像收到了你的email但都是1k大小，应该是没有收到你的例子。
enmity 2001-12-05
- 打赏
- 举报
to:forest_wk
你好，那个例子只是把bmp文件转换成为jpg而已。
在ＶＢ中载入３２位的bmp文件？这个我没有特别测试过，不过，我曾经用VB做过一个图片浏览器，好像没有bmp文件不能载入。你可以测试一下
你好，那个例子只是把bmp文件转换成为jpg而已。
在ＶＢ中载入３２位的bmp文件？这个我没有特别测试过，不过，我曾经用VB做过一个图片浏览器，好像没有bmp文件不能载入。你可以测试一下
forest_wk 2001-12-05
- 打赏
- 举报
enmity(灵感之源)：
你好！我就是那个提问题的人，我已经看了你的代码，请问我想用VB读取32位格式的bmp图片，如何才能做到。在你的代码中只是打开了jpg格式的图片，能不能打开32位格式的bmp图片呢？如果你有相关的资料或好的网站请告诉我！谢谢！
你好！我就是那个提问题的人，我已经看了你的代码，请问我想用VB读取32位格式的bmp图片，如何才能做到。在你的代码中只是打开了jpg格式的图片，能不能打开32位格式的bmp图片呢？如果你有相关的资料或好的网站请告诉我！谢谢！
jincai78 2001-12-04
- 打赏
- 举报
enmity(灵感之源)
谢谢,发到了!
谢谢,发到了!
MyLf 2001-12-04
- 打赏
- 举报
給我一個,好嗎?
lffengfeng@chinaren.com
lffengfeng@chinaren.com
4_Eye_Cat 2001-12-04
- 打赏
- 举报
给我来一个?
siyanmao@163.com
siyanmao@163.com
langzhi 2001-12-04
- 打赏
- 举报
关注。
langzhi888@sohu.com
langzhi888@sohu.com
ssassa 2001-12-04
- 打赏
- 举报
我也想要！可以吗？wuyongwu@sina.com
加载更多回复（17）