www.pudn.com > Doe.rar > FrmOpen.frm, change:2003-01-24,size:12905b
VERSION 5.00
Begin VB.Form FrmOpen
BorderStyle = 1 '單線固定
Caption = "開啟檔案"
ClientHeight = 7050
ClientLeft = 45
ClientTop = 330
ClientWidth = 7110
Icon = "FrmOpen.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 7050
ScaleWidth = 7110
Begin VB.CommandButton cmdExit
Caption = "離開"
Height = 495
Left = 3000
TabIndex = 10
Top = 6480
Width = 1215
End
Begin VB.Frame Frame2
Caption = "開啟舊檔"
BeginProperty Font
Name = "新細明體"
Size = 14.25
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3735
Left = 240
TabIndex = 6
Top = 2640
Width = 6615
Begin VB.CommandButton cmdDel
Caption = "刪除"
Height = 615
Left = 5280
TabIndex = 11
Top = 3000
Width = 1215
End
Begin VB.CommandButton cmdOld
Caption = "開啟舊檔"
Height = 615
Left = 5280
TabIndex = 9
Top = 2160
Width = 1215
End
Begin VB.TextBox txtOldFile
Enabled = 0 'False
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 8
Top = 360
Width = 4575
End
Begin VB.ListBox oldFileList
Height = 2760
ItemData = "FrmOpen.frx":08CA
Left = 480
List = "FrmOpen.frx":08CC
TabIndex = 7
Top = 840
Width = 4575
End
End
Begin VB.Frame Frame1
Caption = "開啟新檔"
BeginProperty Font
Name = "新細明體"
Size = 14.25
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2295
Left = 240
TabIndex = 0
Top = 120
Width = 6615
Begin VB.ComboBox cboTable
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 480
Style = 2 '單純下拉式
TabIndex = 3
Top = 1800
Width = 4575
End
Begin VB.TextBox txtNewFile
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 2
Top = 840
Width = 4575
End
Begin VB.CommandButton cmdNew
Caption = "開啟新檔"
Height = 615
Left = 5280
TabIndex = 1
Top = 1560
Width = 1215
End
Begin VB.Label Label2
Caption = "請選擇直交表 : "
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 5
Top = 1440
Width = 3495
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 = 375
Left = 480
TabIndex = 4
Top = 480
Width = 3495
End
End
End
Attribute VB_Name = "FrmOpen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rsTemp As ADODB.Recordset
Dim rsFileList As New ADODB.Recordset
Private Sub cmdDel_Click()
Dim iAns As Long
If txtOldFile.Text <> "" Then
cmdDel.Enabled = False
With rsFileList
If .RecordCount > 0 Then
.MoveFirst
cSearch = "FileName='" & txtOldFile.Text & "'"
.Find cSearch
If Not .EOF Then '找到資料
iAns = MsgBox("請問是否真的刪除 " & txtOldFile.Text & " ? ", vbQuestion + vbYesNo, "詢問訊息")
'進行刪除
If iAns = vbYes Then
'刪除資料庫
strSQL = "Delete from FileFactor where FileID = " & .Fields("FileID").Value
cnData.Execute strSQL
strSQL = "Delete from SFileName where FileID = " & .Fields("FileID").Value
cnData.Execute strSQL
'刪除 List
For i = 0 To oldFileList.ListCount - 1
If oldFileList.List(i) = txtOldFile.Text Then
oldFileList.RemoveItem i
If i > 0 Then
oldFileList.ListIndex = i - 1
ElseIf i = 0 Then
If oldFileList.ListCount > 0 Then
oldFileList.ListIndex = 0
End If
End If
txtOldFile.Text = oldFileList.Text
Exit For
End If
Next i
'刪除 RS
.Delete
End If
cmdDel.Enabled = True
Else
MsgBox "無此檔案資料,請確認", vbOKOnly + vbInformation, "通知訊息"
cmdDel.Enabled = True
' txtOldFile.SetFocus
Exit Sub
End If
Else
MsgBox "無檔案資料", vbOKOnly + vbInformation, "通知訊息"
cmdDel.Enabled = True
Exit Sub
End If
End With
Else
MsgBox "請選擇欲刪除的檔案", vbOKOnly + vbInformation, "通知訊息"
Exit Sub
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdNew_Click() '開新檔
Dim aryFac
If txtNewFile.Text = "" Then
MsgBox "檔名不可為空,請輸入檔名", vbOKOnly + vbInformation, "通知訊息"
txtNewFile.SetFocus
Exit Sub
Else
'判別是否重複
If rsTemp.State <> adStateClosed Then rsTemp.Close
Set rsTemp = Nothing
strSQL = "select * from SFileName where fileName='" & Trim(txtNewFile.Text) & "'"
Set rsTemp = CreatRS(strSQL)
If rsTemp.RecordCount > 0 Then
MsgBox "檔案名稱重複,請重新輸入", vbOKOnly + vbInformation, "通知訊息"
txtNewFile.SetFocus
Exit Sub
Else
Set rsFactor = New ADODB.Recordset
If rsFactor.State <> adStateClosed Then rsFactor.Close
Set rsFactor = Nothing
strSQL = "select * from CrossHatch where LNo = '" & cboTable.Text & "'"
Set rsFactor = CreatRS(strSQL)
With rsFactor
If .RecordCount > 0 Then
.MoveFirst
'處理水準數(LFactorMemo)
FrmItem.FacRow = .Fields("LFactor").Value '最大控制因子數
FrmItem.FacLevel = .Fields("MaxLevel").Value '最大水準數
FrmItem.strFac = .Fields("LFactorMemo").Value '敘述字串
FrmItem.FacType = cboTable.Text '直交表 Name
FrmItem.newFileName = txtNewFile.Text '紀錄檔名
FrmItem.FacLRow = .Fields("LRow").Value
Else
Exit Sub
End If
End With
FrmItem.Show
End If
End If
End Sub
Private Sub cmdOld_Click()
If txtOldFile.Text <> "" Then
If rsFileList.RecordCount > 0 Then
rsFileList.MoveFirst
With rsFileList
cSearch = "FileName='" & txtOldFile.Text & "'"
.Find cSearch
If Not .EOF Then
FrmDataInput.OpenFileID = .Fields("FileID").Value
FrmDataInput.OpenLNo = .Fields("LNo").Value
FrmDataInput.Show
Else
MsgBox "無此檔案資料,請確認", vbOKOnly + vbInformation, "通知訊息"
' txtOldFile.SetFocus
Exit Sub
End If
End With
Else
MsgBox "無檔案資料", vbOKOnly + vbInformation, "通知訊息"
Exit Sub
End If
Else
MsgBox "請輸入檔案名稱", vbOKOnly + vbInformation, "通知訊息"
Exit Sub
End If
End Sub
Private Sub Form_Activate()
If iFirst Then
iFirst = False
'填入 List
Set rsFileList = New ADODB.Recordset
strSQL = "select FileID, FileName, LNo from SFileName"
Set rsFileList = CreatRS(strSQL)
With rsFileList
If .RecordCount > 0 Then
oldFileList.Clear
.MoveFirst
For i = 1 To .RecordCount
oldFileList.AddItem .Fields("FileName").Value
.MoveNext
Next i
End If
End With
End If
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
'給初值
iFirst = True
'填入combo
Set rsTemp = New ADODB.Recordset
strSQL = "Select distinct LNo from CrossHatch"
Set rsTemp = CreatRS(strSQL)
cboTable.Clear
With rsTemp
.MoveFirst
For i = 1 To .RecordCount
cboTable.AddItem .Fields(0).Value
.MoveNext
Next i
End With
cboTable.ListIndex = 0
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 oldFileList_Click()
If oldFileList.ListIndex <> -1 Then
txtOldFile.Text = oldFileList.Text
' Else
' txtOldFile.Text = ""
End If
End Sub