设置_项目相关明细设置.frm

新世纪ERP设备管理源代码

        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("sx").Enabled = False
    End With

End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
    
    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    Tree_List.Enabled = True
    CzxsGrid.Enabled = True
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    Lrzt = 0
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
    End With

End Sub

Private Sub BcCommand_Click()                                           '保 存
    
    If Not Bclrsj Then
        Exit Sub
    End If
    If Lrzt = 2 Then
        Call Toolfbjzt
    End If

End Sub

Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  
    For jsqte = 0 To Max_Text_Index
        TextValiJudgeLock(jsqte) = True
    Next jsqte
    Call Toolfbjzt

End Sub

Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    FnBln_RefreshArray Col, Position, GridStr(), GridInf()
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    
    Select Case Button.Key
        Case "bcgs"                                       '保存表格格式
            Call Bcwggs(CzxsGrid, GridCode, GridStr())
        Case "hfmrgs"                                     '恢复默认格式
            Call Hfmrgs(CzxsGrid, GridCode, GridStr())
        Case "szxsxm"                                     '设置显示项目
            Call Szxsxm(CzxsGrid, GridCode)
    End Select

End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CzxsGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
    
End Sub

'************以下为文本框录入处理程序(固定不变部分)*************'

Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序

  '以下为依据实际情况自定义部分[
  
      '在此填写文本框录入事后处理程序
   
  ']以上为依据实际情况自定义部分
End Sub

Private Sub LrText_Change(Index As Integer)

    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
   
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
          
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
    Select Case Textint(Index, 1)
        Case 8           '金额型
            Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
        Case 9           '数量型
            Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
        Case 10          '单价型
            Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
        Case Else        '其他小数类型控制
            If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
                Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
            End If
    End Select
    TextChangeLock = False '解锁

End Sub

Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
    
    Call TextShow(Index)
    CurTextIndex = Index

End Sub

Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
    
    Select Case KeyCode
        Case vbKeyF2
            Call Text_Help(Index)
    End Select

End Sub

Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub

Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
    
    If Not Textboolean(Index, 2) Then      '事中判断
        Call TextYxxpd(Index)
    End If

End Sub

Private Sub Tree_List_Click()
    
    If Mid(Trim(Tree_List.SelectedItem.Key), 2, Len(Trim(Tree_List.SelectedItem.Key)) - 1) <> "" Then
        F_Sort.Caption = Tree_List.SelectedItem.Text
        F_Sort1.Caption = F_Sort.Caption
        ReportTitle = "相关明细：" & F_Sort.Caption
        F_Sort.Tag = Trim(Mid(Trim(Tree_List.SelectedItem.Key), 2, Len(Trim(Tree_List.SelectedItem.Key)) - 1))
        Cxnrtcwg
    End If

End Sub

Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
    Call Text_Help(Index)
End Sub

Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
    If Not Ydcommand1(Index).Visible Then
        Exit Sub
    End If
    TextValiJudgeLock(Index) = True
   
    '先进行有效性判断
    If Not TextYxxpd(CurTextIndex) Then
        Exit Sub
    End If
   
    Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
    If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
            LrText(Index).Text = Xtfhcsfz
            LrText(Index).Tag = Xtfhcs
        Else
            LrText(Index).Text = Xtfhcs
            LrText(Index).Tag = Xtfhcsfz
        End If
    End If
    TextValiJudgeLock(Index) = False
    LrText(Index).SetFocus

End Sub

Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息

   '填写文本框得到焦点,进行相应信息处理程序
   
End Sub

Private Sub Wbkcsh()                          '录入文本框初始化
  
    Dim jsqte As Integer
  
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
  
    ReDim TextValiJudgeLock(Max_Text_Index)
    For jsqte = 0 To Max_Text_Index
        If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
            If Textboolean(jsqte, 1) Then
                If jsqte <> 0 Then
                    Load Ydcommand1(jsqte)
                End If
                Ydcommand1(jsqte).Visible = True
                Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
            End If
            TextChangeLock = True
            LrText(jsqte).Text = ""
            LrText(jsqte).Tag = ""
            If Textint(jsqte, 5) <> 0 Then
                LrText(jsqte).MaxLength = Textint(jsqte, 5)
            End If
            TextChangeLock = False
        End If
        TextValiJudgeLock(jsqte) = True
    Next jsqte

End Sub

Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
    Dim Sqlstr As String
    Dim Findrec As ADODB.Recordset
    If TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
        TextYxxpd = True
        Exit Function
    End If
    If Trim(LrText(Index)) = "" Then
        LrText(Index).Tag = ""
        Call Wbklrwbcl(Index)
        TextValiJudgeLock(Index) = True
        TextYxxpd = True
        Exit Function
    End If
    Select Case Textint(Index, 4)
        Case 1      '编码型
            Sqlstr = Trim(Textstr(Index, 5))
            Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
            Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Findrec.EOF Then
                Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
                LrText(Index).SetFocus
                Exit Function
            Else
                Select Case Textint(Index, 3)
                    Case 0
                        If Len(Trim(Textstr(Index, 2))) <> 0 Then
                            LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                        End If
                        If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                            LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                        End If
                    Case 1
                        If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                            LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                        End If
                        If Len(Trim(Textstr(Index, 2))) <> 0 Then
                            LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                        End If
                End Select
            End If
        Case 2      '日期型
            If IsDate(LrText(Index).Text) Then
                LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
            Else
                Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(Index).SetFocus
                Exit Function
            End If
        Case 3      '其他类型
    End Select
    TextValiJudgeLock(Index) = True
    TextYxxpd = True

End Function

Sub Add_Tree()
    
    Dim R_List As New Recordset
    Dim R_Sort As New Recordset
    Tree_List.Nodes.Add , 4, "T", "项目类别", "xttb"
    R_Sort.Open "select * from DEV_CorrelationSort", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
    
    With R_Sort
        Do While Not .EOF
            Set nodX = Tree_List.Nodes.Add("T", 4, "T" & Trim(.Fields("SortCOde")), "(" & Trim(.Fields("SortCOde")) & ")" & Trim(.Fields("SortName")), "gnqx")
            nodX.EnsureVisible
            .MoveNext
        Loop
    End With
 
End Sub