frmtime.frm

一个能够有效管理教师（含家庭人口）的住房信息系统（含信息的添加、修改、删除等）

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmtime 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "输入新分房住户的入住时间："
   ClientHeight    =   1650
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3315
   Icon            =   "frmtime.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1650
   ScaleWidth      =   3315
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "取消(&C)"
      Height          =   375
      Left            =   1800
      TabIndex        =   3
      Top             =   1080
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   1080
      Width           =   975
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   300
      Left            =   1320
      TabIndex        =   1
      Top             =   360
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   529
      _Version        =   393216
      Format          =   23789568
      CurrentDate     =   37743
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "入住时间："
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   420
      Width           =   900
   End
End
Attribute VB_Name = "frmtime"
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 i As Integer, strfrom As String, strto As String, strtmp1 As String, strtmp2 As String, alpha As String
Me.Hide
On Error GoTo errhld
For i = 0 To frmdeal.List3.ListCount - 1
    strfrom = Left(frmdeal.List3.List(i), 4)
    strto = Right(frmdeal.List3.List(i), 4)
    alpha = Asc(Left(strto, 1)) - 65
    BeginTrans    '开始事务处理
    db.Execute "update host set id= '" & strto & "',livedgr=" & Val(Asc(Left(strto, 1)) - 64) & ",indate = # " & DTPicker1.Value & " # where id= '" & strfrom & "'"
    db2.Execute "update " & alpha & " set newid= '" & strto & "' where id= '" & strfrom & "'"
    CommitTrans    '结束事务处理
Next
Unload Me
Unload frmdeal
Unload frmtree2
frmtree2.Show
frmtree2.TreeView1.Nodes.Item("r" & alpha).Selected = True
frmlist.Command5.Enabled = True
frmlist.Command5.Caption = "查看分房记录(&V)"
frmlog.Show 1
Exit Sub
'错误处理
errhld:
    MsgBox Err.Description, vbCritical + vbOKOnly, SYSTITLE
    Rollback
End Sub

Private Sub Command2_Click()
Unload Me
End Sub