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

Attribute VB_Name = "XtjbModule"
                   '系统基本模块(主要用来放置公用函数及模块)
'系 统 信 息
Public XtMenuList As String    '系统菜单功能编码
 
'系 统 日 期
Public Xtkjqjgs As Integer     '用户设定会计期间个数
Public Xtyear As Integer       '用户进入系统选择年度
Public Xtmm As Integer         '用户进入系统选择会计期间
Public Xtrq As Date            '系统日期
Public Xtrlbz As String        '系统日历标志

'系统往返参数值
Public Xtcdcs As String        '系统传递参数值(专门用来传递帮助信息)
Public Xtcdcsfz As String      '系统传递参数值(辅助信息)
Public Xtfhcs As String        '系统返回参数值(专门用来传递帮助信息)
Public Xtfhcsfz As String      '系统返回参数值(辅助信息)

'系统通用编码参照代码
Public Xtbmczdm As String      '系统通用编码参照代码

'(系统等待调用窗体)
Public XtCxgnsm As String      '调用程序功能说明

Public Xtczy As String         '系统使用操作员
Public Xtczybm As String       '系统操作员编码
Public Xtztbm As String        '系统帐套编码
Public Xtdwm As String         '系统打开帐套单位

'帐套基本参数
Public Xtjezws As Integer      '金额总位数
Public Xtslzws As Integer      '数量总位数
Public Xtdjzws As Integer      '单价总位数
Public Xtjexsws As Integer     '金额小数位数
Public Xtslxsws As Integer     '数量小数位数
Public Xtdjxsws As Integer     '单价小数位数
Public XtSCurrCode As String   '本位币编码
Public XtSCurrName As String   '本位币名称

'系统网格设置
Public Dbl_ForeColorFixed As Double  '网格标题前景色
Public Dbl_BackColorFixed As Double  '网格标题背景色

'窗体是否卸载
Public Unload_TF As Boolean     '窗体是否卸载
Public YH_XTXZ  As String       '银行窗体选择
'引用API函数
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function Lrstrcdcs(lrcsstr As TextBox, lrzdcd As Integer)    '文本框录入字符长度限制程序(汉字与字符不区分)
  If lrzdcd <> 0 And Len(lrcsstr) > lrzdcd Then
     lrcsstr = Mid(lrcsstr, 1, lrzdcd)
     lrcsstr.SelStart = lrzdcd
  End If
End Function
Public Function Lrstrcdcsbf(lrcsstr As TextBox, lrzdcd As Integer)  '文本框录入字符长度限制程序(汉字与字符区分)
   lrtextlong = Len(lrcsstr.Text)
   lrcscd = 0
   For jsq = 1 To lrtextlong
       lrcszf = Mid(lrcsstr.Text, jsq, 1)
       lrzzcd = lrcscd
       If Asc(lrcszf) >= 0 And Asc(lrcszf) <= 255 Then
          lrcscd = lrcscd + 1
       Else
          lrcscd = lrcscd + 2
       End If
       If lrcscd > lrzdcd Then
          lrstrjqcd = jsq - 1
          lrcsstr.Text = Mid(lrcsstr.Text, 1, lrstrjqcd)
          lrcsstr.SelStart = lrstrjqcd
          Lrstrcdcsbf = lrzzcd
          Exit Function
       Else
          Lrstrcdcsbf = lrcscd
       End If
   Next jsq
End Function
Public Function Strcdcs(lrcsstr, lrzdcd As Integer) As Integer  '文本框录入字符长度限制程序(汉字与字符区分)
   lrtextlong = Len(Trim(lrcsstr))
   lrcscd = 0
   For jsq = 1 To lrtextlong
       lrcszf = Mid(lrcsstr, jsq, 1)
       lrzzcd = lrcscd
       If Asc(lrcszf) >= 0 And Asc(lrcszf) <= 255 Then
          lrcscd = lrcscd + 1
       Else
          lrcscd = lrcscd + 2
       End If
       If lrcscd > lrzdcd Then
          lrstrjqcd = jsq - 1
          lrcsstr = Mid(lrcsstr, 1, lrstrjqcd)
          Strcdcs = lrzzcd
          Exit Function
       Else
          Strcdcs = lrcscd
       End If
   Next jsq
End Function
Public Sub Lrfzszxz(sjwb As TextBox, lrzfasc As Integer)    '文本框录入整数值(负)限制
   If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or lrzfasc = vbKeyBack Or (Chr(lrzfasc) = "-" And sjwb.SelStart = 0)) Then
      lrzfasc = 0
   End If
