مسائل جالب در vb6(سورس کدهای جالب کامپوننت های جالب و....)

[mohsen_f_b]

دوستان اين سايت رو ببينيد و بگين چطوري در فرم ازش استفاده كنم.
ممنونم
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

[hashem_te]

ديتا بيس در VB6 با استفاده از Microsoft Dao 3.6 Object Library

كساني كه در Access با عنصر RecordSet مربوط به Dao برنامه نويسي كرده اند اكثر كدهايشان بدون تغيير در يك پروژه استاندارد VB6 قابل اجرا است
كافي است از منوي Project گزينه References را اجرا كنيد و از ليستي كه ظاهر ميشود Microsoft Dao 3.6 Object Library را تيك بزنيد
حال براي دسترسي به بانك اطلاعاتي اكسس و نيز دسترسي به ركوردهاي هر يك از جداول آن كافي است متغيرهايي از نوع DAO.Database و DAO.Recordset در سطح فرم تعريف كنيد و آنها را توسط دستور SET در روال Form_Load يا روالهاي ديگر به بانك اطلاعاتي اكسس و جداول آن مرتبط كنيد
با اين كار در صورت وجود ايندكس براي جدول مورد نظر در اكسس ميتوان ايندكس مورد نظر را نيز پس از دستور انتساب SET فعال كرد با اين كار امكان جستجوي سريع در جدول اطلاعاتي بر اساس كليد ايندكس توسط دستور Seek فراهم ميشود در صورتي كه ركورد مورد نظر پيدا نشود خاصيت Nomatch مربوط به متغير نوع RecordSEt مقدار True ميگيرد و در صورت پيدا شدن اين خاصيت False ميشود و ركورد مطابق با جستجو ركورد جاري خواهد شد حال دسترسي به هر يك از فيلدهاي ركورد جاري از طريق فرمول Variable![Field Name] e قابل دسترسي جهت خواندن و نوشتن مي باشد.(حرف e اضافي است)
تمامي كارها شبيه آنچه در اكسس بود پيش مي رود و فقط بعضي روالها بايد با اسامي ديگر جايگزين شوند
مثلا كد موجود در روال AfterUpdate اكسس را در روال Validate ويژوال بيسيك بنويسيد يا كد موجود در روال On Enter اكسس را در روال GotFocus ويژوال بيسيك بنويسيد
كد برنامه خودم را كپي و در زير Paste كرده ام چون چگونگي در اختيار گذاشتن آن را جهت دانلود نمي دانم


Option Explicit
Dim Calibr As DAO.Database
Dim CalibrRst, Au1Rst, LoopRst As DAO.Recordset
Dim DevFound As Boolean

Private Sub C_Dev_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call C_Dev_Validate(False)
Me.ManufacturerCode.SetFocus
End If
End Sub

Private Sub CalibratorDev_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CalibratorSerial.SetFocus
End If
End Sub

Private Sub CalibratorSerial_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.PlaceCod.SetFocus
End If
End Sub

Private Sub CurrentDate_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
'Call CurrentDate_Validate(False)
Me.SabtNo.SetFocus
End If
End Sub

Private Sub Form_Initialize()
Call ClearForm
End Sub

Private Sub Form_Load()
Set Calibr = OpenDatabase("Azma1.mdb")
Set CalibrRst = Calibr.OpenRecordset("CalibrDone", dbOpenTable)
CalibrRst.Index = "SabtNo"
' Set Au1Rst = calibr.OpenRecordset("Au1_01w", dbOpenTable)
' Au1Rst.Index = "C_DEV"
'Set LoopRst = Calibr.OpenRecordset("Loops", dbOpenTable)
'LoopRst.Index = "Loop_Cod"
End Sub

Private Sub MaintainedCode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CalibrDate.SetFocus
End If
End Sub


Private Sub ManufacturerCode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Plant_Cod.SetFocus
End If
End Sub

