مساعدة في حفظ الصورة - alshandodi - 10-11-19
السلام عليكم اخواني هل يمكن مساعدتي في حفظ الصورة بحجم صغير بطريقة الإستاذ @viv
بدلا من
كود :
IO.File.Copy(lblemppic.Text, "EMPimg\" & TxtIDcard.Text & ".jpg")
http://vb4arb.com/vb/showthread.php?tid=24916
RE: مساعدة في حفظ الصورة - AbdoDabak - 10-11-19
كيف يعني اخي
قم بتحميل المشروع واستخدمه
RE: مساعدة في حفظ الصورة - alshandodi - 10-11-19
(10-11-19, 11:55 AM)AbdoDabak كتب : كيف يعني اخي
قم بتحميل المشروع واستخدمه
يمكنني تحميل المشروع ولكن اخي كل مره اضيف صور لازم اعمل اعاده تحجيم لملف الصوره والقصد منه انه حفظ صوره بحجم مصغر
RE: مساعدة في حفظ الصورة - alshandodi - 11-11-19
اين الردود بارك الله فيكم
RE: مساعدة في حفظ الصورة - 3booody - 11-11-19
السلام عليكم وحمة الله وبركاته
اذا تقصد حفظ صورة بحجم صغير ... ممكن تستخدم هذا الكود
كود :
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("مسار الصورة المصغرة")
RE: مساعدة في حفظ الصورة - علي نوري - 11-11-19
السلام عليكم
حفظ الصورة بأستخدام 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
RE: مساعدة في حفظ الصورة - alshandodi - 11-11-19
شكرا جزيلا اخي 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]
على الطريقه الاخرى ولكن انا محتاج حفظه في المجلد الذي احدده وليس ما يحدده الشخص
RE: مساعدة في حفظ الصورة - asemshahen5 - 12-11-19
غيير 120 الى الحجم الذي يناسبك فواحدة Width = العرض و Height = الارتفاع .
[attachment=23406]
RE: مساعدة في حفظ الصورة - viv - 21-12-19
اضافات للافادة
جرب هذا
كود :
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
RE: مساعدة في حفظ الصورة - alshandodi - 26-01-20
كود :
#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
لقد حاولت العمل بهذا الكود ولكن من دون فائده فلم افهمه جيدا
|