تبدیل انواع فرمت عکس

[unit001]

سلام.

خسته نباشید.

می خواستم یه کمکی در مورد تبدیل عکس ها با وی بی به من بکنید. (با کد با اکتیو ایکس یا dll)

یه چیز دیگه اینکه اگه امکان داره قابلیت تبدیل فرمت هایی نظیر gif jpg bmp png رو داشته باشه.

با تشکر.

[IamOverlord]

سلام دوست عزیز!
این برنامه ای رو که نوشتم یه نگاهی بنداز... خیلی ساده نوشته شده...:خجالت: خودت می تونی کاملش کنی... ضمنا از فرمت PNG پشتیبانی نمی کنه...:اشتباه:

[aryasoft2872]

مثال بالا فقط به طور اسمی پسوند رو تغییر میده گه می خواید خواصش به طور کامل تغییر کنه باید از کدهای پیچیده تر استفاده کنید
برای مثال این خطوط bmp رو به jpg تبدیل می کنه:

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

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
'end declarations
'the sub

Public Sub BMPtoJPG(Thebmp As String, Thejpg As String)

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 = Thebmp
jpg_fname = Thejpg
quality = 75
' Get info on the file we're to load
rcode = bmpinfo(bmp_fname, bdat)

If (rcode <> NO_ERROR) Then
MsgBox "Cannot find file", 0, "Error encountered!"
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 "Not enough memory", 0, "Error encountered!"
Exit Sub
End If

' Load image
rcode = loadbmp(bmp_fname, tmpimage)

If (rcode <> NO_ERROR) Then
freeimage tmpimage ' Free image On Error
MsgBox "Cannot load file", 0, "Error encountered!"
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 grays

' cale 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
End Sub


< html>