oaminmodu.bas

一个OA办公自动化管理系统

        GridSum = GridSum + DGrid.Columns(i).Value
    Next
End Function


Public Sub iniBillPower(FrmBill As Form, ByVal strBillNo As String, Optional ByVal islocal As Integer)
    Dim strBillPower As String, rstPower As Recordset
    Dim strBillStyle As String, i As Integer
    
    Set rstPower = New Recordset
    rstPower.Open "Select Style from Inventory_Evidence where Evidence_Number='" & strBillNo & "'", GetCNClient, adOpenForwardOnly
    If Not rstPower.EOF Then
        strBillStyle = rstPower![Style]
    Else
        strBillStyle = 100
    End If
    
    
    
    strBillPower = ReadPower(FrmBill.name)
    
    FrmBill.cmdNew.Enabled = False
    FrmBill.cmdSave.Enabled = False
    FrmBill.cmdDel.Enabled = False
    FrmBill.cmdRefer.Caption = LoadResString(Val(FrmBill.cmdRefer.Tag & GLanguageID))
    FrmBill.cmdRefer.Enabled = False
    
    FrmBill.cmdCheck.Enabled = False
    FrmBill.cmdPost.Caption = LoadResString(Val(FrmBill.cmdPost.Tag & GLanguageID))
    FrmBill.cmdPost.Enabled = False
    FrmBill.cmdProve.Caption = LoadResString(Val(FrmBill.cmdProve.Tag & GLanguageID))
    FrmBill.cmdProve.Enabled = False
    FrmBill.cmdPrint.Enabled = False
    If strBillPower = "" Then Exit Sub
    
    
    
    '新增
    If Left(strBillPower, 1) = "1" Then
        FrmBill.cmdNew.Enabled = True
        FrmBill.cmdSave.Enabled = True
        FrmBill.cmdDel.Enabled = True
        FrmBill.cmdRefer.Enabled = True
        'Me.cmdUnrefer.Enabled = True
    End If
    
    '修改
    If Mid(strBillPower, 2, 1) = "1" Then
        FrmBill.cmdNew.Enabled = True
        FrmBill.cmdSave.Enabled = True
        FrmBill.cmdDel.Enabled = True
        FrmBill.cmdRefer.Enabled = True
    End If
    

    '审核
    If Mid(strBillPower, 4, 1) = "1" Then
        FrmBill.cmdCheck.Enabled = True
    End If
    
    '记帐
    If Mid(strBillPower, 5, 1) = "1" Then
        FrmBill.cmdPost.Enabled = True
    End If

    '财务
    If Mid(strBillPower, 6, 1) = "1" Then
        FrmBill.cmdProve.Enabled = True
    End If

    
    If islocal = 0 Then
        
        FrmBill.TDBGrid1.AllowAddNew = True
        FrmBill.TDBGrid1.AllowUpdate = True
        FrmBill.TDBGrid1.AllowDelete = True
        FrmBill.TDBGrid1.Columns("Inventory_ID").ValueItems.Presentation = 2
        FrmBill.GridSize.AllowUpdate = True
        

        If FrmBill.cmdPost.Enabled = True Then FrmBill.cmdPost.Enabled = False
        If FrmBill.cmdCheck.Enabled = True Then FrmBill.cmdCheck.Enabled = False
        If FrmBill.cmdProve.Enabled = True Then FrmBill.cmdProve.Enabled = False
        
        FrmBill.picStyle.Picture = LoadPicture("")
    Else
        If Dir(App.Path & "\BillStyle" & strBillStyle & ".bmp") <> "" Then
            FrmBill.picStyle.Picture = LoadPicture(App.Path & "\BillStyle" & strBillStyle & ".bmp")
        End If
        FrmBill.cmdPrint.Enabled = True
        FrmBill.cmdSave.Enabled = False
        FrmBill.cmdDel.Enabled = False
        
        FrmBill.TDBGrid1.Columns("Inventory_ID").ValueItems.Presentation = 0
        FrmBill.TDBGrid1.AllowAddNew = False
        FrmBill.TDBGrid1.AllowUpdate = False
        FrmBill.TDBGrid1.AllowDelete = False
        FrmBill.GridSize.AllowUpdate = False

        Select Case strBillStyle
            Case 0
                FrmBill.cmdRefer.Caption = LoadResString(Val("2300" & GLanguageID))
                If FrmBill.cmdProve.Enabled = True Then FrmBill.cmdProve.Enabled = False
            Case 1
                If FrmBill.cmdRefer.Enabled = True Then FrmBill.cmdRefer.Enabled = False
                If FrmBill.cmdProve.Enabled = True Then FrmBill.cmdProve.Enabled = False
            Case 2
                If FrmBill.cmdRefer.Enabled = True Then FrmBill.cmdRefer.Enabled = False
                If FrmBill.cmdCheck.Enabled = True Then FrmBill.cmdCheck.Enabled = False
                If FrmBill.cmdProve.Enabled = True Then FrmBill.cmdProve.Enabled = False
            Case 3
                If FrmBill.cmdCheck.Enabled = True Then FrmBill.cmdCheck.Enabled = False
                If FrmBill.cmdRefer.Enabled = True Then FrmBill.cmdRefer.Enabled = False
                If FrmBill.cmdPost.Enabled = True Then FrmBill.cmdPost.Enabled = False
                If FrmBill.cmdProve.Enabled = True Then FrmBill.cmdProve.Enabled = False
            Case 4
                FrmBill.cmdPost.Caption = LoadResString(Val("2379" & GLanguageID))
                If FrmBill.cmdRefer.Enabled = True Then FrmBill.cmdRefer.Enabled = False
                If FrmBill.cmdCheck.Enabled = True Then FrmBill.cmdCheck.Enabled = False
                FrmBill.TDBGrid1.AllowUpdate = True
                For i = 0 To FrmBill.TDBGrid1.Columns.Count - 1
                    FrmBill.TDBGrid1.Columns(i).Locked = True
                Next
                FrmBill.TDBGrid1.Columns("Price").Locked = False
            Case 5
                FrmBill.cmdProve.Caption = LoadResString(Val("2625" & GLanguageID))
                If FrmBill.cmdRefer.Enabled = True Then FrmBill.cmdRefer.Enabled = False
                If FrmBill.cmdPost.Enabled = True Then FrmBill.cmdPost.Enabled = False
                If FrmBill.cmdCheck.Enabled = True Then FrmBill.cmdCheck.Enabled = False
        End Select
    End If

End Sub

Public Function CheckBill(ByVal strBillNo As String, FromName As Form, CheckReturn As String) As Integer
    Dim Rst1 As ADODB.Recordset, frm1 As pub_CheckFormGet, store1 As ADODB.Command, i As Integer, s As String
    'On Error GoTo Err_CheckBill
    CheckBill = 0
    If Not Checkdate(FromName.txtDate.Text) Then
        MisMsg LoadResString("2382" & GLanguageID) '"当前期间之外不准审核"
        Exit Function
    End If

    Set frm1 = New pub_CheckFormGet
    frm1.strBillNo = strBillNo
    Set frm1.Parent = FromName
    frm1.Show vbModal
    
    Select Case FromName.ReturnValue
        Case 0
        Case 1
            GetCNClient.Execute "Update Inventory_Evidence Set Style=1 Where Evidence_Number='" & strBillNo & "'"
            Set store1 = New ADODB.Command
            store1.ActiveConnection = GetCNClient
            store1.CommandText = "CheckPass"
            store1.CommandType = adCmdStoredProc
            store1.Parameters.Refresh
            store1.Parameters(1).Value = strBillNo
            store1.Execute
            i = store1.Parameters(0).Value
            If i = 0 Then
                GetCNClient.Execute "Update Inventory_Evidence Set Style=2 Where Evidence_Number='" & strBillNo & "'"
                
                If DataPosting(strBillNo, FromName.name, 0) = True Then
                End If
            End If
            
            GetCNClient.Execute "TransList '" & LoginName & "','" & strBillNo & "','" & FromName.name & "','审核通过',''"
       
        Case 2
            GetCNClient.Execute "Update Inventory_Evidence Set Style=3 Where Evidence_Number='" & strBillNo & "'"
            GetCNClient.Execute "TransList '" & LoginName & "','" & strBillNo & "','" & FromName.name & "','单据作废',''"
        Case 3
            GetCNClient.Execute "Update Inventory_Evidence Set Style=0 Where Evidence_Number='" & strBillNo & "'"
            GetCNClient.Execute "TransList '" & LoginName & "','" & strBillNo & "','" & FromName.name & "','单据返回',''"
    
    End Select
    
    
    If FlowPower(FromName.name, strBillNo, 4) = 0 Then

    End If
    
    CheckBill = 1
    Exit Function
