www.pudn.com > textmanager.rar > Frm单位.frm, change:2005-04-12,size:16629b


VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 
Begin VB.Form Frm单位  
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "单位局况维护" 
   ClientHeight    =   6285 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   6540 
   LinkTopic       =   "Form1" 
   LockControls    =   -1  'True 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   6285 
   ScaleWidth      =   6540 
   StartUpPosition =   2  '屏幕中心 
   Begin VB.Frame Frame2  
      Caption         =   "添加科室" 
      Height          =   3375 
      Left            =   90 
      TabIndex        =   8 
      Top             =   2850 
      Width           =   6405 
      Begin VB.CommandButton Cmddel2  
         Caption         =   "删除" 
         Enabled         =   0   'False 
         Height          =   315 
         Left            =   5400 
         TabIndex        =   19 
         Top             =   2370 
         Width           =   855 
      End 
      Begin VB.ComboBox Combo1  
         Appearance      =   0  'Flat 
         BackColor       =   &H00C0FFFF& 
         Height          =   300 
         Left            =   360 
         Style           =   2  'Dropdown List 
         TabIndex        =   17 
         Top             =   450 
         Width           =   2055 
      End 
      Begin VB.TextBox keshiNAME  
         Appearance      =   0  'Flat 
         BackColor       =   &H00C0FFFF& 
         BeginProperty Font  
            Name            =   "MS Sans Serif" 
            Size            =   9.75 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   285 
         Left            =   2670 
         TabIndex        =   14 
         TabStop         =   0   'False 
         Top             =   1050 
         Width           =   2595 
      End 
      Begin VB.TextBox txtID2  
         Appearance      =   0  'Flat 
         BackColor       =   &H00C0FFFF& 
         BeginProperty Font  
            Name            =   "MS Sans Serif" 
            Size            =   9.75 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   285 
         Left            =   360 
         TabIndex        =   13 
         TabStop         =   0   'False 
         Top             =   1050 
         Width           =   2055 
      End 
      Begin VB.CommandButton CmdAdd2  
         Caption         =   "添加" 
         Default         =   -1  'True 
         Height          =   315 
         Left            =   5400 
         TabIndex        =   10 
         Top             =   1830 
         Width           =   855 
      End 
      Begin VB.CommandButton CmdCancel2  
         Cancel          =   -1  'True 
         Caption         =   "取消" 
         Height          =   315 
         Left            =   5400 
         TabIndex        =   9 
         Top             =   2910 
         Width           =   855 
      End 
      Begin MSComctlLib.ListView Lv2  
         Height          =   1905 
         Left            =   330 
         TabIndex        =   11 
         Top             =   1380 
         Width           =   4965 
         _ExtentX        =   8758 
         _ExtentY        =   3360 
         LabelWrap       =   -1  'True 
         HideSelection   =   -1  'True 
         FullRowSelect   =   -1  'True 
         GridLines       =   -1  'True 
         _Version        =   393217 
         ForeColor       =   -2147483640 
         BackColor       =   12648447 
         BorderStyle     =   1 
         Appearance      =   0 
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
            Name            =   "宋体" 
            Size            =   10.5 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         NumItems        =   0 
      End 
      Begin VB.Label Label4  
         Caption         =   "编号:" 
         Height          =   255 
         Left            =   360 
         TabIndex        =   16 
         Top             =   810 
         Width           =   855 
      End 
      Begin VB.Label Label3  
         Caption         =   "科室名称:" 
         Height          =   255 
         Left            =   2670 
         TabIndex        =   15 
         Top             =   840 
         Width           =   975 
      End 
      Begin VB.Label Label2  
         Caption         =   "选择所属分局:" 
         Height          =   255 
         Left            =   360 
         TabIndex        =   12 
         Top             =   240 
         Width           =   1455 
      End 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "添加分局" 
      Height          =   2745 
      Left            =   90 
      TabIndex        =   0 
      Top             =   60 
      Width           =   6405 
      Begin VB.CommandButton CmdDel1  
         Caption         =   "删除" 
         Enabled         =   0   'False 
         Height          =   315 
         Left            =   5490 
         TabIndex        =   18 
         Top             =   1830 
         Width           =   855 
      End 
      Begin MSComctlLib.ListView Lv1  
         Height          =   1875 
         Left            =   330 
         TabIndex        =   7 
         Top             =   810 
         Width           =   5055 
         _ExtentX        =   8916 
         _ExtentY        =   3307 
         LabelWrap       =   -1  'True 
         HideSelection   =   -1  'True 
         FullRowSelect   =   -1  'True 
         GridLines       =   -1  'True 
         _Version        =   393217 
         ForeColor       =   -2147483640 
         BackColor       =   12648447 
         BorderStyle     =   1 
         Appearance      =   0 
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
            Name            =   "宋体" 
            Size            =   10.5 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         NumItems        =   0 
      End 
      Begin VB.CommandButton cmdAdd1  
         Caption         =   "添加" 
         Height          =   315 
         Left            =   5490 
         TabIndex        =   6 
         Top             =   1320 
         Width           =   855 
      End 
      Begin VB.CommandButton cmdCancel1  
         Caption         =   "取消" 
         Height          =   315 
         Left            =   5490 
         TabIndex        =   5 
         Top             =   2340 
         Width           =   855 
      End 
      Begin VB.TextBox fenjuNAME  
         Appearance      =   0  'Flat 
         BackColor       =   &H00C0FFFF& 
         BeginProperty Font  
            Name            =   "MS Sans Serif" 
            Size            =   9.75 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   285 
         Left            =   2640 
         TabIndex        =   4 
         TabStop         =   0   'False 
         Top             =   480 
         Width           =   2745 
      End 
      Begin VB.TextBox txtID1  
         Appearance      =   0  'Flat 
         BackColor       =   &H00C0FFFF& 
         BeginProperty Font  
            Name            =   "MS Sans Serif" 
            Size            =   9.75 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   285 
         Left            =   330 
         TabIndex        =   1 
         TabStop         =   0   'False 
         Top             =   480 
         Width           =   2055 
      End 
      Begin VB.Label Label1  
         Caption         =   "分局名称:" 
         Height          =   225 
         Left            =   2610 
         TabIndex        =   3 
         Top             =   270 
         Width           =   1005 
      End 
      Begin VB.Label lblOID  
         AutoSize        =   -1  'True 
         Caption         =   "编号:" 
         Height          =   180 
         Left            =   330 
         TabIndex        =   2 
         Top             =   270 
         Width           =   450 
      End 
   End 
