تغییر سایز عکس

[mmssoft]

سلام
من به سورسی نیاز دارم که بشه باهاش سایز عکس رو کوچک کرد. یعنی یه عکس که تو PictureBox یا ImageBox هست، سایزش کوچیک بشه و بعد بتونیم تو یه مسیری ذخیرش کنیم. قصد از این کار هم فقط کم کردن حجم عکس هست
آیا به غیر از تغییر سایز روشی دیگه ای هم برای این کار وجود داره؟؟

ممنون میشم راهنمایی کنید

[miladatashin]

سلام
من به سورسی نیاز دارم که بشه باهاش سایز عکس رو کوچک کرد. یعنی یه عکس که تو PictureBox یا ImageBox هست، سایزش کوچیک بشه و بعد بتونیم تو یه مسیری ذخیرش کنیم. قصد از این کار هم فقط کم کردن حجم عکس هست
آیا به غیر از تغییر سایز روشی دیگه ای هم برای این کار وجود داره؟؟

ممنون میشم راهنمایی کنید

بله. فقط تغییر سایز باعث کم حجم شدن تصویر نمیشه. در تصاویر با فرمت gif با کم کردن رنگ های تصویر (از 2 تا 256) و تصاویر jpg با کم کردن Quality تصویر میشه حجم عکس رو کم کرد. اگه میخواهید با کد نویسی حجم تصاویر رو کم کنید باید الگوریتم های ذخیره قالب های مختلف تصویر رو بشناسید و گرنه بهتره از کامپوننت ها استفاده کنید

[m.4.r.m]

Private Sub Command1_Click()
Dim file_name As String

' Resize the picture.
Picture2.AutoRedraw = True
Picture2.PaintPicture Picture1.Picture, _
Picture2.ScaleLeft, Picture2.ScaleTop, Picture2.ScaleWidth, Picture2.ScaleHeight, _
Picture1.ScaleLeft, Picture1.ScaleTop, Picture1.ScaleWidth, Picture1.ScaleHeight
Picture2.Picture = Picture2.Image

' Save the result.
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
SavePicture Picture2.Picture, file_name & "small.bmp"
End Sub


Private Sub Form_Load()
Dim edge As Single

edge = Picture1.Width - Picture1.ScaleWidth
Picture2.Width = (Picture1.Width - edge) / 2 + edge
Picture2.Height = (Picture1.Height - edge) / 2 + edge
Me.Width = Picture2.Left + Picture2.Width + 240
End Sub

[mmssoft]

مرسی. خیلی عالی بود
راه دیگه ای هم برای کاهش حجم وجود داره؟؟

[m.4.r.m]

بله وجود داره باید بری تو Compress کردن کار کنی مثله برنامه های winrar و... که تقریبا خیلی سخته

[miladatashin]

بله وجود داره باید بری تو Compress کردن کار کنی مثله برنامه های winrar و... که تقریبا خیلی سخته
فکر نمیکنم با الگوریتم های فشرده سازی که شما میفرمایید بشه (البته میشه ولی خوب دوباره باید موقع استفاده دیکد بشه که عملا غیر قابل استفادست) من یک مقدار به صورت تئوری در مورد کاهش حجم تصاویر مطالعه داشتم . همونجوری که گفتم تصاویر gif واسه فشرده سازی تعداد رنگ های تصویر رو کم میکنه که خوب مشخصا برای ذخیره تصاویر با رنگ کم میشه تا حد قابل توجهی از حجم عکس رو گرفت چون واسه هر رنگ بیت کمتری لازم میشه . دوستانی که روش هافمن رو بشناسن میفهمن چرا
در تصاویر jpg هم بازه رنگ هاست که با بیشتر شدن حجم کمتری میگیره و این کار باعث افت کیفیت در لبه ها میشه (لبه منظور قسمتی از تصویر هست که رنگ عوض میشه). به هر حال الگوریتم های هر دو فرمت رو تو نت میتونید پیدا کنید

[m.4.r.m]

اینو تست کن برای کاهش حجم تصویر

' Add VICDEF32.BAS to your project
Public Function enlarge_or_reduce(ByRef image1 As imgdes) As Long
Dim timage As imgdes
Dim dx As Integer
Dim dy As Integer
Dim rcode As Integer
Dim pct As Integer
Dim bmh1 As BITMAPINFOHEADER

pct = 83 '83% percent of original size

' Calculate the width and length of the new image
dx = (image1.endx - image1.stx + 1) * pct / 100
dy = (image1.endy - image1.sty + 1) * pct / 100

' Get the bitmapinfoheader data for the image, contains the pixel depth as biBitCount
getbmhfromimage bmh1, image1 ' gethmhfromimage is below

' Allocate space for the new image
rcode = allocimage(timage, dx, dy, bmh1.biBitCount)

If (rcode = NO_ERROR) Then
rcode = resizeex(image1, timage, 1)
If (rcode = NO_ERROR) Then
freeimage image1
copyimgdes timage, image1
Else
freeimage timage
End If

End If
enlarge_or_reduce = rcode
End Function


' Function Declarations for Helper Function ...........................................

Declare Sub RtlMoveMemory Lib "kernel32" (ByVal des As Long, ByVal src As Long, ByVal cnt As Long)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (des As Any, ByVal src As Long, ByVal cnt As Long)


' Helper Function ...........................................
' Get BITMAPINFOHEADER from an image descriptor
Public Sub getbmhfromimage(newBmh As BITMAPINFOHEADER, image As imgdes)
CopyMemory newBmh, image.bmh, 40 ' 40=size of BITMAPINFOHEADER
End Sub


ماژول رو هم دانلود کن به برنامه اضافه کن

[mmssoft]

دوست عزیز لطفا روش استفاده از این ماژول رو هم بنویسید (مثال)
مرسی

[mmssoft]

دوست عزیز لطفا روش استفاده از این ماژول رو هم بنویسید (مثال)
؟؟؟