عملت مشروع بالفيجوال بيسك وهو جاهز حالياً والصور بالمشروع تحفظ في قاعدة البيانات 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
الآن قم باستبدال الأكواد السابقة إلى الأكواد التالية :
كود :
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"
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"
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 جرب كود التعديل التالي :
وإن شاء الله سيشتغل .
كود :
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()
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
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
قد تكون الصورة قيد الاستخدام
جرب هذا الكود أيضا عسى يشتغل إن شاء الله
كود :
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
