تبلیغات :
ماهان سرور
آکوستیک ، فوم شانه تخم مرغی ، پنل صداگیر ، یونولیت
فروش آنلاین لباس کودک
خرید فالوور ایرانی
خرید فالوور اینستاگرام
خرید ممبر تلگرام

[ + افزودن آگهی متنی جدید ]




نمايش نتايج 1 به 5 از 5

نام تاپيک: درخواست سرس "تبدیل فایل bmp به jpg" جهت فشرده سازی

  1. #1
    در آغاز فعالیت
    تاريخ عضويت
    Feb 2006
    پست ها
    6

    پيش فرض درخواست سورس "تبدیل فایل bmp به jpg" جهت فشرده سازی

    دنبال دستوری می گردم که بتوان فایل با پسوند bmpرا به jpg تبدیل کنه تا حجم فایل پایین بیاد.
    ترجیحا با زبان vb.
    كسي از دوستان ميتونه من رو راهنمايي كنه ؟
    خداوند یارتان.
    Last edited by علیم; 10-04-2006 at 23:45. دليل: غلط املایی

  2. #2
    مدیر انجمن برنامه نویسی Payman_62's Avatar
    تاريخ عضويت
    Dec 2005
    محل سكونت
    تهران
    پست ها
    2,445

    پيش فرض

    با يه دستور كه نميشه اين كارو كرد. ميتوني paint رو تو برنامت باز كني و ازش كمك بگيري.

  3. #3
    در آغاز فعالیت
    تاريخ عضويت
    Feb 2006
    پست ها
    6

    پيش فرض

    با سلام
    برنامه اي رو كه خواستم جاي ديگه اي گير آوردم. براي استفاده بقيه دوستان اونو تو پست بعدي گذاشتم.

  4. #4
    در آغاز فعالیت
    تاريخ عضويت
    Feb 2006
    پست ها
    6

    پيش فرض سورس تبدیل bmp to jpg

    فقط باید فایل vic32.dll را در system32 کپی کنید

    'PLACE THIS IN YOUR FORM DECLERATIONS

    Private Sub ConvertToJPEG(bmp_fname As String, jpg_fname As String, Optional quality As Long)
    Dim tmpimage As imgdes ' Image descriptors
    Dim tmp2image As imgdes
    Dim rcode As Long
    'Dim quality As Long
    Dim vbitcount As Long
    Dim bdat As BITMAPINFOHEADER ' Reserve space for BMP struct
    'Dim bmp_fname As String
    'Dim jpg_fname As String

    'bmp_fname = "test.bmp"
    'jpg_fname = "test.jpg"

    If quality = 0 Then quality = 75

    ' Get info on the file we're to load
    rcode = bmpinfo(bmp_fname, bdat)
    If (rcode <> NO_ERROR) Then
    MsgBox "error: Unable to get file info"
    Exit Sub
    End If

    vbitcount = bdat.biBitCount
    If (vbitcount >= 16) Then ' 16-, 24-, or 32-bit image is loaded into 24-bit buffer
    vbitcount = 24
    End If

    ' Allocate space for an image
    rcode = allocimage(tmpimage, bdat.biWidth, bdat.biHeight, vbitcount)
    If (rcode <> NO_ERROR) Then
    MsgBox "error: Not enough memory"
    Exit Sub
    End If

    ' Load image
    rcode = loadbmp(bmp_fname, tmpimage)
    If (rcode <> NO_ERROR) Then
    freeimage tmpimage ' Free image on error
    MsgBox "error: Cannot load file"
    Exit Sub
    End If

    If (vbitcount = 1) Then ' If we loaded a 1-bit image, convert to 8-bit grayscale
    ' because jpeg only supports 8-bit grayscale or 24-bit color images
    rcode = allocimage(tmp2image, bdat.biWidth, bdat.biHeight, 8)
    If (rcode = NO_ERROR) Then
    rcode = convert1bitto8bit(tmpimage, tmp2image)
    freeimage tmpimage ' Replace 1-bit image with grayscale image
    copyimgdes tmp2image, tmpimage
    End If
    End If

    ' Save image
    rcode = savejpg(jpg_fname, tmpimage, quality)
    freeimage tmpimage
    Kill bmp_fname
    MsgBox "picture saved: " & jpg_fname

    End Sub

    Private Sub Command1_Click()
    Call ConvertToJPEG("test.bmp", "test.jpg")
    End Sub

    Private Sub Form_Load()

    End Sub
    ============
    در ماژول برنامه نیز این کدها را بریزید
    'PLACE ALL THIS IN A NEW MODULE

    Declare Function bmpinfo Lib "VIC32.DLL" (ByVal Fname As String, bdat As BITMAPINFOHEADER) As Long
    Declare Function allocimage Lib "VIC32.DLL" (image As imgdes, ByVal wid As Long, ByVal leng As Long, ByVal BPPixel As Long) As Long
    Declare Function loadbmp Lib "VIC32.DLL" (ByVal Fname As String, desimg As imgdes) As Long
    Declare Sub freeimage Lib "VIC32.DLL" (image As imgdes)
    Declare Function convert1bitto8bit Lib "VIC32.DLL" (srcimg As imgdes, desimg As imgdes) As Long
    Declare Sub copyimgdes Lib "VIC32.DLL" (srcimg As imgdes, desimg As imgdes)
    Declare Function savejpg Lib "VIC32.DLL" (ByVal Fname As String, srcimg As imgdes, ByVal quality As Long) As Long



    ' Image descriptor
    Type imgdes
    ibuff As Long
    stx As Long
    sty As Long
    endx As Long
    endy As Long
    buffwidth As Long
    palette As Long
    colors As Long
    imgtype As Long
    bmh As Long
    hBitmap As Long
    End Type

    Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
    End Type
    Last edited by علیم; 12-04-2006 at 23:27. دليل: غلط املایی

  5. #5
    آخر فروم باز WooKMaN's Avatar
    تاريخ عضويت
    Oct 2005
    محل سكونت
    Ķêŗmάņšĥąħ
    پست ها
    10,533

    پيش فرض

    مرسی علیم جان
    خدا یارت

Thread Information

Users Browsing this Thread

هم اکنون 1 کاربر در حال مشاهده این تاپیک میباشد. (0 کاربر عضو شده و 1 مهمان)

User Tag List

قوانين ايجاد تاپيک در انجمن

  • شما نمی توانید تاپیک ایحاد کنید
  • شما نمی توانید پاسخی ارسال کنید
  • شما نمی توانید فایل پیوست کنید
  • شما نمی توانید پاسخ خود را ویرایش کنید
  •