财务分析 财财务分析务分析

    End If
    If Not IsNull(.Fields("Text_Deci_Length")) Then            '字段小数位长度
       GridInt(Qslz + Jsqte, 4) = .Fields("Text_Deci_Length")
    End If
    If Not IsNull(.Fields("NotAllowEmpty_Type")) Then          '字段不允许为空或为零
       GridInt(Qslz + Jsqte, 5) = .Fields("NotAllowEmpty_Type")
    End If
    If Not IsNull(.Fields("Help_Type")) Then                   '帮助类型
       GridInt(Qslz + Jsqte, 6) = .Fields("Help_Type")
    End If
    If Not IsNull(.Fields("HelpReturnValue")) Then             '帮助返回值(0-显示返回编码 1-显示返回名称)
       GridInt(Qslz + Jsqte, 7) = .Fields("HelpReturnValue")
    End If

    GridStr(Qslz + Jsqte, 1) = Trim(.Fields("ColIndex") & "")    '网格列索引值

    GridStr(Qslz + Jsqte, 2) = Trim(.Fields("EmptyMessage") & "") '字段为空提示信息

    GridStr(Qslz + Jsqte, 3) = Trim(.Fields("Help_Code") & "")    '通用帮助编码

    GridStr(Qslz + Jsqte, 4) = Trim(.Fields("FieldsName") & "")   '连接字段(通用帮助)

    GridStr(Qslz + Jsqte, 5) = Trim(.Fields("Combo_Code") & "")   '列表框编码
   
    .MoveNext
    Jsqte = Jsqte + 1
   Loop
    
  End With
   
   '网格列组织形式
   
   With Xsgrid
      .BackColorFixed = &H8000000F                                     '固定行背景色
      .FixedRows = Gdhs                                                '固定行数
      .Rows = Gdhs
      .Cols = Qslz + Wgxsls
      .FixedCols = gdls                                                '固定列数
      .AllowUserResizing = flexResizeBoth
      .MergeCells = flexMergeFixedOnly                                 '合并单元形式
       If Sfhxz Then
         .SelectionMode = flexSelectionByRow
       Else
         .FocusRect = flexFocusHeavy
         .ForeColorSel = &H80000008
         .BackColorSel = &H80000005
       End If
       .ExplorerBar = Wglsfkydpx                                        '网格列是否可移动及排序
       .ScrollTips = True
      .WordWrap = True
     
     '填 充 网 格 标 题
     For Rowjsq = 0 To .FixedRows - 1
        .MergeRow(Rowjsq) = True
        .RowHeight(Rowjsq) = Gdhgd
        For Coljsq = Qslzte To .Cols - 1
           .TextMatrix(Rowjsq, Coljsq) = wglbt(Rowjsq, Coljsq)
        Next Coljsq
     Next Rowjsq
     
     '数 据 网 格 高 度
     For Rowjsq = .FixedRows To .Rows - 1
         .RowHeight(Rowjsq) = Sjhgd
     Next Rowjsq
     
      '定 义 录 入 字 段 属 性
     For Coljsq = 0 To .Cols - 1
         If Coljsq < Qslz Or Sfhide(Coljsq) Then
            .ColHidden(Coljsq) = True
         End If
         .MergeCol(Coljsq) = True
         .ColWidth(Coljsq) = wglkd(Coljsq)
         .ColAlignment(Coljsq) = wglzz(Coljsq)
         If Len(zdxsgs(Coljsq)) <> 0 Then
            .ColFormat(Coljsq) = zdxsgs(Coljsq)
         End If
         If GridBoolean(Coljsq, 6) Then
            .ColDataType(Coljsq) = flexDTBoolean
         End If
         .FixedAlignment(Coljsq) = 4
     Next Coljsq
    
  End With
