frmapply.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmapply 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   3825
   ClientLeft      =   45
   ClientTop       =   45
   ClientWidth     =   8145
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3825
   ScaleWidth      =   8145
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      Caption         =   "申请信息输入"
      Height          =   3615
      Left            =   80
      TabIndex        =   11
      Top             =   0
      Width           =   7815
      Begin VB.CommandButton Command3 
         Caption         =   "重新输入(&R)"
         Height          =   375
         Left            =   4560
         TabIndex        =   10
         Top             =   2880
         Width           =   1335
      End
      Begin MSMask.MaskEdBox Maskid 
         Height          =   315
         Left            =   1320
         TabIndex        =   0
         Top             =   480
         Width           =   855
         _ExtentX        =   1508
         _ExtentY        =   556
         _Version        =   393216
         MaxLength       =   4
         Mask            =   "?###"
         PromptChar      =   " "
      End
      Begin VB.ComboBox Combo5 
         Height          =   300
         ItemData        =   "frmapply.frx":0000
         Left            =   5280
         List            =   "frmapply.frx":0016
         Style           =   2  'Dropdown List
         TabIndex        =   8
         Top             =   2240
         Width           =   2055
      End
      Begin VB.ComboBox Combo4 
         Height          =   300
         ItemData        =   "frmapply.frx":004A
         Left            =   1680
         List            =   "frmapply.frx":0060
         Style           =   2  'Dropdown List
         TabIndex        =   7
         Top             =   2240
         Width           =   2055
      End
      Begin VB.CommandButton Command2 
         Caption         =   "确定输入(&O)"
         Height          =   375
         Left            =   1200
         TabIndex        =   9
         Top             =   2880
         Width           =   1335
      End
      Begin VB.CommandButton Command1 
         Caption         =   "快速输入(&F)"
         Height          =   320
         Left            =   2160
         TabIndex        =   1
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox Text1 
         Height          =   320
         Left            =   5160
         TabIndex        =   2
         Top             =   480
         Width           =   1335
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         ItemData        =   "frmapply.frx":009A
         Left            =   1440
         List            =   "frmapply.frx":00AA
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   1695
         Width           =   1095
      End
      Begin VB.ComboBox Combo3 
         Height          =   300
         ItemData        =   "frmapply.frx":00C8
         Left            =   5160
         List            =   "frmapply.frx":00D8
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   1695
         Width           =   1215
      End
      Begin MSComCtl2.DTPicker DTPicker2 
         Height          =   315
         Left            =   5160
         TabIndex        =   4
         Top             =   1065
         Width           =   1335
         _ExtentX        =   2355
         _ExtentY        =   556
         _Version        =   393216
         CustomFormat    =   "yyyy年MM月"
         Format          =   73924611
         UpDown          =   -1  'True
         CurrentDate     =   37732
      End
      Begin MSComCtl2.DTPicker DTPicker1 
         Height          =   315
         Left            =   1440
         TabIndex        =   3
         Top             =   1065
         Width           =   1335
         _ExtentX        =   2355
         _ExtentY        =   556
         _Version        =   393216
         CustomFormat    =   "yyyy年MM月"
         Format          =   73924611
         UpDown          =   -1  'True
         CurrentDate     =   37732
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         Caption         =   "申请住房等级："
         Height          =   180
         Left            =   3840
         TabIndex        =   19
         Top             =   2300
         Width           =   1260
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "原住房等级："
         Height          =   180
         Left            =   600
         TabIndex        =   18
         Top             =   2300
         Width           =   1080
      End
      Begin VB.Label Labelid 
         AutoSize        =   -1  'True
         Caption         =   "住 号："
         Height          =   180
         Left            =   600
         TabIndex        =   17
         Top             =   555
         Width           =   630
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "姓 名："
         Height          =   180
         Left            =   4200
         TabIndex        =   16
         Top             =   555
         Width           =   630
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "出生年月："
         Height          =   180
         Left            =   480
         TabIndex        =   15
         Top             =   1125
         Width           =   900
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "参加工作年月："
         Height          =   180
         Left            =   3720
         TabIndex        =   14
         Top             =   1125
         Width           =   1260
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "职称："
         Height          =   180
         Left            =   600
         TabIndex        =   13
         Top             =   1755
         Width           =   540
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "最后学历："
         Height          =   180
         Left            =   3840
         TabIndex        =   12
         Top             =   1755
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmapply"
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 Combo4_Click()
'数据有效性检查
If Trim(Maskid.Text) <> "" And Combo4.ListIndex <> Asc(Left(Maskid.Text, 1)) - 65 Then
    MsgBox "该住户的住房等级应该为：" & Combo4.List(Asc(Left(Maskid.Text, 1)) - 65), vbInformation + vbOKOnly, SYSTITLE
    Combo4.ListIndex = Asc(Left(Maskid.Text, 1)) - 65
