hfrm309.frm

饲料生产控制系统

    End If
End Sub

'******************************************************************************
'僀儀儞僩柤: cmdPrint_Click
'婡擻      : 儗億乕僩偺報嶞(F5)
'******************************************************************************
Private Sub cmdPrintAll_Click()
   On Error GoTo Err
    Call PrintFrm
Resume_Err:
    Exit Sub
Err:
    Resume Resume_Err
End Sub

'******************************************************************************
'僀儀儞僩柤: btn_firstend_Click
'婡擻      : 儗僐乕僪
'******************************************************************************
Private Sub btn_firstend_Click()
    If adoRes.recordcount = 0 Then
        txt_val.Text = 0
    Else
        txt_val.Text = 1
        Call SetActiveCell(1, 1)
    End If
End Sub

'******************************************************************************
'僀儀儞僩柤: btn_last_Click
'婡擻      : 儗僐乕僪
'******************************************************************************
Private Sub btn_last_Click()
   If fpSpread.ActiveRow = 1 Then
        txt_val.Text = fpSpread.ActiveRow
    Else
        txt_val.Text = fpSpread.ActiveRow - 1
    End If
    Call SetActiveCell(1, val(txt_val.Text))
End Sub

'******************************************************************************
'僀儀儞僩柤: btn_lastend_Click
'婡擻      : 儗僐乕僪
'******************************************************************************
Private Sub btn_lastend_Click()

    txt_val.Text = adoRes.recordcount
    Call SetActiveCell(1, adoRes.recordcount)
    
End Sub

'******************************************************************************
' 柤徧丂丂丂: btn_next_Click
' 婡擻丂丂丂: Fn僉乕偑墴偝傟偨偲偒偺張棟
' 嶲悢丂丂丂: 側偟
' 曉夞丂丂  : 側偟
'僀儀儞僩柤: btn_next_Click
'婡擻      : Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub btn_next_click()
    If adoRes.recordcount = fpSpread.ActiveRow Then
        txt_val.Text = fpSpread.ActiveRow
    Else
        txt_val.Text = fpSpread.ActiveRow + 1
    End If
    Call SetActiveCell(1, val(txt_val.Text))
End Sub

'******************************************************************************
'僀儀儞僩柤: Form_KeyDown
'婡擻      : 儅僂僗墴壓
'******************************************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err                ' 僄儔乕偺応崌

    Dim CtrlDown
    CtrlDown = (Shift And vbCtrlMask) > 0
        If KeyCode = VK_F12 And CtrlDown Then    '
        rtnVal = MsgBox(ErrorMsg301_1, vbOKOnly + 48, ErrorMsgTit301_1)
        intKAKUNIN = 1
        KeyFlag = False
        closeFlag = True
        Call cmdClose_Click         '廔椆
        Exit Sub
    End If

    If Shift > 0 Then
        Exit Sub
    End If
    
    If ShortKeyPressed(KeyCode) Then
        Exit Sub
    End If
    
    Select Case (KeyCode)
    
         Case VK_F5
            Call cmdPrintAll_Click         '廔椆
            KeyCode = 0
    
        Case VK_F12
            Call cmdClose_Click            '廔椆
            KeyCode = 0

        Case Else
            
    End Select
    
    Exit Sub
Err:
    Exit Sub
    'MsgBox ErrorMsg7
End Sub

'******************************************************************************
'僀儀儞僩柤: Form_Unload
'婡擻      :
'******************************************************************************
Private Sub Form_Unload(Cancel As Integer)
    Call DelTemp
End Sub

'******************************************************************************
'僀儀儞僩柤: fpSpread_BlockSelected
'婡擻      : Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub fpSpread_BlockSelected(ByVal BlockCol As Long, _
                                   ByVal BlockRow As Long, _
                                   ByVal BlockCol2 As Long, _
                                   ByVal BlockRow2 As Long)
    txt_val.Text = BlockRow
    
End Sub

'******************************************************************************
'僀儀儞僩柤: fpSpread_LeaveCell
'婡擻      : Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub fpSpread_LeaveCell(ByVal col As Long, ByVal row As Long, _
                               ByVal NewCol As Long, ByVal NewRow As Long, _
                               Cancel As Boolean)
                               
    If Not NewRow = -1 Then
        txt_val.Text = NewRow
        valrow = NewRow
    End If
    
    If NewCol > 2 Then
        Cancel = True
    End If
    
End Sub

'******************************************************************************
'僀儀儞僩柤: txt_val_KeyDown
'婡擻      : Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub txt_val_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim values As Long
    
    If IsNumeric(txt_val.Text) = False Then
        rtnVal = MsgBox(ErrorMsg309_1, vbOKOnly + 64, ErrorMsgTit309_1)
        txt_val.Text = fpSpread.ActiveRow
        Exit Sub
    End If

    If KeyCode = 13 Then
    
        If adoRes.recordcount = 0 Then
            txt_val.Text = 0
            Exit Sub
        End If
    
        If CLng(txt_val.Text) > 0 And _
           CLng(txt_val.Text) < adoRes.recordcount + 1 Then
           
            Call SetActiveCell(1, CLng(txt_val.Text))
        Else
            rtnVal = MsgBox(ErrorMsg309_1, vbOKOnly + 64, ErrorMsgTit309_1)
            txt_val.Text = valrow
        End If
        
    End If
End Sub

'******************************************************************************
'僀儀儞僩柤: cmdClose_GotFocus
'婡擻      : 僼僅儞僩傪愝掕偡傞丅
'******************************************************************************
Private Sub cmdClose_GotFocus()
    cmdClose.ForeColor = vbRed
End Sub

