تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مساعدة في حفظ الصورة
#1
السلام عليكم اخواني هل يمكن مساعدتي في حفظ الصورة بحجم صغير بطريقة الإستاذ @viv

بدلا من 

كود :
                   IO.File.Copy(lblemppic.Text, "EMPimg\" & TxtIDcard.Text & ".jpg")

http://vb4arb.com/vb/showthread.php?tid=24916
الرد
تم الشكر بواسطة:
#2
كيف يعني اخي
قم بتحميل المشروع واستخدمه
الرد
تم الشكر بواسطة: alshandodi
#3
(10-11-19, 11:55 AM)AbdoDabak كتب : كيف يعني اخي
قم بتحميل المشروع واستخدمه

يمكنني تحميل المشروع ولكن اخي كل مره اضيف صور لازم اعمل اعاده تحجيم لملف الصوره والقصد منه انه حفظ صوره بحجم مصغر
الرد
تم الشكر بواسطة:
#4
اين الردود بارك الله فيكم
الرد
تم الشكر بواسطة:
#5
السلام عليكم وحمة الله وبركاته

اذا تقصد حفظ صورة بحجم صغير ...  ممكن تستخدم هذا الكود



كود :
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("مسار الصورة المصغرة")
الرد
#6
السلام عليكم

حفظ الصورة بأستخدام 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
الرد
#7
شكرا جزيلا اخي 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]

على الطريقه الاخرى ولكن انا محتاج حفظه في المجلد الذي احدده وليس ما يحدده الشخص
الرد
تم الشكر بواسطة: علي نوري , علي نوري
#8
غيير 120 الى الحجم الذي يناسبك فواحدة Width = العرض و Height = الارتفاع .

   
الرد
#9
اضافات للافادة
جرب هذا

كود :
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
الرد
تم الشكر بواسطة: asemshahen5 , ابراهيم ايبو , alshandodi
#10
كود :
#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 
لقد حاولت العمل بهذا الكود ولكن من دون فائده فلم افهمه جيدا
الرد
تم الشكر بواسطة:



التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم