whfrmlwdw.frm

适合于中小型企业管理

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form WhFrmLwdw 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "供应商基本信息"
   ClientHeight    =   5355
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8775
   Icon            =   "WhFrmLwdw.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5355
   ScaleWidth      =   8775
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command1 
      Caption         =   "取消"
      Enabled         =   0   'False
      Height          =   375
      Left            =   5640
      TabIndex        =   8
      Top             =   2040
      Width           =   1575
   End
   Begin VB.CommandButton cmdSaveExp 
      Caption         =   "添加"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   2040
      Width           =   1575
   End
   Begin VB.CommandButton cmdUpdateExp 
      Caption         =   "更新"
      Height          =   375
      Left            =   1920
      TabIndex        =   6
      Top             =   2040
      Width           =   1815
   End
   Begin VB.CommandButton cmdDeleteExp 
      Caption         =   "删除"
      Height          =   375
      Left            =   3840
      TabIndex        =   7
      Top             =   2040
      Width           =   1695
   End
   Begin VB.TextBox Text5 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      MaxLength       =   25
      TabIndex        =   4
      Top             =   1560
      Width           =   6735
   End
   Begin VB.TextBox Text4 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      MaxLength       =   25
      TabIndex        =   3
      Top             =   1080
      Width           =   6735
   End
   Begin VB.TextBox Text3 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6240
      MaxLength       =   4
      TabIndex        =   2
      Top             =   600
      Width           =   2055
   End
   Begin VB.TextBox Text2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      MaxLength       =   15
      TabIndex        =   1
      Top             =   600
      Width           =   2535
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      MaxLength       =   25
      TabIndex        =   0
      Top             =   120
      Width           =   3615
   End
   Begin MSComctlLib.ListView lstContracts 
      Height          =   2775
      Left            =   120
      TabIndex        =   9
      Top             =   2520
      Width           =   8535
      _ExtentX        =   15055
      _ExtentY        =   4895
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "联系人"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   5280
      TabIndex        =   14
      Top             =   600
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "E-mail"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   600
      TabIndex        =   13
      Top             =   1560
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "地址"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   840
      TabIndex        =   12
      Top             =   1080
      Width           =   480
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单位电话"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   360
      TabIndex        =   11
      Top             =   600
      Width           =   960
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单位名称"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   360
      TabIndex        =   10
      Top             =   120
      Width           =   960
   End
End
Attribute VB_Name = "WhFrmLwdw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim LConRs As ADODB.Recordset
Dim ConPayRs As ADODB.Recordset
Dim TxtSql As String

Private Sub DoList()
Dim ItmX As ListItem
lstContracts.ColumnHeaders.Clear
lstContracts.ColumnHeaders.Add , , "单位编号", Len("单位编号") * 100 + 600
lstContracts.ColumnHeaders.Add , , "单位名称", Len("单位名称") * 100 + 1500
lstContracts.ColumnHeaders.Add , , "单位电话", Len("单位电话") * 100 + 900
lstContracts.ColumnHeaders.Add , , "联系人", Len("联系人") * 100 + 900
lstContracts.ColumnHeaders.Add , , "地址", Len("地址") * 100 + 3000
lstContracts.ColumnHeaders.Add , , "E-MAIL", Len("e-mAIL") * 300 + 2000
    Set LConRs = New ADODB.Recordset
    LConRs.Open "SELECT * FROM Fl_供应商表", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
    If Not LConRs.BOF Then LConRs.MoveFirst
    lstContracts.ListItems.Clear
    Do While Not LConRs.EOF
        Set ItmX = lstContracts.ListItems.Add(, , LConRs!单位编号)
         ItmX.SubItems(1) = LConRs!单位名称
         ItmX.SubItems(2) = LConRs!单位电话
         ItmX.SubItems(3) = LConRs!联系人
         ItmX.SubItems(4) = LConRs!地址
         ItmX.SubItems(5) = LConRs![E_mail]
        LConRs.MoveNext
    Loop
    If Not LConRs.EOF Then LConRs.MoveFirst
    lstContracts.Refresh
    GetPayData
End Sub

Private Sub GetPayData()
Dim SqlString As Integer

