项目源代码清单.doc

学生信息管理系统详细设计说明书

        .Row = 0
        .Col = 0
        .Text = "记录号"
        .ColWidth(0) = 900
        For intBak = 1 To .Cols - 1
            .Col = intBak
            .Text = dbCtrlObj.GetCName(rs.Fields(intBak - 1).Name)
            
            '.ColWidth(intbak) = 250 * Len(.Text)
            If Len(.Text) < 4 Then
                .ColWidth(intBak) = 900
            Else
                .ColWidth(intBak) = 200 * Len(Trim(.Text))
        End If
        Next intBak

        intcount = 1
        Do While Not rs.EOF
            .AddItem (Empty)
            .Row = .Rows - 2
            .Col = 0
            .Text = Trim(Str(intcount))
            For intBak = 1 To .Cols - 1
                .Col = intBak
                If Not IsNull(rs(intBak - 1)) Then
                    .Text = LTrim(RTrim((rs(intBak - 1))))
                    .Text = Replace(.Text, dbCtrlObj.STR_SPLIT, "'")   '处理数据,将'替换回来
                End If
            Next intBak
            intcount = intcount + 1
            rs.MoveNext
        Loop
    End With
    rs.Close
    
    Set rs = Nothing
End Sub



Private Sub btnDel_Click()
    DelData
End Sub

Private Sub btnSave_Click()
    If MdfyInf.isMdfing Then
        SaveData
    Else
        ShowErr "请先进行修改!“"
    End If
End Sub

Private Sub btnSeach_Click()
    Dim rs As Recordset
    Dim intBak As Integer
    Dim strSearch As String
    
    strSearch = ""
    Dim Fields() As String
    Fields = Split(dbSrc.Fields, ",")
    For intBak = 0 To UBound(Fields)
        '字段条件
     If Trim(txtCdn(intBak)) <> "" And Trim(txtCdn(intBak)) <> "请输入条件" Then
        strSearch = strSearch & " (" & Fields(intBak) & " "
        If InStr(1, lblcdn(intBak), "(字串)") Then '如果是字串
            If InStr(1, txtCdn(intBak), "'") Then '如果是标准的SQL语句则直接连接
                strSearch = strSearch & txtCdn(intBak)
            Else
                If opnBlur.Value Then  '如果选择模糊
                    strSearch = strSearch & "LIKE '%" & txtCdn(intBak) & "%'"
                Else
                    strSearch = strSearch & "='" & txtCdn(intBak) & "'"
                End If
            End If
            strSearch = strSearch & ")"
        Else  '为其它类型
            If opnBlur.Value Then  '如果选择模糊
               strSearch = strSearch & "LIKE '%" & txtCdn(intBak) & "%'"
            Else
                If dbCtrlObj.IsSafeCode(txtCdn(intBak)) Then '是否含有SQL符号
                    strSearch = strSearch & "=" & txtCdn(intBak)
                Else
                    strSearch = strSearch & txtCdn(intBak)
                End If
            
            End If
            strSearch = strSearch & ")"
        End If
        '与或条件
        If intBak < chkOperate.Count Then
            If chkOperate(intBak).Value Then
                strSearch = strSearch & " OR"
            Else
                strSearch = strSearch & " AND"
            End If
        End If
     End If
    Next intBak
    If Right(strSearch, 2) = "OR" Then strSearch = Mid(strSearch, 1, Len(strSearch) - 2)
    If Right(strSearch, 3) = "AND" Then strSearch = Mid(strSearch, 1, Len(strSearch) - 3)
    strSearchCmd = "Select " & dbSrc.Fields & " from " & dbSrc.tableName & " where " & strSearch
    If strSearch <> "" Then
        FrushFgrid strSearchCmd
    Else
        FrushFgrid "select " & dbSrc.Fields & " from " & dbSrc.tableName
    End If
    
    
    
End Sub


Private Sub FgdData_Click()
    If MdfyInf.isMdfing Then
        If MdfyInf.Row <> FgdData.Row Then
            SaveData
        End If
    End If
    PushRC True
    If FgdData.Row = FgdData.Rows - 1 Then
        MdfyInf.id = ""
    End If
    txtInput.Visible = False
    TxtMove

End Sub

Private Function GetOkTxt(strBak As String) As String
    Dim intBak As Integer
    Dim strBak2 As String
    With FgdData
        For intBak = 0 To .Rows - 1
            strBak2 = .TextArray(intBak * .Cols + .Col)
            If Len(strBak2) > Len(strBak) Then
                If Left(UCase(strBak2), Len(strBak)) = UCase(strBak) Then
                    GetOkTxt = strBak2
                    Exit For
                End If
            End If
        Next intBak
    End With
End Function

Private Sub TxtMove()
    With FgdData
        If .Col <= .Cols - 1 And .Row <= .Rows - 1 Then
            txtInput.Left = .Left + .ColPos(.Col)
            txtInput.Top = .Top + .RowPos(.Row)
            txtInput.Width = .ColWidth(.Col)
            'TxtInput.Height = .RowHeight(.Row)
            txtInput.Text = Trim(.Text)
            txtInput.Visible = True
            txtInput.SetFocus
        End If
    End With
End Sub


Private Function JianYanTXT(Table As MSHFlexGrid, kongJian As TextBox)
   Table.Text = kongJian.Text
End Function
     
       
       
Private Function WanBiTXT(Table As MSHFlexGrid, _
                        kongJian As TextBox, _
                        RowNum As Integer, _
                        ColNum As Integer)
   If Table.Col = ColNum Then
        Table.Col = 0
       If Table.Row = RowNum Then
             Table.Row = 1
             Table.Col = 0
          Else
            Table.Row = Table.Row + 1
       End If
   End If
   If Table.Col < ColNum Then
        Table.Col = Table.Col + 1
   End If
        
     kongJian.Left = Table.Left + Table.ColPos(Table.Col)
     kongJian.Top = Table.Top + _
         Table.RowPos(Table.Row)
     kongJian.Width = Table.ColWidth(Table.Col)
     kongJian.Height = Table.RowHeight(Table.Row)
     kongJian.Text = Table.Text
     kongJian.Visible = True
     kongJian.SetFocus
 End Function





Private Sub txtCdn_click(Index As Integer)
    SendKeys "{Home}+{End}"
End Sub

Private Sub DelData()
    Dim strBak As String
    Dim strCmd As String
    strBak = FgdData.TextArray(FgdData.Row * FgdData.Cols + 1)
    strCmd = "Delete from " & dbSrc.tableName & " where " & dbSrc.KeyName & "="
    If InStr(1, lblcdn(1), "(字串)") > 0 Then
        strCmd = strCmd & "'" & strBak & "'"
    Else
        strCmd = strCmd & strBak
    End If
    dbCtrlObj.RunSql strCmd
    PushRC True
    FrushFgrid (strSearchCmd)
    PushRC False
    
    
    