Err_CheckBill:
    CheckBill = 0
    MisMsg "CheckBill Error:" & Err.Description
    Exit Function
    
End Function


Public Sub IniGeneralBill(TempTdbGrid As TrueOleDBGrid60.TDBGrid, sqlBill As String, Optional LoadRes As Boolean)
'On Error GoTo IniGeneralBill_Err
 Dim IntTemp As Integer
 Dim temprecord As New ADODB.Recordset, temprecord1 As New ADODB.Recordset, rstBill As Recordset
 Dim TempValueItem As New TrueOleDBGrid60.ValueItem, IsShow As Integer, i As Integer
 Dim StrColums As String, StrNumberFormat As String, StrEditMask As String
 '显示页脚
' If IsNull(Index) Then
'    Index = 0
' End If
 iniBillSet (sqlBill)
 
 With TempTdbGrid
     '隐藏列表中的所有列
    For IntTemp = 0 To .Columns.Count - 1
           .Columns(IntTemp).Visible = False
           .Columns(IntTemp).AllowSizing = False
    Next

    .HoldFields
    .ClearFields
    .ColumnFooters = True
 '设置表头图示
    .PictureAddnewRow = LoadPicture(App.Path & "\ProgramIco\Addnew.bmp")
    .PictureCurrentRow = LoadPicture(App.Path & "\ProgramIco\Current.bmp")
    .PictureFooterRow = LoadPicture(App.Path & "\ProgramIco\Footer.bmp")
    .PictureHeaderRow = LoadPicture(App.Path & "\ProgramIco\Header.bmp")
    .PictureModifiedRow = LoadPicture(App.Path & "\ProgramIco\Modified.bmp")
    .PictureStandardRow = LoadPicture(App.Path & "\ProgramIco\Standard.bmp")
 '关闭主模式，使用奇偶行设置
    .AlternatingRowStyle = True
'    .FooterStyle.BackColor = &H8000000F
    .FooterStyle.Alignment = 1
    .FooterStyle.ForeColor = &HFF&
'    .FooterStyle.VerticalAlignment = dbgTop
    '奇行设置
    .OddRowStyle.BackColor = &HE3FBFB
    .OddRowStyle.ForeColor = &H0
    '偶行设置
    .EvenRowStyle.BackColor = &HBEE4E1
    .EvenRowStyle.ForeColor = &H0
 '设置选取行的背景色、前景色及选中单元格的显示方式
'    .HighlightRowStyle.BackColor = &H808080
'    .HighlightRowStyle.ForeColor = &HFFFFFF
'    .MarqueeStyle = 4 '样式4为突起方式
 '设置可下拉编辑
    .EditDropDown = True
 '根据PubTbdGridSet表中的字段设置显示方式及录入格式
    temprecord.Open "select * from v_BillSet where BillName='" & sqlBill & "' ", GetCNLocal, adOpenForwardOnly
    Do Until temprecord.EOF
        
        StrColums = temprecord![strfiled]
