其他数据库

开发平台：
Visual Basic

frmPlan.frm：源码内容
							VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmPlan 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "日常排班"
   ClientHeight    =   8625
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11910
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmPlan.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8625
   ScaleWidth      =   11910
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin ComctlLib.TreeView tvwPlan 
      Height          =   6360
      Left            =   135
      TabIndex        =   0
      Top             =   450
      Width           =   1665
      _ExtentX        =   2937
      _ExtentY        =   11218
      _Version        =   327682
      LabelEdit       =   1
      Style           =   6
      Appearance      =   1
   End
   Begin VB.Frame Frame1 
      Height          =   1140
      Left            =   195
      TabIndex        =   2
      Top             =   7020
      Width           =   11460
      Begin VB.CommandButton cmdPlan 
         Caption         =   "返回(&R)"
         Height          =   555
         Index           =   5
         Left            =   9630
         TabIndex        =   8
         Top             =   375
         Width           =   1530
      End
      Begin VB.CommandButton cmdPlan 
         Caption         =   "打印排班表(&P)"
         Enabled         =   0   'False
         Height          =   555
         Index           =   4
         Left            =   7767
         TabIndex        =   7
         Top             =   375
         Width           =   1530
      End
      Begin VB.CommandButton cmdPlan 
         Caption         =   "查看排班(&L)"
         Enabled         =   0   'False
         Height          =   555
         Index           =   0
         Left            =   315
         TabIndex        =   6
         Top             =   375
         Width           =   1530
      End
      Begin VB.CommandButton cmdPlan 
         Caption         =   "集体排班(&G)"
         Enabled         =   0   'False
         Height          =   555
         Index           =   1
         Left            =   2178
         TabIndex        =   5
         Top             =   375
         Width           =   1530
      End
      Begin VB.CommandButton cmdPlan 
         Caption         =   "单个排班(&S)"
         Enabled         =   0   'False
         Height          =   555
         Index           =   2
         Left            =   4041
         TabIndex        =   4
         Top             =   375
         Width           =   1530
      End
      Begin VB.CommandButton cmdPlan 
         Caption         =   "查找员工(&Y)"
         Enabled         =   0   'False
         Height          =   555
         Index           =   3
         Left            =   5904
         TabIndex        =   3
         Top             =   375
         Width           =   1530
      End
   End
   Begin MSFlexGridLib.MSFlexGrid msfGrid 
      Bindings        =   "frmPlan.frx":000C
      Height          =   6375
      Left            =   1815
      TabIndex        =   1
      Top             =   450
      Width           =   9915
      _ExtentX        =   17489
      _ExtentY        =   11245
      _Version        =   393216
      FixedCols       =   0
      AllowBigSelection=   0   'False
      HighLight       =   0
   End
   Begin VB.Label lblPlan 
      AutoSize        =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000040C0&
      Height          =   240
      Left            =   4950
      TabIndex        =   9
      Top             =   105
      Width           =   120
   End
End
Attribute VB_Name = "frmPlan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mNode As Node
Dim mFormatString As String
Dim mAllowGroup As Boolean
Dim mDeptID As Integer
Dim mDeptName As String
Const mLog = "R"
Const mYEAR = "年"
Const mMONTH = "月"
Const mPlanStr = "的排班情况"
Const mMsg1 = "抱歉,初始化表不成功,您不能进入排班!!"
'********
Const mLookPlan = 0
Const mGroupPlan = 1
Const mSinglePlan = 2
Const mLookEmp = 3
Const mPrintPlan = 4
Const mClosePlan = 5
'*****msfGrid
Const mGridWorkNo = 1
Const mGridName = 0
'***frmdetail.mtitle
Const mstrDui = "对"
Const mstrEmployee = "的员工"
Const mstrDoPlan = "进行排班"
Const mstrLook = "查看"
Const mstrPlan = "的排班"
Private Sub cmdPlan_Click(Index As Integer)
    Select Case Index
        Case mGroupPlan, mSinglePlan, mLookPlan
            If msfGrid.Rows <= msfGrid.FixedRows Then Exit Sub
            DoPlan Index
        Case mLookEmp
            DoLookEmp
        Case mPrintPlan
            Dim tmpStr As String
            tmpStr = gOwnName & "-" & Me.Caption
            PrintGridNormal tmpStr, _
                msfGrid, 1, "", True
        Case mClosePlan
            Unload Me
    End Select