End Sub
Public Sub Bcwggs(Bcgsgrid As vsFlexGrid, Wggsdm As String)             '保存网格格式(包括网格列宽,网格列顺序)
  '过程参数:保存格式网格对象,网格格式代码(网格参数)
  
  Dim Cxsjbrec As New ADODB.Recordset
  Dim Qslzte As Integer
  Dim Tsxx As String
  Cw_DataEnvi.DataConnect.BeginTrans
  On Error GoTo Swcwcl
  If Cxsjbrec.State = 1 Then Cxsjbrec.Close
  Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  With Cxsjbrec
    If Not .EOF Then
       Qslzte = .Fields("BeginCol")
       .MoveNext
    End If
  Do While Not .EOF
     For Jsqte = Qslzte To Bcgsgrid.Cols - 1
       If Bcgsgrid.FixedRows = 1 Then
          If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And .Fields("ColId") = Jsqte - Qslzte + 1 Then
             Exit For
          End If
       Else
          If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, Jsqte)) And .Fields("ColId") = Jsqte - Qslzte + 1 Then
             Exit For
          End If
       End If
     Next Jsqte
       If Jsqte <= Bcgsgrid.Cols - 1 Then
         .Fields("ColId") = Jsqte - Qslzte + 1
         .Fields("ColWidth") = Bcgsgrid.ColWidth(Jsqte)
         .Update
       End If
       .MoveNext
  Loop
  End With
  Cw_DataEnvi.DataConnect.CommitTrans
  Tsxx = "表格格式保存完毕!"
  Call Xtxxts(Tsxx, 0, 4)
  Exit Sub
Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Sub
End Sub
Public Sub Hfmrgs(Bcgsgrid As vsFlexGrid, Wggsdm As String)             '恢复网格默认列宽
  '过程参数:保存格式网格对象,网格格式代码(网格参数)

  Dim Cxsjbrec As New ADODB.Recordset   '查询数据表动态集
  Dim Qslzte As Integer
  Dim Tsxx As String
  Cw_DataEnvi.DataConnect.BeginTrans
   If Cxsjbrec.State = 1 Then Cxsjbrec.Close
  Cxsjbrec.Open "select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  On Error GoTo Swcwcl
  With Cxsjbrec
    If Not .EOF Then
       Qslzte = .Fields("BeginCol")
       .MoveNext
    End If
    Do While Not .EOF
       For Jsqte = Qslzte To Bcgsgrid.Cols - 1
       If Bcgsgrid.FixedRows = 1 Then
          If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And .Fields("ColId") = Jsqte - Qslzte + 1 Then
             Exit For
          End If
       Else
          If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, Jsqte)) And .Fields("ColId") = Jsqte - Qslzte + 1 Then
             Exit For
          End If
       End If
     Next Jsqte
       If Jsqte <= Bcgsgrid.Cols - 1 Then
         Bcgsgrid.ColWidth(Jsqte) = .Fields("DefaultColWidth")
         .Fields("ColWidth") = .Fields("DefaultColWidth") + 0
         .Update
       End If
       .MoveNext
  Loop
End With
  Cw_DataEnvi.DataConnect.CommitTrans
  Exit Sub
Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "恢复过程中出现未知错误,程序自动恢复保存前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Sub
End Sub
Public Sub Szxsxm(SzgsGrid As vsFlexGrid, Wggsdm As String)        '设置网格显示项目
   '过程参数:调整显示项目网格对象,网格格式代码(网格参数)
   Xtcdcs = Wggsdm
   XT_BgxsxmszFrm.Show 1                '调整网格显示项目
   Call Cxxswg(SzgsGrid, Wggsdm)     '重新定义网格显示
