设备档案_备品备件.frm

新世纪ERP设备管理源代码

            YdCombo.Left = .CellLeft + .Left + Wbkpy
            YdCombo.Top = .CellTop + .Top + Wbkpy
            YdCombo.Width = .CellWidth - Wbkpy1
            Call Wbkcl
            YdCombo.Visible = True
            YdCombo.SetFocus
            Ydcommand.Visible = False
            Ydtext.Visible = False
        Else
            If GridBoolean(.Col, 2) Then
                Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
                Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
                Ydcommand.Visible = True
            Else
                Ydcommand.Visible = False
            End If
     
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            
            If Ydcommand.Visible Then
                If Sfblbzkd Then
                    Ydtext.Width = .CellWidth - Ydcommand.Width
                Else
                    Ydtext.Width = .CellWidth - Wbkpy1
                End If
            Else
                Ydtext.Width = .CellWidth - Wbkpy1
            End If
            
            Ydtext.Height = .CellHeight - Wbkpy1
      
            If GridInt(.Col, 2) <> 0 Then
                Ydtext.MaxLength = GridInt(.Col, 2)
            Else
                Ydtext.MaxLength = 3000
            End If
      
            Call Wbkcl
      
            Ydtext.Visible = True
            Ydtext.SetFocus
        End If
        
        Dqtoprow = .TopRow
        Dqleftcol = .LeftCol
    
        '重置锁值
        Valilock = False
        Wbkbhlock = False
        
    End With
 
End Sub

Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
   
    '如果单据操作状态为浏览状态则不能显示录入载体(通用)
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Function
    End If
   
    '[>>
    
        '此处可以填写禁止文本框激活使单据处于录入状态的理由
   
    '<<]
   
    Fun_AllowInput = True
    
End Function

Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
                   
    Dim Wbkpy As Integer, Wbkpy1 As Integer
  
    Wbkpy = 30
    Wbkpy1 = 15
    
    With WglrGrid
        If YdCombo.Visible Then
            YdCombo.Left = .CellLeft + .Left + Wbkpy
            YdCombo.Top = .CellTop + .Top + Wbkpy
            YdCombo.Width = .CellWidth - Wbkpy1
        End If
        If Ydcommand.Visible Then
            Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
            Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
        End If
        If Ydtext.Visible Then
            If Ydcommand.Visible Then
                If Sfblbzkd Then
                    Ydtext.Width = .CellWidth - Ydcommand.Width
                Else
                    Ydtext.Width = .CellWidth - Wbkpy1
                End If
            Else
                Ydtext.Width = .CellWidth - Wbkpy1
            End If
      
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            Ydtext.Height = .CellHeight - Wbkpy1
        End If
   End With

End Sub

Private Sub Lrsjhx()                                                   '文本框录入数据回写
  
    With WglrGrid
        If YdCombo.Visible Then
            .Text = Trim(YdCombo.Text)
        End If
        If Ydtext.Visible Then
            .Text = Trim(Ydtext.Text)
        End If
   
        '(如果字段录入内容发生变化,则打开有效性判断锁)
        If Zdlrqnr <> Trim(.Text) Then
            Yxxpdlock = False
            Hyxxpdlock = False
        End If
   
        '如果字段录入内容不为空则写数据行有效性标志
   
        If Len(Trim(.Text)) <> 0 Then
            Call Xyxhbz(.Row)
        End If
   
        '隐藏文本框,帮助按钮,列表组合框
        Call Ycwbk
    End With
    
End Sub

Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Sub
    End If

    Select Case KeyCode
        Case vbKeyF2                   '按F2键参照
            Call xswbk
        Call Lrzdbz
            Case vbKeyDelete               '删行
        Call Scdqfl
            Case vbKeyInsert               '增行
        Call zjlrfl
    End Select
    
