www.pudn.com > Doe.rar > FrmDataInput.frm
VERSION 5.00
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form FrmDataInput
Caption = "輸入實驗數據"
ClientHeight = 7965
ClientLeft = 60
ClientTop = 345
ClientWidth = 8970
Icon = "FrmDataInput.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 7965
ScaleWidth = 8970
WindowState = 2 '最大化
Begin VB.CommandButton cmdExit
Caption = "離開"
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6840
TabIndex = 3
Top = 6720
Width = 1455
End
Begin VB.CommandButton cmdCal
Caption = "計算"
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5040
TabIndex = 2
Top = 6720
Width = 1455
End
Begin VB.TextBox txtValue
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3360
TabIndex = 1
Top = 2400
Visible = 0 'False
Width = 1575
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid InputGrid
Height = 5655
Left = 840
TabIndex = 0
Top = 720
Width = 7335
_ExtentX = 12938
_ExtentY = 9975
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新細明體"
Size = 9.75
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
Attribute VB_Name = "FrmDataInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public OpenFileID As Long '檔案 ID
Public OpenLNo As String '直交表種類
Dim nLRow As Integer '直交表列數
Dim nLFactor As Integer '直交表最大因子數
Dim rsInput As ADODB.Recordset '載入控制因子設定
Dim rsMData As ADODB.Recordset '載入量測數據
Dim rsTempLNo As ADODB.Recordset
Dim cellRow As Integer, cellCol As Integer '傳回 Grid 位置
Dim avgCol As Integer, avgRow As Integer '傳回平均值欄位的 Col & Row
Dim avgSum As Single, avgNum As Integer '用來計算平均值
'計算
Dim avgAll As Single '紀錄總平均數
Private Sub cmdCal_Click()
'----------------------------------------------------------------------------------------
'紀錄 RS 資訊用
Dim iFIndex As Long
Dim iFacName As String
Dim iFacSI As Single
Dim iavgL1 As Single, iNumL1 As Integer
Dim iavgL2 As Single, iNumL2 As Integer
Dim iavgL3 As Single, iNumL3 As Integer
'----------------------------------------------------------------------------------------
ReDim aryStdData(nLRow) As Single
avgSum = 0
avgNum = 0
'判斷數據是否輸入完整
For j = 1 To 5
If InputGrid.TextMatrix(1, avgCol - j) = "" Then
For k = 1 To nLRow
If InputGrid.TextMatrix(k, avgCol - j) <> "" Then
MsgBox "數據資料不完整,請確認", vbOKOnly + vbInformation, "提示訊息"
Exit Sub
End If
Next k
Else
For k = 1 To nLRow
If InputGrid.TextMatrix(k, avgCol - j) = "" Then
MsgBox "數據資料不完整,請確認", vbOKOnly + vbInformation, "提示訊息"
Exit Sub
End If
Next k
End If
Next j
'判斷平均值是否 OK
For i = 1 To nLRow
If InputGrid.TextMatrix(i, avgCol) = "" Then
MsgBox "數據資料錯誤,請確認", vbOKOnly + vbInformation, "提示訊息"
Exit Sub
Else
aryStdData(i) = InputGrid.TextMatrix(i, avgCol)
avgSum = avgSum + InputGrid.TextMatrix(i, avgCol)
avgNum = avgNum + 1
End If
Next i
'防呆
If avgNum <> 0 Then
aryStdData(0) = cLaiFormat(avgSum / avgNum, 3)
End If
'傳回值給 FrmCaculate
FrmCaculate.CalLNo = OpenLNo
FrmCaculate.eFileID = OpenFileID
FrmCaculate.eFacNum = nLFactor
FrmCaculate.eFacRows = nLRow
'開空白的 RS 做操作
Set rsStdData = New ADODB.Recordset
If rsStdData.State <> adStateClosed Then rsStdData.Close
With rsStdData
.Fields.Append "FIndex", adBigInt '紀錄欄位順序
.Fields.Append "FacName", adBSTR '紀錄控制因子名稱
.Fields.Append "FacSI", adSingle '控制因子的 SI 值
.Fields.Append "avgL1", adSingle '水準一的平均值
.Fields.Append "avgL2", adSingle '水準二的平均值
.Fields.Append "avgL3", adSingle '水準三的平均值
If .State = adStateClosed Then .Open
End With
'填入 RS
' '載入直交表值
Set rsFactor = New Recordset
If rsFactor.State <> adStateClosed Then rsFactor.Close
Set rsFactor = Nothing
strSQL = "select * from " & OpenLNo & " order by index"
Set rsFactor = CreatRS(strSQL)
With rsFactor
If .RecordCount > 0 Then
For j = 1 To nLFactor 'col 迴圈
'給初值
iavgL1 = 0: iNumL1 = 0
iavgL2 = 0: iNumL2 = 0
iavgL3 = 0: iNumL3 = 0
iFacSI = 0
' '紀錄控制因子名稱
iFacName = InputGrid.TextMatrix(0, j)
' '紀錄控制因子值
.MoveFirst
For i = 1 To .RecordCount 'Row 迴圈
If .Fields(j).Value = 1 Then '水準一
iavgL1 = iavgL1 + aryStdData(i)
iNumL1 = iNumL1 + 1
ElseIf .Fields(j).Value = 2 Then '水準二
iavgL2 = iavgL2 + aryStdData(i)
iNumL2 = iNumL2 + 1
ElseIf .Fields(j).Value = 3 Then '水準三
iavgL3 = iavgL3 + aryStdData(i)
iNumL3 = iNumL3 + 1
End If
.MoveNext
Next i
'填數據至 rsStdData
rsStdData.AddNew
rsStdData.Fields("FIndex").Value = j
rsStdData.Fields("FacName").Value = iFacName
If iNumL1 > 0 Then
rsStdData.Fields("avgL1").Value = cLaiFormat(iavgL1 / iNumL1, 3)
iFacSI = iFacSI + ((aryStdData(0) - (iavgL1 / iNumL1)) * (aryStdData(0) - (iavgL1 / iNumL1))) * iNumL1
End If
If iNumL2 > 0 Then
rsStdData.Fields("avgL2").Value = cLaiFormat(iavgL2 / iNumL2, 3)
iFacSI = iFacSI + ((aryStdData(0) - (iavgL2 / iNumL2)) * (aryStdData(0) - (iavgL2 / iNumL2))) * iNumL2
End If
If iNumL3 > 0 Then
rsStdData.Fields("avgL3").Value = cLaiFormat(iavgL3 / iNumL3, 3)
iFacSI = iFacSI + ((aryStdData(0) - (iavgL3 / iNumL3)) * (aryStdData(0) - (iavgL3 / iNumL3))) * iNumL3
End If
rsStdData.Fields("FacSI").Value = cLaiFormat(iFacSI, 3)
rsStdData.Update
Next j
End If
End With
FrmCaculate.Show
End Sub
Private Sub cmdExit_Click()
'離開
Unload Me
End Sub
Private Sub Form_Load()
' 'Check Key
' gnWhatVersion = goKeyCheck.WhatVersion
' gnSpecialCust = goKeyCheck.SpecialCustomer
' If gnWhatVersion <> 16 And gnSpecialCust <> 1000 Then
' MsgBox "Key Error ", vbOKOnly + vbCritical, "錯誤訊息"
' End
' End If
'get RS of data
Set rsInput = New ADODB.Recordset
If rsInput.State <> adStateClosed Then rsInput.Close
Set rsInput = Nothing
strSQL = "select * from FileFactor where FileId = " & OpenFileID & " order by FactorNo ,FIndex "
Set rsInput = CreatRS(strSQL)
'get RS of LNo
Set rsTempLNo = New ADODB.Recordset
If rsTempLNo.State <> adStateClosed Then rsTempLNo.Close
strSQL = "select * from CrossHatch where LNo = '" & OpenLNo & "'"
Set rsTempLNo = CreatRS(strSQL)
With rsTempLNo
If .RecordCount > 0 Then
.MoveFirst
nLRow = .Fields("LRow").Value
nLFactor = .Fields("LFactor").Value
End If
End With
'get rs of measdata
Set rsMData = New ADODB.Recordset
If rsMData.State <> adStateClosed Then rsMData.Close
strSQL = "select * from RMeas where FileID =" & OpenFileID & " order by mIndex "
rsMData.Open strSQL, cnData, adOpenDynamic, adLockOptimistic
'set MFGrid
Call SetMFGrid
End Sub
Private Sub SetMFGrid() '設定 Grid
With InputGrid
.Width = FrmDataInput.Width - 1000
.Height = FrmDataInput.Height - 1500
.Left = 500
.Top = FrmDataInput.Top + 500
'傳入數量by fileid
.Cols = nLFactor + 7 '+7 ,只包含平均值(但資料庫內保留 3 欄位 (含平均值))
.Rows = nLRow + 1
For i = 1 To .Rows - 1
.TextMatrix(i, 0) = i
Next
'填入控制因子
If rsInput.RecordCount > 0 Then
For i = 1 To nLFactor
cSearch = "FactorNo =" & i
rsInput.Filter = cSearch
rsInput.Sort = "FIndex"
For j = 0 To rsInput.RecordCount - 1
.TextMatrix(j, i) = rsInput.Fields("rFactor").Value
rsInput.MoveNext
Next j
Next i
End If
'----------------------------------------------------------------------------------
'填入 Title
For i = 1 To 5
.TextMatrix(0, nLFactor + i) = "第 " & i & " 組"
Next i
.TextMatrix(0, nLFactor + 6) = "平均值"
avgCol = nLFactor + 6 '紀錄平均值的 Col
' .TextMatrix(0, nLFactor + 7) = "保留一"
' .TextMatrix(0, nLFactor + 7) = "保留二"
'----------------------------------------------------------------------------------
'填入量測數據
If rsMData.RecordCount > 0 Then
rsMData.MoveFirst
For k = 1 To rsMData.RecordCount
For i = 1 To 6
If rsMData.Fields(1 + i).Value = -9999 Then
.TextMatrix(k, nLFactor + i) = ""
Else
.TextMatrix(k, nLFactor + i) = rsMData.Fields(1 + i).Value
End If
Next i
rsMData.MoveNext
Next k
End If
End With
End Sub
Private Sub ShowTxtValue()
With InputGrid
.RowSel = .Row
.ColSel = .Col
cellRow = .Row
cellCol = .Col
txtValue.Move .Left + .CellLeft, .Top + .CellTop, .CellWidth - 2 * ScaleX(1, vbPixels, vbTwips), .CellHeight
txtValue.Visible = True
txtValue.BackColor = vbCyan
txtValue.Text = .Text
txtValue.Tag = .Text
txtValue.SetFocus
End With
End Sub
Private Sub Form_Resize()
'設定 Form 位置
If Me.WindowState = 1 Then
Exit Sub
End If
If Me.WindowState <> 2 Then
Me.Top = (ODEMDIForm.ScaleHeight - Me.Height) / 2
Me.Left = (ODEMDIForm.ScaleWidth - Me.Width) / 2
End If
With InputGrid
.Width = FrmDataInput.Width - 1000
.Height = FrmDataInput.Height - 1500
.Left = 500
.Top = 300
End With
cmdExit.Top = InputGrid.Top + InputGrid.Height + 200
cmdExit.Left = InputGrid.Left + InputGrid.Width - cmdExit.Width
cmdCal.Top = cmdExit.Top
cmdCal.Left = cmdExit.Left - cmdCal.Width - 100
End Sub
Private Sub InputGrid_Click()
Select Case InputGrid.Col
Case nLFactor + 1 To nLFactor + 5
rsMData.AbsolutePosition = InputGrid.Row
Call ShowTxtValue
Case Else
End Select
End Sub
Private Sub txtValue_KeyPress(KeyAscii As Integer)
'--------------------------------------------- Use MFGrid -----------------------------------------------------
'需做數字防呆
Select Case KeyAscii
Case Is < 32 'Control 鍵
'按確定
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
If txtValue.Text <> txtValue.Tag Then
If txtValue.Text = "0" Then
InputGrid.TextMatrix(cellRow, cellCol) = Val(txtValue.Text)
' 'update to rs
rsMData.Fields(cellCol - nLFactor + 1).Value = Val(txtValue.Text)
rsMData.Update
Call CalAvg
ElseIf Val(txtValue.Text) <> 0 Then
InputGrid.TextMatrix(cellRow, cellCol) = Val(txtValue.Text)
' 'update to rs
rsMData.Fields(cellCol - nLFactor + 1).Value = Val(txtValue.Text)
rsMData.Update
Call CalAvg
Else
InputGrid.TextMatrix(cellRow, cellCol) = ""
' 'update to rs
rsMData.Fields(cellCol - nLFactor + 1).Value = -9999
rsMData.Update
Call CalAvg
End If
End If
Call MoveMF
End If
Case 46, 48 To 57 '數字鍵
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub txtValue_LostFocus()
'--------------------------------------------- Use MFGrid -----------------------------------------------------
'進行值的修正
If txtValue.Text <> txtValue.Tag Then
If Val(txtValue.Text) <> 0 Then
InputGrid.TextMatrix(cellRow, cellCol) = Val(txtValue.Text)
' 'update to rs
rsMData.Fields(cellCol - nLFactor + 1).Value = Val(txtValue.Text)
rsMData.Update
Call CalAvg
Else
InputGrid.TextMatrix(cellRow, cellCol) = ""
' 'update to rs
rsMData.Fields(cellCol - nLFactor + 1).Value = -9999
rsMData.Update
Call CalAvg
End If
End If
txtValue.Visible = False
txtValue.BackColor = vbWhite
End Sub
Private Sub MoveMF()
Dim inCol As Integer, inRow As Integer
inCol = InputGrid.Col
inRow = InputGrid.Row
Select Case inCol
Case nLFactor + 1 To nLFactor + 5 '實驗數據輸入
If inRow = InputGrid.Rows - 1 Then '最後一筆
txtValue.Visible = False
txtValue.BackColor = vbWhite
Else
InputGrid.Row = inRow + 1
rsMData.AbsolutePosition = InputGrid.Row
Call ShowTxtValue
End If
Case Else '其他
txtValue.Visible = False
txtValue.BackColor = vbWhite
End Select
End Sub
Private Sub CalAvg() '計算平均值
With rsMData
avgSum = 0
avgNum = 0
For i = 2 To 6
If .Fields(i).Value <> -9999 Then
avgNum = avgNum + 1
avgSum = avgSum + .Fields(i).Value
End If
Next i
End With
If avgNum <> 0 Then
avgRow = rsMData.AbsolutePosition
InputGrid.TextMatrix(avgRow, avgCol) = cLaiFormat((avgSum / avgNum), 3)
rsMData.Fields(7) = cLaiFormat((avgSum / avgNum), 3)
rsMData.Update
Else
avgRow = rsMData.AbsolutePosition
InputGrid.TextMatrix(avgRow, avgCol) = ""
rsMData.Fields(7) = -9999
rsMData.Update
End If
End Sub