frm选择供货单位.frm

适合于中小型企业管理

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{D959C709-8613-11D1-9840-002078110E7D}#1.0#0"; "as97Popup.ocx"
Begin VB.Form Frm选择供货单位 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择供货单位"
   ClientHeight    =   7140
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   7650
   Icon            =   "Frm选择供货单位.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7140
   ScaleWidth      =   7650
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   495
      Left            =   6000
      TabIndex        =   1
      Top             =   360
      Width           =   975
   End
   Begin as97Popup.asPopup asPopup1 
      Height          =   735
      Left            =   240
      Top             =   240
      Width           =   855
      _ExtentX        =   1508
      _ExtentY        =   1296
      CustomPicture   =   "Frm选择供货单位.frx":0CCA
      Caption         =   "选中"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Layout          =   3
      ScaleWidth      =   57
      ScaleMode       =   0
      ScaleHeight     =   49
      BackStyle       =   0
   End
   Begin as97Popup.asPopup asPopup 
      DragIcon        =   "Frm选择供货单位.frx":15A4
      Height          =   735
      Left            =   1320
      Top             =   240
      Width           =   735
      _ExtentX        =   1296
      _ExtentY        =   1296
      CustomPicture   =   "Frm选择供货单位.frx":1E6E
      Caption         =   "添加"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Layout          =   3
      ScaleWidth      =   49
      ScaleMode       =   0
      ScaleHeight     =   49
      BackStyle       =   0
   End
   Begin MSComctlLib.ListView lstContracts 
      Height          =   5895
      Left            =   120
      TabIndex        =   0
      Top             =   1200
      Width           =   7335
      _ExtentX        =   12938
      _ExtentY        =   10398
      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.Line Line1 
      X1              =   120
      X2              =   7440
      Y1              =   1080
      Y2              =   1080
   End
End
Attribute VB_Name = "Frm选择供货单位"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim LConRs 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, adLockReadOnly
    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
End Sub

Private Sub asPopup_Click(Cancel As Boolean)
    If Not Security_Log("Rc_Flgl_JBXX_GYSGL", Xtczybm, 1, True) Then
        MsgBox "您没有相应的权限！", vbCritical, "请咨询管理员："
        Exit Sub
    End If
    WhFrmLwdw.Show 1
    DoList
End Sub

Private Sub asPopup1_Click(Cancel As Boolean)
On Error Resume Next

    If Not lstContracts.ListItems.Count < 1 Then
        Dim BH As String
        BH = Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text)
       If SecWz = 1 Then
       Frm实施采购.Text5.Text = BH
       End If
       
    End If
    Command1_Click
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    DoList
End Sub

Private Sub lstContracts_DblClick()
    asPopup1_Click (True)
End Sub