category.frm

一套收银系统

      EMBOSSM         =   12632256
      EMBOSSS         =   16777215
      MPTR            =   0
      MICON           =   "Category.frx":0070
      ALIGN           =   1
      IMGLST          =   "(None)"
      IMGICON         =   "(None)"
      ICONAlign       =   0
      ORIENT          =   0
      STYLE           =   1
      IconSize        =   2
      SHOWF           =   -1  'True
      BSTYLE          =   0
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Search :"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   195
      Index           =   2
      Left            =   180
      TabIndex        =   10
      Top             =   3960
      Width           =   615
   End
   Begin VB.Shape Shape3 
      BorderColor     =   &H80000009&
      FillColor       =   &H00FFFFFF&
      Height          =   15
      Left            =   0
      Top             =   480
      Width           =   6030
   End
   Begin VB.Shape Shape2 
      BorderWidth     =   2
      Height          =   15
      Left            =   0
      Top             =   480
      Width           =   6030
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Category Name  :"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   195
      Index           =   1
      Left            =   150
      TabIndex        =   8
      Top             =   1020
      Width           =   1305
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Category ID  :"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   195
      Index           =   0
      Left            =   150
      TabIndex        =   7
      Top             =   660
      Width           =   1095
   End
End
Attribute VB_Name = "Category"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim adoCategory As New ADODB.Recordset
Dim autoID As New ADODB.Recordset
Dim ls As ListItem
Function CategoryID()
Randomize
txtCatId.Text = "CAT" & Round(Rnd() * 999999) & txtCatId.Text + Chr(Round(Rnd() * 25) + 65)

End Function
Private Sub btnAdd_Click()
Call CategoryID
btnSave.Enabled = True
btnCancel.Enabled = True
btnAdd.Enabled = False
txtCatname.SetFocus
End Sub
Private Sub btnCancel_Click()
On Error Resume Next
adoCategory.CancelUpdate
Call Cancel
End Sub
Private Sub btnDelete_Click()
Dim rsDelete As New ADODB.Recordset
If rsDelete.State = 1 Then Set rsDelete = Nothing

rsDelete.Open "SELECT * from [Category] where [Category Id]='" & txtCatId.Text & "'", con, adOpenDynamic, adLockPessimistic

    With rsDelete
    
        If Not .EOF Then
        
            ans = MsgBox("Are you sure do you want delete this one record?", vbCritical + vbYesNo, "Delete?")
            
                If ans = vbYes Then
                
                    .Delete
                    .Requery
                    .Close
                    Call txtSearch_Change
                    btnAdd.Enabled = True
                    btnEdit.Enabled = False
                    btnDelete.Enabled = False
                    
                    
                End If
        
        Else
            MsgBox "This Record is already Deleted!", vbExclamation + vbOKOnly
        End If
    
    End With
End Sub
Private Sub btnEdit_Click()
If btnEdit.Caption = "&Edit" Then
   btnEdit.Caption = "&Update"
   btnCancel.Enabled = True
   btnAdd.Enabled = False
   btnSave.Enabled = False
   btnDelete.Enabled = False
Else: btnEdit.Caption = "&Update"
btnEdit.Caption = "&Edit"

Dim rsProd As New ADODB.Recordset

If rsProd.State = 1 Then Set rsProd = Nothing

rsProd.Open "SELECT * from [Category] where [Category ID] ='" & txtCatId.Text & "'", con, adOpenDynamic, adLockPessimistic
   
   With rsProd
       
        
        con.BeginTrans
     
        .Fields(0) = txtCatId.Text
        .Fields(1) = UCase(txtCatname.Text)
        .Update
        .Requery
        
        con.CommitTrans
        
        .Close
        Call txtSearch_Change
        btnEdit.Enabled = False
        btnAdd.Enabled = True
      
     
   End With
   
Set rsProd = Nothing

End If
End Sub

Private Sub btnSave_Click()



If txtCatname.Text = "" Then

    MsgBox "Please fill up Category Name!", vbInformation + vbOKOnly

Else

    
    With adoCategory
    
     
        con.BeginTrans
        .AddNew
        .Fields(0) = txtCatId.Text
        .Fields(1) = UCase(txtCatname.Text)
        .Update
        .Requery
        con.CommitTrans
        Call Cancel
        Call txtSearch_Change
        
           
          
      
      
    End With
End If



End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub Form_Load()


 If adoCategory.State = 1 Then Set adoCategory = Nothing
        
        adoCategory.CursorLocation = adUseClient
        adoCategory.Open "SELECT * FROM [Category] ORDER BY [Category Id]", con, adOpenDynamic, adLockOptimistic
        adoCategory.Requery
        
               dview
        

Call colums
End Sub
Function Cancel()
txtCatId.Text = ""
txtCatname.Text = ""
btnAdd.Enabled = True
btnSave.Enabled = False
btnDelete.Enabled = False
End Function
Function colums()
    Me.Width = 6120
    Me.Height = 4935
End Function
Private Sub lv_Click()
btnEdit.Enabled = True
btnDelete.Enabled = True
txtCatId.Text = lv.SelectedItem.Text
txtCatname.Text = lv.SelectedItem.SubItems(1)
End Sub
Private Sub txtSearch_Change()


If adoCategory.State = 1 Then Set adoCategory = Nothing


calther = "SELECT * from [Category] where [Category Name] like '" & Trim(txtSearch) & "%'"

            adoCategory.Open calther, con, adOpenKeyset, adLockOptimistic
                
                
                   lv.ListItems.Clear
                   
                        dview
              
End Sub
Private Sub dview()

Do While Not adoCategory.EOF

    Set ls = lv.ListItems.Add(, , adoCategory.Fields(0))
        ls.SubItems(1) = adoCategory.Fields(1)
        adoCategory.MoveNext
Loop

End Sub