End 
Attribute VB_Name = "Frm单位" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Public clmX As ColumnHeader 
Public itmX As ListItem 
Dim Edit1 As Boolean '分局是否处于修改状态 
Dim Edit2 As Boolean '科室是否处于修改状态 
Private Sub cmdAdd1_Click() 
'On Error GoTo myerror 
If cmdAdd1.Caption = "添加" Then 
txtID1.Text = "": fenjuNAME.Text = "" 
cmdAdd1.Caption = "保存" 
Else 
Dim rs1 As Recordset 
   '修改 
  If Edit1 = True Then 
    Dim anss As String 
    anss = MsgBox("你确实要修改此分局名称吗?" + vbCrLf + "此操作将改变此科室内考生信息", vbExclamation + vbYesNo, "系统提示") 
    If anss = vbYes Then 
    Dim SQL As String 
    SQL = "update fenju set code='" & txtID1 & "' ,name='" & fenjuNAME.Text & "'where code='" & txtID1.Text & "'" 
    DB.Execute SQL 
    Dim sql1 As String 
    sql1 = "update kaosheng set fenju='" & fenjuNAME.Text & "' where fenju='" & Lv1.SelectedItem.SubItems(2) & "'" 
    DB.Execute sql1 
    Else 
    End If 
    Edit1 = False 
     
 Else 
    '添加 
    If txtID1.Text = "" Or fenjuNAME.Text = "" Then 
    MsgBox "请填写完整数据" 
    Exit Sub 
    End If 
    Set rs1 = New Recordset 
    rs1.Open "fenju", DB, adOpenStatic, adLockOptimistic 
    rs1.AddNew 
    rs1.Fields("code").Value = txtID1.Text 
    rs1.Fields("name").Value = fenjuNAME.Text 
    rs1.Update 
  End If 
txtID1.Text = "": fenjuNAME.Text = "" 
cmdAdd1.Caption = "添加" 
FillList ("A") 
FillList ("B") 
addcombo 
End If 
Exit Sub 
myerror: 
MsgBox "编号不能有重复!", vbExclamation 
Exit Sub 
 
End Sub 
 
