frmclient.frm

自己写的物流管理系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmClient 
   Caption         =   "查看客户"
   ClientHeight    =   6375
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10230
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6375
   ScaleWidth      =   10230
   Begin VB.CommandButton Command4 
      Caption         =   "删  除"
      Height          =   370
      Left            =   6480
      TabIndex        =   6
      Top             =   960
      Width           =   1000
   End
   Begin VB.Frame Frame1 
      Height          =   4695
      Left            =   120
      TabIndex        =   3
      Top             =   1440
      Width           =   9975
      Begin MSComctlLib.ListView lsvClient 
         Height          =   4335
         Left            =   120
         TabIndex        =   4
         Top             =   240
         Width           =   9735
         _ExtentX        =   17171
         _ExtentY        =   7646
         View            =   3
         LabelEdit       =   1
         LabelWrap       =   0   'False
         HideSelection   =   0   'False
         FullRowSelect   =   -1  'True
         GridLines       =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   0
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "修  改"
      Height          =   370
      Left            =   4800
      TabIndex        =   2
      Top             =   960
      Width           =   1000
   End
   Begin VB.CommandButton Command1 
      Caption         =   "新  增"
      Height          =   370
      Left            =   3000
      TabIndex        =   1
      Top             =   960
      Width           =   1000
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Height          =   180
      Left            =   8520
      TabIndex        =   5
      Top             =   1050
      Width           =   570
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "查   看   客   户"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   3720
      TabIndex        =   0
      Top             =   240
      Width           =   2940
   End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()

    frmClientAdd.Show
    Unload Me
End Sub

Private Sub Command2_Click()
    
    If IsNumeric(lsvClient.SelectedItem.Tag) Then
    
        frmClientUpdate.myupdateid = sys.TextTolong(lsvClient.SelectedItem.Tag)
        frmClientUpdate.Show
        Unload Me
    Else
        MsgBox "请先选择要修改的记录!"
    End If
End Sub

Private Sub Command4_Click()
    
    If IsNumeric(lsvClient.SelectedItem.Tag) Then
        Dim MyVar
        MyVar = MsgBox("确认删除该条记录？", vbOKCancel, "信息提示")
        If MyVar = vbOK Then
            Dim strsql
            strsql = "DELETE FROM CLIENT WHERE ID=" & sys.TextTolong(lsvClient.SelectedItem.Tag)
            sys.DB.ExecuteSQL (strsql)
            Call query
        End If
    Else
        MsgBox "请先选择要删除的记录!"
    End If
End Sub

Private Sub Form_Load()

    Me.Top = 0
    Me.Left = 0
    Me.Width = MainForm.Width * 0.7
    Me.Height = MainForm.Height * 0.65
    
    Call query
End Sub

Public Sub query(Optional ByVal strsql As String = "SELECT * FROM CLIENT ORDER BY ID DESC")
    
    '查询客户
    Dim inum As Integer
    Dim rs As New ADODB.Recordset
    ReDim arrclient(6, 0)
    Dim total As Integer
    total = 0
    
    '清除原有
    lsvClient.ListItems.Clear
    With lsvClient
        lsvClient.ColumnHeaders.Clear
        .ColumnHeaders.Add , , "序号", 600
        .ColumnHeaders.Add , , "姓名", 1200
        .ColumnHeaders.Add , , "性别", 1200
        .ColumnHeaders.Add , , "公司名称", 1600
        .ColumnHeaders.Add , , "联系电话", 1600
        .ColumnHeaders.Add , , "手机号码", 1600
        .ColumnHeaders.Add , , "备注", 2000
        .GridLines = True
        .ColumnHeaders.Item(1).Alignment = lvwColumnLeft
        .ColumnHeaders.Item(2).Alignment = lvwColumnCenter
        .ColumnHeaders.Item(2).Alignment = lvwColumnCenter
        .ColumnHeaders.Item(3).Alignment = lvwColumnCenter
        .ColumnHeaders.Item(4).Alignment = lvwColumnCenter
        .ColumnHeaders.Item(5).Alignment = lvwColumnCenter
        .ColumnHeaders.Item(6).Alignment = lvwColumnCenter
        .ColumnHeaders.Item(6).Alignment = lvwColumnCenter
    End With
    
    Set rs = sys.DB.OpenRecordSet(strsql)
    If Not (rs.BOF) Or (rs.EOF) Then
        '取出记录集
        inum = 0
        Do While Not rs.EOF
            ReDim Preserve arrclient(6, inum)
            arrclient(0, inum) = rs.Fields("ID")
            arrclient(1, inum) = rs.Fields("NAME")
            If sys.TextTolong(rs.Fields("SEX")) = 0 Then
                arrclient(2, inum) = "男"
            Else
                arrclient(2, inum) = "女"
            End If
            arrclient(3, inum) = rs.Fields("COMPANY")
            arrclient(4, inum) = rs.Fields("TELEPHONE")
            arrclient(5, inum) = rs.Fields("MOBILE")
            arrclient(6, inum) = rs.Fields("REMARK")
            inum = inum + 1
            rs.MoveNext
        Loop
        total = rs.RecordCount
    End If
    
    Dim iq As Integer
    Dim ia As Integer
    For iq = 0 To UBound(arrclient, 2)
        Set Item = lsvClient.ListItems.Add(, , "")
        Item.Tag = sys.StrToText(arrclient(0, iq))
        Item.Text = sys.StrToText(iq + 1)
        Item.SubItems(1) = sys.StrToText(arrclient(1, iq))
        Item.SubItems(2) = sys.StrToText(arrclient(2, iq))
        Item.SubItems(3) = sys.StrToText(arrclient(3, iq))
        Item.SubItems(4) = sys.StrToText(arrclient(4, iq))
        Item.SubItems(5) = sys.StrToText(arrclient(5, iq))
        Item.SubItems(5) = sys.StrToText(arrclient(6, iq))
     Next
    Label2.Caption = "共 " & total & " 条记录"

End Sub