If Not lstContracts.ListItems.Count < 1 Then
    SqlString = Trim(lstContracts.SelectedItem.Text)
    Set ConPayRs = New ADODB.Recordset
    ConPayRs.Open "Select * from Fl_供应商表 where 单位编号=" & SqlString, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic, adCmdText
    Text1.Text = IIf(ConPayRs!单位名称 = Null, " ", ConPayRs!单位名称)
    Text2.Text = IIf(ConPayRs!单位电话 = Null, " ", ConPayRs!单位电话)
    Text3.Text = IIf(ConPayRs!联系人 = Null, " ", ConPayRs!联系人)
    Text4.Text = IIf(ConPayRs!地址 = Null, " ", ConPayRs!地址)
    Text5.Text = IIf(ConPayRs![E_mail] = Null, " ", ConPayRs![E_mail])
    
End If
End Sub

Private Sub cmdDeleteExp_Click()
On Error GoTo Errline
Dim ControlDel As ADODB.Recordset
Dim ContNum As Integer
Dim SqlString As String
If ConPayRs.RecordCount <> 0 Then
    ConPayRs.MoveFirst
    If Not ConPayRs.EOF Or ConPayRs.BOF Then
        If MsgBox("确认要删除么？", vbQuestion + vbYesNo) = vbYes Then
         Set ControlDel = New ADODB.Recordset
         If Not lstContracts.SelectedItem.Text = Empty Then
         ContNum = lstContracts.SelectedItem.Text
         SqlString = "Select * from Fl_供应商表 where 单位编号=" & ContNum
         ControlDel.Open SqlString, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic, adCmdText
         If ControlDel.RecordCount <> 0 Then
          ControlDel.Delete
         End If
            DoList
         End If
        End If
    End If
 End If
  Exit Sub
 
Errline:
    MsgBox err.Source & Chr(13) & err.Description, , "错误代码：" & err.Number
End Sub

Private Sub cmdSaveExp_Click()
On Error GoTo Errline
    If cmdSaveExp.Caption = "添加" Then
        cmdSaveExp.Caption = "保存"
        cmdUpdateExp.Enabled = False
        cmdDeleteExp.Enabled = False
        Command1.Enabled = True
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text5.Text = ""
        ConPayRs.AddNew
        lstContracts.Enabled = False
    ElseIf cmdSaveExp.Caption = "保存" Then
        If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Or Trim(Text4) = "" Or Trim(Text5) = "" Then
            MsgBox "任何一栏不能为空"
            Exit Sub
        End If
       
        ConPayRs!单位名称 = Text1.Text
        ConPayRs!单位电话 = Text2.Text
        ConPayRs!联系人 = Text3.Text
        ConPayRs!地址 = Text4.Text
        ConPayRs![E_mail] = Text5.Text
        ConPayRs.Update
        cmdSaveExp.Caption = "添加"
        cmdUpdateExp.Enabled = True
        cmdDeleteExp.Enabled = True
        Command1.Enabled = False
        lstContracts.Enabled = True
        DoList
    End If
     Exit Sub
 
Errline:
    MsgBox err.Source & Chr(13) & err.Description, , "错误代码：" & err.Number
    
End Sub

Private Sub cmdUpdateExp_Click()
On Error GoTo Errline
        If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Or Trim(Text4) = "" Or Trim(Text5) = "" Then
            MsgBox "任何一栏不能为空"
            Exit Sub
        End If
        ConPayRs!单位名称 = Text1.Text
        ConPayRs!单位电话 = Text2.Text
        ConPayRs!联系人 = Text3.Text
        ConPayRs!地址 = Text4.Text
        ConPayRs![E_mail] = Text5.Text
        ConPayRs.Update
        DoList
         Exit Sub
 
Errline:
    MsgBox err.Source & Chr(13) & err.Description, , "错误代码：" & err.Number
End Sub

Private Sub Command1_Click()
    ConPayRs.CancelUpdate
    cmdUpdateExp.Enabled = True
    cmdDeleteExp.Enabled = True
    Command1.Enabled = False
    cmdSaveExp.Caption = "添加"
    lstContracts.Enabled = True
    DoList
End Sub

Private Sub Form_Load()
    DoList
    Set ConPayRs = New ADODB.Recordset
    ConPayRs.Open "Fl_供应商表", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdTable
End Sub

Private Sub lstContracts_Click()
GetPayData
End Sub