首页 › 资源下载 › *行业应用 › OA编程源代码 › 源码查看
frmapplimit.frm

来自「OA编程源代码」· FRM 代码 · 共 903 行 · 第 1/2 页
FRM
903 行
            strSQL = "select distinct A.LimitName,A.DealName,A.DealTable,A.Write,A.Query,A.Edit,"
            strSQL = strSQL & " G.groupname"
            strSQL = strSQL & " from AppLimittest A,groupuser G "
            strSQL = strSQL & " where A.limitname=G.groupname "
            strSQL = strSQL & " and A.dealtable='" & strTableName & "' "
            strSQL = strSQL & " union "
            strSQL = strSQL & "select distinct A.LimitName,A.DealName,A.DealTable,A.Write,A.Query,A.Edit,"
            strSQL = strSQL & " G.deparment_c as groupname"
            strSQL = strSQL & " from AppLimittest A,groupuser G "
            strSQL = strSQL & " where A.limitname=G.deparment_c "
            strSQL = strSQL & " and A.dealtable='" & strTableName & "' "
            Set appRs = appConn.Execute(strSQL)
            i = 1
            
            While Not appRs.EOF
                MSFGLimit.Rows = i + 1
                MSFGLimit.Row = i
                
                MSFGLimit.TextMatrix(i, 0) = appRs("limitname")
                
                MSFGLimit.Col = 1
                If appRs("Write") = "1" Then
                        Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                        MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
                Else
                    Set MSFGLimit.CellPicture = Nothing
                End If
                
                MSFGLimit.Col = 2
                If appRs("Query") = "1" Then
                        Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                        MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
                Else
                    Set MSFGLimit.CellPicture = Nothing
                End If
                
                MSFGLimit.Col = 3
                If appRs("Edit") = "1" Then
                        Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                        MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
                Else
                    Set MSFGLimit.CellPicture = Nothing
                End If
                MSFGLimit.TextMatrix(i, 4) = appRs("DealName")
                appRs.MoveNext
                i = i + 1
            Wend
    
    End Select

End If

MSFGLimit.Redraw = True

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set appConn = Nothing
End Sub

Private Sub MenuSetupAdd_Click()

Dim strMsTxt As String
strMsTxt = ""
MSFGLimit.AddItem strMsTxt
    
End Sub

Private Sub MenuSetupDelete_Click()
Dim strMessage As String
strMessage = "确实要删除吗？" & Chr(13) & Chr(10)
strMessage = strMessage & "如果删除请选择“是(Y)”，" & Chr(13) & Chr(10)
strMessage = strMessage & "否则选择“否(N)”。"

If MsgBox(strMessage, vbYesNo + vbQuestion + vbDefaultButton2, "系统提示") = vbYes Then
    strSQL = "delete applimittest where "
    strSQL = strSQL & " LimitName='" & MSFGLimit.TextMatrix(MSFGLimit.RowSel, 0) & "' "
    strSQL = strSQL & " and DealName='" & MSFGLimit.TextMatrix(MSFGLimit.RowSel, 4) & "' "
    strSQL = strSQL & " and dealtable='" & strTableName & "' "
    MSFGLimit.Col = 2
        If MSFGLimit.CellPicture = 0 Then
            strSQL = strSQL & " and  Query='0' "
        Else
            strSQL = strSQL & " and query='1' "
        End If
    MSFGLimit.Col = 3
        If MSFGLimit.CellPicture = 0 Then
            strSQL = strSQL & " and  Edit='0' "
        Else
            strSQL = strSQL & " and Edit='1' "
        End If
    Set appRs = appConn.Execute(strSQL, 64)
    If MSFGLimit.RowSel = 1 Then
        MSFGLimit.TextMatrix(MSFGLimit.RowSel, 0) = ""
        MSFGLimit.Col = 1
            If MSFGLimit.CellPicture <> 0 Then
                Set MSFGLimit.CellPicture = Nothing
            End If
        MSFGLimit.Col = 2
            If MSFGLimit.CellPicture <> 0 Then
                Set MSFGLimit.CellPicture = Nothing
            End If
        MSFGLimit.Col = 3
            If MSFGLimit.CellPicture <> 0 Then
                Set MSFGLimit.CellPicture = Nothing
            End If
        MSFGLimit.TextMatrix(MSFGLimit.RowSel, 4) = ""
    Else
        MSFGLimit.RemoveItem (MSFGLimit.RowSel)
    End If