End Sub
Public Sub Lrzszxz(lrzfasc As Integer)     '文本框录入整数值(正)限制
   If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or lrzfasc = vbKeyBack) Then
      lrzfasc = 0
   End If
End Sub
Public Sub Lrszzfxz(lrzfasc As Integer)     '文本框录入数字及字符限制
   If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or (lrzfasc >= Asc("a") And lrzfasc <= Asc("z")) Or (lrzfasc >= Asc("A") And lrzfasc <= Asc("Z")) Or lrzfasc = vbKeyBack) Then
      lrzfasc = 0
   End If
End Sub
Public Sub Lrfhzxz(lrzfasc As Integer)     '文本框录入非汉字限制
   If Not ((lrzfasc >= 0 And lrzfasc <= 255) Or lrzfasc = vbKeyBack) Then
      lrzfasc = 0
   End If
End Sub
Public Sub Lrrqxz(lrzfasc As Integer)      '文本框录入日期限制
   If Not ((lrzfasc >= Asc("0") And lrzfasc <= Asc("9")) Or Chr(lrzfasc) = "-" Or lrzfasc = vbKeyBack) Then
      lrzfasc = 0
   End If
End Sub
Public Sub Lrxszxz(sjwb As TextBox, lrzfasc As Integer)    '文本框录入带有小数位及正负号数值字段
  If Not ((Chr(lrzfasc) >= "0" And Chr(lrzfasc) <= "9") Or (Chr(lrzfasc) = "." And InStr(1, sjwb.Text, ".") = 0) Or lrzfasc = vbKeyBack Or (Chr(lrzfasc) = "-" And sjwb.SelStart = 0)) Then
     lrzfasc = 0
  End If
End Sub
Public Sub Lrxzszxz(sjwb As TextBox, lrzfasc As Integer)    '文本框录入带有小数位正>=0数值字段
  If Not ((Chr(lrzfasc) >= "0" And Chr(lrzfasc) <= "9") Or (Chr(lrzfasc) = "." And InStr(1, sjwb.Text, ".") = 0) Or lrzfasc = vbKeyBack) Then
     lrzfasc = 0
  End If
End Sub
Public Sub Sjgskz(sjwb As TextBox, zsws As Integer, xsws As Integer)     '保证数值录入字段录入格式
   Dim xsdwz%, bccrd%
   xsdwz = InStr(1, sjwb.Text, ".")
   bccrd = sjwb.SelStart
   If xsdwz = 0 Then
      sjwb.Text = Mid(sjwb.Text, 1, zsws)
      sjwb.SelStart = bccrd
      Exit Sub
   End If
   If zsws > xsdwz - 1 Then
        zswstr = Mid(sjwb, 1, xsdwz - 1)
     Else
        zswstr = Mid(sjwb, 1, zsws)
   End If
     xswstr = Mid(sjwb, xsdwz + 1, xsws)
     sjwb = zswstr + "." + xswstr
     sjwb.SelStart = bccrd
End Sub
Public Sub InputFieldLimit(Ydtextte As TextBox, Zdsjlxte As Integer, keyasciite As Integer)     '录入字段事中控制程序

   '函数参数:录入限制文本框,字段数据类型,录入字符
   Select Case Zdsjlxte
      Case 1                                  '录入(Ascii0-255)
        Call Lrfhzxz(keyasciite)
      Case 2
        Call Lrszzfxz(keyasciite)             '录入(0-9,a-z,A-Z)
      Case 3
        Call Lrfzszxz(Ydtextte, keyasciite)   '录入整数值(正负)
      Case 4
        Call Lrzszxz(keyasciite)              '录入整数值(正)
      Case 5, 8, 9, 10
        Call Lrxszxz(Ydtextte, keyasciite)    '录入小数值(正负)
      Case 6
        Call Lrxzszxz(Ydtextte, keyasciite)   '录入小数值(正)
      Case 7
        Call Lrrqxz(keyasciite)               '录入日期
   End Select
End Sub
Public Function Xtxxts(xttsxx As String, xttslb As Integer, Tbtslb As Integer)
          msgtitle = "新世纪/ERP_财务分析系统"
   Select Case xttslb
          Case 0    '确定
           Xtxxts = MsgBox(xttsxx, Tbtslb * 16, msgtitle)
          Case 1    'YES/NO
           Xtxxts = MsgBox(xttsxx, vbYesNo + Tbtslb * 16, msgtitle)
          Case 2    '确定/取消
           Xtxxts = MsgBox(xttsxx, vbOKCancel + Tbtslb * 16, msgtitle)
          Case Else
           Xtxxts = "9"
   End Select