Private Sub Naf_Saat_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.CalibratorDev.SetFocus
End If
End Sub

Private Sub PersonalNo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.PersonalNo2.SetFocus
End If
End Sub

Private Sub PersonalNo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Naf_Saat.SetFocus
End If
End Sub

Private Sub PlaceCod_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.MaintainedCode.SetFocus
End If
End Sub

Private Sub Plant_Cod_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.S_Dev.SetFocus
End If
End Sub

Private Sub S_Dev_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Type.SetFocus
End If
End Sub

Private Sub SabtNo_GotFocus()
CalibrRst.Seek "<", Me.CurrentDate + 1
If CalibrRst!SabtNo Like Me.CurrentDate & "*" Then
If Right(CalibrRst!SabtNo, 2) = "99" Then
Me.SabtNo = CalibrRst!SabtNo
Me.StatusLabel.Caption = "ÔãÇÑå ËÈÊ ãæÌæÏ"
Call RestoreData
Else
Me.SabtNo = CalibrRst!SabtNo + 1
Me.StatusLabel.Caption = "ÔãÇÑå ËÈÊ ÌÏíÏ"
Call ClearForm
End If
Else
Me.SabtNo = Me.CurrentDate & "01"
Call ClearForm
End If
End Sub

Private Sub SabtNo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call SabtNo_Validate(False)
Me.C_Dev.SetFocus
End If
End Sub

Private Sub SabtNo_Validate(Cancel As Boolean)
If Trim(Me.SabtNo) = "" Then Cancel = True
CalibrRst.Seek "=", Me.SabtNo
If CalibrRst.NoMatch Then
Me.StatusLabel.Caption = "ÔãÇÑå ËÈÊ ÌÏíÏ"
Call ClearForm
Else
Me.StatusLabel.Caption = "ÔãÇÑå ËÈÊ ãæÌæÏ"
Call RestoreData
End If
End Sub

Private Sub C_Dev_Validate(Cancel As Boolean)
Set Au1Rst = Calibr.OpenRecordset("Au1_01w", dbOpenTable)
Au1Rst.Index = "C_DEV"
Me.C_Dev = Right("000000" & Trim(Me.C_Dev), 6)
If Val(Me.C_Dev) = 0 Then
Me.C_Dev = "------"
DevFound = False
'Au1Rst.Close
Exit Sub
End If
Au1Rst.Seek "=", Me.C_Dev
If Au1Rst.NoMatch Then
Me.PeriodBox = ""
MsgBox "ÏÓʐÇå ÈÇ ßÏ " & Me.C_Dev & " æÌæÏ äÏÇÑÏ", vbOKOnly, "ÎØÇ"
Me.C_Dev = "------"
DevFound = False
Else
DevFound = True
If CalibrRst.NoMatch Then
Me.Plant_Cod = IIf(IsNull(Au1Rst![Plant_Cod]), "", Au1Rst![Plant_Cod])
Me.S_Dev = IIf(IsNull(Au1Rst![S_Dev]), "", Au1Rst![S_Dev])
Me.Type = IIf(IsNull(Au1Rst![Type]), "", Au1Rst![Type])
End If
Me.PeriodBox = Au1Rst![Period]
End If
End Sub

Private Sub CalibratorDev_Validate(Cancel As Boolean)
'Me.CalibratorDev.SelStart = 0
'Me.CalibratorDev.SelLength = Len(Me.CalibratorDev.Text)
'DoCmd.DoMenuItem acFormBar, acEditMenu, acCopy, , acMenuVer70
Me.CalibratorSerial.Refresh
'Me.CalibratorSerial.Requery
End Sub

Private Sub CalibratorDev_GotFocus()
'Me.CalibratorDev.DropDown
End Sub

Private Sub CalibratorSerial_Validate(Cancel As Boolean)
'Me.CalibratorSerial.Requery
Me.CalibratorSerial.Refresh
'Me.CalibratorSerial.LimitToList = True
End Sub