'        Set rstBill = New Recordset
'        rstBill.Open "Select * From " & sqlBill & " where 1=2 ", GetCNLocal, adOpenForwardOnly
'        IsShow = 1
'        For i = 0 To rstBill.Fields.Count - 1
'            If UCase(rstBill.Fields(i).name) = UCase(StrColums) Then
'                IsShow = 0
'                Exit For
'            End If
'        Next
'        If IsShow = 0 Then
                '设置显示方式及录入格式
                StrNumberFormat = temprecord![NumberFormat]
                StrEditMask = temprecord![EditMask]
                 '设置可设单个单元格格式
                 .Columns(StrColums).FetchStyle = True
                 .Columns(StrColums).Visible = True
                 .Columns(StrColums).AllowSizing = True
                With .Columns(StrColums).ValueItems
                     If temprecord![Merge] Then
                        TempTdbGrid.Columns(StrColums).Merge = True
                        TempTdbGrid.Columns(StrColums).WrapText = True
                     End If
                     
                     If IsNull(temprecord![Width]) Then
                     
                     Else
                        TempTdbGrid.Columns(StrColums).Width = temprecord![Width]
                     End If
                     If StrNumberFormat <> "0" Then
                         TempTdbGrid.Columns(StrColums).NumberFormat = StrNumberFormat
                     End If
                     If StrEditMask <> "0" Then
                         TempTdbGrid.Columns(StrColums).EditMask = StrEditMask
                     End If
                     
                     TempTdbGrid.Columns(StrColums).Caption = LoadResString(Val(temprecord!Title & GLanguageID))
                     Set temprecord1 = New ADODB.Recordset
                     Select Case temprecord![Presentation]
                        Case 0 'dbgNormal
                             .Presentation = 0
                        Case 1 'dbgRadioButton
                             .Presentation = 1
                        Case 2 'dbgComboBox
                             .Presentation = 2
                             .Translate = True
                             .Validate = temprecord![Validate]
                             If IsNull(temprecord!ValueItemvaluePreFiled) Then
                                temprecord1.Open "select " & temprecord![ValueItemvaluefiled] & " as ValueItemvalue," & temprecord![ValueItemdisplayvaluefiled] & " as ValueItemdisplayvalue from " & temprecord!ValueItemtable & "  order by " & temprecord![ValueItemdisplayvaluefiled], GetCNClient(), adOpenKeyset, adLockReadOnly
                             Else
                                temprecord1.Open "select " & temprecord!ValueItemvaluePreFiled & " as valuePreFiled ," & temprecord![ValueItemvaluefiled] & " as ValueItemvalue," & temprecord![ValueItemdisplayvaluefiled] & " as ValueItemdisplayvalue from " & temprecord!ValueItemtable & "  order by " & temprecord![ValueItemdisplayvaluefiled], GetCNClient(), adOpenKeyset, adLockReadOnly
                             End If
                                If temprecord1.RecordCount > 0 Then
                                   Do Until temprecord1.EOF
                                      If IsNull(temprecord!ValueItemvaluePreFiled) Then
                                                  TempValueItem.Value = temprecord1![ValueItemvalue]
                                                  If LoadRes Then
                                                        If IsNumeric(temprecord1![ValueItemdisplayvalue]) Then
                                                            If temprecord![ValueItemljflag] Then
                                                                  TempValueItem.DisplayValue = temprecord1![ValueItemvalue] & "  " & LoadResString(Val(temprecord1![ValueItemdisplayvalue] & GLanguageID))
                                                            Else
                                                                  TempValueItem.DisplayValue = LoadResString(Val(temprecord1![ValueItemdisplayvalue] & GLanguageID))
                                                            End If
                                                        Else
                                                            If temprecord![ValueItemljflag] Then
                                                                  TempValueItem.DisplayValue = temprecord1![ValueItemvalue] & "  " & temprecord1![ValueItemdisplayvalue]
                                                            Else
                                                                  TempValueItem.DisplayValue = temprecord1![ValueItemdisplayvalue]