End Function
Public Function Kjjdzy(Zyjdzs As Integer) As Boolean     '控件焦点转移(针对回车键)
      Kjjdzy = False
      On Error GoTo Cwcl
      If Screen.ActiveControl.TabIndex <= Zyjdzs - 1 Then
         Kjjdzy = True
         SendKeys "{tab}"
      End If
      Exit Function
Cwcl:
     Resume Next         '有些对象不支持TabIndex属性
End Function
Public Sub Kjjdzy1(Kjform As Form, Zyjdzs As Integer)     '控 件 焦 点 转 移(支持上下箭头)
  Dim Nexttabindex As Integer, Jdjsq As Integer, jdkjindexte As Integer
      If Screen.ActiveControl.TabIndex = Kjform.count - 1 Then
         Nexttabindex = 0
      Else
         Nexttabindex = Screen.ActiveControl.TabIndex + 1
      End If
      For Jdjsq = 0 To Kjform.count - 1
          jdkjindexte = Kjform.Controls(Jdjsq).TabIndex
       If jdkjindexte = Nexttabindex And jdkjindexte <= Zyjdzs - 1 Then
          If Kjform.Controls(Jdjsq).Enabled = False Then
             Nexttabindex = Nexttabindex + 1
          End If
       End If
      Next Jdjsq
      For Jdjsq = 0 To Kjform.count - 1
          jdkjindexte = Kjform.Controls(Jdjsq).TabIndex
       If jdkjindexte = Nexttabindex And jdkjindexte <= Zyjdzs - 1 Then
          KeyAscii = 0
          Kjform.Controls(Jdjsq).SetFocus
          Exit For
       End If
      Next Jdjsq
End Sub
Public Sub Pbwxzf(Zfc As Integer)         '录入时屏蔽"'"
  If Chr(Zfc) = "'" Then
     Zfc = 0
  End If