Private Sub CalibratorSerial_GotFocus()
'Me.CalibratorSerial.DropDown
End Sub

Private Sub CalibratorSerial_NotInList(NewData As String, Response As Integer)
Dim CalibratorRst As DAO.Recordset
Set CalibratorRst = Calibr.OpenRecordset("CalibratorDev")
Me.CalibratorSerial.LimitToList = False
CalibratorRst.AddNew
CalibratorRst!CalibratorDev = Me.CalibratorDev
CalibratorRst!SerialNo = NewData
CalibratorRst.Update
Response = 0
CalibratorRst.Close
End Sub

Private Sub CalibrDate_GotFocus()
If CalibrRst.NoMatch Then Me.CalibrDate = Me.CurrentDate
End Sub

Private Sub DelBtn_Click()
Dim ans As Integer
If Not CalibrRst.NoMatch Then
ans = MsgBox("ÔãÇÑå ËÈÊ " & Me.SabtNo & "ÍÐÝ ÔæÏ", vbYesNo, "åÔÏÇÑ")
If ans = 6 Then
CalibrRst.Delete
Call ClearForm
Me.StatusLabel.Caption = "ÍÐÝ ÔÏ"
End If
End If
Me.CurrentDate.SetFocus
End Sub


Private Sub ReceptDate_GotFocus()
If CalibrRst.NoMatch Then Me.ReceptDate = Me.CurrentDate
End Sub

Private Sub MaintainedCode_GotFocus()
'Me.MaintainedCode.DropDown
End Sub

Private Sub CalibrDate_Validate(Cancel As Boolean)
Dim yy, mm, dd As String
yy = Left(CalibrDate, 2)
mm = Val(Mid(CalibrDate, 3, 2))
dd = Val(Mid(CalibrDate, 5, 2))
If mm < 1 Or mm > 12 Then
MsgBox "ÔãÇÑå ãÇå ÑÇ Èíä 1 ÊÇ 12 æÇÑÏ ßäíÏ"
Cancel = True
End If
If dd < 1 Or dd > 31 Then
MsgBox "ÔãÇÑå ãÇå ÑÇ Èíä 1 ÊÇ 31 æÇÑÏ ßäíÏ"
Cancel = True
End If
If CalibrRst.NoMatch Then Me.Exp_Date = NextDate6(Me.CalibrDate, Me.PeriodBox)
End Sub

Private Sub PeriodBox_Validate(Cancel As Boolean)
Me.Exp_Date = NextDate6(Me.CalibrDate, Val(Me.PeriodBox))
Me.SaveCmd.SetFocus
End Sub

Private Sub PersonalNo_GotFocus()
'Me.PersonalNo.DropDown
End Sub

Private Sub PlaceCod_GotFocus()
'Me.PlaceCod.DropDown
End Sub

