مــســاعدة في الفيجوال بيسك يا شباب لو سمحتوا... عاجل !!!

[بـــدر]

السلام عليكم شباب..
لو ممكن بس الكود لأي مشروع تم عمله بواسطة الفيجوال بيسك..
و اللي يتكرم علينا, بس لو يحط شرح بسيط ويش يسوي البرنامج..

مشكوووورين..

[بـــدر]

وينكم يا شباب..

:confused:

[oman001]

أخي بدر هذه بعض المواقع الفيجوال بيسك


وهذا الموقع ممكن تنزل منه مشاريع جاهزة :
http://www.planetsourcecode.com


وهذا منتدى جامعة أهلا عرب "الموقع عماني 100%" وسوف تحصل كل ما تريد في الفيجوال بيسك

وصلة الموقع
www.uni.hiarab.net

وهذه وصلة منتدى الفيجوال بيسك بموقع جامعة أهلا عرب
http://uni.hiarab.net/forumdisplay.php?f=43


أخيك : *****01

[ابوعبيده]

==================form1
Dim falag As Integer

Dim d As Integer




Private Sub cmdmb_Click()
Dim X
rec.MovePrevious

If rec.BOF Then
X = MsgBox(" You Are Already At the First File", vbExclamation + vbOKOnly)
rec.MoveFirst
End If
Call adddata
End Sub

Private Sub cmdmovf_Click()
rec.MoveNext
If rec.EOF Then
MsgBox (" Last File Encountered")
rec.MoveFirst
cmdrtn.SetFocus
End If
Call adddata
End Sub

Private Sub CMDNEW_Click()
Call clear
Text1.Text = BK(0)
Call lockdata
Text2.SetFocus
cmdsave.Visible = True
End Sub


Private Sub cmdrtn_Click()
FRMMAIN.Show
Unload Me
End Sub




Private Sub CMDSAVE_Click()
rec.AddNew
Call getdata
rec.Update
Call clear
Text1.SetFocus
BK.Edit
BK(0) = BK(0) + 1
BK.Update
cmdsave.Visible = False
Call invisble
End Sub

Private Sub cmdsrh_Click()
FRMBD.Visible = False
FRMSRH.Visible = True
End Sub





Private Sub Command3_Click()

End Sub



Private Sub Command4_Click()

End Sub





Public Function getdata()
rec(0) = Val(Text1.Text)
rec(1) = UCase(Text2.Text)
rec(5) = UCase(Text3.Text)
rec(2) = UCase(Text4.Text)
rec(4) = Val(Text5.Text)
rec(3) = UCase(Text6.Text)
rec(6) = UCase(Text7.Text)
End Function








Private Sub Form_Load()
Call invisble
Text8.Text = Format(Date, "dd/mmmm/yyyy")
Text9.Text = Time()
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If Not IsNumeric(Text1.Text) Then
MsgBox " Enter Book No "
Text1.Text = ""
Text1.SetFocus
Else
cmdnew.Enabled = False
Text2.SetFocus
End If
End If
End Sub



Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If IsNumeric(Text2.Text) Or Text2.Text = "" Then
MsgBox "ENTER THE BOOK NAME", vbExclamation, "INFORM"
Text2.Text = ""
Text2.SetFocus
Else
Text3.SetFocus
End If
End If
'end If
End Sub