End Sub
Public Sub BzWgcsh(Xsgrid, Wgdmte As String, GridInf() As Variant, GridBoolean() As Boolean, GridInt() As Integer, GridStr() As String)         '标准网格初始化模块
  
  '过程参数为:生成网格对象名称,网格参数编码,返回网格设置信息(返回整体信息)
  '网格列属性(返回布尔型信息),网格列属性(返回整型信息),网格列属性(返回字符型信息)
  
  Dim wglbt() As String                      '网格显示列标题
  Dim Wgxsls As Long                         '网格显示(主操作)列数
  Dim gdls As Long                           '网格固定列数
  Dim Gdhs As Long                           '网格固定行数(标题行数)
  Dim Gdhgd As Double                        '网格固定行高度
  Dim wglkd() As Double                      '每列默认字符个数
  Dim wglzz() As Integer                     '网格列组织形式
  Dim zdxsgs() As String                     '数值字段显示格式
  Dim Sfhide() As Boolean                    '网格列是否隐藏
  Dim Sfhxz As Boolean                       '网格列是否行选中
  Dim Qslz As Long                           '网格隐藏(非操作显示)列数
  Dim Sjhgd As Double                        '网格数据行高度
  Dim Wglsfkydpx As Integer                  '网格列是否可移动及排序
  Dim wgxsrec As New ADODB.Recordset         '网格显示动态集
  
  ReDim GridInf(1 To 7)                       '整个网格设置信息
  Set wgxsrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_grid WHERE Grid_Code ='" + Wgdmte + "' ORDER BY ColId")
  With wgxsrec
   If .EOF And .BOF Then
      Exit Sub
   Else
      .MoveFirst
   End If
   
   Qslz = .Fields("BeginCol")                '网格隐藏(非操作显示)列数
   Sjhgd = .Fields("DataRowHeight")          '网格数据行高度
   
   GridInf(1) = Qslz                         '起始列值
   GridInf(2) = Sjhgd                        '数据行高度
   GridInf(3) = .Fields("KeepDataRows")      '屏幕保持数据行数
   GridInf(4) = .Fields("AssistantRows")     '辅助项网格行数(例如:合计行)
   If .Fields("SaveHelpWidth_Flag") Then     '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
      GridInf(5) = True
   Else
      GridInf(5) = False
   End If
   If .Fields("DeleteRowAsk_Flag") Then      '删除有效记录行是否提示
      GridInf(6) = True
   Else
      GridInf(6) = False
   End If
   If .Fields("ShowSumGrid_Flag") Then       '是否显示合计网格
      GridInf(7) = True
   Else
      GridInf(7) = False
   End If
      
   Wgxsls = .RecordCount - 1                 '网格显示(主操作)列数(原.Fields("wgxsls"))
   gdls = .Fields("FixCols")                 '网格固定列数
   Gdhs = .Fields("FixRows")                 '网格固定行数(标题行数)
   Gdhgd = .Fields("FixRowHeight")           '网格固定行高度
   Wglsfkydpx = .Fields("explorerbar")       '网格列是否可移动及排序
   
   If .Fields("SelectRow_Flag") Then         '是否行选中
      Sfhxz = True
   End If
   
   ReDim wglbt(Gdhs - 1, Wgxsls + Qslz - 1)  '网格显示列标题
   ReDim wglkd(Qslz + Wgxsls - 1)            '每列默认字符个数
   ReDim zdxsgs(Qslz + Wgxsls - 1)           '数值字段标志
   ReDim wglzz(Qslz + Wgxsls - 1)            '网格列组织形式
   ReDim Sfhide(Qslz + Wgxsls - 1)           '网格列是否显示
   ReDim GridBoolean(Qslz + Wgxsls - 1, 1 To 6)   '网格列属性(布尔型)
   ReDim GridStr(Qslz + Wgxsls - 1, 1 To 20)      '网格列信息(字符型)
   ReDim GridInt(Qslz + Wgxsls - 1, 1 To 7)       '网格列信息(整型)
   
   .MoveNext
   Jsqte = 0
   Do While Not .EOF
 
    wglkd(Qslz + Jsqte) = .Fields("ColWidth")                  '网格列宽度限制
    If Not IsNull(.Fields("ColTitle1")) Then
      wglbt(0, Qslz + Jsqte) = Trim(.Fields("ColTitle1"))      '网格列标题1
    End If
    If Not IsNull(.Fields("ColTitle2")) And Gdhs >= 2 Then     '网格列标题2
      wglbt(1, Qslz + Jsqte) = Trim(.Fields("ColTitle2"))
    End If
    If Not IsNull(.Fields("ColTitle3")) And Gdhs >= 3 Then     '网格列标题3
      wglbt(2, Qslz + Jsqte) = Trim(.Fields("ColTitle3"))
    End If
    
    If .Fields("ColFormat") Then                               '字段显示格式(千分符)
      If .Fields("Text_Int_Length") <> 0 Then
         zdxsgs(Qslz + Jsqte) = "#,##0." + String(.Fields("Text_deci_Length"), "0")
      Else
         zdxsgs(Qslz + Jsqte) = "#,##0.00"
      End If
      Select Case .Fields("Text_Data_Type")
         Case 8   '金额
           zdxsgs(Qslz + Jsqte) = "#,##0." + String(Xtjexsws, "0")
         Case 9   '数量
           zdxsgs(Qslz + Jsqte) = "#,##0." + String(Xtslxsws, "0")
         Case 10  '单价
           zdxsgs(Qslz + Jsqte) = "#,##0." + String(Xtdjxsws, "0")
      End Select
    Else
      If .Fields("Text_Int_Length") <> 0 Then
         zdxsgs(Qslz + Jsqte) = "##0." + String(.Fields("Text_deci_Length"), "0")
      End If
    End If
    
    wglzz(Qslz + Jsqte) = .Fields("ColAlignment")              '网格列组织形式
    If .Fields("ColHidden") Then                               '网格列是否隐藏
       Sfhide(Qslz + Jsqte) = True
    End If
    If .Fields("Edit_Flag") Then                               '网格列是否可编辑
       GridBoolean(Qslz + Jsqte, 1) = True
    End If
    If .Fields("Help_Flag") Then                               '网格列是否提供帮助
       GridBoolean(Qslz + Jsqte, 2) = True
    End If
    If .Fields("Combo_Flag") Then                              '网格列是否列表框录入
       GridBoolean(Qslz + Jsqte, 3) = True
    End If
    If .Fields("ColSum_Flag") Then                             '网格列是否合计
       GridBoolean(Qslz + Jsqte, 4) = True
    End If
    If .Fields("Zero_Empty_Flag") Then                         '网格内容为零是否清空
       GridBoolean(Qslz + Jsqte, 5) = True
    End If
    If .Fields("BooleanFlag") Then                             '网格列是否为布尔型
       GridBoolean(Qslz + Jsqte, 6) = True
    End If

    If Not IsNull(.Fields("Text_Data_Type")) Then              '字段数据类型
       GridInt(Qslz + Jsqte, 1) = .Fields("Text_Data_Type")
    End If
    If Not IsNull(.Fields("Text_Length")) Then                 '字段录入长度
       GridInt(Qslz + Jsqte, 2) = .Fields("Text_Length")
    End If
    If Not IsNull(.Fields("Text_Int_Length")) Then             '字段整数位长度
       GridInt(Qslz + Jsqte, 3) = .Fields("Text_Int_Length")