Private Sub SaveCmd_Click()
If Me.C_Dev = "------" And Me.ManufacturerCode = "" Then
MsgBox "ßÏ ÇÊæãÇÓíæäí ÏÓʐÇå íÇ ßÏ ßÇÑÎÇäå ÓÇÒäÏå ÑÇ æÇÑÏ ßäíÏ", , "ÊæÌå"
Me.C_Dev.SetFocus
Exit Sub
End If
If Me.Plant_Cod = "" Then
MsgBox "ÞÓãÊ íÇ ßÇѐÇå ÏÑÎæÇÓÊ ßääÏå ÑÇ ÇäÊÎÇÈ ßäíÏ", , "ÊæÌå"
Me.Plant_Cod.SetFocus
Exit Sub
End If
If Me.PersonalNo1 = "" Then
MsgBox "ÔÎÕ ßÇáíÈÑå ßääÏå ÑÇ ÇäÊÎÇÈ ßäíÏ", , "ÊæÌå"
Me.PersonalNo1.SetFocus
Exit Sub
End If
If Me.Naf_Saat = "" Then
MsgBox "äÝÑÓÇÚÊ ÑÇ æÇÑÏ ßäíÏ", , "ÊæÌå"
Me.Naf_Saat.SetFocus
Exit Sub
End If
If Me.CalibratorDev = "" Then
MsgBox "ÏÓʐÇå ßÇáíÈÑå ßääÏå ÑÇ ÇäÊÎÇÈ ßäíÏ", , "ÊæÌå"
Me.CalibratorDev.SetFocus
Exit Sub
End If
If Me.PlaceCod = "" Then
MsgBox " ãÍá ßÇáíÈÑå ÑÇ ÇäÊÎÇÈ ßäíÏ", , "ÊæÌå"
Me.PlaceCod.SetFocus
Exit Sub
End If
If Me.MaintainedCode = "" Then
MsgBox "äæÚ ÊÚãíÑÇÊ ÑÇ ÇäÊÎÇÈ ßäíÏ", , "ÊæÌå"
Me.MaintainedCode.SetFocus
Exit Sub
End If
If Me.CalibrDate = "" Then
MsgBox "ÊÇÑíÎ ßÇáíÈÑå ÑÇ æÇÑÏ ßäíÏ", , "ÊæÌå"
Me.CalibrDate.SetFocus
Exit Sub
End If
If Me.Exp_Date = "" Then
MsgBox "ÊÇÑíÎ ÇäÞÖÇÁ ÑÇ æÇÑÏ ßäíÏ", , "ÊæÌå"
Me.Exp_Date.SetFocus
Exit Sub
End If
'Dim ans As Integer
'ans = MsgBox("ÇØáÇÚÇÊ ÐÎíÑå ÔæÏ", vbQuestion + vbYesNo, "ÊæÌå")
'If ans = 6 Then
If CalibrRst.NoMatch Then
CalibrRst.AddNew
CalibrRst!SabtNo = Me.SabtNo
Else
CalibrRst.Edit
End If
Call SaveData
Me.StatusLabel.Caption = "ÐÎíÑå ÔÏ"
'End If
Me.CurrentDate.SetFocus
End Sub


Private Sub FirstBtn_Click()
CalibrRst.MoveFirst
Me.C_Dev = IIf(IsNull(CalibrRst![C_Dev]), "", CalibrRst![C_Dev])
Me.CalibrDate = IIf(IsNull(CalibrRst!CalibrDate), "", CalibrRst![CalibrDate])
Me.Exp_Date = IIf(IsNull(CalibrRst!Exp_Date), "", CalibrRst![Exp_Date])
Me.CalibrDate = ""
Me.Exp_Date = ""
End Sub


Private Sub LastBtn_Click()
CalibrRst.MoveLast
Me.C_Dev = IIf(IsNull(CalibrRst![C_Dev]), "", CalibrRst![C_Dev])
Me.CalibrDate = IIf(IsNull(CalibrRst!CalibrDate), "", CalibrRst!CalibrDate)
Me.Exp_Date = IIf(IsNull(CalibrRst!Exp_Date), "", CalibrRst!Exp_Date)
Me.CalibrDate = ""
Me.Exp_Date = ""
End Sub

Private Sub NextBtn_Click()
CalibrRst.MoveNext
If CalibrRst.EOF Then
MsgBox "Èå ÇäÊåÇ ÑÓíÏ"
CalibrRst.MoveLast
Else
Me.C_Dev = IIf(IsNull(CalibrRst![C_Dev]), "", CalibrRst![C_Dev])
Me.CalibrDate = IIf(IsNull(CalibrRst!CalibrDate), "", CalibrRst!CalibrDate)
Me.Exp_Date = IIf(IsNull(CalibrRst!Exp_Date), "", CalibrRst!Exp_Date)
Me.CalibrDate = ""
Me.Exp_Date = ""
End If
End Sub

