错误依旧！！！！！！！！！！！！

Question

Option Explicit
'如果不能运行则将所附的Gdiplus.dll拷到system32下
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) 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
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, Bitmap As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As LongDim  a
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End TypePrivate Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End TypePrivate Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End TypePrivate Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End TypePrivate Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80) As Boolean
   Dim tSI As GdiplusStartupInput
   Dim lRes&, lGDIP&, lBitmap&
   '初始化 GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI, 0)
   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
   PictureBoxSaveJPG = IIf(lRes, False, True)
End FunctionPrivate Sub Timer1_Timer()
a = a + 1
If a Mod 600 = 1 Then
Dim sfile$
 Dim ret As Boolean 
 Picture1.AutoRedraw = True
 Picture1.Width = Screen.Width 
  Picture1.Height = Screen.Height  
BitBlt Picture1.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy
sfile$ = "C:\123.bmp"
SavePicture Picture1.Image, sfile 
   Picture1.Picture = LoadPicture("C:\123.bmp")  '打开要压缩的图片       
   ret = PictureBoxSaveJPG(Picture1, "C:\123.jpg") '保存压缩后的图片
   If ret = False Then
   End If
End If
End Sub
'我的用意是，让程序每10分钟截取一次桌面，并保存到c盘123.bmp，并产生一个123.jpg，但是实际这个程序运行时的结果却是123.bmp每10分钟会更新为当前桌面，而123.jpg还是第一次截取的桌面！哪里错了呢？
'time1的interval值为1000他这个代码，还是不行，按照别人的修改，还是不能正常运行，JPG文件并没有更新！原帖地址：http://topic.csdn.net/u/20091207/19/5d11cf21-8087-4444-a1e8-48d947b9a270.html我对这个也很感兴趣

Answer 1

应没有问题,想必是没有刷新的缘故
另存为jpg文件前先删除,应没有问题,看看原帖5楼的回答,lz是否没有看到
if dir("c:\123.jpg") <>"" then kill "c:\123.jpg" 

Answer 2

楼主的代码定时肯定不精确，建议你这样做：Option Explicit
'如果不能运行则将所附的Gdiplus.dll拷到system32下
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) 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
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, Bitmap As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim lngS As Long
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End TypePrivate Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End TypePrivate Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End TypePrivate Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End TypePrivate Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80) As Boolean
   Dim tSI As GdiplusStartupInput
   Dim lRes&, lGDIP&, lBitmap&
   '初始化 GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI, 0)
   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
   PictureBoxSaveJPG = IIf(lRes, False, True)
End FunctionPrivate Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 100
End SubPrivate Sub Timer1_Timer()
    Dim sfile$
    Dim ret As Boolean
    If GetTickCount - lngS >= 10000 Then
        Picture1.AutoRedraw = True
        Picture1.Width = Screen.Width
        Picture1.Height = Screen.Height
        BitBlt Picture1.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy
        sfile$ = "C:\123.bmp"
        If Dir("c:\123.jpg") <> "" Then Kill "c:\123.jpg"
        SavePicture Picture1.Image, sfile
        Picture1.Picture = LoadPicture("C:\123.bmp")  '打开要压缩的图片
        ret = PictureBoxSaveJPG(Picture1, "C:\123.jpg") '保存压缩后的图片
        If ret = False Then
        
        End If
        lngS = GetTickCount
    End If
End Sub