Cấu trúc của một chương trỡnh viết bằng ngụn ngữ Visual Basic Mục đích và yêu cầu của phần mềm

 NộI dung

Phần I GiớI thiệu về ngôn ngữ Visual Basic

 Lập trình vớI ngôn ngữ Visual Basic

 Cấu trúc của một chương trình viết bằng ngôn ngữ Visual Basic

Phần II Mục đích và yêu cầu của phần mềm

 Chức năng chính của Phần mềm

Phần III Cơ sở dữ liệu

Phần IV Mã nguồn

 

doc91 trang | Chia sẻ: huong.duong | Ngày: 12/09/2015 | Lượt xem: 863 | Lượt tải: 1download
Bạn đang xem trước 20 trang tài liệu Cấu trúc của một chương trỡnh viết bằng ngụn ngữ Visual Basic Mục đích và yêu cầu của phần mềm, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
Not False cmdDel.Enabled = Not False End If MonthView.Value = Month(Now) & "/" & Day(Now) & "/" & Year(Now) AddDistrict AddTypeHouse AddUserID If rsBuy.RecordCount <= 0 Then LockNavi False cmdDel.Enabled = False cmdModify.Enabled = False End If End Sub Private Sub cmdCancel_Click() 'If UserAdd Then ' cmdExit.Enabled = True ' Unload Me 'End If If IsAdmin = False Then cmdModify.Enabled = False cmdDel.Enabled = False Else cmdModify.Enabled = Not False cmdDel.Enabled = Not False End If LockNavi True cmdAdd.Enabled = True cmdFind.Enabled = True cmdSave.Enabled = False If rsBuy.RecordCount <= 0 Then LockNavi False LockCtl False cmdDel.Enabled = False cmdCancel.Enabled = False cmdModify.Enabled = False Dim ctl As Control EmptyCtl Exit Sub End If rsBuy.CancelUpdate rsBuy.MovePrevious If rsBuy.BOF Then rsBuy.MoveFirst If rsBuy.EOF Then rsBuy.MoveLast Display If IsAdmin = False And LCase(cobUserID.Text) = LCase(User_ID) Then cmdDel.Enabled = True cmdModify.Enabled = True End If End Sub Private Sub cmdSave_Click() Save If Saved = True Then cmdCancel_Click End If addFlag = False If UserAdd Then If Saved = True Then Call MakeTransact(txtBuyID.Text, cobUserID.Text) Unload Me End If End If End Sub ================================================== 3. Form search transaction Private Sub chk_area_Click() If chk_area.Value = 1 Then frm_area.Height = 1475 frm_floor.Top = 5520 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 If chk_expired.Value = 1 Then Me.Height = 8300 Else Me.Height = 7800 End If chk_area.ForeColor = &HFF0000 Else If chk_date.Value = 0 And chk_price.Value = 0 Then If chk_expired.Value = 1 Then Me.Height = 7200 Else Me.Height = 6600 End If frm_floor.Top = 4380 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 End If chk_area.ForeColor = &H808080 frm_area.Height = 375 End If End Sub Private Sub chk_date_Click() If chk_date.Value = 1 Then frm_date.Height = 1475 If chk_expired.Value = 1 Then Me.Height = 8300 Else Me.Height = 7800 End If frm_floor.Top = 5520 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 chk_date.ForeColor = &HFF0000 Else If chk_area.Value = 0 And chk_price.Value = 0 Then If chk_expired.Value = 1 Then Me.Height = 7200 Else Me.Height = 6600 End If frm_floor.Top = 4380 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 End If chk_date.ForeColor = &H808080 frm_date.Height = 385 End If End Sub Private Sub chk_direct_Click() If chk_direct.Value = 1 Then cmb_direct.Visible = True chk_direct.ForeColor = &HFF0000 Else cmb_direct.Visible = False chk_direct.ForeColor = &H808080 End If End Sub Private Sub chk_dist_Click() If chk_dist.Value = 1 Then cmb_dist.Visible = True chk_dist.ForeColor = &HFF0000 Else cmb_dist.Visible = False chk_dist.ForeColor = &H808080 End If End Sub Private Sub chk_expired_Click() If chk_expired.Value = 1 Then chk_expired.ForeColor = &HFF0000 frm_expired.Height = 900 Me.Height = Me.Height + 500 Else chk_expired.ForeColor = &H808080 frm_expired.Height = 345 Me.Height = Me.Height - 500 End If End Sub Private Sub chk_floor_num_Click() If chk_floor_num.Value = 1 Then cmb_operator1.Visible = True lbl1.Visible = True txt_value1.Visible = True frm_floor.Width = 7245 chk_floor_num.ForeColor = &HFF0000 Else chk_floor_num.ForeColor = &H808080 If chk_tot_floor.Value = 0 Then frm_floor.Width = 1980 End If cmb_operator1.Visible = False lbl1.Visible = False txt_value1.Visible = False End If End Sub Private Sub chk_h_type_Click() If chk_h_type.Value = 1 Then chk_floor_num.Value = 0 chk_tot_floor.Value = 0 If cmb_h_type.Text = cmb_h_type.List(6) Or cmb_h_type.Text = cmb_h_type.List(7) Or cmb_h_type.Text = cmb_h_type.List(8) Then chk_floor_num.Enabled = False chk_tot_floor.Enabled = False Else chk_floor_num.Enabled = True chk_tot_floor.Enabled = True End If cmb_h_type.Visible = True chk_h_type.ForeColor = &HFF0000 Else chk_floor_num.Value = 0 chk_tot_floor.Value = 0 chk_floor_num.Enabled = False chk_tot_floor.Enabled = False cmb_h_type.Visible = False chk_h_type.ForeColor = &H808080 End If End Sub Private Sub chk_loc_Click() If chk_loc.Value = 1 Then cmb_loc.Visible = True chk_loc.ForeColor = &HFF0000 Else chk_loc.ForeColor = &H808080 cmb_loc.Visible = False End If End Sub Private Sub chk_price_Click() If chk_price.Value = 1 Then cmb_cur.Visible = True frm_price.Height = 1475 If chk_expired.Value = 1 Then Me.Height = 8300 Else Me.Height = 7800 End If frm_floor.Top = 5520 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 chk_price.ForeColor = &HFF0000 Else If chk_date.Value = 0 And chk_area.Value = 0 Then If chk_expired.Value = 1 Then Me.Height = 7200 Else Me.Height = 6600 End If frm_floor.Top = 4380 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 End If frm_price.Height = 375 chk_price.ForeColor = &H808080 cmb_cur.Visible = False End If End Sub Private Sub chk_street_Click() If chk_street.Value = 1 Then cmb_street.Visible = True chk_street.ForeColor = &HFF0000 Else cmb_street.Visible = False chk_street.ForeColor = &H808080 End If End Sub Private Sub chk_tot_floor_Click() If chk_tot_floor.Value = 1 Then cmb_operator2.Visible = True lbl2.Visible = True txt_value2.Visible = True frm_floor.Width = 7245 chk_tot_floor.ForeColor = &HFF0000 Else If chk_floor_num.Value = 0 Then frm_floor.Width = 1980 End If cmb_operator2.Visible = False lbl2.Visible = False txt_value2.Visible = False chk_tot_floor.ForeColor = &H808080 End If End Sub Private Sub chk_width_Click() If chk_width.Value = 1 Then lbl_width.Visible = True txt_width.Visible = True chk_width.ForeColor = &HFF0000 Else lbl_width.Visible = False txt_width.Visible = False chk_width.ForeColor = &H808080 End If End Sub Private Sub chk7_Click() End Sub Private Sub chk9_Click() End Sub Private Sub chk1_Click() If chk1.Value = 1 Then chk1.ForeColor = &HFF0000 Else chk1.ForeColor = &H808080 End If End Sub Private Sub chk2_Click() If chk2.Value = 1 Then chk2.ForeColor = &HFF0000 Else chk2.ForeColor = &H808080 End If End Sub Private Sub cmb_dist_Click() Call Add_Street(cmb_dist.Text) End Sub Private Sub cmb_h_type_Click() If cmb_h_type.Text = cmb_h_type.List(6) Or cmb_h_type.Text = cmb_h_type.List(7) Or cmb_h_type.Text = cmb_h_type.List(8) Then chk_floor_num.Enabled = False chk_tot_floor.Enabled = False Else If chk_h_type.Value = 1 Then chk_floor_num.Enabled = True chk_tot_floor.Enabled = True End If End If End Sub Private Sub Command1_Click() End Sub Private Sub cmd_search_Click() If Check_Condition = False Then Exit Sub End If Call Set_Condition lbl_pro.Visible = True pic1.Visible = True DoEvents frm_tran_res.lst1.ColumnHeaders.Clear frm_tran_res.lst1.ListItems.Clear frm_tran_res.lst1.ColumnHeaders.Add , , "Item ID" frm_tran_res.lst1.ColumnHeaders.Add , , "Type" frm_tran_res2.lst1.ColumnHeaders.Clear frm_tran_res2.lst1.ListItems.Clear frm_tran_res2.lst1.ColumnHeaders.Add , , "Item ID" frm_tran_res2.lst1.ColumnHeaders.Add , , "Type" Call Search_Trans(True, TblTran, AuthID, AuthID_chk, TranID, TranID_chk, Street, District, HType, Location, Direct, HWidth, FDate, LDate, Oper1, Oper2, Value1, Value2, FExpired, LExpired, MinArea, MaxArea, MinPrice, MaxPrice) End Sub Private Sub Command3_Click() Unload Me End Sub Private Sub cmdClose_Click() Unload frm_find_trans End Sub Private Sub Form_Load() If User_Permission = "Administrator" Then chk_expired.Enabled = True End If Set cnnFind = New ADODB.Connection 'cnn.Open "Provider=" & "Microsoft.Jet.OLEDB.3.51;" & "Data Source=" & App.Path & "\Database\advertisement.mdb;" & "Jet OLEDB:Database Password=" & "dankadv;" cnnFind.Provider = "Microsoft.Jet.OLEDB.4.0" cnnFind.Open App.Path & "\database\nhadatdatabase.mdb" frm_floor.Width = 1980 frm_floor.Top = 4380 frm_area.Height = 375 frm_area.Height = 375 frm_price.Height = 375 frm_date.Height = 375 Me.Height = 2590 ' Me.WindowState = 0 Call Default End Sub '-------------------------------------------------------------------------------- If District " " And District "( ALL )" Then 'Match District If rs!District = District Then FDistrict = True Else FDistrict = False End If Else FDistrict = True End If '-------------------------------------------------------------------------------- If Street " " And Street "( ALL )" Then 'Match Street If rs!Street = Street Then FStreet = True Else FStreet = False End If Else FStreet = True End If '-------------------------------------------------------------------------------- If Direction " " Then 'Match Direction If rs!Direction = Direction Then FDirection = True Else FDirection = False End If Else FDirection = True End If '-------------------------------------------------------------------------------- If Location " " Then 'Match Location If rs!Location = Location Then FLocation = True Else FLocation = False End If Else FLocation = True End If '-------------------------------------------------------------------------------- If HWidth -1 Then 'Match Width If rs!Width >= HWidth Then FWidth = True Else FWidth = False End If Else FWidth = True End If '-------------------------------------------------------------------------------- If FDate " " Then 'Match Date of Update Dim Max If CDate(FDate) > CDate(LDate) Then Max = FDate LDate = FDate FDate = Max End If If CDate(rs!dofupdate) >= FDate And CDate(rs!dofupdate) <= LDate Then FoDate = True Else FoDate = False End If Else FoDate = True End If '-------------------------------------------------------------------------------- If FExpired " " Then 'Match Date of Expired Dim MaxD If CDate(FExpired) > CDate(LExpired) Then MaxD = FExpired LExpired = FExpired FExpired = Max End If If CDate(rs!dofupdate) >= FExpired And CDate(rs!dofupdate) <= LExpired Then FoExpired = True Else FoExpired = False End If Else FoExpired = True End If '-------------------------------------------------------------------------------- If HType " " Then ' Match House Type If LCase(rs!thouse) = LCase(HType) Then FType = True Else FType = False End If Else FType = True End If '-------------------------------------------------------------------------------- 'Match Area If MinArea -1 And MaxArea = -1 Then ' Min only If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!area >= MinArea Then FArea = True Else FArea = False End If Else If rs!MinArea >= MinArea Then FArea = True Else FArea = False End If End If End If If MinArea = -1 And MaxArea -1 Then 'Max Only If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!area <= MaxArea Then FArea = True Else FArea = False End If Else If rs!MaxArea >= MaxArea Then FArea = True Else FArea = False End If End If End If If MinArea -1 And MaxArea -1 Then 'Min And Max If TblTran = "tbl_selling" Or TblTran = "tbl_hire" Then If rs!area >= MinArea And rs!area <= MaxArea Then FArea = True Else FArea = False End If Else If rs!minTarea >= MinArea And rs!MaxTarea <= MaxArea Then FArea = True Else FArea = False End If End If End If If MinArea = -1 And MaxArea = -1 Then FArea = True End If '-------------------------------------------------------------------------------- 'Match Price If MinPrice -1 And MaxPrice = -1 Then If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!Price >= MinPrice Then FPrice = True Else FPrice = False End If Else If rs!MinPrice >= MinPrice Then FPrice = True Else FPrice = False End If End If End If If MinPrice = -1 And MaxPrice -1 Then If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!Price <= MaxPrice Then FPrice = True Else FPrice = False End If Else If rs!MaxPrice >= MaxPrice Then FPrice = True Else FPrice = False End If End If End If If MinPrice -1 And MaxPrice -1 Then If TblTran = "tbl_selling" Or TblTran = "tbl_hire" Then If rs!Price >= MinPrice And rs!Price <= MaxPrice Then FPrice = True Else FPrice = False End If Else If rs!MinPrice >= MinPrice And rs!MaxPrice <= MaxPrice Then FPrice = True Else FPrice = False End If End If End If If MinPrice = -1 And MaxPrice = -1 Then FPrice = True End If '-------------------------------------------------------------------------------- 'Match Floor number If Oper1 6 Then If Oper1 = 0 Then If rs!fno Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 1 Then If rs!fno = Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 2 Then If rs!fno > Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 3 Then If rs!fno >= Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 4 Then If rs!fno < Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 5 Then If rs!fno <= Value1 Then FFloorNum = True Else FFloorNum = False End If End If Else FFloorNum = True End If '-------------------------------------------------------------------------------- 'Match Total of floor If Oper2 6 Then If Oper2 = 0 Then If rs!toffloor Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 1 Then If rs!toffloor = Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 2 Then If rs!toffloor > Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 3 Then If rs!toffloor >= Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 4 Then If rs!toffloor < Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 5 Then If rs!toffloor <= Value2 Then FFloorTot = True Else FFloorTot = False End If End If Else FFloorTot = True End If '-------------------------------------------------------------------------------- 'FINAL UNION FOUND CONDITION If FTran = True And FAuth = True And FDistrict = True _ And FStreet = True And FWidth = True And FoDate = True _ And FDirection = True And FLocation = True And FType = True _ And FArea = True And FPrice = True And FoExpired = True _ And FFloorNum = True And FFloorTot = True Then found = found + 1 End Function ================================================== 4. Form compose Private Sub Initial() rtxtBox.Text = "" cboSize.Text = "10" cboFont.Text = "MS Sans Serif" End Sub Private Sub lblTransparent() Dim i As Byte For i = 0 To 8 picAlign(i).BackColor = vbButtonFace Next i End Sub Private Sub cboFont_LostFocus() rtxtBox.SelFontName = cboFont.Text rtxtBox.Refresh End Sub Private Sub cboSize_Change() On Error GoTo lbl rtxtBox.SelFontSize = cboSize.Text rtxtBox.Refresh lbl: End Sub Private Sub cboSize_LostFocus() rtxtBox.SelFontSize = cboSize.Text rtxtBox.Refresh End Sub Private Sub cmdClose_Click(Index As Integer) Unload Me End Sub Private Sub cmdSend_Click(Index As Integer) If txtTo.Text = "" Then MsgBox "You must enter the UserName to sent to !", vbInformation, "Message can not be send " Exit Sub End If txtTo.Text = Trim(txtTo.Text) If rtxtBox.Text = "" Then MsgBox "You must type in the message to be sent !", vbInformation, "Message empty !" rtxtBox.SetFocus Exit Sub End If Dim rsU As ADODB.Recordset Set rsU = New ADODB.Recordset rsU.Open "tbl_Account", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If rsU.RecordCount <= 0 Then Exit Sub End If rsU.MoveFirst Dim Ex As Boolean Ex = False Do While Not rsU.EOF If LCase(rsU.Fields(0)) = LCase(txtTo.Text) Then Ex = True Exit Do End If rsU.MoveNext Loop If Ex = False Then MsgBox "The User '" & txtTo.Text & "' is not exist . Please check down your Send to !", vbCritical, "User Invalid" Exit Sub End If Select Case Index Case 0 Call UpdateM Case 1 End Select MsgBox "Message has been sent to " & txtTo.Text & " !", vbOKOnly + vbInformation, "Note !" Unload Me End Sub Private Sub Form_Load() lblTransparent Initial End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not FFlag Then lblTransparent FFlag = True End If End Sub Private Sub picAlign_Click(Index As Integer) If Index >= 0 And Index <= 5 Then picAlign(Index).BorderStyle = _ (picAlign(Index).BorderStyle + 1) Mod 2 End If Select Case Index Case 0 rtxtBox.SelBold = Not rtxtBox.SelBold Case 1 rtxtBox.SelItalic = Not rtxtBox.SelItalic Case 2 rtxtBox.SelUnderline = Not rtxtBox.SelUnderline Case 3 rtxtBox.SelAlignment = vbLeftJustify Case 4 rtxtBox.SelAlignment = vbCenter Case 5 rtxtBox.SelAlignment = vbRightJustify Case 6 Seltext = rtxtBox.Seltext rtxtBox.Seltext = "" Case 7 Seltext = rtxtBox.Seltext Case 8 rtxtBox.Seltext = Seltext End Select If Index = 3 Then picAlign(ClickPicAlign).BorderStyle = 0 ClickPicAlign = Index End If If Index >= 6 And Index <= 8 Then picAlign(ClickPicEdit).BorderStyle = 0 ClickPicEdit = Index End If End Sub Private Sub picAlign_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Index >= 6 And Index <= 8 Then picAlign(Index).BorderStyle = 1 End If End Sub Private Sub picAlign_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Index MoveLabel Then picAlign(MoveLabel).BackColor = vbButtonFace picAlign(Index).BackColor = vbWhite '&H80000016 MoveLabel = Index End If FFlag = False End Sub Private Sub picAlign_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Index >= 6 And Index <= 8 Then picAlign(Index).BorderStyle = 0 End If End Sub Private Sub UpdateM() Dim rs As New ADODB.Recordset If Not TSend Then TableM = "Tbl_Message_Account" End If rs.Open TableM, cnNet, adOpenDynamic, adLockPessimistic, adCmdTable rs.AddNew rs!RUserID = Trim(txtTo.Text) rs!Suserid = User_ID rs!DofSending = Date rs!Subject = txtSubject.Text If TSend Then rs.Fields(1) = Tcode End If rtxtBox.SaveFile (netPathDir + "User\" + Trim(txtTo.Text) + "\" + CStr(rs.Fields(0)) + ".rtf") rs.Update End Sub ================================================== 5.form browse transaction Private Sub cmb_auth_Click() cmd_qsearch.Enabled = True End Sub Private Sub cmb_dist_Click() cmd_qsearch.Enabled = True If cmb_dist.Text = "( ALL )" Then Dim rs_street As ADODB.Recordset Set rs_street = New ADODB.Recordset rs_street.Open "Tbl_street", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable rs_street.MoveFirst Do While Not rs_street.EOF cmb_street.AddItem rs_street.Fields(2).Value rs_street.MoveNext Loop Exit Sub End If Call Add_Street End Sub Private Sub cmb_id_Click() cmd_qsearch.Enabled = True End Sub Private Sub cmb_id_GotFocus() cmb_id.SelStart = 0 cmb_id.SelLength = Len(cmb_id.Text) End Sub Private Sub cmb_street_Click() cmd_qsearch.Enabled = True End Sub Private Sub cmd_close_Click() Unload Me End Sub Private Sub cmd_cont_Click() Dim au As String Dim item_name As String grid1.row = row_auth grid1.Col = 6 au = grid1.Text grid1.Col = 1 item_name = grid1.Text If row_auth = 0 Then MsgBox "You must choose one of User in the list", vbInformation, "Contact Failed !" Exit Sub End If If Tab_i = 1 Then ' Tab_i = TableM = "tbl_message_selling" End If If Tab_i = 2 Then ' Tab_i = TableM = "tbl_message_buying" End If If Tab_i = 3 Then ' Tab_i = TableM = "tbl_message_rent" End If If Tab_i = 4 Then ' Tab_i = TableM = "tbl_message_hire" End If Tcode = item_name frmCompose.txtTo = au Unload Me frmCompose.Show End Sub Private Sub cmd_detail_Click() Dim i As Byte For i = 1 To 4 If tab1.Tabs(i).Selected Then Tab_i = i End If Next i Me.Hide frm_adv_det.List_Call = True frm_adv_det.Item_call = grid1.TextMatrix(grid1.RowSel, 1) frm_adv_det.Show End Sub Private Sub cmd_find_Click() Unload Me frm_find_trans.Show End Sub Private Sub cmd_list_all_Click() If tab1.Tabs(1).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Selling", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then ' MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_SH Call ADD_ITEM_SEL End If If tab1.Tabs(2).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Buying", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then ' MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_BR Call ADD_ITEM_SEL End If If tab1.Tabs(3).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Rent", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then 'MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_BR Call ADD_ITEM_SEL End If If tab1.Tabs(4).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Hire", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then 'MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_SH Call ADD_ITEM_SEL End If End Sub Private Sub cmd_New_Click() frm_adv_new.Show vbModal End Sub Private Sub cmd_qsearch_Click() row = 0 grid1.Enabled = True Dim found As Boolean Dim completed As Boolean Dim f_id As Boolean Dim f_street As Boolean Dim f_dist As Boolean Dim f_auth As Boolean Dim i As Integer Dim per As Integer If cmb_id.Text = "( ALL )" And cmb_street.Text = "( ALL )" And cmb_dist.Text = "( ALL )" And cmb_auth.Text = "( ALL )" Then If grid1.rows Rs_local.RecordCount Then Call ADD_ITEM_SEL End If Exit Sub End If grid1.Clear If cmb_id.Text = "" And cmb_street.Text = "" And cmb_dist.Text = "" And cmb_auth.Text = "" Then MsgBox "You must type in on value in one of Item ID, Street, District or Author ID", vbExclamation, "Quick Search Failed !" cmd_qsearch.Enabled = False Exit Sub Else If Rs_local.RecordCount >= 1 Then Rs_local.MoveFirst pic_progress.Visible = True pic_progress.Refresh Do While Not Rs_local.EOF per = per + 1 UpdateStatus pic_progress, per / Rs_local.RecordCount, "Searching ...", True found = False If Rs_local.Fields(0) = cmb_id.Text Then 'Item ID match or not f_id = True Else f_id = False If cmb_id.Text = "( ALL )" Then f_id = True End If End If If tab1.Tabs(1).Selected Or tab1.Tabs(4).Selected Then If Rs_local!Street = cmb_street.Text Then 'Match street for Sell and Hire f_street = True Else f_street = False If cmb_street.Text = "( ALL )" Then f_street = True End If End If If Rs_local!District.Value = cmb_dist.Text Then 'match distict f_dist = True Else f_dist = False If cmb_dist.Text = "( ALL )" Then f_dist = True End If End If If Rs_local!userid = cmb_auth.Text Then 'Match author f_auth = True Else f_auth = False If cmb_auth.Text = "( ALL )" Then f_auth = True End If End If Else If Rs_local!Street = cmb_street.Text Then 'Match street for buy and Rent f_street = True Else f_street = False If cmb_street.Text = "( ALL )" Then f_street = True End If End If If Rs_local!District.Value = cmb_dist.Text Then 'match distict f_dist = True Else f_dist = False If cmb_dist.Text = "( ALL )" Then f_dist = True End If End If If Rs_local!userid = cmb_auth.Text Then 'Match author f_auth = True Else f_auth = False If cmb_auth.Text = "( ALL )" Then f_auth = True End If End If End If If f_id = True And f_street = True And f_auth = True And f_dist = True Then found = True End If If found = True Then completed = True row = row + 1 grid1.rows = row + 1 If tab1.Tabs(1).Selected Or tab1.Tabs(4).Selected Then Call ADD_ITEM Call Create_grid_header_SH Else Call ADD_ITEM_B

Các file đính kèm theo tài liệu này:

  • docP0048.doc
Tài liệu liên quan