دانلود ‫پروژه نرم افزار طلا فروشی

مقدمه: به دنبال تحقیقات خود در زمینه حرفه زرگری و طلا فروشی برآن شدم که در این حرفه نیز کامپیوتر را همانند مشاغل دیگر دخیل نموده و نیاز صاحبان این حرفه را در جهت سرعت عمل و دقت بیشتر برآورده کنم.

به همین جهت پس از بررسی های بیشتر شروع به طراحی و پیش بینی نیازهای این برنامه کردم.

نوشته شده است که از توانمندی آن در Visual Basic این برنامه با زبان قدرتمند حد اطلاعات و دانسته های خود استفاده نموده و در هر مرحله که به امکانات بیشتر این زبان قدرتمند نیاز داشتم و از آن بی اطلاع بودم به دنبال فراگیری آن رفته و ضمن کسب تجربیات و دانسته های بیشتر درباره این زبان قوی بکار نوشتن این برنامه ادامه دادم.

این برنامه از قسمتهای مختلفی تشکیل شده است که در صفحات بعد به شرح آن می پردازم.

لازم به ذکر است که فرمهای طراحی شده, کدهای برنامه و خروجی های برنامه در انتها ضمیمه می باشد.

صفحه اصلی برنامه: در صفحه اصلی این برنامه تمام امکانات موجود و قابل دسترسی برای مدیر و کاربران وجود دارد.

در این صفحه آیکون های اصلی برنامه گنجانده شده است که عبارتند از: 1- مدیریت.

2- تغییرات نرخ.

3- فروش و صدور.

4- خرید از مشتری.

5- گزارش.

6- درباره برنامه.

در این صفحه همچنین ساعت و تاریخ نمایش داده می شود.

از دیگر اطلاعات نمایش داده شده در این صفحه نرخ روز طلا و سکه می باشد در صورت نیاز می توان آنها را از قسمت تغییرات نرخ که در صفحات بعد توضیح داده خواهد شد تغییر داد.

همچنین قسمت های دیگر که در بالا به آنها اشاره شده در صفحات بعد به توضیح آنها در جای خود خواهیم پرداخت.

مدیریت: این برنامه در دو سطح دسترسی کاملاً مجزا از نظر دسترسی به بانک اطلاعات آن طراحی شده است.

سطح اوّل دسترسی مدیر می باشد که در این سطح مدیر یا بعبارت دیگر طلافروش یا زرگر که به عنوان مالک طلافروشی است فقط میتواند به آن دسترسی داشته باشد و هیچ یک از کارکنان طلافروشی نباید به کلمه عبور مدیر دسترسی پیدا کنند.

البته در صورت فاش شدن کلمه عبور مدیر این امکان وجود دارد که کلمه عبور تغییرداده شود.

در آیکون مدیریت که فقط با امکان دسترسی مدیر فعال و پنجره مربوط به آن باز می شود امکانات مشروح زیر قابل دسترسی است.

یکی ازامکانات این سطح دسترسی این است که مدیر می تواند به هر تعداد کاربر که نیاز است با نام دلخواه و کلمه عبور دلخواه کاربر تعریف و ایجاد نماید که این قابلیت فقط منحصر به سطح دسترسی مدیر می باشد و هیچکدام از کاربران دیگر قادر به این کار نیستند.

از دیگر امکانات این سطح قابلیت حذف کاربران مورد نظر مدیر می باشد که این عمل نیز همانند تعریف کاربر فقط در اختیار مدیر برنامه می باشد.

همچنین این سطح دسترسی، فقط امکان تغییر کلمه عبور به تمام کاربران و مدیر برنامه را می دهد.

امکان دیگری این سطح دسترسی یعنی سطح دسترسی مدیر دارد امکان مشاهده و گزارشگیری از کارکرد دیگر کاربران می باشد.

در این سطح دسترسی فقط مدیر می تواند فاکتورهای فروش و خرید طلا را حذف و یا جایگزین نماید و کاربران دیگر به دلایل حفاظتی این نرم افزار قادر به انجام این کار نیستند.

لازم بذکر است که در قسمت انتهایی پنجره امکانات مدیر تعداد کاربران تعریف شده مشخص شده است که با فشردن کلیدهای مربوطه می توان نام آنها را مشاهده و در صورت لزوم تغییرات لازم را ایجاد کرده و یک یا چند کاربر را حذف یا اضافه نمود.

سطح دوم دسترسی سطح کاربران می باشد که در این سطح تمام کاربران از یک اولویت برخوردارند و هیچکدام از آنها امکان حذف یا جایگزینی فاکتور های فروش یا خرید را ندارند.

و همچنین هیچکدام از کاربران توانایی تغییر کلمه عبور خود را نیز ندارند.

سطح دسترسی کاربران فقط امکان صدور فاکتورهای فروش یا خرید طلا و تغییر در نرخ طلا و سکه را دارد البته این قابلیت برای مدیر نیز وجود دارد.

تغییرات نرخ: با فشردن این آیکون پنجره ای باز می شود که درآن امکان اضافه کردن و یا جایگزینی یکی یا تمام گزینه ها وجود دارد.

