Сохрание рисунка в Jpeg

[13GHOST]

Как сохранить рисунок в Jpeg формате? Заранее спасибо за ответ...

[hCORe]

gdi+

[Sasha_karasov]

исходник

[13GHOST]

А без ijl11.dll нельзя?

[GM]

А без ijl11.dll нельзя?

Можна как уже писал hCore c GDI+, но тоже DLL прийдется таскать. Если не подходить можеш разобраться с форматом JPEG, ну и ручками сохранять.

[Sasha_karasov]

Код: Выделить всё

' ----==== API Declarations ====----

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

' ----==== SaveJPG ====----

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

   ' Initialize GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI)
   
   If lRes = 0 Then
   
      ' Create the GDI+ bitmap
      ' from the image handle
      lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
   
      If lRes = 0 Then
         Dim tJpgEncoder As GUID
         Dim tParams As EncoderParameters
         
         ' Initialize the encoder GUID
         CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
                         tJpgEncoder
       
         ' Initialize the encoder parameters
         tParams.Count = 1
         With tParams.Parameter ' Quality
            ' Set the Quality GUID
            CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"), .GUID
            .NumberOfValues = 1
            .type = 1
            .Value = VarPtr(Quality)
         End With
         
         ' Save the image
         lRes = GdipSaveImageToFile( _
                  lBitmap, _
                  StrPtr(Filename), _
                  tJpgEncoder, _
                  tParams)
                             
         ' Destroy the bitmap
         GdipDisposeImage lBitmap
         
      End If
       
      ' Shutdown GDI+
      GdiplusShutdown lGDIP

   End If
   
   If lRes Then
      Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
   End If
   
End Sub


А как в gif или PNG Сохранить?

[Sasha_karasov]

<<<Здесь не нужно таскать DLL>>>

[GM]

2Sasha_karasov, а разве gdiplus есть на всех виндах? Если не ошибаюсь с ХР.

Насчет gif'ов поищи пример Тёмыча, там он вручную открывал и сохранял gif.

[eugene2005]

a GDI есть на Милениуме или 98? с апдейтом только приходит ГДИ да?

[tyomitch]

GDI+ есть только на WinXP.
Установить его можно на Win98 или выше.
В апдейты для старых виндов оно не входит.

[Cryonyx]

А если сюда приписать ещё и проклятый мсвбвм60.длл, то...

[eugene2005]

исходник

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection2 Lib "gdi32" Alias "CreateDIBSection" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw 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 SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Type QUANTIZATIONTABLE
Qk(63) As Integer
FScale(63) As Single
IScale(63) As Single
End Type



а этому не надо гдиплюс 1.6 мб?

[codemaster]

А без ijl11.dll нельзя?

Лучше пользовать ijl2*.dll в ней исправлено много ошибок

Плюсы от Intel по сравнению с GDI
быстродействие
размер

[eugene2005]

да но gdi32 есть во многих осях. и весит 230 кб
а от интела нужно таскать отдельно хоть и меньше размеров

кто нить бенчмарки делал кто как делает жопэгэ?

[eugene2005]

[quote="Sasha_karasov"][b]исходник[/b][/quote]

используя образцы тут я беру снимок экрана
option Explicit

Private Declare Function GetDesktopWindow Lib "user32" () 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 Const SRCCOPY = &HCC0020

Private Sub Command1_Click()
Dim hDesk, hDeskDC

hDesk = GetDesktopWindow()
hDeskDC = GetDC(hDesk)
BitBlt picShot.hDC, 0, 0, Width, Height, hDeskDC, 0, 0, SRCCOPY

' SavePicture picShot.Image, "C:\PicOut.bmp"

End Sub


и хочу перенаправить на Set MyPic =

как мне туда перенаправить снимок не сохраняя файл БМП на диск и не загружая его заново через loadpicture?

как можно ускорить процесс сохранения бмп в жпег?
то есть безовсего сразу конвертировать десктоп скрин в жпег?



im MyPic As StdPicture
Dim FileName As String

Set MyPic = LoadPicture(FileName)

Set m_Image = New cImage
m_Image.CopyStdPicture MyPic

Set MyPic = Nothing