End If

End Sub

Private Sub MSFGLimit_Click()

If MSFGLimit.Row < 1 Then Exit Sub

Select Case Tabindex
    Case 0
        If MSFGLimit.Col = 0 Then
'            CmbDepart.Width = MSFGLimit.CellWidth
'            CmbDepart.Top = MSFGLimit.Top + MSFGLimit.CellTop
'            CmbDepart.Left = MSFGLimit.Left + MSFGLimit.CellLeft
            CmbDepart.Visible = False
            CmbDepartD.Visible = False
        ElseIf MSFGLimit.Col = 4 Then
'            CmbDepartD.Width = MSFGLimit.CellWidth
'            CmbDepartD.Top = MSFGLimit.Top + MSFGLimit.CellTop
'            CmbDepartD.Left = MSFGLimit.Left + MSFGLimit.CellLeft
            CmbDepartD.Visible = False
            CmbDepart.Visible = False
        ElseIf MSFGLimit.Col = 1 Or MSFGLimit.Col = 2 Or MSFGLimit.Col = 3 Then
            CmbDepart.Visible = False
            CmbDepartD.Visible = False
            If MSFGLimit.CellPicture = 0 Then
                Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
            Else
                Set MSFGLimit.CellPicture = Nothing
            End If
            blnLimitChange = True
        End If
    Case 1
        If MSFGLimit.Col = 0 Or MSFGLimit.Col = 4 Then
'            CmbDepart.Width = MSFGLimit.CellWidth
'            CmbDepart.Top = MSFGLimit.Top + MSFGLimit.CellTop
'            CmbDepart.Left = MSFGLimit.Left + MSFGLimit.CellLeft
            CmbDepart.Visible = False
        ElseIf MSFGLimit.Col = 1 Or MSFGLimit.Col = 2 Or MSFGLimit.Col = 3 Then
            CmbDepart.Visible = False
            If MSFGLimit.CellPicture = 0 Then
                Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
            Else
                Set MSFGLimit.CellPicture = Nothing
            End If
            blnLimitChange = True
        End If
End Select

End Sub

Private Sub MSFGLimit_DblClick()

Dim i As Integer        '单击次数

If MSFGLimit.Row < 1 Then Exit Sub

Select Case Tabindex
    Case 0
        If MSFGLimit.Col = 0 Then
            CmbDepart.Width = MSFGLimit.CellWidth
            CmbDepart.Top = MSFGLimit.Top + MSFGLimit.CellTop
            CmbDepart.Left = MSFGLimit.Left + MSFGLimit.CellLeft
            CmbDepart.Visible = True
            CmbDepartD.Visible = False
        ElseIf MSFGLimit.Col = 4 Then
            CmbDepartD.Width = MSFGLimit.CellWidth
            CmbDepartD.Top = MSFGLimit.Top + MSFGLimit.CellTop
            CmbDepartD.Left = MSFGLimit.Left + MSFGLimit.CellLeft
            CmbDepartD.Visible = True
            CmbDepart.Visible = False
        ElseIf MSFGLimit.Col = 1 Or MSFGLimit.Col = 2 Or MSFGLimit.Col = 3 Then
            CmbDepart.Visible = False
            CmbDepartD.Visible = False
            If MSFGLimit.CellPicture = 0 Then
                Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
            Else
                Set MSFGLimit.CellPicture = Nothing
            End If
        End If
    Case 1
        If MSFGLimit.Col = 0 Or MSFGLimit.Col = 4 Then
            CmbDepartD.Width = MSFGLimit.CellWidth
            CmbDepartD.Top = MSFGLimit.Top + MSFGLimit.CellTop
            CmbDepartD.Left = MSFGLimit.Left + MSFGLimit.CellLeft
'            CmbDepart.Visible = True
            CmbDepartD.Visible = True
