منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب > قسم لغة الفيجوال بيسك VB.NET > قسم اسئلة VB.NET > تغيير مكان حفظ الصورة من قاعدة البيانات إلى مجلد في مسار البرنامج
نسخة كاملة : تغيير مكان حفظ الصورة من قاعدة البيانات إلى مجلد في مسار البرنامج
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
الصفحات : 1 2 3 4

F.H.M

26-10-24, 07:37 PM
الأخوة الأعزاء 

السلام عليكم ورحمة الله وبركاته ،،،

عملت مشروع بالفيجوال بيسك وهو جاهز حالياً والصور بالمشروع تحفظ في قاعدة البيانات Access ولكن قاعدة البيانات محدودة بـ 2 قيقا فقط والصور راح تاخذ هذا الحجم بسرعة

فهل يمكن تغيير كود الحفظ في قاعدة البيانات إلى الحفظ في مجلد داخل مسار البرنامج

والكود الحالي هو 

Module
كود :
Public Sub ChoosePicture(Pbox As PictureBox)
   Dim a As New OpenFileDialog
   With a
       .AddExtension = True
       .CheckPathExists = True
       .CheckFileExists = True
       .Title = "Choose Image"
       .Filter = "Choose Image (*.PNG; *.JPG; *.GIF; *.JPEG)| *.PNG; *.JPG; *.GIF; *.JPEG | All Files (*.*)|*.*"
       If .ShowDialog = DialogResult.OK Then
           Pbox.Image = Image.FromFile(.FileName)
       End If
   End With
End Sub
Public Function DGVCurrentImageView(ByVal byt As Byte()) As Image
   Dim MS As New System.IO.MemoryStream()
   Dim drwing As Image = Nothing
   MS.Write(byt, 0, byt.Length)
   drwing = New Bitmap(MS)
   MS.Close()
   Return drwing
End Function

كود الحفظ
كود :
Public Sub Insert_Car_Arshef(ByVal ID As Long, ByVal Car_Doc As PictureBox)
   Dim Cmd As New OleDbCommand
   With Cmd
       .Connection = con
       .CommandType = CommandType.Text
       .CommandText = "Insert Into Car_Arshef ( ID,Car_Doc)values(@ID,@Car_Doc)"
       .Parameters.Clear()
       .Parameters.AddWithValue("@ID", OleDbType.Integer).Value = ID
              Dim ms As New MemoryStream()
       Dim bmpImage As New Bitmap(Car_Doc.Image)
       bmpImage.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
       Dim data As Byte() = ms.GetBuffer()
       Dim p As New OleDbParameter("@Car_Doc", OleDbType.Binary)
       p.Value = data
       .Parameters.Add(p)
   End With
   If con.State = 1 Then con.Close()
   con.Open()
   Cmd.ExecuteNonQuery()
   con.Close()
   MsgBox("تم إضافة السجل بنجاح", MsgBoxStyle.Information, "حفظ")
   Cmd = Nothing
End Sub

كود التعديل
كود :
Public Sub Update_Car_Arshef(ByVal Car_Doc As PictureBox, ByVal IDW As Long)
    Dim Cmd As New OleDbCommand
    With Cmd
        .Connection = con
        .CommandType = CommandType.Text
        .CommandText = "Update Car_Arshef Set Car_Doc = @Car_Doc Where ID = @ID"
        .Parameters.Clear()
              Dim ms As New MemoryStream()
        Dim bmpImage As New Bitmap(Car_Doc.Image)
        bmpImage.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
        Dim data As Byte() = ms.GetBuffer()
        Dim p As New OleDbParameter("@Car_Doc", OleDbType.LongVarBinary)
        p.Value = data
        .Parameters.Add(p)
        .Parameters.AddWithValue("@ID", OleDbType.Integer).Value = IDW
    End With
    If con.State = 1 Then con.Close()
    con.Open()
    Cmd.ExecuteNonQuery()
    con.Close()
    MsgBox("تم تعديل السجل بنجاح", MsgBoxStyle.Information, "تعديل")
    Cmd = Nothing
End Sub

أبو خالد الشكري

27-10-24, 09:22 AM
أولا ضع المكتبات التالية :
كود :
Imports System.IO
Imports System.Data.OleDb
Imports System.Drawing
Imports System.Windows.Forms



الآن قم باستبدال الأكواد السابقة إلى الأكواد التالية :

