www.pudn.com > Doe.rar > FrmItem.frm
VERSION 5.00
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form FrmItem
BorderStyle = 1 '虫絬㏕﹚
Caption = "ミ北戈"
ClientHeight = 5760
ClientLeft = 45
ClientTop = 330
ClientWidth = 8430
Icon = "FrmItem.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5760
ScaleWidth = 8430
Begin VB.TextBox txtValue
BeginProperty Font
Name = "穝灿砰"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1680
TabIndex = 5
Top = 3000
Visible = 0 'False
Width = 1215
End
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 = 495
Left = 6960
TabIndex = 3
Top = 5160
Width = 1215
End
Begin VB.CommandButton cmdOK
Caption = "絋﹚"
BeginProperty Font
Name = "穝灿砰"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5280
TabIndex = 1
Top = 5160
Width = 1215
End
Begin VB.ComboBox cboFactor
BeginProperty Font
Name = "穝灿砰"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1800
TabIndex = 4
Top = 2040
Visible = 0 'False
Width = 975
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid ItemGrid
Height = 4095
Left = 240
TabIndex = 0
Top = 840
Width = 7995
_ExtentX = 14102
_ExtentY = 7223
_Version = 393216
Cols = 6
RowSizingMode = 1
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 = 6
End
Begin VB.Label Label1
Caption = "弧"
BeginProperty Font
Name = "穝灿砰"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 240
TabIndex = 2
Top = 120
Width = 7935
End
End
Attribute VB_Name = "FrmItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public FacRow As Integer '魁北计
Public FacLevel As Integer '魁北非计
Public FacType As String '魁ユ嘿
Public strFac As String '痹瓃ユず甧
Public FacLRow As Integer '魁ユ计
Public newFileName As String '魁郎
Dim rsTemp As Recordset
Dim isMoveMF As Boolean
Dim cellRow As Integer, cellCol As Integer
Private Sub cboFactor_KeyPress(KeyAscii As Integer)
'--------------------------------------------- Use MFGrid -----------------------------------------------------
'絋﹚
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
If cboFactor.Text <> cboFactor.Tag Then
ItemGrid.TextMatrix(cellRow, cellCol) = cboFactor.Text
' 'update to rs
' rsMeasData.Fields(cellCol + 1).Value = cboFactor.Text
' rsMeasData.Update
End If
Call MoveMF
End If
End Sub
Private Sub cboFactor_LostFocus()
'--------------------------------------------- Use MFGrid -----------------------------------------------------
If isMoveMF = True Then
isMoveMF = False
Exit Sub
End If
'秈︽タ
If cboFactor.Text <> cboFactor.Tag Then
ItemGrid.TextMatrix(cellRow, cellCol) = cboFactor.Text
' 'update to rs
' rsMeasData.Fields(cellCol + 1).Value = cboFactor.Text
' rsMeasData.Update
End If
cboFactor.Visible = False
cboFactor.BackColor = vbWhite
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim nFileID As Long
Dim nAccID As Long
Dim strValue As String
FrmItem.Enabled = False
'to get FileID
nFileID = GetAutoNumber("FileID")
'ミ郎戈 ( Table sFileName )
strSQL = "Insert into sFileName ( FileID, FileName,LNo,FactorNun ) Values ( " & nFileID & ", '" & newFileName & "', '" & FacType & "', " & FacRow & " ) "
cnData.Execute strSQL
'更ユ
Set rsFactor = New Recordset
If rsFactor.State <> adStateClosed Then rsFactor.Close
strSQL = "select * from " & FacType & " order by index"
Set rsFactor = CreatRS(strSQL)
With rsFactor
If .RecordCount > 0 Then
For j = 1 To FacRow 'col 癹伴
'魁北嘿
strValue = ItemGrid.TextMatrix(j, 1)
strSQL = "Insert into FileFactor (FileID, FactorNo, rFactor, FIndex) values ( " & nFileID & ", " & j & ", '" & strValue & "', " & 0 & " ) "
cnData.Execute strSQL
'魁北
.MoveFirst
For i = 1 To .RecordCount 'Row 癹伴
If .Fields(j).Value = 1 Then '非
'save to table FileFactor
strValue = ItemGrid.TextMatrix(j, 3)
strSQL = "Insert into FileFactor (FileID, FactorNo, rFactor, FIndex) values ( " & nFileID & ", " & j & ", '" & strValue & "', " & i & " ) "
cnData.Execute strSQL
' .Fields(i).Value = ItemGrid.TextMatrix(i, j + 2) '材 j 恨兜ヘず, 材 i Row Value ( 非 )
'
ElseIf .Fields(j).Value = 2 Then '非
strValue = ItemGrid.TextMatrix(j, 4)
strSQL = "Insert into FileFactor (FileID, FactorNo, rFactor, FIndex) values ( " & nFileID & ", " & j & ", '" & strValue & "', " & i & " ) "
cnData.Execute strSQL
' .Fields(i).Value = ItemGrid.TextMatrix(i, j + 3) '材 j 恨兜ヘず, 材 i Row Value ( 非 )
ElseIf .Fields(j).Value = 3 Then '非
strValue = ItemGrid.TextMatrix(j, 5)
strSQL = "Insert into FileFactor (FileID, FactorNo, rFactor, FIndex) values ( " & nFileID & ", " & j & ", '" & strValue & "', " & i & " ) "
cnData.Execute strSQL
' .Fields(i).Value = ItemGrid.TextMatrix(i, j + 4) '材 j 恨兜ヘず, 材 i Row Value ( 非 )
End If
.MoveNext
Next i
Next j
'秖代计沮 ( RMeas )
For k = 1 To FacLRow
nAccID = GetAutoNumber("AccID")
strSQL = "Insert into RMeas ( FileID, AccID, mIndex ) values ( " & nFileID & ", " & nAccID & ", " & k & " )"
cnData.Execute strSQL
Next k
'戈畐, 盢倒块礶
FrmDataInput.OpenFileID = nFileID
FrmDataInput.OpenLNo = FacType
End If
End With
Unload Me
FrmDataInput.Show
End Sub
Private Sub Form_Load()
'砞﹚礶
Label1.Caption = strFac
Call SetMFGrid
'砞﹚Combo
Set rsTemp = New ADODB.Recordset
If rsTemp.State <> adStateClosed Then rsTemp.Close
strSQL = "select FactorName from FactorType"
Set rsTemp = CreatRS(strSQL)
With rsTemp
If .RecordCount > 0 Then
cboFactor.Clear
.MoveFirst
For i = 1 To .RecordCount
cboFactor.AddItem .Fields(0).Value
.MoveNext
Next i
End If
End With
End Sub
Private Sub SetMFGrid()
Select Case FacType
Case "L4", "L8", "L12", "L16", "L32" '非
With ItemGrid
.AllowUserResizing = flexResizeBoth
.Rows = FacRow + 1
.Cols = FacLevel + 3
.FontHeader(0).Size = 10
.TextMatrix(0, 1) = "北"
.TextMatrix(0, 2) = "非计"
.TextMatrix(0, 3) = "非"
.TextMatrix(0, 4) = "非"
' .TextMatrix(0, 5) = "非"
' .TextMatrix(0, 5) = "非"
' .TextMatrix(0, 6) = "非き"
.ColWidth(0) = 500
.ColAlignmentFixed(0) = 4
.ColWidth(1) = 2000
.ColAlignmentFixed(1) = 4
.ColWidth(2) = 800
.ColAlignmentFixed(2) = 4
For i = 3 To 4
.ColWidth(i) = 1200
.ColAlignmentFixed(i) = 4
Next i
For i = 1 To .Rows - 1
.TextMatrix(i, 2) = "2"
.TextMatrix(i, 0) = i
Next
End With
Case "L9", "L27" '非
With ItemGrid
.AllowUserResizing = flexResizeBoth
.Rows = FacRow + 1
.Cols = FacLevel + 3
.FontHeader(0).Size = 10
.TextMatrix(0, 1) = "北"
.TextMatrix(0, 2) = "非计"
.TextMatrix(0, 3) = "非"
.TextMatrix(0, 4) = "非"
.TextMatrix(0, 5) = "非"
' .TextMatrix(0, 5) = "非"
' .TextMatrix(0, 6) = "非き"
.ColWidth(0) = 500
.ColAlignmentFixed(0) = 4
.ColWidth(1) = 2000
.ColAlignmentFixed(1) = 4
.ColWidth(2) = 800
.ColAlignmentFixed(2) = 4
For i = 3 To 5
.ColWidth(i) = 1200
.ColAlignmentFixed(i) = 4
Next i
For i = 1 To .Rows - 1
.TextMatrix(i, 2) = "3"
.TextMatrix(i, 0) = i
Next
End With
Case "L18"
With ItemGrid
.AllowUserResizing = flexResizeBoth
.Rows = FacRow + 1
.Cols = FacLevel + 3
.FontHeader(0).Size = 10
.TextMatrix(0, 1) = "北"
.TextMatrix(0, 2) = "非计"
.TextMatrix(0, 3) = "非"
.TextMatrix(0, 4) = "非"
.TextMatrix(0, 5) = "非"
' .TextMatrix(0, 5) = "非"
' .TextMatrix(0, 6) = "非き"
.ColWidth(0) = 500
.ColAlignmentFixed(0) = 4
.ColWidth(1) = 2000
.ColAlignmentFixed(1) = 4
.ColWidth(2) = 800
.ColAlignmentFixed(2) = 4
For i = 3 To 5
.ColWidth(i) = 1200
.ColAlignmentFixed(i) = 4
Next i
.TextMatrix(1, 2) = "2"
.TextMatrix(1, 0) = 1
For i = 2 To .Rows - 1
.TextMatrix(i, 2) = "3"
.TextMatrix(i, 0) = i
Next
End With
End Select
' 'Set Grid
' With ItemGrid
' .AllowUserResizing = flexResizeBoth
' .Rows = FacRow + 1
' .Cols = FacLevel + 3
' .FontHeader(0).Size = 10
' .TextMatrix(0, 1) = "北"
' .TextMatrix(0, 2) = "非计"
' .TextMatrix(0, 3) = "非"
' .TextMatrix(0, 4) = "非"
' .TextMatrix(0, 5) = "非"
'' .TextMatrix(0, 5) = "非"
'' .TextMatrix(0, 6) = "非き"
' .ColWidth(0) = 500
' .ColAlignmentFixed(0) = 4
' .ColWidth(1) = 2000
' .ColAlignmentFixed(1) = 4
' .ColWidth(2) = 800
' .ColAlignmentFixed(2) = 4
' For i = 3 To 5
' .ColWidth(i) = 1200
' .ColAlignmentFixed(i) = 4
' Next i
' End With
'
End Sub
Private Sub Form_Resize()
'砞﹚ Form 竚
Me.Top = (ODEMDIForm.ScaleHeight - Me.Height) / 2
Me.Left = (ODEMDIForm.ScaleWidth - Me.Width) / 2
End Sub
Private Sub ShowCboFactor()
With ItemGrid
.RowSel = .Row
.ColSel = .Col
cellRow = .Row
cellCol = .Col
cboFactor.Move .Left + .CellLeft, .Top + .CellTop, .CellWidth - ScaleX(1, vbPixels, vbTwips)
cboFactor.Visible = True
cboFactor.BackColor = vbCyan
cboFactor.Text = .Text
cboFactor.Tag = .Text
cboFactor.SetFocus
End With
End Sub
Private Sub ShowTxtValue()
With ItemGrid
.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 ItemGrid_DblClick()
Select Case ItemGrid.Col
Case 1
txtValue.Visible = False
Call ShowCboFactor
Case 3 To 5
cboFactor.Visible = False
Call ShowTxtValue
Case Else
txtValue.Visible = False
cboFactor.Visible = False
End Select
End Sub
Private Sub txtValue_KeyPress(KeyAscii As Integer)
'--------------------------------------------- Use MFGrid -----------------------------------------------------
'絋﹚
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
If txtValue.Text <> txtValue.Tag Then
ItemGrid.TextMatrix(cellRow, cellCol) = txtValue.Text
' 'update to rs
' rsMeasData.Fields(cellCol + 1).Value = txtValue.Text
' rsMeasData.Update
End If
Call MoveMF
End If
End Sub
Private Sub txtValue_LostFocus()
'--------------------------------------------- Use MFGrid -----------------------------------------------------
If isMoveMF = True Then
isMoveMF = False
Exit Sub
End If
'秈︽タ
If txtValue.Text <> txtValue.Tag Then
ItemGrid.TextMatrix(cellRow, cellCol) = txtValue.Text
' 'update to rs
' rsMeasData.Fields(cellCol + 1).Value = txtValue.Text
' rsMeasData.Update
End If
txtValue.Visible = False
txtValue.BackColor = vbWhite
End Sub
Private Sub MoveMF() '簿笆村夹
' dim chart
Dim inCol As Integer, inRow As Integer
'絋﹚
inCol = ItemGrid.Col
inRow = ItemGrid.Row
If inRow <> ItemGrid.Rows - 1 Then
Select Case inCol
Case 1
cboFactor.Visible = False
cboFactor.BackColor = vbWhite
ItemGrid.Col = 3
isMoveMF = True
Call ShowTxtValue
Case 3
If inCol <> ItemGrid.Cols - 1 Then
ItemGrid.Col = 4
Call ShowTxtValue
Else
txtValue.Visible = False
txtValue.BackColor = vbWhite
ItemGrid.Row = ItemGrid.Row + 1
ItemGrid.Col = 1
isMoveMF = True
Call ShowCboFactor
End If
Case 4
If inCol <> ItemGrid.Cols - 1 Then
ItemGrid.Col = 5
Call ShowTxtValue
Else
txtValue.Visible = False
txtValue.BackColor = vbWhite
ItemGrid.Row = ItemGrid.Row + 1
ItemGrid.Col = 1
isMoveMF = True
Call ShowCboFactor
End If
Case 5
If inCol <> ItemGrid.Cols - 1 Then
ItemGrid.Col = 4
Call ShowTxtValue
Else
txtValue.Visible = False
txtValue.BackColor = vbWhite
ItemGrid.Row = ItemGrid.Row + 1
ItemGrid.Col = 1
isMoveMF = True
Call ShowCboFactor
End If
End Select
Else
Select Case inCol
Case 1
cboFactor.Visible = False
cboFactor.BackColor = vbWhite
ItemGrid.Col = 3
isMoveMF = True
Call ShowTxtValue
Case 3
If inCol <> ItemGrid.Cols - 1 Then
ItemGrid.Col = 4
Call ShowTxtValue
Else
txtValue.Visible = False
txtValue.BackColor = vbWhite
Exit Sub
End If
Case 4
If inCol <> ItemGrid.Cols - 1 Then
ItemGrid.Col = 5
Call ShowTxtValue
Else
txtValue.Visible = False
txtValue.BackColor = vbWhite
Exit Sub
End If
Case 5
If inCol <> ItemGrid.Cols - 1 Then
ItemGrid.Col = 4
Call ShowTxtValue
Else
txtValue.Visible = False
txtValue.BackColor = vbWhite
Exit Sub
End If
End Select
End If
End Sub