📄 limit.frm

📁 OA编程源代码
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call SaveLimit
End Sub

Private Sub HFlLimit_Click()
    Dim strC As String

    On Error GoTo DatabaseError

    If HFlLimit.Row = 0 Then
        Exit Sub
    End If
    
    If HFlLimit.Row = 1 Then
        If Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 0))) = 0 And Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 1))) = 0 Then
            Exit Sub
        End If
    End If
    
    Select Case HFlLimit.Col
    Case 0
        If HFlLimit.Row > 0 Then
            If Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, HFlLimit.Col))) <> 0 Then
                strC = Trim(HFlLimit.TextMatrix(HFlLimit.Row, HFlLimit.Col)) & "用户组的用户有："
                
                sql = "SELECT username FROM groupuser WHERE "
                sql = sql & "groupname='" & Trim(HFlLimit.TextMatrix(HFlLimit.Row, HFlLimit.Col)) & "'"
                Set rst = gclsDatabase.RDOSelect(sql)
                
                If rst.RowCount > 0 Then
                    Do While Not rst.EOF
                        strC = strC & Trim(rst!Username) & ","
                        rst.MoveNext
                    Loop
                    
                    strC = Mid(Trim(strC), 1, Len(Trim(strC)) - 1)
                End If
                
                rst.Close
                
                MsgBox strC, vbInformation, "系统信息"
            End If
        End If
    Case 1
    Case 2
        
        If HFlLimit.Row > 0 Then
            If Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 1) = 0 Then
                Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    "1" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 2, 9)
            Else
                HFlLimit.Col = 2
                Set HFlLimit.CellPicture = LoadPicture("")
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    "0" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 2, 9)
            End If
            SaveFlag = True
        End If
    Case 3
        If HFlLimit.Row > 0 Then
            If Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 2, 1) = 0 Then
                Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 1) _
                    & "1" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 3, 8)
            Else
                HFlLimit.Col = 3
                Set HFlLimit.CellPicture = LoadPicture("")
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 1) _
                    & "0" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 3, 8)
            End If
            SaveFlag = True
        End If
    Case 4
        If HFlLimit.Row > 0 Then
            If Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 3, 1) = 0 Then
                Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 2) _
                    & "1" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 4, 7)
            Else
                HFlLimit.Col = 4
                Set HFlLimit.CellPicture = LoadPicture("")
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 2) _
                    & "0" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 4, 7)
            End If
            SaveFlag = True
        End If
    Case 5
        If HFlLimit.Row > 0 Then
            If Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 4, 1) = 0 Then
                Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 3) _
                    & "1" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 5, 6)
            Else
                HFlLimit.Col = 5
                Set HFlLimit.CellPicture = LoadPicture("")
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 3) _
                    & "0" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 5, 6)
            End If
            SaveFlag = True
        End If
    Case 6
        If HFlLimit.Row > 0 Then
            If Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 5, 1) = 0 Then
                Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                HFlLimit.CellPictureAlignment = flexAlignCenterCenter
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 4) _
                    & "1" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 6, 5)
            Else
                HFlLimit.Col = 6
                Set HFlLimit.CellPicture = LoadPicture("")
                HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                    Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 1, 4) _
                    & "0" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 6, 5)
            End If
            SaveFlag = True
        End If
    End Select
    
    Exit Sub
DatabaseError:
    Call ManageQuit
End Sub

Private Sub LimitRefresh_click()
    On Error GoTo DatabaseError

    If SaveFlag Then
        Call SaveLimit
    End If
   
    Call ManageLimit

    TreTree.Nodes.Clear
    
    sql = "SELECT treeno,treename FROM treebase ORDER BY TREENO"
    Set rst = gclsDatabase.RDOSelect(sql)
    
    If rst.RowCount > 0 Then
        Do While Not rst.EOF
            If Len(Trim(rst!TreeNo)) = 2 Then
                    Set nodX = TreTree.Nodes.Add(, , _
                        TreeViewChar & Trim(rst!TreeNo), _
                        Trim(rst!treename))
            Else
                Set nodX = TreTree.Nodes.Add( _
                    TreeViewChar & Trim(Mid(Trim(rst!TreeNo), 1, _
                    Len(Trim(rst!TreeNo)) - 2)), _
                    tvwChild, TreeViewChar & Trim(rst!TreeNo), _
                    Trim(rst!treename))
            End If
            rst.MoveNext
        Loop
        
        rst.MoveFirst
        
        strNodeKey = Trim(rst!TreeNo)
        
        Call DispLimit
    Else
        MsgBox "栏目不存在，请先进行栏目设置！", vbExclamation, "系统信息"
        Unload Me
    End If

    rst.Close

    SaveFlag = False
    
    Exit Sub
DatabaseError:
    Call ManageQuit
End Sub

Private Sub menuNotSet_Click()
Dim i, j As Integer
Dim TotalCol As Integer

    If HFlLimit.Row = 0 Then
        Exit Sub
    End If
    
    If HFlLimit.Row = 1 Then
        If Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 0))) = 0 And Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 1))) = 0 Then
            Exit Sub
        End If
    End If
    If HFlLimit.ColWidth(4) = 0 Then
        TotalCol = 4
    Else
        TotalCol = 7
    End If
    
    HFlLimit.Redraw = False
    For i = 1 To HFlLimit.Rows - 1
        For j = 2 To TotalCol - 1
            HFlLimit.Row = i
            HFlLimit.Col = j
            Set HFlLimit.CellPicture = LoadPicture("")
            HFlLimit.CellPictureAlignment = flexAlignCenterCenter
        Next
        If TotalCol = 4 Then
            HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                "00" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 3, 8)
        ElseIf TotalCol = 7 Then
            HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                "00000" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 6, 5)
        End If
    Next
    
    SaveFlag = True
    HFlLimit.Redraw = True
    
End Sub

Private Sub menuSetLimit_Click()
Dim i, j As Integer
Dim TotalCol As Integer

    If HFlLimit.Row = 0 Then
        Exit Sub
    End If
    
    If HFlLimit.Row = 1 Then
        If Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 0))) = 0 And Len(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 1))) = 0 Then
            Exit Sub
        End If
    End If
    If HFlLimit.ColWidth(4) = 0 Then
        TotalCol = 4
    Else
        TotalCol = 7
    End If
    
    HFlLimit.Redraw = False
    For i = 1 To HFlLimit.Rows - 1
        For j = 2 To TotalCol - 1
            HFlLimit.Row = i
            HFlLimit.Col = j
            Set HFlLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
            HFlLimit.CellPictureAlignment = flexAlignCenterCenter
        Next
        If TotalCol = 4 Then
            HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                "11" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 3, 8)
        ElseIf TotalCol = 7 Then
            HFlLimit.TextMatrix(HFlLimit.Row, 7) = _
                "11111" & Mid(Trim(HFlLimit.TextMatrix(HFlLimit.Row, 7)), 6, 5)
        End If
    Next
    
    SaveFlag = True
    HFlLimit.Redraw = True
    
End Sub

Private Sub TreTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        Me.PopupMenu LimitPopMenu
    End If
End Sub

Private Sub TreTree_NodeClick(ByVal Node As ComctlLib.Node)
    If SaveFlag Then
        Call SaveLimit
    End If
    
    strNodeKey = Mid(Trim(Node.Key), 2, Len(Trim(Node.Key)) - 1)
    
    Call DispLimit
End Sub
上一页 1 23
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -