تم تحديث موضوع : [مشروع] سورس كود لعمل تبيه تنبيه / ترحيب باعلى الساعة النظام
تم اضافة تحديد لغة نظام الحاسب الالى
اذا كان يعمل باللغة العربية أم انه يعمل باللغة الاجنبية
تحياتى لك
وتمنياتى لك التوفيق
ولحل مشكلة الحفظ عند الاضافة او التعديل
فاليك كود الفورم كاملاً بعد التعديل على المشروع وتصحيح الاخطاء
فى شرط التحقق الكود كاملاً استبدله بالفورم لديك
كود :
Imports System.Data.OleDb
Imports System.IO
Imports System.Drawing.Imaging
Public Class FrmMotabah
Dim id As Integer
Sub show_record_data(x)
Dim sql As String = "SELECT Transactions.Tran_ID, Transactions.Tran_Num, Transactions.Tran_DateW, Managements.Manage_Name, Transactions.Tran_Subj, Transactions.Tran_Requ, Transactions.Tran_YesNo, Transactions.Tran_Dura, Transactions.Tran_StDa, Transactions.Tran_EnDa, Transactions.Tran_Case, Departments.Depart_Name, Transactions.Tran_Emp, Transactions.Tran_ProcEm, Transactions.Tran_ProcMd, Transactions.Tran_GvMd, Transactions.Tran_RecMd, Transactions.Tran_ImagW, Transactions.Tran_DaGvMm, Transactions.Tran_NumS, Transactions.Tran_DateS, Managements.Manage_Name, Transactions.Tran_ImagS, Transactions.Tran_Notes, Transactions.Tran_Update, Transactions.Tran_DDate, Transactions.Tran_DTime, Transactions.Tran_DUser, Transactions.Tran_DPC, Transactions.Tran_UserPC FROM Departments,Managements,Transactions where Managements.Manage_ID = Transactions.Tran_MangS AND Transactions.Tran_MangW AND Departments.Depart_ID = Transactions.Tran_IDdepart and Tran_Num='" & x & "'"
Dim Lda As New OleDbDataAdapter(sql, con)
Dim dtm As New DataTable
Lda.Fill(dtm)
If dtm.Rows.Count = 0 Then
MessageBox.Show("لم يتم إيجاد خطاب بهذا الرقم يرجى التأكد من الرقم الصحيح ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
Dim dr = dtm.Rows(0)
On Error Resume Next
id = dr(0)
txtTran_Num.Text = dr(1)
dtpTran_DateW.Value = dr(2)
cmbTran_MangW.Text = dr(3)
txtTran_Subj.Text = dr(4)
txtTran_Requ.Text = dr(5)
ckTran_YesNo.Checked = dr(6)
txtTran_Dura.Text = dr(7)
dtpTran_StDa.Value = dr(8)
dtpTran_EnDa.Value = dr(9)
cmbTran_Case.Text = dr(10)
cmbTran_IDdepart.Text = dr(11)
txtTran_Emp.Text = dr(12)
txtTran_ProcEm.Text = dr(13)
cmbTran_ProcMd.Text = dr(14)
dtpTran_GvMd.Value = dr(15)
dtpTran_RecMd.Value = dr(16)
'=======================================
If IsDBNull(dr(17) = False) Then
'اذا الصورة غير فارغة فك تشفيرها
Dim imgByteArray() As Byte
imgByteArray = CType(dr(17), Byte())
Dim strim As New MemoryStream(imgByteArray)
Dim bmp As New Bitmap(strim)
picTran_ImagW.Image = Image.FromStream(strim)
strim.Close()
Label30.Visible = False
End If
' جلب الصورة
'========================================
dtpTran_DaGvMm.Value = dr(18)
txtTran_NumS.Text = dr(19)
dtpTran_DateS.Value = dr(20)
cmbTran_MangS.Text = dr(21)
'========================================
If IsDBNull(dr(22) = False) Then
'اذا الصورة غير فارغة فك تشفيرها
Dim imgByteArray() As Byte
imgByteArray = CType(dr(22), Byte())
Dim strim As New MemoryStream(imgByteArray)
Dim bmp As New Bitmap(strim)
picTran_ImagS.Image = Image.FromStream(strim)
strim.Close()
Label31.Visible = False
End If
' جلب صورة الصادر
'========================================
txtTran_Notes.Text = dr(23)
txtTran_Update.Text = dr(24)
dtpTran_DDate.Value = dr(25)
dtpTran_DTime.Value = dr(26)
txtTran_DUser.Text = dr(27)
txtTran_DPC.Text = dr(28)
txtTran_UserPC.Text = dr(29)
'نقل البيانات من الجدول إلى الادوات
'==================================================
End If
picSave.Enabled = False
picEdit.Enabled = True
picDelete.Enabled = True
End Sub
Sub newMotabah()
txtTran_Num.Text = ""
dtpTran_DateW.Value = Now.Date
cmbTran_MangW.Text = ""
txtTran_Subj.Text = ""
txtTran_Requ.Text = ""
picTran_ImagW.Image = Nothing
ckTran_YesNo.Checked = False
cmbTran_Case.Text = ""
dtpTran_StDa.Value = Now.Date
txtTran_Dura.Text = ""
txtTran_Emp.Text = ""
txtTran_ProcEm.Text = ""
dtpTran_EnDa.Value = Now.Date
cmbTran_IDdepart.Text = ""
dtpTran_GvMd.Value = Now.Date
dtpTran_RecMd.Value = Now.Date
cmbTran_ProcMd.Text = ""
dtpTran_DaGvMm.Value = Now.Date
dtpTran_DateS.Value = Now.Date
txtTran_NumS.Text = ""
cmbTran_MangS.Text = ""
txtTran_Notes.Text = ""
txtTran_Update.Text = ""
picTran_ImagS.Image = Nothing
txtTran_DUser.Text = ""
dtpTran_DDate.Value = Now.Date
dtpTran_DTime.Value = Now
txtTran_DPC.Text = My.Computer.Name
txtTran_UserPC.Text = Environment.UserName
picSave.Enabled = True
picEdit.Enabled = False
picDelete.Enabled = False
Label31.Visible = True
Label30.Visible = True
End Sub
Private Sub FrmMotabah_Load(sender As Object, e As EventArgs) Handles MyBase.Load
LoadDepar()
cmbTran_IDdepart.DataSource = DeparDT
cmbTran_IDdepart.DisplayMember = "Depart_Name"
cmbTran_IDdepart.ValueMember = "Depart_ID"
'تحميل جدول الاقسام
'==========================================
LoadManagements()
cmbTran_MangW.DataSource = ManagDT
cmbTran_MangW.DisplayMember = "Manage_Name"
cmbTran_MangW.ValueMember = "Manage_ID"
'الادارات الوارده
'===============================================
Dim MDT As New DataTable
Dim MDA As New OleDbDataAdapter
MDT.Rows.Clear()
MDA = New OleDbDataAdapter("select * from Managements", con)
MDA.Fill(MDT)
cmbTran_MangS.DataSource = MDT
cmbTran_MangS.DisplayMember = "Manage_Name"
cmbTran_MangS.ValueMember = "Manage_ID"
'الادارات الصادرة
End Sub
Private Sub picSearch_Click(sender As Object, e As EventArgs) Handles picSearch.Click
FrmSearchMotabah.ShowDialog()
End Sub
Private Sub picSave_Click(sender As Object, e As EventArgs) Handles picSave.Click
'زر حفظ
If txtTran_Num.Text.Trim = "" Then
MessageBox.Show("يجب وضع رقم الوارد قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Num.Focus()
Exit Sub
'اذا رقم الوارد فارغ تظهر رسالة خطأ
End If
If cmbTran_MangW.Text.Trim = "" Then
MessageBox.Show("يجب وضع اسم الإدارة العامة قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
cmbTran_MangW.Focus()
Exit Sub
'اذا اسم لم يختار الإدارة تظهر رسالة خطأ
End If
If txtTran_Subj.Text.Trim = "" Then
MessageBox.Show("يجب وضع موضوع الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Num.Focus()
Exit Sub
'اذا لم يضع موضوع للخطاب تظهر رسالة خطأ
End If
If txtTran_Requ.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Requ.Focus()
Exit Sub
'اذا لم يكتب المطلوب من الخطاب تظهر رسالة خطأ
End If
If txtTran_Dura.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Dura.Focus()
Exit Sub
'اذا لم يكتب المدة المفترض انهاء العمل بها تظهر رسالة خطأ
End If
If cmbTran_IDdepart.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
cmbTran_IDdepart.Focus()
Exit Sub
'اذا لم يضع القسم تظهر رسالة خطأ
End If
If txtTran_Emp.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Emp.Focus()
Exit Sub
'اذا لم يضع الموظفين تظهر رسالة خطأ
End If
If txtTran_ProcEm.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_ProcEm.Focus()
Exit Sub
'اذا لم يضع الاجراء الذي قام به الموظف تظهر رسالة خطأ
End If
If cmbTran_ProcMd.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل الحفظ", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
cmbTran_ProcMd.Focus()
Exit Sub
'اذا لم يضع الاجراء الذي قام به المدير تظهر رسالة خطأ
End If
'========================================================================================
' Try
Dim dt As New DataTable
dt.Rows.Clear()
Dim sql As String = "select * from Transactions where Tran_Num= '" & txtTran_Num.Text & "'"
Dim da As New OleDbDataAdapter(sql, con)
da.Fill(dt)
If dt.Rows.Count > 0 Then
MessageBox.Show("الخطاب موجود مسبقاً", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
dt.Rows.Add()
Dim last As Integer = dt.Rows.Count - 1
dt.Rows(last).Item("Tran_Num") = txtTran_Num.Text
dt.Rows(last).Item("Tran_DateW") = dtpTran_DateW.Value
dt.Rows(last).Item("Tran_MangW") = cmbTran_MangW.SelectedValue()
dt.Rows(last).Item("Tran_Subj") = txtTran_Subj.Text
dt.Rows(last).Item("Tran_Requ") = txtTran_Requ.Text
dt.Rows(last).Item("Tran_YesNo") = ckTran_YesNo.Checked
dt.Rows(last).Item("Tran_Case") = cmbTran_Case.Text
dt.Rows(last).Item("Tran_StDa") = dtpTran_StDa.Value
dt.Rows(last).Item("Tran_Dura") = txtTran_Dura.Text
dt.Rows(last).Item("Tran_Emp") = txtTran_Emp.Text
dt.Rows(last).Item("Tran_ProcEm") = txtTran_ProcEm.Text
dt.Rows(last).Item("Tran_EnDa") = dtpTran_EnDa.Value
dt.Rows(last).Item("Tran_IDdepart") = cmbTran_IDdepart.SelectedValue()
dt.Rows(last).Item("Tran_GvMd") = dtpTran_GvMd.Value
dt.Rows(last).Item("Tran_RecMd") = dtpTran_RecMd.Value
dt.Rows(last).Item("Tran_ProcMd") = cmbTran_ProcMd.Text
dt.Rows(last).Item("Tran_DaGvMm") = dtpTran_DaGvMm.Value
dt.Rows(last).Item("Tran_DateS") = dtpTran_DateS.Value
dt.Rows(last).Item("Tran_NumS") = txtTran_NumS.Text
dt.Rows(last).Item("Tran_MangS") = cmbTran_MangS.SelectedValue
dt.Rows(last).Item("Tran_Notes") = txtTran_Notes.Text
dt.Rows(last).Item("Tran_Update") = txtTran_Update.Text
dt.Rows(last).Item("Tran_DUser") = txtTran_DUser.Text
dt.Rows(last).Item("Tran_DDate") = dtpTran_DDate.Value
dt.Rows(last).Item("Tran_DTime") = dtpTran_DTime.Value
dt.Rows(last).Item("Tran_DPC") = txtTran_DPC.Text
dt.Rows(last).Item("Tran_UserPC") = txtTran_UserPC.Text
If Not picTran_ImagW.Image Is Nothing Then
Dim imgByteArray() As Byte
Dim strim As New MemoryStream
picTran_ImagW.Image.Save(strim, ImageFormat.Jpeg)
imgByteArray = strim.ToArray
strim.Close()
dt.Rows(last).Item("Tran_ImagW") = imgByteArray
Label16.Visible = False
End If
'حفظ صورة الوارد
'==========================================
If Not picTran_ImagS.Image Is Nothing Then
Dim imgByteArray() As Byte
Dim strim As New MemoryStream
picTran_ImagS.Image.Save(strim, ImageFormat.Jpeg)
imgByteArray = strim.ToArray
strim.Close()
dt.Rows(last).Item("Tran_ImagS") = imgByteArray
Label16.Visible = False
End If
'حفظ صورة الصادر
'=======================================
Dim cmd As New OleDbCommandBuilder(da)
da.Update(dt)
dt.AcceptChanges()
newMotabah()
MessageBox.Show("تمت إضافة البيانات بكل نجاح", "الحفظ", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub txtTran_DUser_TextChanged(sender As Object, e As EventArgs) Handles txtTran_DUser.TextChanged
End Sub
Private Sub picCancel_Click(sender As Object, e As EventArgs) Handles picCancel.Click
newMotabah()
End Sub
Private Sub picTran_ImagW_Click(sender As Object, e As EventArgs) Handles picTran_ImagW.Click
'عند الضغط على مكان الصورة يتم اختيار الصورة وعرضها
OpenFileDialog1.FileName = ""
OpenFileDialog1.Filter = "Jpeg|*.Jpg|PNG|*.png|GIF|*.gif"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName = "" Then Exit Sub
Label30.Visible = False
picTran_ImagW.Image = Image.FromFile(OpenFileDialog1.FileName)
End Sub
Private Sub picTran_ImagS_Click(sender As Object, e As EventArgs) Handles picTran_ImagS.Click
'عند الضغط على مكان الصورة يتم اختيار الصورة وعرضها
OpenFileDialog1.FileName = ""
OpenFileDialog1.Filter = "Jpeg|*.Jpg|PNG|*.png|GIF|*.gif"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName = "" Then Exit Sub
Label31.Visible = False
picTran_ImagS.Image = Image.FromFile(OpenFileDialog1.FileName)
End Sub
Private Sub picEdit_Click(sender As Object, e As EventArgs) Handles picEdit.Click
'زر تعديل
If txtTran_Num.Text.Trim = "" Then
MessageBox.Show("يجب وضع رقم الوارد قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Num.Focus()
Exit Sub
'اذا رقم الوارد فارغ تظهر رسالة خطأ
End If
If cmbTran_MangW.Text.Trim = "" Then
MessageBox.Show("يجب وضع اسم الإدارة العامة قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
cmbTran_MangW.Focus()
Exit Sub
'اذا اسم لم يختار الإدارة تظهر رسالة خطأ
End If
If txtTran_Subj.Text.Trim = "" Then
MessageBox.Show("يجب وضع موضوع الخطاب قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Num.Focus()
Exit Sub
'اذا لم يضع موضوع للخطاب تظهر رسالة خطأ
End If
If txtTran_Requ.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المطلوب من الخطاب قبل العديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Requ.Focus()
Exit Sub
'اذا لم يكتب المطلوب من الخطاب تظهر رسالة خطأ
End If
If txtTran_Dura.Text.Trim = "" Then
MessageBox.Show("يجب كتابه المدة قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Dura.Focus()
Exit Sub
'اذا لم يكتب المدة المفترض انهاء العمل بها تظهر رسالة خطأ
End If
If cmbTran_IDdepart.Text.Trim = "" Then
MessageBox.Show("يجب كتابه القسم المطلوب قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
cmbTran_IDdepart.Focus()
Exit Sub
'اذا لم يضع القسم تظهر رسالة خطأ
End If
If txtTran_Emp.Text.Trim = "" Then
MessageBox.Show("يجب كتابه اسماء الموظفين قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_Emp.Focus()
Exit Sub
'اذا لم يضع الموظفين تظهر رسالة خطأ
End If
If txtTran_ProcEm.Text.Trim = "" Then
MessageBox.Show("يجب كتابه الإجراء قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
txtTran_ProcEm.Focus()
Exit Sub
'اذا لم يضع الاجراء الذي قام به الموظف تظهر رسالة خطأ
End If
If cmbTran_ProcMd.Text.Trim = "" Then
MessageBox.Show("يجب كتابه اجراء المدير قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
cmbTran_ProcMd.Focus()
Exit Sub
'اذا لم يضع الاجراء الذي قام به المدير تظهر رسالة خطأ
End If
'If picTran_ImagW Is Nothing Then
' MessageBox.Show("يجب وضع صورة قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
' Exit Sub
'End If
'If picTran_ImagS.Image Is Nothing Then
' MessageBox.Show("يجب وضع صورة قبل التعديل", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Information)
' Exit Sub
'End If
'========================================================================================
If MsgBox("سوف يتم حفظ هذه التعديلات , هل تريد الإستمرار", MsgBoxStyle.Question + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2, "رسالة") = Windows.Forms.DialogResult.No Then Exit Sub
' Try
Dim sql As String = "select * from Transactions where Tran_Num='" & txtTran_Num.Text & "'"
Dim da As New OleDbDataAdapter(sql, con)
Dim dt As New DataTable
dt.Rows.Clear()
da.Fill(dt)
If dt.Rows.Count = 0 Then
MessageBox.Show("لم يتم إيجاد سجل لخطاب بهذا الرقم يرجى التأكد من الرقم الصحيح", "تنبيه", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Dim dr = dt.Rows(0)
dr("Tran_Num") = txtTran_Num.Text
dr("Tran_DateW") = dtpTran_DateW.Value
dr("Tran_MangW") = cmbTran_MangW.SelectedValue
dr("Tran_Subj") = txtTran_Subj.Text
dr("Tran_Requ") = txtTran_Requ.Text
dr("Tran_YesNo") = ckTran_YesNo.Checked
dr("Tran_Dura") = txtTran_Dura.Text
dr("Tran_StDa") = dtpTran_StDa.Value
dr("Tran_EnDa") = dtpTran_EnDa.Value
dr("Tran_Case") = cmbTran_Case.Text
dr("Tran_IDdepart") = cmbTran_IDdepart.SelectedValue
dr("Tran_Emp") = txtTran_Emp.Text
dr("Tran_ProcEm") = txtTran_ProcEm.Text
dr("Tran_ProcMd") = cmbTran_ProcMd.Text
dr("Tran_GvMd") = dtpTran_GvMd.Value
dr("Tran_RecMd") = dtpTran_RecMd.Value
'==========================
If Not picTran_ImagW.Image Is Nothing Then
Dim imgByteArray() As Byte
Dim strim As New MemoryStream
picTran_ImagW.Image.Save(strim, ImageFormat.Jpeg)
imgByteArray = strim.ToArray
strim.Close()
dr("Tran_ImagW") = imgByteArray
Label30.Visible = False
End If
'======================
dr("Tran_DaGvMm") = dtpTran_DaGvMm.Value
dr("Tran_NumS") = txtTran_NumS.Text
dr("Tran_DateS") = dtpTran_DateS.Value
dr("Tran_MangS") = cmbTran_MangS.SelectedValue
'============================
If Not picTran_ImagS.Image Is Nothing Then
Dim imeByteArray1() As Byte
Dim strim2 As New MemoryStream
picTran_ImagS.Image.Save(strim2, ImageFormat.Jpeg)
imeByteArray1 = strim2.ToArray
strim2.Close()
dr("Tran_ImagS") = imeByteArray1
Label31.Visible = False
End If
'==============================
dr("Tran_Notes") = txtTran_Notes.Text
dr("Tran_Update") = txtTran_Update.Text
dr("Tran_DDate") = dtpTran_DDate.Value
dr("Tran_DTime") = dtpTran_DTime.Value
dr("Tran_DUser") = txtTran_DUser.Text
dr("Tran_DPC") = txtTran_DPC.Text
dr("Tran_UserPC") = txtTran_UserPC.Text
'==================================================================
Dim cmd As New OleDbCommandBuilder(da)
da.Update(dt)
newMotabah()
MessageBox.Show("تم تعديل البيانات بكل نجاح", "التعديل", MessageBoxButtons.OK, MessageBoxIcon.Information)
'Catch ex As Exception
' MessageBox.Show(ex.Message, "فشل في عملية التعديل", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
'End Try
'Catch ex As Exception
' MessageBox.Show(ex.Message, "فشل في عملية التعديل", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
'End Try
End Sub
End Class
تحياتى لك
وتمنياتى لك التوفيق
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله
▼ شرح كيفية عمل قاعدة بيانات تعمل على اكثر من جهاز على الشبكة الداخلية
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله
▼ شرح كيفية عمل قاعدة بيانات تعمل على اكثر من جهاز على الشبكة الداخلية