Private Sub PrevBtn_Click()
CalibrRst.MovePrevious
If CalibrRst.BOF Then
MsgBox "Èå ÇÈÊÏÇ ÑÓíÏ"
CalibrRst.MoveFirst
Else
Me.C_Dev = IIf(IsNull(CalibrRst![C_Dev]), "", CalibrRst![C_Dev])
Me.CalibrDate = IIf(IsNull(CalibrRst!CalibrDate), "", CalibrRst!CalibrDate)
Me.Exp_Date = IIf(IsNull(CalibrRst!Exp_Date), "", CalibrRst!Exp_Date)
Me.CalibrDate = ""
Me.Exp_Date = ""
End If
End Sub


Private Sub ExitCmd_Click()
CalibrRst.Close
'Au1Rst.Close
Calibr.Close
DoCmd.Close
End Sub

Private Sub Type_GotFocus()
'Me.Type.DataSource
'Me.Type.ItemData (1)
'Me.Type.List (1)
'Me.Type.ZOrder ([0])
End Sub

Private Sub ClearForm()
DevFound = False
Me.C_Dev = ""
Me.ManufacturerCode = ""
Me.Plant_Cod = ""
Me.S_Dev = ""
Me.Type = ""
Me.PersonalNo1 = ""
Me.PersonalNo2 = ""
Me.Naf_Saat = ""
Me.CalibratorDev = ""
Me.CalibratorSerial = ""
Me.PlaceCod = ""
Me.MaintainedCode = ""
Me.ReceptDate = ""
Me.CalibrDate = ""
Me.Exp_Date = ""
End Sub

Private Sub RestoreData()
Me.C_Dev = CalibrRst!C_Dev
Me.ManufacturerCode = IIf(IsNull(CalibrRst!ManufacturerCode), "", CalibrRst!ManufacturerCode)
Me.Plant_Cod = IIf(IsNull(CalibrRst!Plant_Cod), "", CalibrRst!Plant_Cod)
Me.S_Dev = IIf(IsNull(CalibrRst!S_Dev), "", CalibrRst!S_Dev)
Me.Type = IIf(IsNull(CalibrRst!Type), "", CalibrRst!Type)
Me.PersonalNo1 = IIf(IsNull(CalibrRst!PersonalNo1), "", CalibrRst!PersonalNo1)
Me.PersonalNo2 = IIf(IsNull(CalibrRst!PersonalNo2), "", CalibrRst!PersonalNo2)
Me.Naf_Saat = IIf(IsNull(CalibrRst!Naf_Saat), "", CalibrRst!Naf_Saat)
Me.CalibratorDev = IIf(IsNull(CalibrRst!CalibratorDev), "", CalibrRst!CalibratorDev)
Me.CalibratorSerial = IIf(IsNull(CalibrRst!CalibratorSerial), "", CalibrRst!CalibratorSerial)
Me.PlaceCod = IIf(IsNull(CalibrRst!PlaceCod), "", CalibrRst!PlaceCod)
Me.MaintainedCode = IIf(IsNull(CalibrRst!MaintainedCode), "", CalibrRst!MaintainedCode)
Me.ReceptDate = IIf(IsNull(CalibrRst!ReceptDate), "", CalibrRst!ReceptDate)
Me.CalibrDate = IIf(IsNull(CalibrRst!CalibrDate), "", CalibrRst!CalibrDate)
Me.Exp_Date = IIf(IsNull(CalibrRst!Exp_Date), "", CalibrRst!Exp_Date)
End Sub