Private Sub CmdAdd2_Click() 
'On Error GoTo myerror 
If CmdAdd2.Caption = "添加" Then 
txtID2.Text = "": keshiNAME.Text = "" 
CmdAdd2.Caption = "保存" 
Else 
Dim rs2 As Recordset 
   '修改 
 If Edit2 = True Then 
    Dim answer As String 
    answer = MsgBox("你确实要更改此科室名称吗?" + vbCrLf + "执行此操作在此科室内的考生将也随之改变", vbInformation + vbYesNo) 
     If answer = vbYes Then 
      Dim SQL As String 
      SQL = "update keshi set code='" & txtID2 & "' ,name='" & keshiNAME.Text & "'where code='" & txtID2.Text & "'" 
      DB.Execute SQL 
      Dim sql1 As String 
      sql1 = "update kaosheng set keshi='" & keshiNAME.Text & "' where keshi='" & Lv2.SelectedItem.SubItems(2) & "'" 
      DB.Execute sql1 
     Else 
      Edit2 = False 
    End If 
 Else 
    '添加 
    If txtID2.Text = "" Or keshiNAME.Text = "" Then 
    MsgBox "请填写完整数据" 
    Exit Sub 
    End If 
     
    Dim tempRS As Recordset 
    Set tempRS = New Recordset 
    tempRS.Open "select * from fenju where name='" & Combo1.Text & "'", DB, adOpenStatic, adLockOptimistic 
    Set rs2 = New Recordset 
    rs2.Open "keshi", DB, adOpenStatic, adLockOptimistic 
    rs2.AddNew 
    rs2.Fields("pcode").Value = tempRS.Fields("code").Value 
    rs2.Fields("code").Value = txtID2.Text 
    rs2.Fields("name").Value = keshiNAME.Text 
    rs2.Update 
        
    tempRS.Close 
    Set tempRS = Nothing 
  End If 
txtID2.Text = "": keshiNAME.Text = "" 
CmdAdd2.Caption = "添加" 
FillList ("B") 
End If 
Exit Sub 
myerror: 
If Combo1.Text = "" Then 
MsgBox "请选择所属分局" 
Else 
MsgBox "编号不能有重复!", vbExclamation 
End If 
End Sub 
 
Private Sub cmdCancel1_Click() 
txtID1.Text = "": fenjuNAME.Text = "" 
cmdAdd1.Caption = "添加" 
CmdDel1.Enabled = False 
End Sub 
 
Private Sub CmdCancel2_Click() 
txtID2.Text = "": keshiNAME.Text = "" 
CmdAdd2.Caption = "添加" 
Cmddel2.Enabled = False 
End Sub 
 
Private Sub CmdDel1_Click() 
Dim asn As String 
asn = MsgBox("你确实要删除此分局吗?" + vbCrLf + "执行此操作将删除此分局内的所有考生", vbExclamation + vbYesNo, "系统提示") 
If asn = vbYes Then 
Dim SQL As String 
SQL = "delete * from fenju where code='" & txtID1 & "'" 
DB.Execute SQL 
Dim sql1 As String 
sql1 = "delete * from kaosheng where fenju='" & Lv1.SelectedItem.SubItems(2) & "'" 
DB.Execute sql1 
Dim sql2 As String 
sql2 = "delete * from keshi where pcode='" & Lv1.SelectedItem.SubItems(1) & "'" 
DB.Execute sql2 
Else 
End If 
Edit1 = False 
cmdAdd1.Caption = "添加" 
CmdDel1.Enabled = False 
txtID1.Text = "": fenjuNAME.Text = "" 
FillList ("A") 
FillList ("B") 
addcombo 
End Sub 
 
Private Sub Cmddel2_Click() 
Dim SQL As String 
Dim ans As String 
ans = MsgBox("确实要删除此科室吗?" + vbCrLf + "若删除此科室则科室内的考生信息将全部删除", vbExclamation + vbYesNo, "系统提示") 
If ans = vbYes Then 
   SQL = "delete * from keshi where code='" & txtID2 & "'" 
    DB.Execute SQL 
   Dim sql1 As String 
   sql1 = "delete * from kaosheng where keshi='" & Lv2.SelectedItem.SubItems(2) & "'" 
   DB.Execute sql1 
Else 
'hello 
End If 
 Edit2 = False 
 CmdAdd2.Caption = "添加" 
 Cmddel2.Enabled = False 
 txtID2.Text = "": keshiNAME.Text = "" 
 FillList ("B") 