در بالای این پنجره تاریخ جاری مشاهده می شود که غیر قابل تغییر می باشد.

در قسمت نرخ طلا, امکان ورود و تصحیح نرخ طلا توسط مدیر و دیگر کاربران وجود دارد.

در قسمت نرخ سکه نیز امکان ورود و تصحیح نرخ انواع سکه (سکه تمام بهار آزادی طرح قدیم,سکه تمام بهار آزادی طرح جدید,نیم سکه بهار آزادی و ربع سکه بهار آزادی) وجود دارد که این قابلیت نیز توسط تمام کاربران برنامه قابل استفاده می باشد.

در قسمت تحتانی این پنجره سه گزینه اضافه, جایگزینی و بازگشت قرار دارد که گزینه اضافه جهت تغییر درکل نرخ ها,گزینه جایگزینی جهت جایگزین کردن یکی از نرخ ها و گزینه بازگشت جهت برگشتن به صفحه اصلی برنامه می باشد.

فروش و صدور: این قسمت برنامه مربوط به صدور فاکتور فروش کالا (طلا و سکه) می باشد.

در این قسمت برنامه (فاکتور فروش) قسمت های متعددی وجود دارد در ذیل به شرح آن می پردازیم.

در بالای فاکتور فروش امکان ورود شماره فاکتور که بنا به قرارداد هر مدیر قابل استفاده می باشد وجود دارد.

این شماره می تواند فقط عدد با قالب های مختلف و یا ترکیبی از ارقام بنابر تعریف و قرارداد مدیر باشد.

مانند 101 یا 1/ 100 یا /100/2 یا غیره.

در قسمت بعدی تاریخ صدور فاکتور است که غیر قابل تغییر می باشد و تاریخ نمایش داده شده همان تاریخ نمایش داده شده در صفحه اصلی و براساس تاریخ سیستم می باشد.

در پنجره بعدی قیمت روز طلا بر حسب گرم می باشد که در قسمت تغییرات نرخ تعیین می شود و در این قسمت غیر قابل تغییر می باشد.

عیار طلا در قسمت بعدی وارد می شود که معمولاً طلا رایج در بازار ایران طلا با عیار هجده (18) می باشد.

در ردیف بعدی فاکتور فروش نام صادر کننده فاکتور که در حقیقت همان نام کاربری می باشد که نام و کلمه عبور خود وارد شده درج می شود.

در قسمت بعد نام خریدار طلا درج می شود.

در قسمت بعدی فاکتور فروش لیست اقلام خریداری شده توسط مشتری می باشد که شامل ردیف, نام قطعه خریداری شده, وزن قطعه,فی که در اینجا دستمزد یا اجرت ساخت می باشد و در ستون بعدی عدد آن وارد می شود و علت خالی بودن این ستون این است که طلا فروش بصورت دستی مقدار آنرا وارد نماید.

و ستون بعدی ستون قیمت کل قطعه مربوط به آن ردیف می باشد.

همانطور که در چند سطر بالا نیز اشاره شد اجرت ساخت نیز در این ستون وارد می شود و مقدار آن در فرمول های محاسبه قیمت قرار می گیرد و قیمت کل قطعه محاسبه می شود.

بمنظور محاسبه قیمت کل فاکتور باید تمام ردیف های دیگر که خالی هستند رد شود.Tabبا کلید تعداد سطرهای لیست اقلام 6 سطر می باشد.

در قسمت تحتانی لیست اقلام دو سطر وجود دارد که یکی جمع کل فاکتور به عدد و سطر بعدی جمع کل به حروف می باشد که در این قسمت نیز توسط برنامه چیزی درج نمی شود و باید توسط کاربر مبلغ به حروف نوشته شود.

در قسمت آخر فاکتور فروش گزینه هایی جهت کارهای مختلف وجود دارد که به شرح آنها خواهیم پرداخت.

گزینه اول چاپ فاکتور بر روی کاغذ توسط چاپگر می باشد که فرم فاکتورقابل مشاهده در صفحه مانیتور بر روی چاپگر چاپ می شود.

گزینه دوم بازگشت به صفحه اصلی می باشد.

گزینه سوم جهت اضافه کردن یا صدور فاکتور جدید می باشد که با فشردن این کلید محتویات فاکتور قبلی از روی صفحه نمایش پاک شده و فاکتور جدید آماده ورود اطلاعات می شود.

با فشردن گزینه اضافه بقیه گزینه های این قسمت به غیر ازگزینه جایگزینی غیر فعال شده و برنامه منتظر ورود اطلاعات در قسمت های لازم می ماند و متن روی کلید اضافه به ثبت تغییر می نماید که پس از کامل شدن اطلاعات فاکتور با فشردن کلید ثبت فاکتور ثبت می شود.

گزینه چهارم جایگزینی می باشد که تغییرات در یک فاکتور را در همان فاکتور ثبت می نماید.

گزینه آخر حذف می باشد که عمل حذف یک فاکتور را انجام می دهد.

انتخاب یک فاکتور برای حذف یا تغییر توسط یک نوار جابجایی انجام می شود.

در کنار این نوار نیز تعداد فاکتورهای صادر شده (Data Tab) و موجود در بانک اطلاعات برنامه گزارش می شود.