'        ElseIf MSFGLimit.Col = 2 Then
'            CmbDepartD.Width = MSFGLimit.CellWidth
'            CmbDepartD.Top = MSFGLimit.Top + MSFGLimit.CellTop
'            CmbDepartD.Left = MSFGLimit.Left + MSFGLimit.CellLeft
'            CmbDepartD.Visible = True
''            CmbDepart.Visible = False
        Else
            CmbDepart.Visible = False
            CmbDepartD.Visible = False
            If MSFGLimit.CellPicture = 0 Then
                Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
                MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
            Else
                Set MSFGLimit.CellPicture = Nothing
            End If
        End If
End Select

End Sub

Private Sub MSFGLimit_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

If Button = 2 Then
    PopupMenu MenuSetup
End If
    
End Sub


Private Sub SSTabLimit_Click(PreviousTab As Integer)

CmbDepart.Visible = False

Select Case SSTabLimit.Tab
    Case 0
        CmbDepart.Visible = False
        CmbDepartD.Visible = False
        Tabindex = SSTabLimit.Tab
        WriteLimit
        FormatMSFlexGrid SSTabLimit.Tab, strTableName
    Case 1
        FormatCmbDepartD
        CmbDepart.Visible = False
        CmbDepartD.Visible = False
        Tabindex = SSTabLimit.Tab
        WriteLimit
        FormatMSFlexGrid SSTabLimit.Tab, strTableName
End Select

End Sub

Private Function WriteLimit()

Dim i As Integer
Dim strLimitName As String
Dim strDealName As String
'//////// 删除权限 /////////
'strSQL = "delete from applimittest where DealTable='" & strTableName & "' "
'Set appRs = appConn.Execute(strSQL, 64)

'appConn.BeginTrans

'//////// 写权限 ///////////

Dim strMessage As String
strMessage = "确实要保存所做的更改吗？" & Chr(13) & Chr(10)
strMessage = strMessage & "如果有所更改请选择“是(Y)”，" & Chr(13) & Chr(10)
strMessage = strMessage & "否则选择“否(N)”。"
If Not blnLimitChange Then Exit Function
If MsgBox(strMessage, vbYesNo + vbQuestion + vbDefaultButton2, "系统提示") = vbYes Then
    For i = 1 To MSFGLimit.Rows - 1
        MSFGLimit.Row = i
        If MSFGLimit.TextMatrix(MSFGLimit.Row, 0) <> "" Then
            strLimitName = UserCode(MSFGLimit.TextMatrix(MSFGLimit.Row, 0))
            If MSFGLimit.TextMatrix(MSFGLimit.Row, 4) <> "" Then
                strDealName = UserCode(MSFGLimit.TextMatrix(MSFGLimit.Row, 4))
            
                strSQL = "select max(code) from applimittest"
                Set appRs = appConn.Execute(strSQL)
                While Not appRs.EOF
                    If IsNull(appRs(0)) Then
                        MaxCode = 1
                    Else
                        MaxCode = appRs(0) + 1
                    End If
                    appRs.MoveNext
                Wend
                appRs.Close
                
                strSQL = "select * from applimittest where "
                strSQL = strSQL & " dealtable='" & strTableName & "' "
                strSQL = strSQL & " and limitname='" & strLimitName & "' "
                strSQL = strSQL & " and dealname='" & strDealName & "'"
                Set appRs = appConn.Execute(strSQL)
                
                If appRs.EOF Then
                    appRs.Close
                    strSQL = "insert into applimittest "
                    strSQL = strSQL & " ( Code,LimitName,DealName,DealTable,Query,Edit,Write ) "
                    strSQL = strSQL & " values "
                    strSQL = strSQL & " ( " & MaxCode & ","
                    strSQL = strSQL & " '" & strLimitName & "',"
                    strSQL = strSQL & " '" & strDealName & "',"
                    strSQL = strSQL & " '" & strTableName & "',"
                    MSFGLimit.Col = 2
                    If MSFGLimit.CellPicture = 0 Then
                        strSQL = strSQL & " '0',"
                    Else
                        strSQL = strSQL & " '1',"
                    End If
                    MSFGLimit.Col = 3
                    If MSFGLimit.CellPicture = 0 Then
                        strSQL = strSQL & " '0',"
                    Else
                        strSQL = strSQL & " '1',"
                    End If
                    strSQL = strSQL & "'1')"
                    
                    Set appRs = appConn.Execute(strSQL, 64)
                Else
                    appRs.Close
                    strSQL = "delete from applimittest where "
                    strSQL = strSQL & " dealtable='" & strTableName & "' "
                    strSQL = strSQL & " and limitname='" & strLimitName & "' "
                    strSQL = strSQL & " and dealname='" & strDealName & "'"
                    Set appRs = appConn.Execute(strSQL, 64)

                    strSQL = "insert into applimittest "
                    strSQL = strSQL & " ( Code,LimitName,DealName,DealTable,Query,Edit,Write ) "
                    strSQL = strSQL & " values "
                    strSQL = strSQL & " ( " & MaxCode & ","
                    strSQL = strSQL & " '" & strLimitName & "',"
                    strSQL = strSQL & " '" & strDealName & "',"
                    strSQL = strSQL & " '" & strTableName & "',"
                    MSFGLimit.Col = 2
                    If MSFGLimit.CellPicture = 0 Then
                        strSQL = strSQL & " '0',"
                    Else
                        strSQL = strSQL & " '1',"
                    End If
                    MSFGLimit.Col = 3
                    If MSFGLimit.CellPicture = 0 Then
                        strSQL = strSQL & " '0',"
                    Else
                        strSQL = strSQL & " '1',"
                    End If
                    strSQL = strSQL & "'1')"
                    
                    Set appRs = appConn.Execute(strSQL, 64)
                End If
             End If
         End If
    Next
