Office中国论坛/Access中国论坛

标题: [讨论]改变图片文件的大小 [打印本页]

作者: kevindeng 时间: 2004-12-30 22:30
标题: [讨论]改变图片文件的大小
我想在ＡＣＣＥＳＳ中实现用一个按钮选择一个图片文件(jpg)改变大小后ＣＯＰＹ到另外一个文件夹中，不知道各位有什么好的办法实现吗？

作者: zyp 时间: 2004-12-30 22:33
更改圖片原始尺寸嗎?原800*600,處理成640*480????如果是怎樣,用access那可能是選錯了工具

作者: kevindeng 时间: 2004-12-30 22:36
是的。我是想用VBA代码实现

作者: appleking 时间: 2012-6-2 16:24
这个没人能作吗?
在vb里实现的方式在ACC里为什么不行.
'保存JPEG用

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type

Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, _
inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
ByVal Image As Long, ByVal filename As Long, _
clsidEncoder As GUID, encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

Public Sub SaveJPG(ByVal pict As StdPicture, ByVal filename As String, _
         Optional ByVal quality As Byte = 80)
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long

' 初始化 GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)

If lRes = 0 Then

   ' 从句柄创建 GDI+ 图像
   lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

   If lRes = 0 Then
      Dim tJpgEncoder As GUID
      Dim tParams As EncoderParameters

      '初始化解码器的GUID标识
      CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
                     tJpgEncoder

      ' 设置解码器参数
      tParams.Count = 1
      With tParams.Parameter ' Quality
         ' 得到Quality参数的GUID标识
         CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
         .NumberOfValues = 1
         .type = 4
         .Value = VarPtr(quality)
      End With

      '保存图像
      lRes = GdipSaveImageToFile( _
               lBitmap, _
               StrPtr(filename), _
               tJpgEncoder, _
               tParams)

      ' 销毁GDI+图像
      GdipDisposeImage lBitmap

   End If

   '销毁 GDI+
   GdiplusShutdown lGDIP

End If

If lRes Then
   Err.Raise 5, , "不能保存这个图像：" & lRes
End If

End Sub

Private Sub Command1_Click()
SaveJPG Image1.Picture, sfile, SPA
End Sub
提示是 Image1.Picture 类型不匹配怎么回事

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)