كود :
Public Sub Insert_Car_Arshef(ByVal ID As Long, ByVal Car_Doc As PictureBox)
       Dim folderPath As String = Application.StartupPath & "\Images\"
       If Not Directory.Exists(folderPath) Then
           Directory.CreateDirectory(folderPath)
       End If

       Dim imagePath As String = folderPath & ID.ToString() & ".jpg"

       Car_Doc.Image.Save(imagePath, System.Drawing.Imaging.ImageFormat.Jpeg)

       Dim Cmd As New OleDbCommand
       With Cmd
           .Connection = con
           .CommandType = CommandType.Text
           .CommandText = "Insert Into Car_Arshef (ID, Car_Doc) values(@ID, @Car_Doc)"
           .Parameters.Clear()
           .Parameters.AddWithValue("@ID", ID)
           .Parameters.AddWithValue("@Car_Doc", imagePath)
       End With

       If con.State = ConnectionState.Open Then con.Close()
       con.Open()
       Cmd.ExecuteNonQuery()
       con.Close()
       MsgBox("تم إضافة السجل بنجاح", MsgBoxStyle.Information, "حفظ")
   End Sub


كود :
Public Sub Update_Car_Arshef(ByVal Car_Doc As PictureBox, ByVal IDW As Long)
       Dim folderPath As String = Application.StartupPath & "\Images\"
       If Not Directory.Exists(folderPath) Then
           Directory.CreateDirectory(folderPath)
       End If

       Dim imagePath As String = folderPath & IDW.ToString() & ".jpg"

       Car_Doc.Image.Save(imagePath, System.Drawing.Imaging.ImageFormat.Jpeg)

       Dim Cmd As New OleDbCommand
       With Cmd
           .Connection = con
           .CommandType = CommandType.Text
           .CommandText = "Update Car_Arshef Set Car_Doc = @Car_Doc Where ID = @ID"
           .Parameters.Clear()
           .Parameters.AddWithValue("@Car_Doc", imagePath)
           .Parameters.AddWithValue("@ID", IDW)
       End With

       If con.State = ConnectionState.Open Then con.Close()
       con.Open()
       Cmd.ExecuteNonQuery()
       con.Close()
       MsgBox("تم تعديل السجل بنجاح", MsgBoxStyle.Information, "تعديل")
   End Sub


كود :
   Public Function DGVCurrentImageView(ByVal imagePath As String) As Image
       If File.Exists(imagePath) Then
           Return Image.FromFile(imagePath)
       Else
           Return Nothing
       End If
   End Function

F.H.M

27-10-24, 10:42 AM
الله يعطيك العافية أخي أبوخالد وجزاك الله خير في الدنيا والآخرة

الحفظ شغال 100% بدون مشاكل لكن التعديل يظهر لي هذا الخطأ

أبو خالد الشكري

27-10-24, 02:47 PM
اللهم آمين وإياكم أجمعين

أخي F.H.M جرب كود التعديل التالي :
وإن شاء الله سيشتغل .

كود :
  Public Sub Update_Car_Arshef(ByVal Car_Doc As PictureBox, ByVal IDW As Long)

       Try
           Dim folderPath As String = Path.Combine(Application.StartupPath, "Images")

           If Not Directory.Exists(folderPath) Then
               Directory.CreateDirectory(folderPath)
           End If

           Dim imagePath As String = Path.Combine(folderPath, IDW.ToString() & ".jpg")
           Car_Doc.Image.Save(imagePath, System.Drawing.Imaging.ImageFormat.Jpeg)

           Dim Cmd As New OleDbCommand
           With Cmd
               .Connection = con
               .CommandType = CommandType.Text
               .CommandText = "Update Car_Arshef Set Car_Doc = @Car_Doc Where ID = @ID"
               .Parameters.Clear()
               .Parameters.AddWithValue("@Car_Doc", imagePath)
               .Parameters.AddWithValue("@ID", IDW)
           End With

           If con.State = ConnectionState.Open Then con.Close()
           con.Open()
           Cmd.ExecuteNonQuery()
           con.Close()

           MsgBox("تم تعديل السجل بنجاح", MsgBoxStyle.Information, "تعديل")

       Catch ex As Exception
           MsgBox("حدث خطأ أثناء محاولة تعديل الصورة" & ex.Message, MsgBoxStyle.Critical)
       End Try
   End Sub

F.H.M

27-10-24, 03:02 PM
الله يحفظك أخ بوخالد

خطأ عند الضغط على زر التعديل

أبو خالد الشكري

27-10-24, 03:18 PM
سبحان الله


