+

VB开发的ERP系统

    End Select

End Sub

Private Sub QdCommand_Click()                          '确 定
  Call Fhxzbm
End Sub
Private Sub QxCommand_Click()                          '取 消
   Xtfhcs = ""
   Xtfhcsfz = ""
   Me.Hide
End Sub
Private Sub Fhxzbm()                                   '返回用户选中编码并退出
  With CzxsGrid
   If .Row >= .FixedRows Then
      Xtfhcs = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))
      Xtfhcsfz = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls)))
   Else
      Xtfhcs = ""
      Xtfhcsfz = ""
   End If
  End With
  Me.Hide
End Sub
Private Sub Sub_ShowGrid(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 .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")
    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                                     '固定行背景色 ('&H80000018)
      .FixedRows = Gdhs                                                '固定行数
      .Rows = Gdhs
      .FixedCols = gdls                                                '固定列数
      .Cols = Qslz + Wgxsls
      .AllowUserResizing = flexResizeBoth
      .SelectionMode = flexSelectionByRow
      .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
         .ColWidth(Coljsq) = wglkd(Coljsq)
         .ColAlignment(Coljsq) = wglzz(Coljsq)
         .FixedAlignment(Coljsq) = 4
     Next Coljsq
    
  End With
End Sub

Private Sub Bcwggs1(Bcgsgrid, 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)) 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
                .Fields("ColId") = jsqte - Qslzte + 1
                .Fields("ColWidth") = Bcgsgrid.ColWidth(jsqte)
                .Update
            Else
                GoTo Swcwcl
            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

Private Sub Hfmrgs1(Bcgsgrid, 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)) 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
                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