rhfrm304.frm

饲料生产控制系统

VERSION 5.00
Object = "{C4847593-972C-11D0-9567-00A0C9273C2A}#8.0#0"; "crviewer.dll"
Begin VB.Form RHFrm304 
   BorderStyle     =   1  '屌掕(幚慄)
   Caption         =   "郫臅蕱習繒蕦礂繋缾褋i僶僢僠枅乯"
   ClientHeight    =   14820
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   19110
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   14820
   ScaleWidth      =   19110
   StartUpPosition =   3  'Windows 偺婛掕抣
   WindowState     =   2  '嵟戝壔
   Begin CRVIEWERLibCtl.CRViewer CRViewer 
      Height          =   14775
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   19095
      DisplayGroupTree=   -1  'True
      DisplayToolbar  =   -1  'True
      EnableGroupTree =   0   'False
      EnableNavigationControls=   -1  'True
      EnableStopButton=   -1  'True
      EnablePrintButton=   -1  'True
      EnableZoomControl=   -1  'True
      EnableCloseButton=   -1  'True
      EnableProgressControl=   -1  'True
      EnableSearchControl=   -1  'True
      EnableRefreshButton=   -1  'True
      EnableDrillDown =   -1  'True
      EnableAnimationControl=   -1  'True
      EnableSelectExpertButton=   0   'False
      EnableToolbar   =   -1  'True
      DisplayBorder   =   0   'False
      DisplayTabs     =   0   'False
      DisplayBackgroundEdge=   -1  'True
      SelectionFormula=   ""
      EnablePopupMenu =   -1  'True
      EnableExportButton=   0   'False
      EnableSearchExpertButton=   0   'False
      EnableHelpButton=   0   'False
   End
End
Attribute VB_Name = "RHFrm304"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************************
'僔僗僥儉柤丗椦寭嶻嬈壓娭
'僾儘僌儔儉ID丗RHFrm304
'僾儘僌儔儉柤丗
'嶌惉幰丗滹奀撿
'嶌惉擔丗2007/08/08
'廋惓擔/廋惓幰丗
'******************************************************************************
Option Explicit

Dim strNStar As String
Dim strNEnd As String
Public rsPageC As New ADODB.Recordset
Public RS As New ADODB.Recordset

'******************************************************************************
' 柤徧丂丂丂: Form_Load
' 婘擻丂丂丂: 僼僅乕儉偺弶婜壔
' 嶲悢丂丂丂: 側偟
' 曉夞丂丂  : 側偟
'******************************************************************************
Private Sub Form_Load()
    Dim rep As New CRH304
On Error GoTo Err
    Dim i As Integer
    Dim RSE As ADODB.Recordset
    
    Set RSE = New ADODB.Recordset
'    Set rsPageC = SetPartData(RS, 0)
            
'    'add by zz 20071005 300審偺専嶕寢壥傪挻偊偨傜丄儐乕僓乕偵専嶕偺峣傝側偍偟傪梫媮偡傞丅
'    If rsPageC.recordcount > 300 Then
'        If MsgBox(ErrorMsgR304_1 & vbLf & ErrorMsgR304_2, _
'                  vbOKCancel + 32, _
'                  ErrorMsgTitR304_1) _
'                = vbCancel Then
'            'Unload Me
'            Exit Sub
'        End If
'    End If
    
    'rep.Database.SetDataSource SetPartData(RS, 0)
    rep.Database.SetDataSource rsPageC
    rep.txtStar.SetText (Year(CDate(strNStar)) & "擭" & Month(CDate(strNStar)) & "寧" & Day(CDate(strNStar)) & "擔")
    rep.txtEnd.SetText (Year(CDate(strNEnd)) & "擭" & Month(CDate(strNEnd)) & "寧" & Day(CDate(strNEnd)) & "擔")
        
        
    For i = 1 To 6
        Set RSE = SetPartData(RS, i)

        'modified by zz 20071005
'        If RSE.recordcount <> 0 Then
'            rep.OpenSubreport("SKN" & i).Database.SetDataSource RSE
'        End If
        rep.OpenSubreport("SKN" & i).Database.SetDataSource RSE
    Next i

    Me.CRViewer.ReportSource = rep
'    DoEvents
    Me.CRViewer.ViewReport
    

    
Resume_Err:
    Exit Sub

