المشاركات : 285
المواضيع 63
الإنتساب : Sep 2018
السمعة :
32
الشكر: 485
تم شكره 456 مرات في 198 مشاركات
السلام عليكم اخواني هل يمكن مساعدتي في حفظ الصورة بحجم صغير بطريقة الإستاذ @viv
بدلا من
كود :
IO.File.Copy(lblemppic.Text, "EMPimg\" & TxtIDcard.Text & ".jpg")
http://vb4arb.com/vb/showthread.php?tid=24916
المشاركات : 136
المواضيع 24
الإنتساب : Sep 2019
السمعة :
1
الشكر: 122
تم شكره 131 مرات في 73 مشاركات
كيف يعني اخي
قم بتحميل المشروع واستخدمه
المشاركات : 285
المواضيع 63
الإنتساب : Sep 2018
السمعة :
32
الشكر: 485
تم شكره 456 مرات في 198 مشاركات
(10-11-19, 11:55 AM)AbdoDabak كتب : كيف يعني اخي
قم بتحميل المشروع واستخدمه
يمكنني تحميل المشروع ولكن اخي كل مره اضيف صور لازم اعمل اعاده تحجيم لملف الصوره والقصد منه انه حفظ صوره بحجم مصغر
المشاركات : 285
المواضيع 63
الإنتساب : Sep 2018
السمعة :
32
الشكر: 485
تم شكره 456 مرات في 198 مشاركات
اين الردود بارك الله فيكم
المشاركات : 664
المواضيع 32
الإنتساب : Oct 2013
السمعة :
81
الشكر: 776
تم شكره 992 مرات في 298 مشاركات
السلام عليكم وحمة الله وبركاته
اذا تقصد حفظ صورة بحجم صغير ... ممكن تستخدم هذا الكود
كود :
Dim bit As New Bitmap("المسار للصورة") 'الصورة الاصلية
Dim bit2 As New Bitmap(120, 120) 'الصورة بأختيار الحجم الجديد
Dim gr As Graphics = Graphics.FromImage(bit2)
gr.DrawImage(bit, 0, 0, 120, 120)
bit2.Save("مسار الصورة المصغرة")
المشاركات : 25
المواضيع 1
الإنتساب : Oct 2015
السمعة :
12
الشكر: 91
تم شكره 71 مرات في 26 مشاركات
السلام عليكم
حفظ الصورة بأستخدام SaveFileDialog
كود :
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim SaveFileDialog1 As New SaveFileDialog()
SaveFileDialog1.Filter = _
"Image files (*.BMP, *.JPG, *.GIF)|*.bmp;*.jpg;*.gif"
If SaveFileDialog1.ShowDialog() = DialogResult.OK Then
PictureBox1.Image.Save(SaveFileDialog1.FileName)
End If
End Sub
طريقة اخرى للحفظ باستخدام SaveFileDialog (من احد امثلة الاخ ramilove)
كود :
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Try
' تصدير الصورة
If PictureBox1.Image Is Nothing Then
MsgBox("الصورة غير موجودة ", 16 + 524288, "تنبيه")
Exit Sub
End If
Application.DoEvents()
Dim s As New SaveFileDialog
s.Filter = "Files(*.jpg)|*.jpg"
s.Title = "تصدير صورة"
s.FileName = ""
If s.ShowDialog = System.Windows.Forms.DialogResult.OK Then
'تصير الصورة من بكشر بوكس
Dim bm As New Bitmap(PictureBox1.Image)
bm.Save(s.FileName, System.Drawing.Imaging.ImageFormat.Jpeg)
MsgBox("تم تصدير الصورة بنجاح", MsgBoxStyle.MsgBoxRight + MsgBoxStyle.Information, "تصدير صورة موظف")
s.Dispose()
End If
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
المشاركات : 285
المواضيع 63
الإنتساب : Sep 2018
السمعة :
32
الشكر: 485
تم شكره 456 مرات في 198 مشاركات
11-11-19, 08:36 PM
(آخر تعديل لهذه المشاركة : 11-11-19, 08:58 PM {2} بواسطة alshandodi.)
شكرا جزيلا اخي 3booody
لقد قمت بعمل بالكود الخاص بك واكرر شكري نجح الكود
ولكن هنالك مشكله الا وهي انه حجم الصورة صغير
هذا هو الكود
كود :
Dim bit As New Bitmap(lABEL1.Text) 'الصورة الاصلية
Dim bit2 As New Bitmap(120, 120) 'الصورة بأختيار الحجم الجديد
Dim gr As Graphics = Graphics.FromImage(bit2)
gr.DrawImage(bit, 0, 0, 120, 120)
bit2.Save("Empimg\" & LBL_NAME.Text & ".jpg")
وأشكر اخي [b][b]علي نوري[/b][/b]
على الطريقه الاخرى ولكن انا محتاج حفظه في المجلد الذي احدده وليس ما يحدده الشخص
المشاركات : 2,329
المواضيع 81
الإنتساب : May 2018
السمعة :
522
الشكر: 14039
تم شكره 5671 مرات في 2269 مشاركات
12-11-19, 07:13 AM
(آخر تعديل لهذه المشاركة : 12-11-19, 07:17 AM {2} بواسطة asemshahen5.)
غيير 120 الى الحجم الذي يناسبك فواحدة Width = العرض و Height = الارتفاع .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
المشاركات : 752
المواضيع 239
الإنتساب : May 2018
السمعة :
209
الشكر: 765
تم شكره 2214 مرات في 752 مشاركات
21-12-19, 12:26 PM
(آخر تعديل لهذه المشاركة : 21-12-19, 12:29 PM {2} بواسطة viv.)
اضافات للافادة
جرب هذا
كود :
Private Sub btnScale_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnScale.Click
' Get the scale factor.
Dim scale_factor As Single = Single.Parse(txtScale.Text)
' Get the source bitmap.
Dim bm_source As New Bitmap(picSource.Image)
' Make a bitmap for the result.
Dim bm_dest As New Bitmap( _
CInt(bm_source.Width * scale_factor), _
CInt(bm_source.Height * scale_factor))
' Make a Graphics object for the result Bitmap.
Dim gr_dest As Graphics = Graphics.FromImage(bm_dest)
' Copy the source image into the destination bitmap.
gr_dest.DrawImage(bm_source, 0, 0, _
bm_dest.Width + 1, _
bm_dest.Height + 1)
' Display the result.
picDest.Image = bm_dest
End Sub
او هذا
كود :
Public Shared Function ResizeImage(ByVal InputImage As Image) As Image
Return New Bitmap(InputImage, New Size(64, 64))
End Function
او هذا
كود :
Dim source As New Bitmap("C:\image.png")
Dim target As New Bitmap(size.Width, size.Height, PixelFormat.Format24bppRgb)
Using graphics As Graphics = Graphics.FromImage(target)
graphics.DrawImage(source, new Size(48, 48))
End Using
هذا ربما يكون الافضل من بينها
كود :
#Region " ResizeImage "
Public Overloads Shared Function ResizeImage(SourceImage As Drawing.Image, TargetWidth As Int32, TargetHeight As Int32) As Drawing.Bitmap
Dim bmSource = New Drawing.Bitmap(SourceImage)
Return ResizeImage(bmSource, TargetWidth, TargetHeight)
End Function
Public Overloads Shared Function ResizeImage(bmSource As Drawing.Bitmap, TargetWidth As Int32, TargetHeight As Int32) As Drawing.Bitmap
Dim bmDest As New Drawing.Bitmap(TargetWidth, TargetHeight, Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim nSourceAspectRatio = bmSource.Width / bmSource.Height
Dim nDestAspectRatio = bmDest.Width / bmDest.Height
Dim NewX = 0
Dim NewY = 0
Dim NewWidth = bmDest.Width
Dim NewHeight = bmDest.Height
If nDestAspectRatio = nSourceAspectRatio Then
'same ratio
ElseIf nDestAspectRatio > nSourceAspectRatio Then
'Source is taller
NewWidth = Convert.ToInt32(Math.Floor(nSourceAspectRatio * NewHeight))
NewX = Convert.ToInt32(Math.Floor((bmDest.Width - NewWidth) / 2))
Else
'Source is wider
NewHeight = Convert.ToInt32(Math.Floor((1 / nSourceAspectRatio) * NewWidth))
NewY = Convert.ToInt32(Math.Floor((bmDest.Height - NewHeight) / 2))
End If
Using grDest = Drawing.Graphics.FromImage(bmDest)
With grDest
.CompositingQuality = Drawing.Drawing2D.CompositingQuality.HighQuality
.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
.PixelOffsetMode = Drawing.Drawing2D.PixelOffsetMode.HighQuality
.SmoothingMode = Drawing.Drawing2D.SmoothingMode.AntiAlias
.CompositingMode = Drawing.Drawing2D.CompositingMode.SourceOver
.DrawImage(bmSource, NewX, NewY, NewWidth, NewHeight)
End With
End Using
Return bmDest
End Function
#End Region
المشاركات : 285
المواضيع 63
الإنتساب : Sep 2018
السمعة :
32
الشكر: 485
تم شكره 456 مرات في 198 مشاركات
كود :
#Region " ResizeImage "
Public Overloads Shared Function ResizeImage(SourceImage As Drawing.Image, TargetWidth As Int32, TargetHeight As Int32) As Drawing.Bitmap
Dim bmSource = New Drawing.Bitmap(SourceImage)
Return ResizeImage(bmSource, TargetWidth, TargetHeight)
End Function
Public Overloads Shared Function ResizeImage(bmSource As Drawing.Bitmap, TargetWidth As Int32, TargetHeight As Int32) As Drawing.Bitmap
Dim bmDest As New Drawing.Bitmap(TargetWidth, TargetHeight, Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim nSourceAspectRatio = bmSource.Width / bmSource.Height
Dim nDestAspectRatio = bmDest.Width / bmDest.Height
Dim NewX = 0
Dim NewY = 0
Dim NewWidth = bmDest.Width
Dim NewHeight = bmDest.Height
If nDestAspectRatio = nSourceAspectRatio Then
'same ratio
ElseIf nDestAspectRatio > nSourceAspectRatio Then
'Source is taller
NewWidth = Convert.ToInt32(Math.Floor(nSourceAspectRatio * NewHeight))
NewX = Convert.ToInt32(Math.Floor((bmDest.Width - NewWidth) / 2))
Else
'Source is wider
NewHeight = Convert.ToInt32(Math.Floor((1 / nSourceAspectRatio) * NewWidth))
NewY = Convert.ToInt32(Math.Floor((bmDest.Height - NewHeight) / 2))
End If
Using grDest = Drawing.Graphics.FromImage(bmDest)
With grDest
.CompositingQuality = Drawing.Drawing2D.CompositingQuality.HighQuality
.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
.PixelOffsetMode = Drawing.Drawing2D.PixelOffsetMode.HighQuality
.SmoothingMode = Drawing.Drawing2D.SmoothingMode.AntiAlias
.CompositingMode = Drawing.Drawing2D.CompositingMode.SourceOver
.DrawImage(bmSource, NewX, NewY, NewWidth, NewHeight)
End With
End Using
Return bmDest
End Function
#End Region
استاذي العزيز viv
لقد حاولت العمل بهذا الكود ولكن من دون فائده فلم افهمه جيدا
|