End Sub

Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入

    '当某种条件成立时禁止文本框激活使单据处于录入状态
    If Not Fun_AllowInput Then
        Exit Sub
    End If
  
    With WglrGrid
  
        '屏 蔽 回 车 键
        If KeyAscii = vbKeyReturn Then
            KeyAscii = 0
            Rowjsq = .Row
            Coljsq = .Col + 1
            If Coljsq > .Cols - 1 Then
                If Rowjsq < .Rows - 1 Then
                    Rowjsq = Rowjsq + 1
                End If
                Coljsq = Qslz
            End If
            Do While Rowjsq <= .Rows - 1
                If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq + 1
                    If Coljsq > .Cols - 1 Then
                        Rowjsq = Rowjsq + 1
                        Coljsq = Qslz
                    End If
                Else
                    Exit Do
                End If
            Loop
          
            If Rowjsq <= .Rows - 1 Then
               .Select Rowjsq, Coljsq
            End If
       
             Exit Sub
        End If
     
        '接受用户录入
        Select Case KeyAscii
            Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
          
                '显示录入载体
                Call xswbk

            Case Else

                '防止非编辑字段SendKeys()出现死循环
                If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
                   Exit Sub
                End If

                '如果此字段为列表框录入则调入相应列表框
                If GridBoolean(.Col, 3) Then

                    '列表框录入
                    Call xswbk
                Else

                    Ydtext.Text = ""
            
                    '录入限制
                    Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
            
                    If KeyAscii = 0 Then
                        Exit Sub
                    End If

                    '如果录入字符有效则写有效行数据标志
                    Call Xyxhbz(.Row)
                    Call xswbk
                    Ydtext.Text = ""
                    Valilock = True
                    SendKeys Chr(KeyAscii), True
                    DoEvents
                    Valilock = False
                End If
        End Select
    End With
        
End Sub

Private Sub zjlrfl()                                                    '增加录入分录
  
    With WglrGrid
  
        '处于录入状态不能增行
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            If Not Fun_Drfrmyxxpd Then
                Exit Sub
            End If
        Else
            Exit Sub
        End If
    
        '处于非数据行和最后一行时不能增行
        If .Row < .FixedRows Or .Row = .Rows - 1 Then
            Exit Sub
        End If
    
        .AddItem "", .Row
        .RowHeight(.Row) = Sjhgd
    
        If .Row <> .Rows - 1 Then
            If .TextMatrix(.Row + 1, 0) = "*" Then
                .TextMatrix(.Row, 0) = "*"
            Else
                .RemoveItem .Rows - 1
            End If
        End If
        Call Xldqh
        Call Xldql
        Hyxxpdlock = False
    End With
    
End Sub

Private Sub Scdqfl()                                                    '删除当前分录
 
    Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
    Dim Sqlstr As String   '临时使用连接字符串
 
    With WglrGrid
        Scqwghz = .Row
        Scqwglz = .Col
        
        If .TextMatrix(.Row, 0) = "*" Then
            '判断是否为录入状态
            If Ydtext.Visible Or YdCombo.Visible Then
                Sflrzt = True
                Validate = True
                Call Lrsjhx
                Validate = False
            End If
       
            Call Xldqh
            Changelock = True
            .Select .Row, 0
            Changelock = False
            If Shsfts Then
                .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
                Tsxx = "请确认是否删除当前记录?"
                Yhanswer = Xtxxts(Tsxx, 2, 2)
                If Yhanswer = 2 Then
                    .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
                    Changelock = True
                    .Select Scqwghz, Scqwglz
                    Changelock = False
              
                    '如为录入状态,则恢复录入
                    If Sflrzt Then
                       Call xswbk
                    End If
              
                    Exit Sub
                End If
            End If
       
            '[>>以下为自定义部分
       
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
       
            If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
                Sqlstr = "Delete Dev_SparePart From Dev_SparePart WHERE SparePartID = " & Val(WglrGrid.TextMatrix(.Row, 1))
                Cw_DataEnvi.DataConnect.Execute (Sqlstr)
            End If
       
            Cw_DataEnvi.DataConnect.CommitTrans
       
            '<<以上为自定义部分]
       
            .RemoveItem .Row
 
            If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
            End If
            
            Changelock = True
            .Select .Row, Scqwglz
            Changelock = False
        End If
        
    End With
 
    Exit Sub
 
    '[>>事务错误处理
    
Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    
    Tsxx = "删除过程中出现错误!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    '<<]
End Sub

Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段

    If Not GridBoolean(Sjl, 5) Then
        Exit Sub
    End If
    
    With WglrGrid
        If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
            .TextMatrix(sjh, Sjl) = ""