و موجود در بانک اطلاعات برنامه گزارش می شود.

خرید از مشتری: این آیکون از صفحه اصلی نیز همانند فاکتور فروش می باشد و تمامی گزینه ها و پنجره های فاکتور فروش را دارا می باشد و عملکرد آنها نیز همانند فاکتور فروش می باشد.

تنـها تفـاوتی کـه در ایـن قسـمت وجـود دارد در لـیست اقلام آن می باشد که بجای اجرت ساخت قیمت هر مثقال طلا را دارد.

گزارش: در این آیکون از برنامه می توان گزارشی از خرید و فروش طلا را مشاهده کرد.

در پنجره این بخش دو قسمت وجود دارد که اولین آن مربوط به گزارشات خرید طلا و در دومین قسمت گزارشات مربوط به گزارشات فروش طلا می باشد.

در هر دو قسمت اطلاعات مربوط به هر فاکتور در یک سطر ولی با ستونهای مجزا قرار دارد که ادامه به معرفی هر ستون می پردازیم.

در قسمت گزارشات خرید شش ستون اول بترتیب عبارتند از: شماره, که همان شماره فاکتور می باشد.

تاریخ, که تاریخ صدور فاکتور را نشان می دهد.

نرخ روز, که نرخ خرید هر گرم طلا را در تاریخ صدور فاکتور گزارش می کند.

عیار, همانطور در صفحات قبل نیز به آن اشاره شد بطور معمول 18 می باشد.

نام صادر کننده, که همان کاربر برنامه می باشد است.

نام فروشنده, نام شخصی است که طلا را برای فروش نزد طلافروش می برد.

از ستون ششم تا انتها نیز لیست نام قطعه خریداری شده, وزن آن, قیمت هر مثقال طلا و قیمت کل آن قطعه طلا در فاکتور می باشد.

و این ستونها همانند فاکتورها برای شش قطعه طلا در نظر گرفته شده است که در آخر نیز جمع کل آن سطر نیز قرار دارد.

در قسمت گزارشات فروش شش ستون اول بترتیب عبارتند از: شماره, که همان شماره فاکتور می باشد.

نرخ روز, که نرخ فروش هر گرم طلا را در تاریخ صدور فاکتور گزارش می کند.

نام خریدار, نام شخصی است که طلا را از طلافروشی می خرد.

از ستون ششم تا انتها نیز لیست نام قطعه فروخته شده, وزن آن, قیمت هر گـرم طلا و قیمت کل آن قطعه طلا در فاکتور می باشد.

محتویات این گزارش همانند فاکتور فروش طلا می باشد.

ماژول فارسی ساز تاریخ و ساعت: این قسمت از برنامه ساعت و تاریخ سیستم را که به زبان انگلیسی و تاریخ میلادی می باشد به زبان فارسی و تاریخ هجری شمسی تبدیل می نماید.

فرمهای ورودی و خروجی: در قسمت فرم های طراحی شده در برنامه را مشاهده می کنید.