End Sub
Private Sub DoLookEmp()
    Dim MyfrmLookMan As frmLookMan
    Dim Sql As String
    Dim strWorkNo As String
    Dim DeptName  As String
    Dim i As Integer
    Dim NodX As Node
    Dim H As Integer
    Set MyfrmLookMan = New frmLookMan
    With MyfrmLookMan
        .Show vbModal
        strWorkNo = Trim(.mWorkNo)
        DeptName = Trim(.mDept)
    End With
    If strWorkNo <> Empty Then
        If DeptName <> Trim(mNode.Text) Then
            For i = 0 To tvwPlan.Nodes.Count - 1
                If Trim(tvwPlan.Nodes(i).Text) = DeptName Then
                    Set NodX = tvwPlan.Nodes(i)
                    tvwPlan_NodeClick NodX
                    Exit For
                End If
            Next
        End If
        With msfGrid
            CloseColor msfGrid
            If .Redraw Then .Redraw = False
            For i = .FixedRows To .Rows - 1
                If Trim(.TextMatrix(i, mGridWorkNo)) = strWorkNo Then
                     For H = 0 To .Cols - 1
                        .row = i
                        .col = H
                        .CellBackColor = gCellSelBackColor
                        .CellForeColor = gCellSelForeColor
                    Next
                    Exit For
                End If
            Next
            .Redraw = True
        End With
    End If
    
    Unload MyfrmLookMan
End Sub
Private Sub DoPlan(Index As Integer)
    Dim MyfrmDetail As frmDetail
    Set MyfrmDetail = New frmDetail
    Dim strName As String
    Dim strTemp As String
    With MyfrmDetail
        If Index = mGroupPlan Then
            If Not mAllowGroup Then Exit Sub
            .mDeptID = mDeptID
            .mWorkNo = Trim(msfGrid.TextMatrix _
                (msfGrid.FixedRows, mGridWorkNo))
            .mTitle = mstrDui & "[" & mDeptName & "]" & mstrDoPlan
            .mIsToLook = False
        Else
            .mDeptID = Empty
            .mWorkNo = Trim(msfGrid.TextMatrix _
                (msfGrid.row, mGridWorkNo))
            strName = Trim(msfGrid.TextMatrix(msfGrid.row, mGridName))
            If Index = mSinglePlan Then
                strTemp = mstrDui
            Else
                strTemp = mstrLook
            End If
            strTemp = strTemp & "[" & mDeptName & "]" & mstrEmployee _
                     & "[" & strName & "]"
            If Index = mSinglePlan Then
                .mTitle = strTemp & mstrDoPlan
                .mIsToLook = False
            Else
                .mTitle = strTemp & mstrPlan
                .mIsToLook = True
            End If
        End If
        '.mTableName = Trim(mTableName)
        '.mQryName = Trim(gCMDQUERY)
        .Show vbModal
        If .mNeedToRefresh Then tvwPlan_NodeClick mNode
        Unload MyfrmDetail
    End With
End Sub
Private Sub Form_Load()
    mAllowGroup = True
    
    If Not CreatePlanTable Then
        MsgBox mMsg1, vbCritical, gTitle
        End '若用unload me 会造成循环显示上面的提示
    End If
    Me.Caption = Format(Year(Date), "0000") & mYEAR _
        & Format(Month(Date), "00") & mMONTH _
        & Space(2) & Me.Caption
    mFormatString = "<姓名   " & vbTab _
        & "^卡号 " & vbTab
    IniMyGrid
     
    AddDataToTreeView