Err:
    '僄儔乕儘僌傪婰榐
    WriteErrLog "RHFrm304", "Form_Load", "", Err.Number, Err.Description
    Resume Resume_Err

End Sub

'******************************************************************************
' 柤徧丂丂丂: Form_Resize
' 婘擻丂丂丂:
' 嶲悢丂丂丂: 側偟
' 曉夞丂丂  : 側偟
'******************************************************************************
Private Sub Form_Resize()

On Error GoTo Err
    
    CRViewer.Top = 0
    CRViewer.Left = 0
    CRViewer.Height = ScaleHeight
    CRViewer.Width = ScaleWidth
    
Resume_Err:
    Exit Sub

Err:
    Resume Resume_Err
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Call DelTemp
    
End Sub

Public Sub SetDateSco(strStar As String, strend As String)
    strNStar = strStar
    strNEnd = strend
End Sub

Public Function SetPartData(RSbf As ADODB.Recordset, DCont As Integer) As ADODB.Recordset

    Dim RSTemp As ADODB.Recordset
    Dim i As Integer
    Dim strKeyNo As String
    Dim strSkn As String
    Dim intCount As Integer
    Dim dblTse As Double
    Dim dblTsy As Double
    
    Set RSTemp = New ADODB.Recordset
    
    For i = 0 To RSbf.Fields.Count - 1
        RSTemp.Fields.Append RSbf.Fields(i).Name, RSbf.Fields(i).Type, RSbf.Fields(i).DefinedSize
    Next i
     
    RSTemp.Open
    
    Do
        If RSbf.EOF Or RS.BOF Then
            Exit Do
        End If

        If RSbf.Fields("SKNwk").Value = DCont And DCont <> 0 Then
            If strKeyNo = RSbf.Fields("KeyNo").Value And strSkn = RSbf.Fields("SKN").Value Then
                intCount = intCount + 1

                If intCount > 10 Then
                    GoTo INext
                End If

            Else
                strKeyNo = RSbf.Fields("KeyNo").Value
                strSkn = RSbf.Fields("SKN").Value
                intCount = 0
            End If

                    
            RSTemp.AddNew
            
            For i = 0 To RSbf.Fields.Count - 1

                  Select Case (RSbf.Fields(i).Type)
                    Case adSmallInt
                        RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), 0, RSbf.Fields(i).Value)
                    Case adInteger
                        RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), 0, RSbf.Fields(i).Value)
                    Case adDBTimeStamp
                        RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), #1/1/1900#, RSbf.Fields(i).Value)
                    Case Else
                        RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), "", RSbf.Fields(i).Value)
                End Select
             
            Next i

        ElseIf DCont = 0 Then
            If strKeyNo <> RSbf.Fields("KeyNo").Value Then
                If strKeyNo <> "" Then
                    RSTemp.Fields("TSYWeight") = dblTsy
                    RSTemp.Fields("TSEWeight") = dblTse
                    dblTsy = 0
                    dblTse = 0
                End If
                    
                strKeyNo = RSbf.Fields("KeyNo").Value
                RSTemp.AddNew
           
                For i = 0 To RSbf.Fields.Count - 1
                
                    Select Case (RSbf.Fields(i).Type)
                        Case adSmallInt
                            RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), 0, RSbf.Fields(i).Value)
                        Case adInteger
                            RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), 0, RSbf.Fields(i).Value)
                        Case adDBTimeStamp
                            RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), #1/1/1900#, RSbf.Fields(i).Value)
                        Case Else
                            RSTemp.Fields(i) = IIf(IsNull(RSbf.Fields(i)), "", RSbf.Fields(i).Value)
                    End Select
                    
                Next i
            End If
                dblTse = dblTse + IIf(IsNull(RSbf.Fields("TSEWeight").Value), 0, RSbf.Fields("TSEWeight").Value)
                dblTsy = dblTsy + IIf(IsNull(RSbf.Fields("TSYWeight").Value), 0, RSbf.Fields("TSYWeight").Value)
                
        End If

INext:
       RSbf.MoveNext
    Loop
    
    If DCont = 0 Then
        RSTemp.Fields("TSYWeight") = dblTsy
        RSTemp.Fields("TSEWeight") = dblTse
    End If
    
    Set SetPartData = RSTemp
    RSbf.MoveFirst
    
End Function