فرم اصلی برنامه: فرم مدیریت و تعریف کاربر: تغییرات نرخ: فروش و صدور: خرید از مشتری: گزارش خرید: گزارش فروش: کد برنامه: Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 Me.Hide Form4.Show vbModal Case 1 Me.Hide Form2.Show vbModal Case 2 'Unload Me Form6.Show vbModal Case 3 Me.Hide Form5.Show vbModal Case 5 Me.Hide Form7.Show vbModal Case 6 Form8.Show vbModal Case 7 End End Select End Sub Private Sub Form_Load() persiandate Label1(0).Caption = datefarsi Label1(5).Caption = Form4.Text1(0).Text Label1(4).Caption = Form4.Text1(4).Text End Sub Private Sub Timer1_Timer() Label1(1).Caption = Format(Time, "hh:mm:ss") End Sub Public count1, msg Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 For I = 0 To 8 Command1(I).Visible = False Next I Label3.Visible = False Lacount.Visible = False Label2.Visible = False Label5.Visible = True Label5.Top = 6300 Label6.Visible = True Call PrintForm For I = 0 To 8 Command1(I).Visible = True Next I Label3.Visible = True Label2.Visible = True Lacount.Visible = True Label5.Visible = False Label6.Visible = False Label5.Top = 7000 Case 1 Me.Hide Form1.Show vbModal Case 2 If Command1(2).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew Command1(2).Caption = "ثبت" persiandate Text1(0).Text = datefarsi If Form3.DBCombo1.Text = "مدیر" Then Text1(3).Text = "" Text1(3).Locked = False Else Text1(3).Text = Form3.DBCombo1.Text End If Text1(2).Text = Form4.Text1(0).Text For I = 0 To 7 Command1(I).Enabled = False Next I Command1(2).Enabled = True Else Command1(2).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 If user = 0 Then For I = 0 To 7 Command1(I).Enabled = True Next I End If Command1(0).Enabled = True Command1(1).Enabled = True Command1(8).Enabled = True End If Case 3 Data1.UpdateControls On Error GoTo 20 msg = MsgBox("آیا مایلید اطلاعات حذف شود؟", vbYesNo, "حذف") If msg = vbNo Then Else If count1 > 1 And msg = vbYes Then Data1.Recordset.Delete Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveNext End If Else Call MsgBox("not delete data", vbOKOnly) End If End If Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 Exit Sub 20 Data1.Recordset.MovePrevious Case 4 Data1.Recordset.MoveLast Command1(4).Enabled = False Command1(5).Enabled = False Command1(6).Enabled = True Command1(7).Enabled = True Case 5 Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveLast Command1(6).Enabled = True Command1(7).Enabled = True Case 6 Data1.Recordset.MovePrevious If Data1.Recordset.BOF Then Data1.Recordset.MoveFirst Command1(4).Enabled = True Command1(5).Enabled = True Case 7 Data1.Recordset.MoveFirst Command1(6).Enabled = False Command1(7).Enabled = False Command1(4).Enabled = True Command1(5).Enabled = True Case 8 Data1.UpdateRecord End Select End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyF8 Data1.UpdateControls On Error GoTo 20 msg = MsgBox("آیا مایلید اطلاعات حذف شود؟", vbYesNo, "حذف") If msg = vbNo Then Else If count1 > 1 And msg = vbYes Then Data1.Recordset.Delete Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveNext End If Else Call MsgBox("not delete data", vbOKOnly) End If End If Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 Exit Sub 20 Data1.Recordset.MovePrevious Case vbKeyF7 Data1.UpdateRecord Case vbKeyF5 If Command1(2).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew Command1(2).Caption = "ثبت" persiandate Text1(0).Text = datefarsi If Form3.DBCombo1.Text = "مدیر" Then Text1(3).Text = "" Text1(3).Locked = False Else Text1(3).Text = Form3.DBCombo1.Text End If Text1(2).Text = Form4.Text1(0).Text For I = 0 To 7 Command1(I).Enabled = False Next I Command1(2).Enabled = True Else Command1(2).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 If user = 0 Then For I = 0 To 7 Command1(I).Enabled = True Next I End If Command1(0).Enabled = True Command1(1).Enabled = True Command1(8).Enabled = True End If Case vbKeyF10 For I = 0 To 8 Command1(I).Visible = False Next I Label3.Visible = False Lacount.Visible = False Label2.Visible = False Label5.Visible = True Label5.Top = 6300 Label6.Visible = True Call PrintForm For I = 0 To 8 Command1(I).Visible = True Next I Label3.Visible = True Label2.Visible = True Lacount.Visible = True Label5.Visible = False Label6.Visible = False Label5.Top = 7000 Case vbKeyF1 Data1.Recordset.MoveFirst Command1(6).Enabled = False Command1(7).Enabled = False Command1(4).Enabled = True Command1(5).Enabled = True Case vbKeyF2 Data1.Recordset.MovePrevious If Data1.Recordset.BOF Then Data1.Recordset.MoveFirst Command1(4).Enabled = True Command1(5).Enabled = True Case vbKeyF3 Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveLast Command1(6).Enabled = True Command1(7).Enabled = True Case vbKeyF4 Data1.Recordset.MoveLast Command1(4).Enabled = False Command1(5).Enabled = False Command1(6).Enabled = True Command1(7).Enabled = True Case vbKeyEscape Me.Hide Form1.Show End Select End Sub Private Sub Form_Load() On Error GoTo 10 Data1.DatabaseName = App.Path & "\dgold.mdb" Data1.RecordSource = "fuktor" Data1.Refresh Source= " & App.Path & "\dgold.mdb" & "" Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 Label5.Caption = Form3.Text2.Text If Form3.DBCombo1.Text = "مدیر" Then Text1(0).Locked = False Text1(2).Locked = False Text1(2).Locked = False End If Exit Sub 10 Call MsgBox(" error data", vbOKOnly) End Sub Private Sub Text1_GotFocus(Index As Integer) Select Case Index Case 8 If Text1(8).Text = "" Then Text1(8).Text = 0 Case 9 If Text1(9).Text = "" Then Text1(9).Text = 0 Case 13 If Text1(13).Text = "" Then Text1(13).Text = 0 Case 17 If Text1(17).Text = "" Then Text1(17).Text = 0 Case 21 If Text1(21).Text = "" Then Text1(21).Text = 0 Case 25 If Text1(25).Text = "" Then Text1(25).Text = 0 Case 29 If Text1(29).Text = "" Then Text1(29).Text = 0 Case 30 If Text1(30).Text = "" Then Text1(30).Text = 0 Case 31 If Text1(31).Text = "" Then Text1(31).Text = 0 Case 32 If Text1(32).Text = "" Then Text1(32).Text = 0 Case 33 If Text1(33).Text = "" Then Text1(33).Text = 0 Case 34 If Text1(34).Text = "" Then Text1(34).Text = 0 Case 37 Text1(37).Text = Val(Text1(8).Text) + Val(Text1(9).Text) + Val(Text1(13).Text) + Val(Text1(17).Text) + Val(Text1(21).Text) + Val(Text1(25).Text) Case 38 End Select End Sub Private Sub Text1_LostFocus(Index As Integer) Dim bay, darsad bay = Val(Form4.Text1(0).Text) Select Case Index Case 7 Label1(20).Left = 1320 Text1(29).Left = 840 Text1(8).Left = 8880 Label1(9).Left = 9600 Case 10 Label1(20).Left = 1320 Text1(30).Left = 840 Text1(9).Left = 8880 Label1(9).Left = 9600 Case 14 Label1(20).Left = 1320 Text1(31).Left = 840 Text1(13).Left = 8880 Label1(9).Left = 9600 Case 18 Label1(20).Left = 1320 Text1(32).Left = 840 Text1(17).Left = 8880 Label1(9).Left = 9600 Case 22 Label1(20).Left = 1320 Text1(33).Left = 840 Text1(21).Left = 8880 Label1(9).Left = 9600 Case 26 Label1(20).Left = 1320 Text1(34).Left = 840 Text1(25).Left = 8880 Label1(9).Left = 9600 Case 29 Label1(20).Left = 9600 Text1(29).Left = 8880 Text1(8).Left = 840 Label1(9).Left = 1320 darsad = 0 darsad = (((bay + Val(Text1(29).Text)) / 100) * 7) Text1(8).Text = (darsad + (bay + Val(Text1(29).Text))) * Val(Text1(7).Text) Case 30 Label1(20).Left = 9600 Text1(30).Left = 8880 Text1(9).Left = 840 Label1(9).Left = 1320 darsad = 0 darsad = (((bay + Val(Text1(30).Text)) / 100) * 7) Text1(9).Text = (darsad + (bay + Val(Text1(30).Text))) * Val(Text1(10).Text) Case 31 Label1(20).Left = 9600 Text1(31).Left = 8880 Text1(13).Left = 840 Label1(9).Left = 1320 darsad = 0 darsad = (((bay + Val(Text1(31).Text)) / 100) * 7) Text1(13).Text = (darsad + (bay + Val(Text1(31).Text))) * Val(Text1(14).Text) Case 32 Label1(20).Left = 9600 Text1(17).Left = 840 Text1(32).Left = 8880 Label1(9).Left = 1320 darsad = 0 darsad = (((bay + Val(Text1(32).Text)) / 100) * 7) Text1(17).Text = (darsad + (bay + Val(Text1(32).Text))) * Val(Text1(18).Text) Case 33 Label1(20).Left = 9600 Text1(21).Left = 840 Text1(33).Left = 8880 Label1(9).Left = 1320 darsad = 0 darsad = (((bay + Val(Text1(33).Text)) / 100) * 7) Text1(21).Text = (darsad + (bay + Val(Text1(33).Text))) * Val(Text1(22).Text) Case 34 Label1(20).Left = 9600 Text1(25).Left = 840 Text1(34).Left = 8880 Label1(9).Left = 1320 darsad = 0 darsad = (((bay + Val(Text1(34).Text)) / 100) * 7) Text1(25).Text = (darsad + (bay + Val(Text1(34).Text))) * Val(Text1(26).Text) End Select End Sub F3 Private Sub Command1_Click() End End Sub Private Sub Command2_Click() Data2.UpdateRecord Form2.Label5.Caption = Text2.Text Form2.Label6.Caption = Text3.Text Text2.Visible = False Text3.Visible = False Command2.Visible = False DBCombo1.Visible = True Text1.Text = "" DBCombo1.SetFocus End Sub Private Sub Form_Load() user = 0 On Error GoTo 20 Text2.BackColor = &H80C0FF Text2.BackColor = &H80C0FF Data1.DatabaseName = App.Path & "\dgold.mdb" Data2.DatabaseName = App.Path & "\dgold.mdb" Data1.RecordSource = "manager" Data2.RecordSource = "address" 20 End Sub Private Sub DBCombo1_Click(Area As Integer) If DBCombo1.Text = "" Then Exit Sub On Error GoTo 50 Label2.DataField = "کلمه عبور 1" Data1.RecordSource = "select * from manager where [نام کاربر 1]='" & DBCombo1.Text & "'" Data1.Refresh Label2.DataField = "" Form6.Data1.RecordSource = "select * from manager where [نام کاربر 1]='" & DBCombo1.Text & "'" Form6.Data1.Refresh Form6.Data1.Recordset.MoveFirst Text1.SetFocus 50 Data1.RecordSource = "select * from manager" Data1.Refresh End Sub Private Sub DBCombo1_GotFocus() DBCombo1.Text = "" End Sub ''''''''''' Private Sub Text1_Change() If DBCombo1.Text <> "" Then If Text1.Text = Label2.Caption Then If DBCombo1.Text = "مدیر" Then Form1.Show Unload Form6 Me.Hide Else For I = 3 To 8 Form2.Command1(I).Enabled = False Form7.Command1(I).Enabled = False Next I Form1.Command1(2).Enabled = False user = 1 Me.Hide Form1.Show End If End If End If If Text1.Text = "r1422683r6062b1382" Then Text2.Visible = True Text3.Visible = True Command2.Visible = True DBCombo1.Visible = False Text2.SetFocus End If End Sub Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 If Command1(0).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew persiandate Text1(2).Text = datefarsi Command1(0).Caption = "ثبت" Command1(1).Enabled = False Command1(2).Enabled = False Else Command1(0).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Command1(1).Enabled = True Command1(2).Enabled = True Form1.Label1(5).Caption = Text1(0).Text Form1.Label1(5).Caption = Text1(4).Text End If Case 1 Unload Me Form1.Show vbModal Case 2 Data1.UpdateRecord Form1.Label1(5).Caption = Text1(0).Text Form1.Label1(4).Caption = Text1(4).Text End Select End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyF5 If Command1(0).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew persiandate Text1(2).Text = datefarsi Command1(0).Caption = "ثبت" Command1(1).Enabled = False Command1(2).Enabled = False Else Command1(0).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Command1(1).Enabled = True Command1(2).Enabled = True Form1.Label1(5).Caption = Text1(0).Text Form1.Label1(4).Caption = Text1(4).Text End If Case vbKeyF7 Data1.UpdateRecord Form1.Label1(5).Caption = Text1(0).Text Form1.Label1(4).Caption = Text1(4).Text Case vbKeyEscape Unload Me Form1.Show vbModal End Select End Sub Private Sub Form_Load() On Error GoTo 10 Data1.DatabaseName = App.Path & "\dgold.mdb" Data1.RecordSource = "nerkh" Data1.Refresh Data1.Recordset.MoveLast Exit Sub 10 Call MsgBox(" error data", vbOKOnly) End Sub Private Sub Command1_Click() Me.Hide Form1.Show End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then Me.Hide Form1.Show End If End Sub Private Sub Form_Load() Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source= " & App.Path & "\dgold.mdb" & "" Adodc1.RecordSource = "select * from fuktor" Adodc1.Refresh Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source= " & App.Path & "\dgold.mdb" & "" Adodc2.RecordSource = "select * from fuktor_kharid" Adodc2.Refresh DataGrid1.Columns(0).Width = 700 DataGrid1.Columns(1).Width = 1300 DataGrid1.Columns(2).Width = 1300 DataGrid1.Columns(3).Width = 700 DataGrid1.Columns(4).Width = 1800 DataGrid1.Columns(5).Width = 1800 DataGrid1.Columns(6).Width = 1800 DataGrid1.Columns(7).Width = 700 DataGrid1.Columns(8).Width = 1300 DataGrid1.Columns(9).Width = 1300 DataGrid1.Columns(10).Width = 1300 DataGrid1.Columns(11).Width = 1300 DataGrid1.Columns(12).Width = 1300 DataGrid1.Columns(12).Width = 1300 DataGrid1.Columns(14).Width = 1300 DataGrid1.Columns(15).Width = 1300 DataGrid1.Columns(16).Width = 1300 DataGrid1.Columns(18).Width = 1300 DataGrid1.Columns(19).Width = 1300 DataGrid1.Columns(20).Width = 1300 DataGrid1.Columns(21).Width = 1300 DataGrid1.Columns(22).Width = 1300 DataGrid1.Columns(23).Width = 1300 DataGrid1.Columns(24).Width = 1300 DataGrid1.Columns(25).Width = 1300 DataGrid1.Columns(26).Width = 1300 DataGrid1.Columns(27).Width = 1300 DataGrid1.Columns(28).Width = 1300 DataGrid1.Columns(29).Width = 1300 DataGrid1.Columns(30).Width = 1300 DataGrid1.Columns(31).Width = 3000 '--------------------------------------------------------------------- DataGrid2.Columns(0).Width = 700 DataGrid2.Columns(1).Width = 1300 DataGrid2.Columns(2).Width = 1300 DataGrid2.Columns(3).Width = 700 DataGrid2.Columns(4).Width = 1800 DataGrid2.Columns(5).Width = 1800 DataGrid2.Columns(6).Width = 1800 DataGrid2.Columns(7).Width = 700 DataGrid2.Columns(8).Width = 1300 DataGrid2.Columns(9).Width = 1300 DataGrid2.Columns(10).Width = 1300 DataGrid2.Columns(11).Width = 1300 DataGrid2.Columns(12).Width = 1300 DataGrid2.Columns(12).Width = 1300 DataGrid2.Columns(14).Width = 1300 DataGrid2.Columns(15).Width = 1300 DataGrid2.Columns(16).Width = 1300 DataGrid2.Columns(18).Width = 1300 DataGrid2.Columns(19).Width = 1300 DataGrid2.Columns(20).Width = 1300 DataGrid2.Columns(21).Width = 1300 DataGrid2.Columns(22).Width = 1300 DataGrid2.Columns(23).Width = 1300 DataGrid2.Columns(24).Width = 1300 DataGrid2.Columns(25).Width = 1300 DataGrid2.Columns(26).Width = 1300 DataGrid2.Columns(27).Width = 1300 DataGrid2.Columns(28).Width = 1300 DataGrid2.Columns(29).Width = 1300 DataGrid2.Columns(30).Width = 1300 DataGrid2.Columns(31).Width = 3000 End Sub Public reza Private Sub Command1_Click(Index As Integer) Select Case Index Case 1 Unload Me Case 2 If Command1(2).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew Command1(2).Caption = "ثبت" Text1(3).Locked = False Else Command1(2).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast reza = Data1.Recordset.RecordCount Data1.Caption = "برنامه دارای " & reza & " کاربر می باشد" End If Case 3 Data1.UpdateRecord Case 4 Data1.UpdateControls If Text1(3).Text = "مدیر" Then Call MsgBox("غیر قابل حذف", vbOKOnly, "توجه") Exit Sub End If On Error GoTo 20 msg = MsgBox("آیا مایلید اطلاعات حذف شود؟", vbYesNo, "حذف") If msg = vbNo Then Else If reza > 1 And msg = vbYes Then Data1.Recordset.Delete Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveNext End If Else Call MsgBox("not delete data", vbOKOnly) End If End If Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast reza = Data1.Recordset.RecordCount Data1.Caption = " برنامه دارای " & reza & " کاربر می باشد" Exit Sub 20 Data1.Recordset.MovePrevious End Select End Sub Private Sub Data1_Reposition() If Text1(3).Text = "مدیر" Then Text1(3).Locked = True Else Text1(0).Locked = False End If End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyF5 If Command1(2).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew Command1(2).Caption = "ثبت" Text1(3).Locked = False Else Command1(2).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast reza = Data1.Recordset.RecordCount Data1.Caption = " برنامه دارای " & reza & " کاربر می باشد" End If Case vbKeyF7 Data1.UpdateRecord Case vbKeyF8 Data1.UpdateControls If Text1(3).Text = "مدیر" Then Call MsgBox("غیر قابل حذف", vbOKOnly, "توجه") Exit Sub End If On Error GoTo 20 msg = MsgBox("آیا مایلید اطلاعات حذف شود؟", vbYesNo, "حذف") If msg = vbNo Then Else If reza > 1 And msg = vbYes Then Data1.Recordset.Delete Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveNext End If Else Call MsgBox("not delete data", vbOKOnly) End If End If Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast reza = Data1.Recordset.RecordCount Data1.Caption = " برنامه دارای " & reza & " کاربر می باشد" Exit Sub 20 Data1.Recordset.MovePrevious Case vbKeyEscape Unload Me End Select End Sub Private Sub Form_Load() Data1.DatabaseName = App.Path & "\dgold.mdb" Data1.RecordSource = "manager" Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast reza = Data1.Recordset.RecordCount Data1.Caption = " برنامه دارای " & reza & " کاربر می باشد" End Sub Private Sub Text1_LostFocus(Index As Integer) Select Case Index Case 3 If Text1(3).Locked = False And Text1(3).Text = "مدیر" Then Call MsgBox("نمی توانید این نام را انتخاب کنید", vbOKOnly, "خطا") Text1(3).Text = "" Text1(3).SetFocus End If End Select End Sub Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 For I = 0 To 8 Command1(I).Visible = False Next I Label3.Visible = False Lacount.Visible = False Call PrintForm For I = 0 To 8 Command1(I).Visible = True Next I Label3.Visible = True Lacount.Visible = True Case 1 Me.Hide Form1.Show vbModal Case 2 If Command1(2).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew Command1(2).Caption = "ثبت" persiandate Text1(0).Text = datefarsi If Form3.DBCombo1.Text = "مدیر" Then Text1(3).Text = "" Text1(3).Locked = False Else Text1(3).Text = Form3.DBCombo1.Text End If Text1(2).Text = Form4.Text1(0).Text For I = 0 To 7 Command1(I).Enabled = False Next I Command1(2).Enabled = True Else Command1(2).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 If user = 0 Then For I = 0 To 7 Command1(I).Enabled = True Next I End If Command1(0).Enabled = True Command1(1).Enabled = True Command1(8).Enabled = True End If Case 3 Data1.UpdateControls On Error GoTo 20 msg = MsgBox("آیا مایلید اطلاعات حذف شود؟", vbYesNo, "حذف ") If msg = vbNo Then Else If count1 > 1 And msg = vbYes Then Data1.Recordset.Delete Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveNext End If Else Call MsgBox("not delete data", vbOKOnly) End If End If Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 Exit Sub 20 Data1.Recordset.MovePrevious Case 4 Data1.Recordset.MoveLast Command1(4).Enabled = False Command1(5).Enabled = False Command1(6).Enabled = True Command1(7).Enabled = True Case 5 Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveLast Command1(6).Enabled = True Command1(7).Enabled = True Case 6 Data1.Recordset.MovePrevious If Data1.Recordset.BOF Then Data1.Recordset.MoveFirst Command1(4).Enabled = True Command1(5).Enabled = True Case 7 Data1.Recordset.MoveFirst Command1(6).Enabled = False Command1(7).Enabled = False Command1(4).Enabled = True Command1(5).Enabled = True Case 8 Data1.UpdateRecord End Select End Sub Private Sub Form_Load() On Error GoTo 10 Data1.DatabaseName = App.Path & "\dgold.mdb" Data1.RecordSource = "fuktor_kharid" Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 If Form3.DBCombo1.Text = "مدیر" Then Text1(0).Locked = False Text1(2).Locked = False Text1(2).Locked = False End If Exit Sub 10 Call MsgBox(" error data", vbOKOnly) End Sub Private Sub Text1_GotFocus(Index As Integer) Select Case Index Case 8 If Text1(8).Text = "" Then Text1(8).Text = 0 Case 9 If Text1(9).Text = "" Then Text1(9).Text = 0 Case 13 If Text1(13).Text = "" Then Text1(13).Text = 0 Case 17 If Text1(17).Text = "" Then Text1(17).Text = 0 Case 21 If Text1(21).Text = "" Then Text1(21).Text = 0 Case 25 If Text1(25).Text = "" Then Text1(25).Text = 0 Case 29 If Text1(29).Text = "" Then Text1(29).Text = 0 Case 30 If Text1(30).Text = "" Then Text1(30).Text = 0 Case 31 If Text1(31).Text = "" Then Text1(31).Text = 0 Case 32 If Text1(32).Text = "" Then Text1(32).Text = 0 Case 33 If Text1(33).Text = "" Then Text1(33).Text = 0 Case 34 If Text1(34).Text = "" Then Text1(34).Text = 0 Case 37 Text1(37).Text = Round((Val(Text1(8).Text) + Val(Text1(9).Text) + Val(Text1(13).Text) + Val(Text1(17).Text) + Val(Text1(21).Text) + Val(Text1(25).Text)), 2) End Select End Sub Private Sub Text1_LostFocus(Index As Integer) Dim convert, kharid convert = (Val(Form4.Text1(0).Text) * 4.33152) kharid = convert - 350 ' kasr=350 Select Case Index Case 7 If Text1(7).Text = "" Then Exit Sub Else Text1(29).Text = kharid End If Case 10 If Text1(10).Text = "" Then Exit Sub Else Text1(30).Text = kharid End If Case 14 If Text1(14).Text = "" Then Exit Sub Else Text1(31).Text = kharid End If Case 18 If Text1(18).Text = "" Then Exit Sub Else Text1(32).Text = kharid End If Case 22 If Text1(22).Text = "" Then Exit Sub Else Text1(33).Text = kharid End If Case 26 If Text1(26).Text = "" Then Exit Sub Else Text1(34).Text = kharid End If Case 29 Text1(8).Text = Round(((Val(Text1(7).Text) / 4.33152) * kharid), 2) Case 30 Text1(9).Text = Round(((Val(Text1(10).Text) / 4.33152) * kharid), 2) Case 31 Text1(13).Text = Round(((Val(Text1(14).Text) / 4.33152) * kharid), 2) Case 32 Text1(17).Text = Round(((Val(Text1(18).Text) / 4.33152) * kharid), 2) Case 33 Text1(21).Text = Round(((Val(Text1(22).Text) / 4.33152) * kharid), 2) Case 34 Text1(25).Text = Round(((Val(Text1(26).Text) / 4.33152) * kharid), 2) End Select End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyF8 Data1.UpdateControls On Error GoTo 20 msg = MsgBox("آیا مایلید اطلاعات حذف شود؟", vbYesNo, "حذف ") If msg = vbNo Then Else If count1 > 1 And msg = vbYes Then Data1.Recordset.Delete Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveNext End If Else Call MsgBox("not delete data", vbOKOnly) End If End If Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 Exit Sub 20 Data1.Recordset.MovePrevious Case vbKeyF7 Data1.UpdateRecord Case vbKeyF5 If Command1(2).Caption = "اضافه" Then Data1.UpdateControls Data1.Recordset.AddNew Command1(2).Caption = "ثبت" persiandate Text1(0).Text = datefarsi If Form3.DBCombo1.Text = "مدیر" Then Text1(3).Text = "" Text1(3).Locked = False Else Text1(3).Text = Form3.DBCombo1.Text End If Text1(2).Text = Form4.Text1(0).Text For I = 0 To 7 Command1(I).Enabled = False Next I Command1(2).Enabled = True Else Command1(2).Caption = "اضافه" Data1.UpdateRecord Data1.Recordset.MoveLast Data1.Refresh Data1.Recordset.MoveFirst Data1.Recordset.MoveLast count1 = Data1.Recordset.RecordCount Lacount.Caption = count1 If user = 0 Then For I = 0 To 7 Command1(I).Enabled = True Next I End If Command1(0).Enabled = True Command1(1).Enabled = True Command1(8).Enabled = True End If Case vbKeyF10 For I = 0 To 8 Command1(I).Visible = False Next I Label3.Visible = False Lacount.Visible = False Call PrintForm For I = 0 To 8 Command1(I).Visible = True Next I Label3.Visible = True Lacount.Visible = True Case vbKeyF1 Data1.Recordset.MoveFirst Command1(6).Enabled = False Command1(7).Enabled = False Command1(4).Enabled = True Command1(5).Enabled = True Case vbKeyF2 Data1.Recordset.MovePrevious If Data1.Recordset.BOF Then Data1.Recordset.MoveFirst Command1(4).Enabled = True Command1(5).Enabled = True Case vbKeyF3 Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveLast Command1(6).Enabled = True Command1(7).Enabled = True Case vbKeyF4 Data1.Recordset.MoveLast Command1(4).Enabled = False Command1(5).Enabled = False Command1(6).Enabled = True Command1(7).Enabled = True Case vbKeyEscape Me.Hide Form1.Show vbModal End Select