End If
'appConn.CommitTrans
blnLimitChange = False
End Function

'Private Sub TVTable_NodeClick(ByVal Node As MSComctlLib.Node)
'
'strTableName = Node.Text
'
'TxtApp.Text = strTableName
'
'WriteLimit
'
'FormatMSFlexGrid SSTabLimit.Tab, strTableName
'
'End Sub

Private Sub FormatCmbDepart()

Dim i As Integer
CmbDepart.Clear

strSQL = "select distinct username,username_c from groupuser"
Set appRs = appConn.Execute(strSQL)
i = 0
While Not appRs.EOF
    If IsNull(Trim(appRs(0))) Then
        appRs.MoveNext
    Else
'                Debug.Print appRs(0)
        CmbDepart.AddItem appRs(0) & "(" & appRs(1) & ")", i
        appRs.MoveNext
        i = i + 1
    End If
Wend
appRs.Close

End Sub

Private Sub FormatCmbDepartD()

Dim i As Integer
CmbDepartD.Clear
strSQL = "select distinct deparment_c from groupuser"
Set appRs = appConn.Execute(strSQL)
i = 0
While Not appRs.EOF
    If IsNull(Trim(appRs(0))) Then
        appRs.MoveNext
    Else
'        Debug.Print appRs(0)
        CmbDepartD.AddItem appRs(0), i
        appRs.MoveNext
        i = i + 1
    End If
Wend
appRs.Close
i = i - 1
strSQL = "select distinct groupname from groupuser"
Set appRs = appConn.Execute(strSQL)
While Not appRs.EOF
    If Len(Trim(appRs(0))) = 0 Then
        appRs.MoveNext
    Else
'        Debug.Print appRs(0)
        CmbDepartD.AddItem appRs(0), i
        appRs.MoveNext
        i = i + 1
    End If
Wend

End Sub

Private Function UserCode(StrName As String) As String

Dim i As Integer

    i = InStrRev(StrName, "(")
    If i < 1 Then
        UserCode = StrName
        Exit Function
    Else
        UserCode = Mid(StrName, 1, i - 1)
    End If
    
End Function

Private Sub TVTable_NodeClick(ByVal Node As ComctlLib.Node)

WriteLimit

strTableName = Node.Text
TxtApp.Text = strTableName

FormatMSFlexGrid SSTabLimit.Tab, strTableName

End Sub
frmapplimit.frm - 源码说明

本页面展示了「OA编程源代码」中的 frmapplimit.frm 源码文件，采用 FRM 编程语言编写，共 903 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫开发者社区收录了大量与OA系统相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

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