Private Sub SaveData()
CalibrRst!C_Dev = Me.C_Dev
CalibrRst!ManufacturerCode = Me.ManufacturerCode
CalibrRst!Plant_Cod = Me.Plant_Cod
CalibrRst!S_Dev = Me.S_Dev
CalibrRst!Type = Me.Type
CalibrRst!PersonalNo1 = Me.PersonalNo1
CalibrRst!PersonalNo2 = Me.PersonalNo2
CalibrRst!Naf_Saat = Me.Naf_Saat
CalibrRst!CalibratorDev = Me.CalibratorDev
CalibrRst!CalibratorSerial = Me.CalibratorSerial
CalibrRst!PlaceCod = Me.PlaceCod
CalibrRst!MaintainedCode = Me.MaintainedCode
CalibrRst!ReceptDate = Me.ReceptDate
CalibrRst!CalibrDate = Me.CalibrDate
CalibrRst!Exp_Date = Me.Exp_Date
CalibrRst.Update
If DevFound Then
If Me.C_Dev = Au1Rst!C_Dev Then
Au1Rst.Edit
Au1Rst!LastCalibr = Me.CalibrDate
Au1Rst!LastRecept = Me.ReceptDate
Au1Rst!Exp_Date = Me.Exp_Date
Au1Rst!Period = Me.PeriodBox
Au1Rst.Update
Au1Rst.Close
Else
MsgBox "áØÝÇ ÎØÇí Èå æÌæÏ ÂãÏå ÑÇ Èå ãåäÏÓ åÇÔãí ÈÇ ÊáÝä 3272 ÇØáÇÚ ÏåíÏ", , Au1Rst!C_Dev
End If
End If
End Sub

Private Sub Type_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.PersonalNo1.SetFocus
End If
End Sub

[Arash_XL7710i_207]

سلام:
خوب چه جوري ميتونيم براي فرمامون در وي بي يك Style يا Theme داشته باشيم مثل برنامه Style XP

[Arash_XL7710i_207]

سلام:
خوب چه جوري ميتونيم Style فرممون رو تغيير بديم(مثل برنامه Style XP كه قالب يا شكل ظاهري پنجره هاي ويندوز رو تغيير ميده)

[MohammadJavad.T]

سلام خسته نباشيد ميشه source پست 6 ر و بزارينpopup menu made simple

[Farzin.net]

سلام واقعا از کارتون ممنون من هفته بعد با دست پر میام من برنامه نویس vb.net ,vb هستم

[reza.a]

اول سلام

دوم خسته نباشی

من اولین باری بود که به این قسمت سر زدم

چون من که آخر وی بی هستم فکر می کردم خیلی آماتوری باشه

در هر صورت خیلی عالی بود

بازم سر می زنم

[M.K_Soft]

دوستان این چطوره؟ اگه جالبه بگین بقیش رو هم بزارم.

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

اینم لینکش :
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

[Blue Rose]

البته اگه باقيشون رو هم بذاري هم ازشون استفاده ميكنيم هم خودتو دعا ميكنيم

[M.K_Soft]

اينم يكي ديگه
يه كنترل CheckBox توپ با امكانات بي نهايت : عکس در خود فایل دانلود شده می باشد.

از اينجا بگيريد:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

و

بعدي كنترل ComboBox باحال
براي رجيستر كردن كنترل ابتدا فايل Install.bat را اجرا كنيد سپس با برنامه Light Register و با يوزر و پسوردي كه تو فايل Serial.txt است آن را رجيستر كنيد

از اينجا بگيريد
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

و

كنترل بعدي يه TextBox براي كار با پول
براي رجيستر كردن كنترل ابتدا فايل Install.bat را اجرا كنيد سپس با برنامه Light Register و با يوزر و پسوردي كه تو فايل Serial.txt است آن را رجيستر كنيد

از اينجا بگيريد:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

و

اين كنترل DateTime براي كار با زمان و تاريخ
براي رجيستر كردن كنترل ابتدا فايل Install.bat را اجرا كنيد سپس با برنامه Light Register و با يوزر و پسوردي كه تو فايل Serial.txt است آن را رجيستر كنيد

از اينجا بگيريد:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

خواهش می کنم نظر بدید.