Private Sub Text3_KEYPRESS(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If IsNumeric(Text5.Text) Or Text3.Text = "" Then
MsgBox "Enter The Author Name", vbCritical + vbOKOnly
Text3.SetFocus
Text3.Text = ""
Else
Text7.SetFocus
End If
End If
End Sub

Private Sub Text4_keypress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If IsNumeric(Text4.Text) Or Text4.Text = "" Then
MsgBox "ENTER THE CATAGORY", vbExclamation, "INFORM"
Text4.Text = ""
Text4.SetFocus
Else
Text6.SetFocus
End If
End If
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If Not IsNumeric(Text5.Text) Then
MsgBox "Enter A Valid Numeric Value", vbCritical + vbOKOnly
Text5.SetFocus
Text5.Text = ""
Else
cmdsave.Visible = True
cmdnew.Enabled = True
Call FILLDATA
End If
End If
End Sub


Private Sub Text6_KEYPRESS(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If IsNumeric(Text6.Text) Or Text6.Text = "" Then
MsgBox "ENTER THE PUBLISHER", vbExclamation, "INFORM"
Text6.Text = ""
Text6.SetFocus
Else
Text5.SetFocus
End If
End If

End Sub

Public Function clear()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
End Function



Public Function invisble()
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
Text6.Enabled = False
Text7.Enabled = False
Text8.Enabled = False
Text9.Enabled = False
End Function

Public Function lockdata()
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text5.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Text8.Enabled = True
Text9.Enabled = True
End Function

Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 9 Then
If IsNumeric(Text7.Text) Then
Text7.Text = ""
Text7.SetFocus
Else
Text4.SetFocus
End If

If Not Text7.Text = "yes" Then
MsgBox "Enter Yes /No"
Text7.Text = ""
Text7.SetFocus
End If
End If
End Sub

Public Function FILLDATA()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Then
MsgBox " ENTER VALUES TO ALL TEXT BOXES"
End If
End Function


Public Function adddata()
Text1.Text = rec(0)
Text2.Text = rec(1)
Text3.Text = rec(5)
Text4.Text = rec(2)
Text5.Text = rec(4)
Text6.Text = rec(3)
Text7.Text = rec(6)
End Function

[ابوعبيده]

===================================form2
Private Sub Command1_Click()
Unload Me
FRMMAIN.Show
End Sub

Private Sub Command2_Click()
frmtrn.Show
End Sub

Private Sub cmdbr_Click()
frmtrn.Caption = "Book Return Menu"
frmtrn.Show
frmtrn.txtrn.SetFocus

End Sub

Private Sub cmdbt_Click()
frmtrn.Caption = "Book Issue Menu"
frmtrn.Show
End Sub

[ابوعبيده]

================================form3
Private Sub cmdbd_Click()
FRMBD.Show
End Sub
Private Sub cmdcancel_Click()
Text2.Text = ""
Text3.Text = ""
cmdmd.SetFocus
End Sub
Private Sub cmdmd_Click()
frmmd.Show
End Sub
Private Sub cmdquit_Click()
End
End Sub
Private Sub cmdtrn_Click()
FRMCHK.Show
End Sub

Private Sub Command1_Click()
PASSFORM.Show
End Sub

Private Sub Form_Activate()
Set db = OpenDatabase(apppath + "bookdetails.mdb")
Set paswd = db.OpenRecordset("password")
Set memd = db.OpenRecordset("membership")
Set rec = db.OpenRecordset("bookdetail")
Set TRN = db.OpenRecordset("transaction")
Set BK = db.OpenRecordset("BOOKNO")
Set MN = db.OpenRecordset("MEMBERNO")
End Sub

[ابوعبيده]

===================================form4
Dim X As String
Dim i, j As Integer
Dim R As Integer

Private Sub CMDNEW_Click()
'Call clear
Call setdata
txtnme(1).SetFocus
TXTDTE(5).Text = Format(Date, "DD.MMMM.YYYY")
TXTNO(0).Text = MN(0)
CMDNEW.Visible = False
CMDSAVE.Visible = True

End Sub

Private Sub cmdrtn_Click()
FRMMAIN.Show
frmmd.Visible = False
End Sub


Private Sub CMDSAVE_Click()
Call FILLDATA
memd.AddNew
Call getdata
memd.Update
MN.Edit
MN(0) = MN(0) + 1
MN.Update
Call clear
CMDSAVE.Visible = False
CMDNEW.Visible = True

'ERROR:
' MsgBox "THE OPERATION RESULTED IN THE FOLLOWING ERROR" & vbCrLf & Err.Description
End Sub

Private Sub cmdview_Click()
MSFG.Visible = True
MSFG.ColWidth(1) = 500
MSFG.ColWidth(2) = 2000
MSFG.ColWidth(3) = 2500
MSFG.ColWidth(4) = 500
MSFG.ColWidth(5) = 500
MSFG.ColWidth(6) = 2000
MSFG.ColWidth(7) = 700
MSFG.ColWidth(8) = 500
MSFG.ColWidth(9) = 400
MSFG.ColWidth(10) = 700
MSFG.TextMatrix(0, 1) = " No"
MSFG.TextMatrix(0, 2) = "Name"
MSFG.TextMatrix(0, 3) = "Address"
MSFG.TextMatrix(0, 4) = "Age"
MSFG.TextMatrix(0, 5) = "Sex"
MSFG.TextMatrix(0, 6) = "Occpation"
MSFG.TextMatrix(0, 7) = "Date"
MSFG.TextMatrix(0, 8) = "Class"
MSFG.TextMatrix(0, 9) = "Fee"
MSFG.TextMatrix(0, 10) = "Deposit"
X = InputBox("Enter The Register No")
memd.Index = "no"

memd.Seek "=", X
If memd.NoMatch Then
MsgBox "No Such Member With That RegNo: "
Else
If memd(0) = X Then
MSFG.TextMatrix(1, 1) = memd(0)
MSFG.TextMatrix(1, 2) = memd(1)
MSFG.TextMatrix(1, 3) = memd(2)
MSFG.TextMatrix(1, 4) = memd(3)
MSFG.TextMatrix(1, 5) = memd(4)
MSFG.TextMatrix(1, 6) = memd(5)
MSFG.TextMatrix(1, 7) = memd(6)
MSFG.TextMatrix(1, 8) = memd(7)
MSFG.TextMatrix(1, 9) = memd(8)
MSFG.TextMatrix(1, 10) = memd(9)
memd.MoveNext
End If
End If
End Sub

Private Sub Form_Activate()

End Sub

Private Sub Form_Load()
MSFG.Visible = False
End Sub
Public Function clear()
txtnme(1).Text = ""
TXTADS(2).Text = ""
TXTAGE(3).Text = ""
TXTDPT(7).Text = ""
TXTDTE(5).Text = ""
TXTFEE(6).Text = ""
TXTOCN(4).Text = ""
TXTNO(0).Text = ""
If optmale.Value = True Then
optmale.Value = False
Else
optfemle.Value = False
If OPTCL1.Value = True Then
OPTCL1.Value = False
Else
OPTCLS2.Value = False
End If
End If
End Function
Public Function getdata()
memd(0) = TXTNO(0).Text
memd(1) = UCase(txtnme(1).Text)
memd(2) = UCase(TXTADS(2).Text)
memd(3) = Val(TXTAGE(3).Text)
If optmale.Value = True Then
memd(4) = "MALE"
Else
memd(4) = "FEMALE"
End If
memd(5) = UCase(TXTOCN(4).Text)
memd(6) = Date
If OPTA.Value = True Then
memd(7) = "A"
Else
memd(7) = "B"
End If
memd(8) = Val(TXTFEE(6).Text)
memd(9) = Val(TXTDPT(7).Text)
End Function
Public Function setdata()
txtnme(1).Enabled = True
TXTADS(2).Enabled = True
TXTAGE(3).Enabled = True
optmale.Enabled = True
optfemle.Enabled = True
TXTOCN(4).Enabled = True
TXTDTE(5).Enabled = True
OPTA.Enabled = True
OPTB.Enabled = True
TXTFEE(6).Enabled = True
TXTDPT(7).Enabled = True
End Function

Public Function FILLDATA()
If KeyAscii = 13 Then
If txtnme(1).Text = "" Or _
TXTADS(2).Text = "" Or _
TXTAGE(3).Text = "" Or _
TXTOCN(4).Text = "" Or _
(optmale.Value = False And optfemle.Value = False) Or _
(OPTA.Value = False And OPTB.Value = False) Then
MsgBox " PLEASE ENTER DATA IN ALL EMPTY TEXTBOXES"
CMDSAVE.Enabled = False
End If
End If
End Function

[ابوعبيده]

اعذرني اخي حاولت احمل الملف ولاكن لم استطع

واي حاجه نحن تحت الخدمه اخوك ابوعبيده

[بـــدر]

أخي: *****01.. مشكور جدا و ما قصرت..

أخي: أبو عبيدة تسلم و جزاك الله خير, بس يا ليت لو تخبرني ويش كل برنامج يسوي..

تسلموووووا شباب

[ابوعبيده]

اخي بدر ارسلي ايميلك على الخاص وسوف اقوم بشرح المشروع بالكامل

اخوك ابوعبيده

[oman001]

اعذرني اخي حاولت احمل الملف ولاكن لم استطع

واي حاجه نحن تحت الخدمه اخوك ابوعبيده


أخي ابو عبيده

استخدم هذا الموقع في تحميل الملفات لتعم الفائده

http://www.malfat.com