关于JPG图片旋转问题,急急急!!!
我想用VB将JPG图片旋转90度
在网上找了好多源代码,一般都是放在PICBOX上转成BMP,思路如下:
JPG->BMP->旋转90度->BMP->JPG
不过这样速度太慢了,因为我的JPG原图一般都是6M左右.一般转一个都需要好几分钟
请问各位有没有更好的方法,速度越快越好!
另,我要的是VB源代码,不要老告诉我用第三方软件什么去手动转.
还有,如果机子装了ACDsee,至需要在图片右键选择旋转多少度就可以了,速度也非常快!
,我听说可以引用ACDSee的控件什么,具体怎么做呢?
[解决办法]
其实旋转算法本身很快，拿5000*4000这个大小的图片来说，在我的机器上只需要1S左右， 从物理文件读取图像数据到内存需要1.5s，旋转都保存图像需要大概需要3S。
你从网络上得到的代码都是一些没有优化的比较原始的，并且旋转90度因其特殊性可优化空间很大。
我给你一个函数，你自己看看速度如何，基本上比网络上的都快不过我没有写任何注释。
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type RECTF
nLeft As Single
nTop As Single
nWidth As Single
nHeight As Single
End Type
Private Type BitmapData
Width As Long
Height As Long
Stride As Long
PixelFormat As Long
scan0 As Long
Reserved As Long
End Type
Private Enum ImageLockMode
ImageLockModeRead = &H1
ImageLockModeWrite = &H2
ImageLockModeUserInputBuf = &H4
End Enum
Private Enum EncoderParameterValueType
[EncoderParameterValueTypeByte] = 1
[EncoderParameterValueTypeASCII] = 2
[EncoderParameterValueTypeShort] = 3
[EncoderParameterValueTypeLong] = 4
[EncoderParameterValueTypeRational] = 5
[EncoderParameterValueTypeLongRange] = 6
[EncoderParameterValueTypeUndefined] = 7
[EncoderParameterValueTypeRationalRange] = 8
End Enum
Private Type EncoderParameter
GUID(0 To 3) As Long
NumberOfValues As Long
Type As EncoderParameterValueType
Value As Long
End Type
'-- Encoder Parameters structure
Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type
Private Type ImageCodecInfo
ClassID(0 To 3) As Long
FormatID(0 To 3) As Long
CodecName As Long
DllName As Long
FormatDescription As Long
FilenameExtension As Long
MimeType As Long
flags As Long
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long
SigMask As Long
End Type
Private Const PixelFormat32bppARGB = &H26200A
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, hImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, Graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Private Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal bitmap As Long, Rct As RECT, ByVal flags As ImageLockMode, ByVal PixelFormat As Long, lockedBitmapData As BitmapData) As Long
Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal bitmap As Long, lockedBitmapData As BitmapData) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszProgID As Long, pCLSID As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal hImage As Long, ByVal sFilename As Long, clsidEncoder As Any, encoderParams As Any) 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 VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Function GdipGetImageBounds Lib "gdiplus.dll" (ByVal nImage As Long, srcRect As RECTF, srcUnit As Long) As Long
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, Size As Long) As Long
Private Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal Size As Long, Encoders As Any) As Long
Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal Stride As Long, ByVal PixelFormat As Long, scan0 As Any, bitmap As Long) As Long
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, Image As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
[解决办法]
Private Function Rotate90(FileName As String) As Long
Dim i As Long, j As Long
Dim Token As Long
Dim Gsp As GdiplusStartupInput
Dim BmpData As BitmapData, Image As Long
Dim Dimensions As RECTF, Rct As RECT
Dim DataArr(0) As Long, pDataArr(0 To 0) As Long
Dim OldArrPtr As Long, OldpArrPtr As Long
Dim LineAddBytes As Long
Dim DataArrC(0) As Long, pDataArrC(0 To 0) As Long
Dim OldArrPtrC As Long, OldpArrPtrC As Long
Dim mPtrC As Long
Dim Width As Long, Height As Long
Dim Stride As Long, Pointer As Long
Rotate90 = GetTickCount - Rotate90
Gsp.GdiplusVersion = 1
GdiplusStartup Token, Gsp
GdipLoadImageFromFile StrPtr(FileName), Image
GdipGetImageBounds Image, Dimensions, 2
Rct.Right = Dimensions.nWidth
Rct.Bottom = Dimensions.nHeight
GdipBitmapLockBits Image, Rct, ImageLockModeRead, PixelFormat32bppARGB, BmpData
mPtrC = GlobalAlloc(GPTR, BmpData.Stride * BmpData.Height)
CopyMemory ByVal mPtrC, ByVal BmpData.scan0, BmpData.Stride * BmpData.Height
MakePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr
MakePoint VarPtrArray(DataArrC), VarPtrArray(pDataArrC), OldArrPtrC, OldpArrPtrC
Pointer = BmpData.scan0
Width = BmpData.Width
Height = BmpData.Height
Stride = BmpData.Stride
pDataArr(0) = mPtrC
For j = 1 To Width
pDataArrC(0) = Pointer + 4 * (Width - j)
For i = 1 To Height
DataArr(0) = DataArrC(0)
pDataArr(0) = pDataArr(0) + 4
pDataArrC(0) = pDataArrC(0) + Stride
Next
Next
FreePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr
FreePoint VarPtrArray(DataArrC), VarPtrArray(pDataArrC), OldArrPtrC, OldpArrPtrC
GdipBitmapUnlockBits Image, BmpData
GdipDisposeImage Image
GdipCreateBitmapFromScan0 Height, Width, Height * 4, PixelFormat32bppARGB, ByVal mPtrC, Image
SavePictureToFile Image, FileName
GdipDisposeImage Image
GlobalFree mPtrC
GdiplusShutdown Token
Rotate90 = GetTickCount
End Function
Private Function SavePictureToFile(Image As Long, FileName As String, Optional ByVal Quality As Long = 80) As Boolean
Dim aEncParams() As Byte
Dim uEncCLSID(0 To 3) As Long, uEncParams As EncoderParameters
Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
If GetEncoderClsID("image/jpeg", uEncCLSID) <> -1 Then
uEncParams.Count = 1 ' 设置自定义的编码参数，这里为1个参数
ReDim aEncParams(1 To Len(uEncParams))
With uEncParams.Parameter
.NumberOfValues = 1
.Type = [EncoderParameterValueTypeLong] ' 设置参数值的数据类型为长整型
Call CLSIDFromString(StrPtr(EncoderQuality), .GUID(0)) ' 设置参数唯一标志的GUID，这里为编码品质
If Quality < 0 Then
Quality = 0
ElseIf Quality > 100 Then
Quality = 100
End If
.Value = VarPtr(Quality) ' 设置参数的值：品质等级，最高为100，图像文件大小与品质成正比
End With
CopyMemory aEncParams(1), uEncParams, Len(uEncParams)
'If FileExist(FileName) Then Kill FileName
SavePictureToFile = (GdipSaveImageToFile(Image, StrPtr(FileName), uEncCLSID(0), aEncParams(1)) = 0&)
End If
End Function
Private Function GetEncoderClsID(strMimeType As String, ClassID() As Long) As Long
Dim Num As Long
Dim Size As Long
Dim i As Long
Dim Info() As ImageCodecInfo
Dim Buffer() As Byte
GetEncoderClsID = -1
'得到解码器数组的大小
Call GdipGetImageEncodersSize(Num, Size)
If (Size = 0) Then Exit Function ' 失败
ReDim Info(1 To Num) As ImageCodecInfo '给数组动态分配内存
ReDim Buffer(1 To Size) As Byte
Call GdipGetImageEncoders(Num, Size, Buffer(1)) '得到数组和字符数据
Call CopyMemory(Info(1), Buffer(1), (Len(Info(1)) * Num)) '复制类头
For i = 1 To Num '循环检测所有解码
If (StrComp(PtrToStrW(Info(i).MimeType), strMimeType, vbTextCompare) = 0) Then '必须把指针转换成可用的字符
CopyMemory ClassID(0), Info(i).ClassID(0), 16 '保存类的ID
GetEncoderClsID = i '返回成功的索引值
Exit For
End If
Next
Erase Info
Erase Buffer
End Function
Public Function PtrToStrW(ByVal lpsz As Long) As String
Dim Out As String
Dim lLen As Long
lLen = lstrlenW(lpsz)
If (lLen > 0) Then
Out = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal Out, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(Out, vbFromUnicode)
End If
End Function
Private Sub MakePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByRef OldArrPtr As Long, ByRef OldpArrPtr As Long)
Dim Temp As Long, TempPtr As Long
CopyMemory Temp, ByVal DataArrPtr, 4 '得到DataArrPtr的SAFEARRAY结构的地址
Temp = Temp + 12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal pDataArrPtr, 4 '得到pDataArrPtr的SAFEARRAY结构的地址
TempPtr = TempPtr + 12 '这个指针偏移12个字节后就是pvData指针
CopyMemory OldpArrPtr, ByVal TempPtr, 4 '保存旧地址
CopyMemory ByVal TempPtr, Temp, 4 '使pDataArrPtr指向DataArrPtr的SAFEARRAY结构的pvData指针
CopyMemory OldArrPtr, ByVal Temp, 4 '保存旧地址
End Sub
'*****************************************************************************************
'** 过 程 名 ： FreePoint
'** 输 入 ：
'** 功能描述 ： 取消绑定模拟数组
'** 开发日期 ： 2007-4-02
'** 作 者 ： laviewpbt
'** 修改日期 ：
'** 版 本 ： Version 1.2.1
'****************************************************************************************
Private Sub FreePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByVal OldArrPtr As Long, ByVal OldpArrPtr As Long)
Dim TempPtr As Long
CopyMemory TempPtr, ByVal DataArrPtr, 4 '得到DataArrPtr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + 12), OldArrPtr, 4 '恢复旧地址
CopyMemory TempPtr, ByVal pDataArrPtr, 4 '得到pDataArrPtr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + 12), OldpArrPtr, 4 '恢复旧地址
End Sub
Public Function FileExist(FileName As String) As Boolean
On Error GoTo Handler
If (GetAttr(FileName) And vbArchive) = vbArchive Then
FileExist = True
End If
Exit Function
Handler:
End Function