End Sub
Private Sub SaveData()   '保存输入的数据
    Dim rs As Recordset
    Dim intBak As Integer
    Dim strSaveCMd As String
    Dim Fields() As String
    intBak = 0
    strSaveCMd = ""
    Fields = Split(dbSrc.Fields, ",")
    If Trim(FgdData.TextArray(MdfyInf.Row * FgdData.Cols + 1)) = "" Then
        MsgBox "关键字不能为空!", vbOKOnly
        MdfyInf.isMdfing = False
        PushRC True
        FrushFgrid strSearchCmd
        PushRC False
        Exit Sub
    End If
    If MdfyInf.id <> "" Then
        For intBak = 0 To UBound(Fields)  '修改
            strSaveCMd = strSaveCMd & Fields(intBak) & "="
            If InStr(1, lblcdn(intBak), "(字串)") > 0 Then
                
                strSaveCMd = strSaveCMd & "'" & Replace(FgdData.TextArray(MdfyInf.Row * FgdData.Cols + intBak + 1), "'", dbCtrlObj.STR_SPLIT) & "',"
            Else
                strSaveCMd = strSaveCMd & FgdData.TextArray(MdfyInf.Row * FgdData.Cols + intBak + 1) & " ,"
            End If
        Next intBak
        strSaveCMd = Mid(strSaveCMd, 1, Len(strSaveCMd) - 1)
        strSaveCMd = "update [" & dbSrc.tableName & "] set " & strSaveCMd & " where " & dbSrc.KeyName & "='" & MdfyInf.id & "'"
    Else
        strSaveCMd = strSaveCMd & dbSrc.Fields '添加
        strSaveCMd = "insert into [" & dbSrc.tableName & "] (" & strSaveCMd & ") values("
        For intBak = 0 To UBound(Fields)
            If InStr(1, lblcdn(intBak), "(字串)") > 0 Then
                strSaveCMd = strSaveCMd & "'" & Replace(FgdData.TextArray(MdfyInf.Row * FgdData.Cols + intBak + 1), "'", dbCtrlObj.STR_SPLIT) & "',"
            Else
                strSaveCMd = strSaveCMd & FgdData.TextArray(MdfyInf.Row * FgdData.Cols + intBak + 1) & " ,"
            End If
        Next intBak
        strSaveCMd = Mid(strSaveCMd, 1, Len(strSaveCMd) - 1)
        strSaveCMd = strSaveCMd & ")"
    End If
    If dbCtrlObj.RunSql(strSaveCMd) = 0 Then
        MdfyInf.isMdfing = False
        MsgBox "操作失败!", vbOKOnly
        PushRC True
        FrushFgrid strSearchCmd
        PushRC False
    Else
        If MdfyInf.Row >= FgdData.Rows - 1 Then
            FgdData.AddItem Empty
        End If
        MdfyInf.id = ""
        MdfyInf.MdfOldData = ""
        MdfyInf.isMdfing = False
        
    End If
    
End Sub

'   压栈与退栈
'

Private Sub PushRC(blnBak As Boolean)
    Static intCol As Integer
    Static intRow As Integer
    If blnBak Then
        intCol = FgdData.Col
        intRow = FgdData.Row
    Else
        If intCol < FgdData.Cols Then
            FgdData.Col = intCol
        Else
            FgdData.Col = FgdData.Cols - 1
        End If
        If intRow < FgdData.Rows Then
            FgdData.Row = intRow
        Else
            FgdData.Row = FgdData.Rows - 1
        End If
    End If
    FgdData.SetFocus
End Sub


Private Sub txtCdn_KeyPress(Index As Integer, KeyAscii As Integer)
    If InStr(1, lblcdn(Index), "(数值)") > 0 Then
        If InStr(1, ".><=+-1234567890", Chr(KeyAscii)) > 0 Then
            Exit Sub
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub txtInput_KeyPress(KeyAscii As Integer)
    If InStr(1, lblcdn(FgdData.Col - 1), "(数值)") > 0 Then
        If InStr(1, ".><=+-1234567890", Chr(KeyAscii)) > 0 Then
            Exit Sub
        Else
            KeyAscii = 0
        End If
    End If
    
End Sub

Private Sub TxtInput_KeyUp(KeyCode As Integer, Shift As Integer)
    
    With FgdData
        If KeyCode = 27 Then  'ESC
            If MdfyInf.isMdfing Then
                MdfyInf.isMdfing = False
                .Text = MdfyInf.MdfOldData
                txtInput = .Text
            End If
        Else
            If Not MdfyInf.isMdfing Then
                MdfyInf.isMdfing = True
                MdfyInf.MdfOldData = .Text
                .Text = txtInput
                MdfyInf.id = .TextArray(.Row * .Cols + 1)
                MdfyInf.Row = .Row
            End If
            .Text = txtInput
        End If
        If KeyCode = 13 Then '回车
            If .Col < .Cols - 1 Then
                .Col = .Col + 1
            Else
                SaveData
                .Col = 1
                If .Row < .Rows - 2 Then
                    .Row = .Row + 1
                Else
                    .Row = .Rows - 1
                End If