End Sub
Public Sub Cxxswg(Bcgsgrid As vsFlexGrid, Wggsdm As String)        '根据用户定义显示项目重新显示网格
  '过程参数:调整显示项目网格对象,网格格式代码(网格参数)
  
  Dim Cxsjbrec As New ADODB.Recordset   '查询数据表动态集
  Dim Qslzte As Integer
  Dim Tsxx As String
  Set Cxsjbrec = Cw_DataEnvi.DataConnect.Execute("select * from xt_grid where Grid_Code='" + Trim(Wggsdm) + "' order by ColId")
  With Cxsjbrec
    If Not .EOF Then
       Qslzte = .Fields("BeginCol")
       .MoveNext
    End If
    Do While Not .EOF
       For Jsqte = Qslzte To Bcgsgrid.Cols - 1
       If Bcgsgrid.FixedRows = 1 Then
          If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) Then
             Exit For
          End If
       Else
          If Trim(.Fields("ColTitle1")) = Trim(Bcgsgrid.TextMatrix(0, Jsqte)) And Trim(.Fields("ColTitle2")) = Trim(Bcgsgrid.TextMatrix(1, Jsqte)) Then
             Exit For
          End If
       End If
     Next Jsqte
       If Jsqte <= Bcgsgrid.Cols - 1 Then
          If .Fields("ColHidden") Then
             Bcgsgrid.ColHidden(Jsqte) = True
          Else
             Bcgsgrid.ColHidden(Jsqte) = False
          End If
       End If
       .MoveNext
   Loop
  End With
End Sub
Public Function Sydz(Zdbmte As String, GridStr() As String, Szzls As Integer) As Integer   '网格索引对照表(用来对照网格物理与逻辑顺序关系)
  '函数参数:索引编码,网格列属性(字符型),网格列最大数组下标值
   Sydz = 0
   For Jsqte = 0 To Szzls
     If Trim(GridStr(Jsqte, 1)) = Zdbmte Then
        Sydz = Jsqte
        Exit Function
     End If
   Next Jsqte
End Function
Public Function Mmjm(Srmm As String) As String                                              '密码加密对照模块
   Dim Zfcte As Integer
   Mmjm = ""
   For Jsqte = 1 To Len(Srmm)
       Zfcte = Asc(Mid(Srmm, Jsqte, 1)) + Asc(Mid(Srmm, Len(Srmm) - Jsqte + 1, 1)) + Len(Srmm) + Jsqte
       Mmjm = Mmjm + Trim(Str(Zfcte))
   Next Jsqte
End Function
Public Sub Txfxbb(CxbbGrid, Title As String, Footer As String, Fxxmnr() As String, Fxxmlz() As Integer, Fxxmzs As Integer, Qshz As Long, Zzhz As Long)                '图形分析模块
  '过程参数为:分析网格,标题,脚标,分析项目内容描述,分析项目对应网格列值,分析项目数,分析网格起始行值,分析网格终止行值
  
  Dim Rowlabjsq As Integer, Collabjsq As Integer
  If Zzhz < Qshz Then
     Exit Sub
  End If
  With XT_TxfxFrm.Txfxchart
    .TitleText = Title
    .FootnoteText = Footer
    .ColumnCount = Fxxmzs
    For Collabjsq = 1 To .ColumnCount
        .Column = Collabjsq
        .ColumnLabel = Fxxmnr(Collabjsq)
    Next Collabjsq
    .RowCount = Zzhz - Qshz + 1
     Rowlabjsq = 1
    For Jsqte = Qshz To Zzhz
        .Row = Rowlabjsq
        .RowLabel = CxbbGrid.TextMatrix(Jsqte, Qslz)
         Rowlabjsq = Rowlabjsq + 1
      For Collabjsq = 1 To .ColumnCount
        .DataGrid.SetData .Row, Collabjsq, Val(CxbbGrid.TextMatrix(Jsqte, Fxxmlz(Collabjsq))), 0
      Next Collabjsq
    Next Jsqte
  End With
  XT_TxfxFrm.Show 1
End Sub
Public Sub F1bz()                                                                     '发送F1键
  SendKeys "{F1}"
End Sub
Public Sub Textyx(Textte As TextBox)                                                  '文本框有效
   Textte.Enabled = True
   Textte.BackColor = &H80000005
