frmcompany.frm

报警信息查询系统VB+ACESS 根据某啤酒厂出现故障不同（如系统错误、负亟接地、操作错误等）计算机系统进行报警

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form FrmCompany 
   AutoRedraw      =   -1  'True
   Caption         =   "选择企业"
   ClientHeight    =   4440
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5955
   Icon            =   "FrmCompany.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   5955
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   315
      Left            =   2100
      TabIndex        =   2
      Top             =   4080
      Width           =   1275
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   315
      Left            =   240
      TabIndex        =   1
      Top             =   4080
      Width           =   1275
   End
   Begin MSComctlLib.ListView lvwDB 
      Height          =   3945
      Left            =   60
      TabIndex        =   0
      Top             =   0
      Width           =   5835
      _ExtentX        =   10292
      _ExtentY        =   6959
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
End
Attribute VB_Name = "FrmCompany"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Sub GetTitles()
Dim TempSql As String, TempRec As New ADODB.Recordset
Dim TempItem As ListItem
On Error GoTo GetErr

Set TempRec = New ADODB.Recordset

TempSql = "select distinct CompanyId,CompanyName from sourcedata  "
TempRec.Open TempSql, GlobalCon, adOpenDynamic, adLockReadOnly

If TempRec.EOF Then
  lvwDB.ListItems.Clear
  TempRec.Close
  Set TempRec = Nothing
  Exit Sub
End If

lvwDB.ListItems.Clear

Do Until TempRec.EOF
    '添加 ListItem。
    Set TempItem = lvwDB.ListItems.Add()
    
    If Not IsNull(TempRec!CompanyId) Then
      TempItem.Text = TempRec!CompanyId
    Else
      TempItem.Text = ""
    End If
    
    TempItem.Key = "KEY" & Trim$(TempRec!CompanyId)
    TempItem.SubItems(1) = Trim$(TempRec!CompanyName)
    
                 
    TempRec.MoveNext
Loop

TempRec.Close
Set TempRec = Nothing

Exit Sub

GetErr:
 MsgBox Err.Description, vbExclamation
 Resume Next
 
End Sub








    

Private Sub MakeColumns()
Dim i As Integer
        
i = CInt(lvwDB.Width / 5) - 15
lvwDB.ColumnHeaders.Clear
lvwDB.ColumnHeaders.Add , , "代码", i * 1, lvwColumnLeft
lvwDB.ColumnHeaders.Add , , "名称", i * 4, lvwColumnCenter

End Sub










Private Sub Command1_Click()
SelectQy = ""
If Not lvwDB.SelectedItem Is Nothing Then
   SelectQy = lvwDB.SelectedItem.Text
End If
Me.Hide

End Sub

Private Sub Command2_Click()
Unload Me
End Sub


Private Sub Form_Load()

MakeColumns
GetTitles

End Sub


Private Sub lvwDB_DblClick()
Call Command1_Click
End Sub