'******************************************************************************
'僀儀儞僩柤: cmdClose_LostFocus
'婡擻      : 僼僅儞僩傪愝掕偡傞丅
'******************************************************************************
Private Sub cmdClose_LostFocus()
    cmdClose.ForeColor = vbBlack
End Sub

'******************************************************************************
'僀儀儞僩柤: cmdPrintAll_GotFocus
'婡擻      : 僼僅儞僩傪愝掕偡傞丅
'******************************************************************************
Private Sub cmdPrintAll_GotFocus()
    cmdPrintAll.ForeColor = vbRed
End Sub

'******************************************************************************
'僀儀儞僩柤: cmdPrintAll_LostFocus
'婡擻      : 僼僅儞僩傪愝掕偡傞丅
'******************************************************************************
Private Sub cmdPrintAll_LostFocus()
    cmdPrintAll.ForeColor = vbBlack
End Sub

'******************************************************************************
' 僀儀儞僩柤: Form_KeyUp
' 婡擻丂丂丂: Ctrl,Alt,Shift 僉乕偺張棟偡傞
'******************************************************************************
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 16 Or KeyCode = 17 Or KeyCode = 18 Then
        KeyFlag = False
    End If
End Sub

'******************************************************************************
' 僀儀儞僩柤: Form_QueryUnload
' 婡擻丂丂丂: 僼僅乕儉傪暵偠側偄
'******************************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If closeFlag Then
        closeFlag = False
        Cancel = 1
    End If
End Sub

Private Sub btn_firstend_DblClick(Cancel As MSForms.ReturnBoolean)
    Cancel = True
End Sub

Private Sub btn_last_DblClick(Cancel As MSForms.ReturnBoolean)
    Cancel = True
End Sub

Private Sub btn_lastend_DblClick(Cancel As MSForms.ReturnBoolean)
    Cancel = True
End Sub

Private Sub btn_next_DblClick(Cancel As MSForms.ReturnBoolean)
    Cancel = True
End Sub
'##### END ########丂僀儀儞僩丂################################################

'#####STRAT########丂娭丂丂悢丂################################################
'******************************************************************************
' 娭悢柤 : GetDataGrid
' 婡擻丂 : Spread偵僨乕僞傪撉傒崬傓
' 堷悢   : 側偟
' 栠傝抣 : True:惉岟    False:幐攕
'******************************************************************************
Private Sub GetDataGrid()
On Error GoTo Err                ' 僄儔乕偺応崌
    Dim CurRecount As Long
    Dim i As Long
    Dim j As Long

    strSql = vbNullString
    strSql = strSql & " select "
    strSql = strSql & " SUBSTRING(CONVERT(char(19), LogDate, 120), 0, 11) as LogDate, " ' 敪惗擔晅
    strSql = strSql & " SUBSTRING(CONVERT(char(19), LogTime, 120), 12, 8) as LogTime, " ' 敪惗帪娫
    strSql = strSql & " ErrCode, "                   '僄儔乕
    strSql = strSql & " ErrName, "                   '僄儔乕
    strSql = strSql & " ErrKubunName "               '嬫暘
    strSql = strSql & " from ErrLogC00"
    strSql = strSql & " order by LogDate desc,LogTime desc"
   
    Set adoRes = Nothing
    Call gfCreateRecordset(strSql, adoRes)

    '僨乕僞偑懚嵼偟側偄偺応崌
    If adoRes.recordcount = 0 Then
        fpSpread.MaxRows = 0
        Exit Sub
    Else
        '儁乕僕偺僨乕僞
        CurRecount = adoRes.recordcount
    End If

    'Spread偵僨乕僞傪彂偄偰
    With fpSpread
        .MaxCols = 5
        .MaxRows = CurRecount
        For i = 0 To CurRecount - 1 Step 1
            .row = i + 1
            For j = 1 To 5 Step 1
                .col = j
                If Not adoRes.Fields(j - 1).Value = "" Then
                If j = 1 Then
                    .Text = Left(Trim(adoRes.Fields(j - 1).Value), 10)
                ElseIf j = 2 Then
                    .Text = Trim(Right(Trim(adoRes.Fields(j - 1).Value), 8))
                Else
                    .Text = Trim(adoRes.Fields(j - 1).Value)
                End If
                Else
                .Text = ""
                End If
            Next j
            adoRes.MoveNext
            If adoRes.EOF Then
              Exit Sub
            End If
        Next i
    End With

    Exit Sub
Err:
    MsgBox ErrorMsg2
End Sub

'******************************************************************************
' 娭悢柤 : SetActiveCell
' 婡擻丂 : 帪娫傪張棟偡傞丅
' 堷悢   : col   ----峴
'          row   ----楍
' 栠傝抣 : 側偟
'******************************************************************************
Private Function SetActiveCell(ByVal col As Long, ByVal row As Long)
    fpSpread.row = row
    fpSpread.col = col
    fpSpread.Action = ActionActiveCell
    fpSpread.SetFocus
End Function

'******************************************************************************
' 娭悢柤    : ShortKeyPressed
' 婡擻丂丂丂: Ctrl,Alt,Shift墴壓偺張棟偡傞
' 堷悢丂丂丂: KeyCode
' 栠傝抣丂  : 側偟
'******************************************************************************
Private Function ShortKeyPressed(ByVal KeyCode As Long) As Boolean
    
    ShortKeyPressed = True
    If KeyCode = 16 Or KeyCode = 17 Or KeyCode = 18 Then
        KeyFlag = True
    End If
    
    If KeyFlag = False Then
        ShortKeyPressed = False
    Else
        ShortKeyPressed = True
    End If
End Function
'##### END ########丂娭丂丂悢丂################################################