End Sub
Public Sub Textwx(Textte As TextBox)                                                  '文本框无效
   Textte.Enabled = False
   Textte.BackColor = &HC0C0C0
End Sub
Public Sub Drbmhelp(bzlx As Integer, Helpbm As String, Scdwnr As String)                  '调入编码参照窗体
  '函数参数:帮助类型(0-通用型 1-日期型 2-特殊型),帮助编码,首次定位内容
  Dim XT_TybmczFrmte As New XT_TybmczFrm
  Xtcdcs = Scdwnr
  Xtfhcs = ""
  Xtfhcsfz = ""
  Select Case bzlx
     Case 0
        Xtbmczdm = Trim(Helpbm)
          XT_TybmczFrmte.Show 1
        Xtbmczdm = ""
     Case 1
        XT_calendar.Show 1
     Case 2
        Select Case Helpbm
          
        End Select
  End Select
End Sub
Public Sub Drbmbj(Helpbm As String)                                                        '调入编码参照编辑窗体
   Select Case Helpbm
      Case "gy_dept"             '部门编辑
        JC_BmszFrm.Show 1
      Case "gy_foreign"          '外币表编辑
        JC_WbjhlszFrm.Show 1
      Case "Cwzz_Digest"         '常用摘要
        JC_cyzyszfrm.Show 1
      Case "Cwzz_Settlement"     '结算方式
        JC_JsfsszFrm.Show 1
      Case "gy_customer"         '往来单位表
        Call XtWaitMess("c_wldwsz")
      Case "Cwzz_AccCode"        '会计科目设置
        Call XtWaitMess("c_kjkmsz")
      Case "gy_person"           '公司职员
        JC_GszyszFrm.Show 1
   End Select
End Sub
Public Function FillCombo(Combote As ComboBox, Lbkbmte As String, Dwnr As String, AddType As Integer) As String   '填充列表框并定位

  '函数参数：列表框，列表框分组编码，定位内容,填充类型(0-无空记录  1-有空记录(1个空格) )

  Dim Lbknrrec As ADODB.Recordset
  
  '填充列表框内容
  Set Lbknrrec = Cw_DataEnvi.DataConnect.Execute("select * from xt_combolist where combo_code='" + Trim(Lbkbmte) + "' order by item_index")
  Combote.Clear
  If AddType = 1 Then
     Combote.AddItem " "
  End If
  With Lbknrrec
    Do While Not .EOF
       Combote.AddItem Trim(.Fields("item_content"))
       .MoveNext
    Loop
  End With
  '定位列表框内容
  With Combote
    For Jsqte = .ListCount - 1 To 0 Step -1
        If Dwnr = Trim(.List(Jsqte)) Then
           Exit For
        End If
    Next Jsqte
    If Jsqte <> -1 Then
      Combote.Text = .List(Jsqte)
      Else
        If .ListCount <> 0 Then
           .Text = .List(0)
        End If
    End If
  End With
End Function
Public Sub Drwbkxx(Wbklrbmte As String, Textvar() As Variant, Textboolean() As Boolean, Textint() As Integer, Textstr() As String)                                 '读入文本框录入信息
   Dim Wbklrbrec As ADODB.Recordset
   Dim Zdszxb As Integer           '最大数组下标
   Dim text_indexte As Integer     '文本框索引值
   
   ReDim Textvar(1 To 1)
   Set Wbklrbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Xt_text_input WHERE text_group_code ='" + Wbklrbmte + "' ORDER BY text_index")
   With Wbklrbrec
        If Not (.BOF And .EOF) Then
           .MoveLast
           Zdszxb = .Fields("text_index")
           Textvar(1) = Zdszxb
           ReDim Textboolean(0 To Zdszxb, 1 To 3)
           ReDim Textint(0 To Zdszxb, 1 To 9)
           ReDim Textstr(0 To Zdszxb, 1 To 7)
           .MoveFirst
        Else
          Exit Sub
        End If
      Do While Not .EOF
         text_indexte = .Fields("text_index")