frmadd.frm

该软件（教师住房管理系统）能实现如下功能： 基本信息录入 基本信息浏览 基本查询 分类查询 查基本信息的添加、删除修改。分房申请信息的录入及平分 分房处理 报表生成 打印功能 帮助

VERSION 5.00
Begin VB.Form frmadd 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "输入信息"
   ClientHeight    =   2835
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5325
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   2835
   ScaleWidth      =   5325
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command3 
      Caption         =   "关闭(&C)"
      Height          =   375
      Left            =   4320
      TabIndex        =   5
      Top             =   1560
      Width           =   855
   End
   Begin VB.CommandButton Command2 
      Caption         =   "确定(&O)"
      Height          =   375
      Left            =   4320
      TabIndex        =   4
      Top             =   720
      Width           =   855
   End
   Begin VB.Frame Frame1 
      Caption         =   "请选择住户："
      Height          =   2750
      Left            =   80
      TabIndex        =   6
      Top             =   0
      Width           =   4095
      Begin VB.TextBox Text1 
         Height          =   350
         Left            =   120
         TabIndex        =   0
         Top             =   240
         Width           =   1575
      End
      Begin VB.CommandButton Command1 
         Caption         =   ">>"
         Height          =   495
         Left            =   1800
         TabIndex        =   2
         Top             =   1320
         Width           =   375
      End
      Begin VB.ListBox List2 
         Height          =   1860
         Left            =   2280
         TabIndex        =   3
         Top             =   720
         Width           =   1575
      End
      Begin VB.ListBox List1 
         Height          =   1860
         Left            =   120
         Sorted          =   -1  'True
         TabIndex        =   1
         Top             =   720
         Width           =   1575
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "家庭成员信息："
         Height          =   180
         Left            =   2280
         TabIndex        =   7
         Top             =   360
         Width           =   1260
      End
   End
End
Attribute VB_Name = "frmadd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''                    教师住房管理系统   Version 1.0                    '''
'''                         （VB6.0 源代码）                             '''
'''                                                                      '''
'''                        俊彦软件工作室出品                            '''
'''                                                                      '''
'''            （浦口校区科技节“电子杯”程序设计大赛参赛作品）          '''
'''                                                                      '''
'''                程序设计：东南大学土木工程学院   周曹俊               '''
'''                                                                      '''
'''                 CopyRight AllRights Reserved (c)2003                 '''
'''                                                                      '''
'''                         2003年5月15日                                '''
'''                                                                      '''
'''                                                                      '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Sub Command1_Click()
Dim strtmp As String, rs2 As Recordset
strtmp = Mid$(List1.List(List1.ListIndex), 1, 4)
Set rs2 = db.OpenRecordset("select ID,name from member where ID=" & "'" & strtmp & "'")
List2.Clear
If Not rs2.EOF Then
    rs2.MoveFirst
    Do Until rs2.EOF
        List2.AddItem rs2!id & Space(2) & rs2!Name
    rs2.MoveNext
    Loop
    List2.ListIndex = 0
End If
End Sub

Private Sub Command2_Click()
Dim rs1 As Recordset
On Error GoTo errhdl
If List2.ListCount = 0 Then
    Set rs1 = db.OpenRecordset("select * from host where ID = " & "'" & Mid$(List1.List(List1.ListIndex), 1, 4) & "'")
    '从快速输入窗口中想表单添加数据
    With frmapply
        .Maskid.Text = rs1!id
        .Text1.Text = rs1!Name
        .DTPicker1.Value = rs1!birth
        .DTPicker2.Value = rs1!workdate
        .Combo2.Text = rs1!zc
        .Combo3.Text = rs1!xl
        .Combo4.ListIndex = rs1!livedgr - 1
        .Combo5.SetFocus
    End With
Else
    Set rs1 = db.OpenRecordset("select ID,name from member where Id=" & "'" & Mid$(List2.List(List2.ListIndex), 1, 4) & "'")
    frmapply.Maskid.Text = rs1!id
    frmapply.Text1.Text = rs1!Name
    frmapply.DTPicker1.SetFocus
End If
Set rs1 = Nothing
Unload Me
Exit Sub
errhdl:
    MsgBox Err.Description, vbCritical + vbOKOnly, SYSTITLE
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim rs1 As Recordset
'初始化数据库对象和记录集对象
Set db = OpenDatabase(App.Path & "\data\basicinfo.db")
Set rs1 = db.OpenRecordset("select id,name from host where livedgr<7")
'设置出现的位置
With frmapply
    Move .Command1.Left + .Frame1.Left + .Left, .Command1.Top + .Frame1.Top + .Command1.Height
End With
Show
rs1.MoveFirst
Do Until rs1.EOF
    List1.AddItem rs1!id & Space(2) & rs1!Name
    rs1.MoveNext
Loop
List1.ListIndex = 0
End Sub
Private Sub Text1_Change()
Dim i As Integer
For i = 0 To List1.ListCount - 1
    If InStr(List1.List(i), Text1.Text) <> 0 Then
        List1.ListIndex = i
        Exit For
    Else
        List1.ListIndex = 0
    End If
Next
End Sub