企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form XT_ItemHelp 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "核算项目编码参照表"
   ClientHeight    =   6015
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6435
   Icon            =   "系统_项目编码参照.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6015
   ScaleWidth      =   6435
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox CodeText 
      Height          =   300
      Left            =   1020
      TabIndex        =   1
      Top             =   150
      Width           =   5355
   End
   Begin VB.CommandButton QxCommand 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   5220
      TabIndex        =   3
      Top             =   5580
      Width           =   1120
   End
   Begin VB.CommandButton QdCommand 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   300
      Left            =   4050
      TabIndex        =   2
      Top             =   5580
      Width           =   1120
   End
   Begin MSFlexGridLib.MSFlexGrid CzxsGrid 
      Height          =   4905
      Left            =   90
      TabIndex        =   0
      Top             =   540
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   8652
      _Version        =   393216
      FocusRect       =   0
   End
   Begin VB.Label Label1 
      BackColor       =   &H00C0C0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "编码或名称"
      Height          =   255
      Index           =   0
      Left            =   90
      TabIndex        =   4
      Top             =   210
      Width           =   975
   End
End
Attribute VB_Name = "XT_ItemHelp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************
'*    模 块 名 称 :核算项目编码参照
'*    功 能 描 述 :
'*    程序员姓名  : 张建忠
'*    最后修改人  : 张建忠
'*    最后修改时间:2000/09/11
'*    备        注:
'*    使用说明： Xtcdcs 用来传递用户输入内容; xtbmczdm 用来传递所选编码参照
'                xtfhcs 用来返回用户所选编码; xtfhcsfz 用来返回用户所选名称
'**************************************************************************
Dim Cznr As String                       '网格首次进入查找内容
Dim Str_ClassCode As String              '项目分类编码
 '以下为固定使用变量
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Private Sub CodeText_Change()            '用户可模糊定位编码或名称信息
  Dim DwRow As Long
  Dim Lng_BmCol As Long
  Dim Lng_McCol As Long
  
  On Error Resume Next
  Lng_BmCol = Sydz("001", GridStr(), Szzls)
  Lng_McCol = Sydz("002", GridStr(), Szzls)
  Cznr = Trim(CodeText.Text)
  With CzxsGrid
    For DwRow = .FixedRows To .Rows - 1
        If Mid(.TextMatrix(DwRow, Lng_BmCol), 1, Len(Cznr)) = Cznr Then
           .Row = DwRow
           .Col = Lng_BmCol
           CzxsGrid.SetFocus
           SendKeys "{LEFT}", True
           CodeText.SetFocus
           .TopRow = DwRow
           Exit Sub
        End If
    Next DwRow
    For DwRow = .FixedRows To .Rows - 1
        If Mid(.TextMatrix(DwRow, Lng_McCol), 1, Len(Cznr)) = Cznr Then
           .Row = DwRow
           .Col = Lng_BmCol
           CzxsGrid.SetFocus
           SendKeys "{LEFT}", True
           CodeText.SetFocus
           .TopRow = DwRow
           Exit Sub
        End If
    Next DwRow
  End With
End Sub
Private Sub CzxsGrid_GotFocus()
   SendKeys "{LEFT}", True
End Sub
Private Sub Form_Load()                             '调 入 窗 体
    
  '传递项目类别代码
  
  Str_ClassCode = Xtcdcsfz
    
  '调 入 网 格
  GridCode = "cwzz_item"
  
  Call Sub_ShowGrid(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  
  Qslz = GridInf(1)
  Sjhgd = GridInf(2)
  Szzls = CzxsGrid.Cols - 1
  
  '填 充 网 格
   Call Cxnrtcwg
   
  CodeText.Text = Trim(Xtcdcs)
   
 End Sub
Private Sub Cxnrtcwg()                               '查 询 内 容 填 充 网 格
  Dim SqlStr As String
  Dim Jsqte As Long
  
  '查询连接串
  SqlStr = "SELECT * FROM Cwzz_Item Where ItemClassCode='" & Str_ClassCode & "'and EndFlag='1' order by ItemCode"
  Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  With Cxnrrec
     CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
     If .EOF And .BOF Then
        Exit Sub
     End If
     Jsqte = CzxsGrid.FixedRows
     Do While Not .EOF
       If Jsqte >= CzxsGrid.Rows Then
          CzxsGrid.AddItem ""
       End If
       
        Call Jltcwg(Cxnrrec, Jsqte)
              
        CzxsGrid.RowHeight(Jsqte) = Sjhgd
        .MoveNext
        Jsqte = Jsqte + 1
     Loop
  End With
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)                                     '记录内容填充网格
    Dim Str_Fzhs As String      '辅助核算
    
    '[以下为自定义部分
     With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ItemCode"))
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ItemName") & "")
        If .Fields("QuantityFlag") Then
           CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = "√"
        End If
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Measure") & "")
     End With
    '以上为自定义部分]
End Sub
Private Sub CzxsGrid_DblClick()                        '用户双击网格返回当前选中编码
  Call Fhxzbm
End Sub
Private Sub Form_Unload(Cancel As Integer)             '退出
   Set Cxnrrec = Nothing
End Sub
Private Sub QdCommand_Click()                          '确 定
  Call Fhxzbm
End Sub
Private Sub QxCommand_Click()                          '取 消
   Xtfhcs = ""
   Xtfhcsfz = ""
   Unload Me
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
  Unload Me
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

						