End If
End Sub
Private Sub Combo5_Click()
'数据有效性检查
If Combo5.ListIndex <= Asc(Left(Maskid.Text, 1)) - 66 And Combo5.ListIndex <> -1 Then
    MsgBox "申请的住房等级必须高于：" & Combo4.List(Combo4.ListIndex), vbInformation + vbOKOnly, SYSTITLE
    Combo5.ListIndex = -1
End If
End Sub

Private Sub Command1_Click()
Load frmadd
frmadd.Show
frmadd.SetFocus
End Sub
Private Sub Command2_Click()
Dim rst As Recordset
Dim sglzcf As Single, sglglf As Single, sglnlf As Single, sglxlf As Single
Dim listx As ListItem
'有效性检查
If DTPicker1.Value >= DTPicker2.Value Then
    MsgBox "参加工作时间不应早于出生年月，请重新输入！", vbCritical + vbOKOnly, SYSTITLE
    DTPicker2.SetFocus
    Exit Sub
End If
If Combo5.ListIndex = -1 Then
    MsgBox "请选择申请住房等级！", vbCritical + vbOKOnly, SYSTITLE
    Combo5.SetFocus
    Exit Sub
End If
Select Case Combo2.ListIndex
    Case 0: sglzcf = 20#
    Case 1: sglzcf = 16#
    Case 2: sglzcf = 12#
    Case 3: sglzcf = 8#
End Select
sglglf = (Year(Now) - DTPicker2.Year - 1) * 0.5 + (12 - DTPicker2.Month + Month(Now)) * 0.5 / 12
sglnlf = (Year(Now) - DTPicker1.Year - 1) * 0.1 + (12 - DTPicker1.Month + Month(Now)) * 0.1 / 12
Select Case Combo3.ListIndex
    Case 0: sglxlf = 4.5
    Case 1: sglxlf = 3.25
    Case 2: sglxlf = 2#
    Case 3: sglxlf = 0#
End Select
On Error GoTo errhdl
BeginTrans
Set rst = db2.OpenRecordset(CStr(Combo5.ListIndex + 1))
'添加申请信息
With rst
    .AddNew
    !id = Maskid.Text
    !Name = Text1.Text
    !birth = DTPicker1.Value
    !workdate = DTPicker2.Value
    !zc = Combo2.Text
    !xl = Combo3.Text
    !livedgr = Combo4.ListIndex + 1
    !zcf = Format(sglzcf, "0.00")
    !glf = Format(sglglf, "0.00")
    !nlf = Format(sglnlf, "0.00")
    !xlf = Format(sglxlf, "0.00")
    !zf = Format(sglzcf + sglglf + sglnlf + sglxlf, "0.00")
    .Update
End With
frmtree2.TreeView1.Nodes.Item("r" & CStr(Combo5.ListIndex + 1)).Text = "申请" & Combo5.Text & "（已有" & rst.RecordCount & "户）"
frmtree2.TreeView1.Nodes.Item("r" & CStr(Combo5.ListIndex + 1)).Selected = True
Call treenode(frmtree2.TreeView1.Nodes.Item("r" & CStr(Combo5.ListIndex + 1)))
Call clearapp
CommitTrans
Exit Sub
errhdl:
    MsgBox Err.Description, vbCritical + vbOKOnly, SYSTITLE
    Rollback
End Sub

Private Sub Command3_Click()
Call clearapp
End Sub

Private Sub Form_Load()
'设置界面布局
Call changefrmapp
Me.Top = 0
Me.Left = frmtree2.Width
Me.Height = frmMDI.ScaleHeight / 2
Me.Width = frmMDI.ScaleWidth - frmtree2.Width
Frame1.Width = Me.ScaleWidth - 2 * Frame1.Left
Command2.Enabled = False
End Sub

Private Sub Maskid_Change()
If Trim(Maskid.Text) <> "" Then
    Command2.Enabled = True
Else
    Command2.Enabled = False
End If
End Sub

Private Sub Maskid_LostFocus()
Maskid.Text = UCase(Maskid.Text)
If Trim(Maskid.Text) <> "" And (Asc(Left(Maskid.Text, 1)) < 65 Or Asc(Left(Maskid.Text, 1)) > 71) Then
    MsgBox "住号有误，请重新输入！", vbCritical + vbOKOnly, SYSTITLE
    Maskid.Mask = ""
    Maskid.Text = ""
    Maskid.Mask = "?###"
    Maskid.SetFocus
    Exit Sub
End If
If Trim(Maskid.Text) <> "" Then
    Combo4.ListIndex = Asc(Left(Maskid.Text, 1)) - 65
End If
End Sub