End Sub
Private Sub IniMyGrid()
    Dim i As Integer
    
    For i = 1 To gMaxDay
        mFormatString = mFormatString & CStr(i)
        If i <> gMaxDay Then mFormatString = mFormatString & vbTab
    Next
    SetGridColor msfGrid
    msfGrid.FormatString = mFormatString
End Sub
Private Sub AddDataToTreeView()
    Dim i As Integer
    Dim NodX As Node
    With tvwPlan
        If UBound(aDepartment) < 1 Then Exit Sub
        For i = 1 To UBound(aDepartment)
            .Nodes.Add , , mLog & aDepartment(i).ID, _
                aDepartment(i).Name
        Next
    End With
    Set NodX = tvwPlan.Nodes(1)
    tvwPlan_NodeClick NodX
End Sub
Private Sub msfGrid_DblClick()
    cmdPlan_Click mLookPlan
End Sub
Private Sub tvwPlan_NodeClick(ByVal Node As ComctlLib.Node)
'    Dim DeptID As Integer
'    Dim QD As QueryDef
'    Dim DeptRst As Recordset
    Dim EmpRst As Recordset
    Dim ShiftRst As Recordset
    Dim Sql As String
    Dim strWorkNo As String
    Dim strName As String
    Dim strShift As String
    Dim Str As String
    Dim intRows As Integer
    Dim intCols As Integer
    
    Set mNode = Node
    'mNodeIndex=tvwplan.Nodes
    mAllowGroup = True
    mDeptID = CInt(Val(Mid(Node.Key, Len(mLog) + 1)))
    mDeptName = Trim(Node.Text)
'    Set QD = gDataBase.QueryDefs(mQuery)
    'QD.Parameters("DeptID") = DeptID
    'Set DeptRst = QD.OpenRecordset(dbOpenSnapshot)
    Sql = "select distinct Name,WorkNo from " & gPlanQryName _
        & " where DeptID=" & mDeptID _
        & " order by WorkNo"
    Set EmpRst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    While Not EmpRst.EOF
        intRows = intRows + 1
        strName = Trim(EmpRst!Name)
        strWorkNo = Trim(EmpRst!WorkNo)
        Str = Str & strName & vbTab & strWorkNo & vbTab
        Sql = "select ShiftName from " & gPlanQryName _
            & " where WorkNo='" & strWorkNo _
            & "' order by F_Day"
        Set ShiftRst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
        While Not ShiftRst.EOF
            strShift = IIf(IsNull(ShiftRst!ShiftName), "", Trim(ShiftRst!ShiftName))
            If mAllowGroup Then
                If strShift <> Empty Then mAllowGroup = False
            End If
            Str = Str & strShift & vbTab
            ShiftRst.MoveNext
        Wend
        ShiftRst.Close
        Set ShiftRst = Nothing
        If Not EmpRst.EOF Then Str = Str & vbCr
        EmpRst.MoveNext
    Wend
    EmpRst.Close
    Set EmpRst = Nothing
    
    intRows = intRows + 1
    intCols = gMaxDay + 2 'col name and workno
    ClipToGrid msfGrid, Str, intRows, intCols
    
    ChangeTolblPlan Trim(Node.Text)
    ChangeToCmdPlan
End Sub
Private Sub ChangeToCmdPlan()
    Dim i As Integer
    Dim IsAllowChange As Boolean
    IsAllowChange = (msfGrid.Rows > msfGrid.FixedRows)
    For i = 0 To cmdPlan.Count - 2
        cmdPlan(i).Enabled = IsAllowChange
        If IsAllowChange Then
            If i = mGroupPlan Then
                cmdPlan(i).Enabled = mAllowGroup
            End If
        End If
    Next
End Sub
Private Sub ChangeTolblPlan(Str As String)
    Dim intLeft As Integer
    lblPlan = Str & mPlanStr
    intLeft = CInt((Me.Width - Me.TextWidth(lblPlan.Caption)) / 2)
    lblPlan.Left = intLeft
End Sub

						