طيب جرب هذا الكود
كود :
Public Sub Update_Car_Arshef(ByVal Car_Doc As PictureBox, ByVal IDW As Long)

       Try
           Dim folderPath As String = Path.Combine(Application.StartupPath, "Images")

           If Not Directory.Exists(folderPath) Then
               Directory.CreateDirectory(folderPath)
           End If

           Dim imagePath As String = Path.Combine(folderPath, IDW.ToString() & ".jpg")

           If File.Exists(imagePath) Then
               File.Delete(imagePath)
           End If

           Dim bmpCopy As New Bitmap(Car_Doc.Image)
           bmpCopy.Save(imagePath, System.Drawing.Imaging.ImageFormat.Jpeg)
           bmpCopy.Dispose()

           Dim Cmd As New OleDbCommand
           With Cmd
               .Connection = con
               .CommandType = CommandType.Text
               .CommandText = "Update Car_Arshef Set Car_Doc = @Car_Doc Where ID = @ID"
               .Parameters.Clear()
               .Parameters.AddWithValue("@Car_Doc", imagePath)
               .Parameters.AddWithValue("@ID", IDW)
           End With

           If con.State = ConnectionState.Open Then con.Close()
           con.Open()
           Cmd.ExecuteNonQuery()
           con.Close()

           MsgBox("تم تعديل الصورة بنجاح", MsgBoxStyle.Information, "تعديل")
       Catch ex As Exception
           MsgBox("حدث خطأ أثناء محاولة تعديل الصورة" & ex.Message, MsgBoxStyle.Critical)
       End Try

   End Sub

F.H.M

27-10-24, 03:54 PM
الآن يقول الخطأ بأن الصورة مستخدمة من قبل برنامج آخر

أبو خالد الشكري

27-10-24, 04:04 PM
طيب جرب هذا الكود

كود :
Public Sub Update_Car_Arshef(ByVal Car_Doc As PictureBox, ByVal IDW As Long)

       Try
           Dim folderPath As String = Path.Combine(Application.StartupPath, "Images")

           If Not Directory.Exists(folderPath) Then
               Directory.CreateDirectory(folderPath)
           End If

           Dim imagePath As String = Path.Combine(folderPath, IDW.ToString() & ".jpg")

           If File.Exists(imagePath) Then
               File.Delete(imagePath)
           End If

           Dim bmpCopy As New Bitmap(Car_Doc.Image)
           Car_Doc.Image = Nothing

           bmpCopy.Save(imagePath, System.Drawing.Imaging.ImageFormat.Jpeg)
           bmpCopy.Dispose()

           Dim Cmd As New OleDbCommand
           With Cmd
               .Connection = con
               .CommandType = CommandType.Text
               .CommandText = "Update Car_Arshef Set Car_Doc = @Car_Doc Where ID = @ID"
               .Parameters.Clear()
               .Parameters.AddWithValue("@Car_Doc", imagePath)
               .Parameters.AddWithValue("@ID", IDW)
           End With

           If con.State = ConnectionState.Open Then con.Close()
           con.Open()
           Cmd.ExecuteNonQuery()
           con.Close()

           MsgBox("تم تعديل السجل بنجاح", MsgBoxStyle.Information, "تعديل")
       Catch ex As Exception
           MsgBox("حدث خطأ أثناء محاولة تعديل الصورة" & ex.Message, MsgBoxStyle.Critical)
       End Try
   End Sub

F.H.M

27-10-24, 04:21 PM
أتعبتك معي بوخالد عسى الله يعطيك الصحة والعافية

نفس الرسالة السابقة الصورة مستخدمة من قبل برنامج آخر

أبو خالد الشكري

27-10-24, 04:27 PM
قد تكون الصورة قيد الاستخدام
جرب هذا الكود أيضا عسى يشتغل إن شاء الله
كود :
Public Sub Update_Car_Arshef(ByVal Car_Doc As PictureBox, ByVal IDW As Long)
       Try

           Dim folderPath As String = Path.Combine(Application.StartupPath, "Images")

           If Not Directory.Exists(folderPath) Then
               Directory.CreateDirectory(folderPath)
           End If

           Dim imagePath As String = Path.Combine(folderPath, IDW.ToString() & ".jpg")

           If File.Exists(imagePath) Then
               File.Delete(imagePath)
           End If

           Using bmpCopy As New Bitmap(Car_Doc.Image)
               bmpCopy.Save(imagePath, System.Drawing.Imaging.ImageFormat.Jpeg)
           End Using

           Dim Cmd As New OleDbCommand
           With Cmd
               .Connection = con
               .CommandType = CommandType.Text
               .CommandText = "Update Car_Arshef Set Car_Doc = @Car_Doc Where ID = @ID"
               .Parameters.Clear()
               .Parameters.AddWithValue("@Car_Doc", imagePath)
               .Parameters.AddWithValue("@ID", IDW)
           End With

           If con.State = ConnectionState.Open Then con.Close()
           con.Open()
           Cmd.ExecuteNonQuery()
           con.Close()

           MsgBox("تم تعديل السجل بنجاح", MsgBoxStyle.Information, "تعديل")
       Catch ex As Exception
           MsgBox("حدث خطأ أثناء محاولة تعديل الصورة: " & ex.Message, MsgBoxStyle.Critical)
       End Try
   End Sub
الصفحات : 1 2 3 4
منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب > قسم لغة الفيجوال بيسك VB.NET > قسم اسئلة VB.NET > تغيير مكان حفظ الصورة من قاعدة البيانات إلى مجلد في مسار البرنامج