End Sub 
 
 
 
Private Sub Form_Load() 
 addcombo 
 Lv1.View = lvwReport 
  Set clmX = Lv1.ColumnHeaders.Add(, , "选择", 800) 
  Set clmX = Lv1.ColumnHeaders.Add(, , "编号:", 1400) 
  Set clmX = Lv1.ColumnHeaders.Add(, , "分局名称:", 2500) 
 
 Lv2.View = lvwReport 
  Set clmX = Lv2.ColumnHeaders.Add(, , "选择", 800) 
  Set clmX = Lv2.ColumnHeaders.Add(, , "编号:", 800) 
  Set clmX = Lv2.ColumnHeaders.Add(, , "科室名称:", 1800) 
  Set clmX = Lv2.ColumnHeaders.Add(, , "所属分局:", 1600) 
 
FillList ("A") 
FillList ("B") 
 
 
End Sub 
 
Sub FillList(biao As String) 
If biao = "A" Then 
   Lv1.ListItems.Clear 
   
 Dim aRS As Recordset 
 Set aRS = New Recordset 
 aRS.Open "fenju", DB, adOpenStatic, adLockOptimistic 
 Do While Not aRS.EOF 
  Set itmX = Lv1.ListItems.Add(, , "") 
   'itmX.Tag = 7 
   itmX.SubItems(1) = aRS.Fields("code") 
   itmX.SubItems(2) = aRS.Fields("name") 
 aRS.MoveNext 
 Loop 
aRS.Close 
Set aRS = Nothing 
 
ElseIf biao = "B" Then 
 Lv2.ListItems.Clear 
 Dim aRS1 As Recordset 
 Set aRS1 = New Recordset 
 'aRS1.Open "keshi", DB, adOpenStatic, adLockOptimistic 
 ' Dim temprs As Recordset 
 'Set temprs = New Recordset 
 aRS1.Open "select keshi.code,keshi.name,fenju.name from keshi,fenju where keshi.pcode=fenju.code", DB, adOpenStatic, adLockOptimistic 
  Do While Not aRS1.EOF 
  Set itmX = Lv2.ListItems.Add(, , "") 
   'itmX.Tag = 7 
   itmX.SubItems(1) = aRS1.Fields(0) 
   itmX.SubItems(2) = aRS1.Fields(1) 
   itmX.SubItems(3) = aRS1.Fields(2) 
 aRS1.MoveNext 
 Loop 
aRS1.Close 
Set aRS1 = Nothing 
End If 
End Sub 
 
Private Sub addcombo() 
Combo1.Clear 
Dim rs As Recordset 
Set rs = New Recordset 
rs.Open "fenju", DB, adOpenStatic, adLockOptimistic 
Do While Not rs.EOF 
   Combo1.AddItem rs.Fields("name") 
rs.MoveNext 
Loop 
rs.Close 
Set rs = Nothing 
End Sub 
 
Private Sub Lv1_Click() 
Dim k As Integer 
If Lv1.ListItems.Count = 0 Then Exit Sub 
For k = 1 To Lv1.ListItems.Count 
    Lv1.ListItems(k).Text = "" 
Next k 
Lv1.SelectedItem.Text = "=>" 
If Lv1.SelectedItem.SubItems(1) <> "" Then 
   txtID1.Text = Lv1.SelectedItem.SubItems(1) 
   fenjuNAME.Text = Lv1.SelectedItem.SubItems(2) 
   cmdAdd1.Caption = "保存" 
   Edit1 = True '允许修改 
   CmdDel1.Enabled = True '允许删除 
End If 
End Sub 
 
Private Sub Lv2_Click() 
Dim k As Integer 
If Lv2.ListItems.Count = 0 Then Exit Sub 
For k = 1 To Lv2.ListItems.Count 
    Lv2.ListItems(k).Text = "" 
Next k 
Lv2.SelectedItem.Text = "=>" 
If Lv2.SelectedItem.SubItems(1) <> "" Then 
   txtID2.Text = Lv2.SelectedItem.SubItems(1) 
   keshiNAME.Text = Lv2.SelectedItem.SubItems(2) 
   CmdAdd2.Caption = "保存" 
   Edit2 = True '允许修改 
   Cmddel2.Enabled = True '允许删除 
End If 
End Sub