ذخیره کردن عکس با پسوند jpg (واقعی و درست)

ای بابا. خدا بگم چه کار کنه سرپرست مهندسی تیم برنامه نویسی ویژوال بیسیک را. خدا ریششو بکنه.

اخه کسی اون موقع نبود بهش بگه که خب مرد تو که دستور SavePcture را تو کدهایت گذاشتی با پسونذ BMP. اخه دیگه چرا JPG را نگونجوندی؟؟؟؟ که این همه برنامه نویس دچار درد سر بشوند تو سایت برنامه نویس؟؟؟ هـــــــــــــــــــــا؟

خب متعسفانه(دلم میخواد اینجوری بنویسم کی به کیه؟) دستمون که بهش نمیرسه که یقشو بگیریم ولی حداقل دستمون به یک کدی جمع و جور میرسه که اینکارو برامون به شکل ساده انجام بده!.

خیلی ساده س
اینو اول تو ماژول/Module کپی کنید.!

Option Explicit





' ----==== 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-5DB35105E7EB}"), .GUID

                .NumberOfValues = 1

                .Type = 4

                .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

و بعدش مثل بچه آدم این کد برای ذخیره کردن در کدهایتان استفاده میکنید.
فقط عدد آخر که اینجا 50 است مربوط سطح کیفیت عکس که 0 تا 100 میتونید کیفیت ذخیره عکس را تغییر دهید.

SaveJPG(Picture1, "C:\x.jpg", 50)

دیدید که چه راحــــــــــــــــــت.! خب می مُرد اینو تو ویژال بیسیک میگنجوند؟ والا

درضمن از این به بعد نبینم کسی در این مورد سوالی تو برنامه نویس بکنه . چون بهترینشو گیر آوردم و نوشم.! هـا

:لبخندساده:لطفا لبخند فراموش نشه:لبخندساده:

وای دمت گرم داداش فقط یه سوال آیا این کد کلا برسی شده که در آینده با خطا یا باگی رو برو نشه ؟

و یه درخواست : من نیاز به یه مبدل عکس دارم که بتونم چندین فرمت رو به هم دیگه تبدیل کنم اگه ممکنه چند تا کلاس دیگه هم در مورد بقیه فرمت ها بزارید
به خواندنو ذخیره این فرمت ها شدیدا نیاز دارم
PNG,BMP,TGA,PCX,PSD,TIF,DDS طوری که بشه بصورت ترانسپرنت لود و ذخیرشون کنم اگه ممکنه به این تایپک یه سر بزنید ممنون میشم کمک کنید
https://barnamenevis.org/showthread....DB%8C%DA%A9-6&

یا ابوالفضل، دادا ببین
نرم افزار Photoshop میخوای درست کنی؟ فکر کردی که بچه بازیه که هر عکسی رو کنی و بعد تبدیل کنی؟؟؟ اینها هر کدومشون برای خودشون کلی DLL دارند.
می‌دونی مثلاً خود این DDS باید بایت به بایت بخونی و بعد کدهای پیکسل عکسو به صورت فشرده دربیاری و بعد به شکل باینری ذخیره کنی.
فکر کردی علکیه،
اگر دیده باشی بیشتر برنامه های ویرایش عکس کنار خودشون حتما چندین تا dll دارند که به صورت مستقیم با اونها در ارتباط هستند.
حالا اگر بتونی اون dll را باز کنی و کار کنی اون هم با vb6 شاید بگم تونسته باشی یک کاری کرده باشی.

خب من کلاس همه اینهارو دارم منتها توی یه پست دیگه هم توضیح دادم کدهاشون خیلی زیاده و برای من قابل درک نیست خواستم اگه امکان داشته باشه با کد های کوتها تری این فرمت هارو لود کنم
در ضمن اگه لازم میدونید بگید که کلاس هارو براتون بفرستم

بزار ببینم چی میگی.

درضمن مگه چیزی میخواهی درست کنی که به نوع کار ها نیاز داری

آره من با برنامه های سه بعدی ساز کار میکنم و فایل هایی که ا ز نت میگیرم همه ی تکسچر هاشون فرمتشون DDS و TGA هستن برای همین بعضی وقتها نیاز دارم ویرایششون کنم و یک ویرایشگر قوی ه با وژوال بیسیک ساختم و شدیدن به برناه ای برای تبدیل فرت ها نیاز دارم اکثر برنامه ها هم یا پولین یا ت 3 4 روز بصورت آزمایشی کار میکنن بعد باید خریداری بشن