“.Text”属性 未定义？
".Text" property not defined?
我已经尝试激活多个资源，但无论我做什么，.Text 方法都没有定义/识别，.Text 在下面的代码行中：
Private Sub Form_Load()
StartDate = Date
meBakBlauw.Text = "-"
meBakGeel.Text = "-"
运行 之后出现的提示说：'Method or Datamember is not found'。
有没有人知道如何解决这个问题？
它是由我们的老程序员编写的，他在其中构建了对扩展资源的限制。它是用 Visual Basic 6 编写的。
完整程序：
VERSION 5.00
Begin VB.Form frmKoppelBak
BackColor = &H80000005&
Caption = "Bakken Koppelen"
ClientHeight = 9285
ClientLeft = 60
ClientTop = 750
ClientWidth = 13590
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 9285
ScaleWidth = 13590
Begin VB.PictureBox meBakGeel
BackColor = &H0000FFFF&
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 6
TabStop = 0 'False
Top = 2280
Width = 6000
End
Begin VB.PictureBox meBakBlauw
BackColor = &H00FF0000&
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 5
TabStop = 0 'False
Top = 600
Width = 6000
End
Begin VB.PictureBox meBlauw
Appearance = 0 'Flat
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Index = 0
Left = 480
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 4
TabStop = 0 'False
Top = 600
Width = 6375
End
Begin VB.PictureBox PVMaskEdit4
Appearance = 0 'Flat
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 495
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 3
TabStop = 0 'False
Top = 7200
Width = 6375
End
Begin VB.PictureBox PVMaskEdit3
Appearance = 0 'Flat
BackColor = &H80000014&
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 480
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 2
TabStop = 0 'False
Top = 5520
Width = 6375
End
Begin VB.PictureBox meScanOrder
CausesValidation= 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 0
Top = 5520
Width = 6000
End
Begin VB.PictureBox meScanBak
BackColor = &H0000FFFF&
CausesValidation= 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 1
Top = 7200
Width = 6000
End
Begin VB.PictureBox meBlauw
Appearance = 0 'Flat
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Index = 1
Left = 480
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 7
TabStop = 0 'False
Top = 2280
Width = 6375
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 10000
Left = 255
Top = 75
End
Begin VB.Frame Frame1
BackColor = &H80000005&
Caption = "Koppel Order aan Bak"
Height = 4095
Left = 120
TabIndex = 8
Top = 4920
Width = 13320
End
Begin VB.Menu File
Caption = "&File"
Begin VB.Menu mnuExit
Caption = "&Exit"
End
End
End
Attribute VB_Name = "frmKoppelBak"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_LOOP = &H8
Const SND_NOSTOP = &H10
Const glBlauweBak As Long = 1
Const glGeleBak As Long = 2
Const glNeeGELEBak As Long = 3
Const glOrderOnbekend As Long = 4
Const glNietVoorLegborden As Long = 5
Const glOngeldigBakNummer As Long = 6
Dim INIfile As String
Dim StartDate As Date
Dim ConnectOK As Boolean
Dim ChildHDL As Variant
Dim GeleBak As Boolean
Dim pp5000 As ADODB.Connection
Dim KoppelBak As ADODB.Command
Dim BakkenPerKleur As ADODB.Command
Dim PakOrder As ADODB.Command
Dim ConnStrPP5000 As String
Dim winTop As Integer
Dim winLeft As Integer
Dim winHeight As Integer
Dim winWidth As Integer
Dim wavBlauweBak As String
Dim wavGeleBak As String
Dim wavNeeGELEBak As String
Dim wavNietVoorLegborden As String
Dim wavOrderOnbekend As String
Dim wavOngeldigBakNummer As String
Private Declare Function GetPrivateProfileString _
Lib "kernel32" _
Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString _
Lib "kernel32" _
Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Private Declare Function sndPlaySound _
Lib "winmm.dll" _
Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
Private Sub Form_Load()
StartDate = Date
meBakBlauw.Text = "-"
meBakGeel.Text = "-"
INIfile = App.Path & "\KoppelBak.ini"
GetSettings
ConnectOK = False
connectDB
If Not ConnectOK Then
MsgBox "ERROR: Geen verbinding met de database", vbCritical, "Koppel Bak"
Unload Me
End
End If
Me.Top = winTop
Me.Left = winLeft
TelBakken
Timer1.Enabled = True
End Sub
Private Sub Form_Resize()
If (frmKoppelBak.WindowState <> vbMinimized) Then
If (frmKoppelBak.Width <> 13710) Then
frmKoppelBak.Width = 13710
End If
If (frmKoppelBak.Height <> 10095) Then
frmKoppelBak.Height = 10095
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim INIresult As Long
disconnectDB
If (frmKoppelBak.WindowState <> vbMinimized) Then
INIresult = WritePrivateProfileString("Settings", "winTop", CStr(Me.Top), INIfile)
INIresult = WritePrivateProfileString("Settings", "winLeft", CStr(Me.Left), INIfile)
End If
End Sub
Sub Geluidje(GeluidNR As Long)
Dim SoundName As String
Dim wFlags, playRes As Long
wFlags = SND_ASYNC Or SND_NODEFAULT
SoundName = ""
Select Case GeluidNR
Case glBlauweBak
SoundName = wavBlauweBak
Case glGeleBak
SoundName = wavGeleBak
Case glNeeGELEBak
SoundName = wavNeeGELEBak
Case glOrderOnbekend
SoundName = wavOrderOnbekend
Case glNietVoorLegborden
SoundName = wavNietVoorLegborden
Case glOngeldigBakNummer
SoundName = wavOngeldigBakNummer
Case Else
SoundName = "Windows XP Hardwarefout.wav"
End Select
If (SoundName <> "") Then
playRes = sndPlaySound(SoundName, wFlags)
End If
End Sub
Private Sub mnuExit_Click()
Unload frmKoppelBak
End Sub
Private Sub Timer1_Timer()
Dim INIresult As Long
Timer1.Enabled = False
If (Timer > 18000) Then '05:00
If Not ConnectOK Then
connectDB
End If
TelBakken
Else
If ConnectOK Then
disconnectDB
End If
If (StartDate < Date) Then 'nieuwe instance starten en zelf stoppen i.v.m memory leaks
If (frmKoppelBak.WindowState <> vbMinimized) Then
INIresult = WritePrivateProfileString("Settings", "winTop", CStr(Me.Top), INIfile)
INIresult = WritePrivateProfileString("Settings", "winLeft", CStr(Me.Left), INIfile)
End If
ChildHDL = Shell(App.Path & "\" & App.EXEName, vbNormalNoFocus)
If ChildHDL <> 0 Then
Unload frmKoppelBak
End
End If
End If
End If
Timer1.Enabled = True
End Sub
Private Sub TelBakken()
meBakBlauw.Text = "-"
meBakGeel.Text = "-"
BakkenPerKleur.Execute , , adExecuteNoRecords
meBakBlauw.Text = CStr(BakkenPerKleur.Parameters("@o_BlauweBakken").Value)
meBakGeel.Text = CStr(BakkenPerKleur.Parameters("@o_GeleBakken").Value)
End Sub
Private Sub meScanOrder_GotFocusEvent()
meScanOrder.Text = ""
End Sub
Private Sub meScanOrder_KeyPress(KeyAscii As Integer)
Dim FoutCode As Long
If KeyAscii = 13 Then
' Zoek de order en bepaal de bakkleur
meScanBak.Text = ""
Timer1.Enabled = False
PakOrder.Parameters("@i_AUFTRAG").Value = meScanOrder.Text
PakOrder.Execute , , adExecuteNoRecords
Timer1.Enabled = True
FoutCode = PakOrder.Parameters("@o_FoutCode").Value
GeleBak = PakOrder.Parameters("@o_GeleBak").Value
'MsgBox CStr(FoutCode) & "; " & CStr(GeleBak)
If (FoutCode = 0) Then
If GeleBak Then
meScanBak.ForeColor = &H0&
meScanBak.BackColor = &HFFFF&
Call Geluidje(glGeleBak)
Else
meScanBak.ForeColor = &HFFFFFF
meScanBak.BackColor = &HFF0000
Call Geluidje(glBlauweBak)
End If
' Nu naar het baknummer
meScanBak.SetFocus
Else
If (FoutCode = 1) Then
Call Geluidje(glOrderOnbekend)
Else
Call Geluidje(glNietVoorLegborden)
End If
meScanOrder.Text = ""
meScanOrder.SetFocus
End If
End If
End Sub
Private Sub meScanBak_GotFocusEvent()
meScanBak.Text = ""
End Sub
Private Sub meScanBak_KeyPress(KeyAscii As Integer)
Dim sBakNR As String
Dim iBakNR As Long
If KeyAscii = 13 Then
sBakNR = meScanBak.Text
If (Len(sBakNR) = 4) And IsNumeric(sBakNR) Then
iBakNR = CLng(sBakNR)
If GeleBak And (iBakNR > 1049) Then
Geluidje (glNeeGELEBak)
meScanBak.Text = ""
meScanBak.SetFocus
ElseIf (iBakNR < 1000) Or (iBakNR > 1450) Then
Geluidje (glOngeldigBakNummer)
meScanBak.Text = ""
meScanBak.SetFocus
Else
'pp5000.BeginTrans
Timer1.Enabled = False
With KoppelBak
.Parameters("rVal").Value = 0
.Parameters("@terminal_id").Value = ""
.Parameters("@i_Ordernr").Value = meScanOrder.Text
.Parameters("@i_HuidigeBak").Value = ""
.Parameters("@i_NieuweBak").Value = sBakNR
.Parameters("@i_HuidigeZone").Value = ""
.Execute , , adExecuteNoRecords
End With
'pp5000.CommitTrans
TelBakken
Timer1.Enabled = True
meScanBak.Text = ""
meScanOrder.Text = ""
meScanOrder.SetFocus
End If
End If
End If
End Sub
Sub connectDB()
Dim iloop As Integer
On Error GoTo CheckConnectError
If (pp5000 Is Nothing) Then
Set pp5000 = New ADODB.Connection
ElseIf (pp5000.State <> adStateClosed) Then
pp5000.Close
End If
pp5000.ConnectionString = ConnStrPP5000
'pp5000.Properties("Multiple Connections") = True
'pp5000.ConnectionString = "Driver={SQL Native Client};Server=LT-KTS\SQLEXPRESS;Database=PP5000-v36;Uid=eks;Pwd=kardex."
pp5000.Open
Set KoppelBak = New ADODB.Command
With KoppelBak
.ActiveConnection = pp5000
.CommandText = "EKS_Koppel_Bak"
.CommandType = adCmdStoredProc
.NamedParameters = False
.Parameters.Append .CreateParameter("rVal", adInteger, adParamReturnValue, 8, 0)
.Parameters.Append .CreateParameter("@terminal_id", adVarChar, adParamInput, 24, "")
.Parameters.Append .CreateParameter("@i_Ordernr", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@i_HuidigeBak", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@i_NieuweBak", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@i_HuidigeZone", adVarChar, adParamInput, 20, "")
End With
Set BakkenPerKleur = New ADODB.Command
With BakkenPerKleur
.ActiveConnection = pp5000
.CommandText = "EKS_BakkenPerKleur"
.CommandType = adCmdStoredProc
.NamedParameters = True
.Parameters.Append .CreateParameter("@o_BlauweBakken", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@o_GeleBakken", adInteger, adParamOutput)
End With
Set PakOrder = New ADODB.Command
With PakOrder
.ActiveConnection = pp5000
.CommandText = "EKS_PakOrder"
.CommandType = adCmdStoredProc
.NamedParameters = True
.Parameters.Append .CreateParameter("@i_AUFTRAG", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@o_FoutCode", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@o_GeleBak", adBoolean, adParamOutput)
End With
ConnectOK = True
Exit Sub
CheckConnectError:
If Not (pp5000 Is Nothing) Then
If (pp5000.Errors.Count > 0) Then
For iloop = 1 To pp5000.Errors.Count
MsgBox "ERROR:" & vbCrLf & _
"Description = " & pp5000.Errors.Item(iloop - 1).Description & vbCrLf & _
"NativeError = " & CStr(pp5000.Errors.Item(iloop - 1).NativeError) & vbCrLf & _
"Number = " & CStr(pp5000.Errors.Item(iloop - 1).Number) & vbCrLf & _
"Source = " & pp5000.Errors.Item(iloop - 1).Source & vbCrLf & _
"SQLState = " & pp5000.Errors.Item(iloop - 1).SQLState, vbCritical, "PP database"
Next iloop
End If
End If
End Sub
Sub disconnectDB()
If Not (pp5000 Is Nothing) Then
If Not (KoppelBak Is Nothing) Then
Set KoppelBak.ActiveConnection = Nothing
Set KoppelBak = Nothing
End If
If Not (BakkenPerKleur Is Nothing) Then
Set BakkenPerKleur.ActiveConnection = Nothing
Set BakkenPerKleur = Nothing
End If
If (pp5000.State = adStateOpen) Then
pp5000.Close
End If
Set pp5000 = Nothing
End If
ConnectOK = False
End Sub
Public Sub GetSettings()
Dim INIresult As Long
Dim INIvalue As String
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Settings", "winTop", "0", INIvalue, 255, INIfile)
If (INIresult > 0) Then
winTop = CInt(Left(INIvalue, INIresult))
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Settings", "winLeft", "0", INIvalue, 255, INIfile)
If (INIresult > 0) Then
winLeft = CInt(Left(INIvalue, INIresult))
End If
' INIvalue = String(255, vbNullChar)
' INIresult = GetPrivateProfileString("Settings", "winHeight", "3600", INIvalue, 255, INIfile)
' If (INIresult > 0) Then
' winHeight = CInt(Left(INIvalue, INIresult))
' End If
'
' INIvalue = String(255, vbNullChar)
' INIresult = GetPrivateProfileString("Settings", "winWidth", "4680", INIvalue, 255, INIfile)
' If (INIresult > 0) Then
' winWidth = CInt(Left(INIvalue, INIresult))
' End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Connection", "ConnStrPP5000", "Driver={SQL Native Client};Server=schuurkx\sqlexpress;Database=PP5000-v36;Uid=eks;Pwd=kardex.", INIvalue, 255, INIfile)
If (INIresult > 0) Then
ConnStrPP5000 = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "BlauweBak", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavBlauweBak = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "GeleBak", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavGeleBak = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "NeeGELEBak", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavNeeGELEBak = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "OrderOnbekend", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavOrderOnbekend = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "NietVoorLegborden", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavNietVoorLegborden = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "OngeldigBakNummer", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavOngeldigBakNummer = Left(INIvalue, INIresult)
End If
End Sub
我希望这能更清楚地说明它是什么和做什么？
该表单上的每个 单个 控件都是一个 PictureBox。如果在加载项目时 VB 无法解析项目文件 (*.vbp) 中的 (COM) 引用，通常会发生这种情况。在这种情况下，VB 会在启动时抛出一条错误消息，并将任何控件替换为 PictureBox 作为占位符。
它还应该在表单所在的文件夹中创建一个名为 frmKoppelBak.log 的文件，以提供更多信息。
我希望你没有保存那个表格的更改（或有备份），否则你会被 PictureBoxes 困住。这 可能 已经发生，因为您在 OS > XP 上以普通用户帐户启动 VB6。尝试启动 VB IDE 'As Administrator'
我已经尝试激活多个资源，但无论我做什么，.Text 方法都没有定义/识别，.Text 在下面的代码行中：
Private Sub Form_Load()
StartDate = Date
meBakBlauw.Text = "-"
meBakGeel.Text = "-"
运行 之后出现的提示说：'Method or Datamember is not found'。
有没有人知道如何解决这个问题？
它是由我们的老程序员编写的，他在其中构建了对扩展资源的限制。它是用 Visual Basic 6 编写的。
完整程序：
VERSION 5.00
Begin VB.Form frmKoppelBak
BackColor = &H80000005&
Caption = "Bakken Koppelen"
ClientHeight = 9285
ClientLeft = 60
ClientTop = 750
ClientWidth = 13590
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 9285
ScaleWidth = 13590
Begin VB.PictureBox meBakGeel
BackColor = &H0000FFFF&
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 6
TabStop = 0 'False
Top = 2280
Width = 6000
End
Begin VB.PictureBox meBakBlauw
BackColor = &H00FF0000&
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 5
TabStop = 0 'False
Top = 600
Width = 6000
End
Begin VB.PictureBox meBlauw
Appearance = 0 'Flat
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Index = 0
Left = 480
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 4
TabStop = 0 'False
Top = 600
Width = 6375
End
Begin VB.PictureBox PVMaskEdit4
Appearance = 0 'Flat
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 495
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 3
TabStop = 0 'False
Top = 7200
Width = 6375
End
Begin VB.PictureBox PVMaskEdit3
Appearance = 0 'Flat
BackColor = &H80000014&
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 480
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 2
TabStop = 0 'False
Top = 5520
Width = 6375
End
Begin VB.PictureBox meScanOrder
CausesValidation= 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 0
Top = 5520
Width = 6000
End
Begin VB.PictureBox meScanBak
BackColor = &H0000FFFF&
CausesValidation= 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 48
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1440
Left = 7080
ScaleHeight = 1380
ScaleWidth = 5940
TabIndex = 1
Top = 7200
Width = 6000
End
Begin VB.PictureBox meBlauw
Appearance = 0 'Flat
Enabled = 0 'False
BeginProperty Font
Name = "Arial Black"
Size = 72
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Index = 1
Left = 480
ScaleHeight = 1425
ScaleWidth = 6345
TabIndex = 7
TabStop = 0 'False
Top = 2280
Width = 6375
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 10000
Left = 255
Top = 75
End
Begin VB.Frame Frame1
BackColor = &H80000005&
Caption = "Koppel Order aan Bak"
Height = 4095
Left = 120
TabIndex = 8
Top = 4920
Width = 13320
End
Begin VB.Menu File
Caption = "&File"
Begin VB.Menu mnuExit
Caption = "&Exit"
End
End
End
Attribute VB_Name = "frmKoppelBak"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_LOOP = &H8
Const SND_NOSTOP = &H10
Const glBlauweBak As Long = 1
Const glGeleBak As Long = 2
Const glNeeGELEBak As Long = 3
Const glOrderOnbekend As Long = 4
Const glNietVoorLegborden As Long = 5
Const glOngeldigBakNummer As Long = 6
Dim INIfile As String
Dim StartDate As Date
Dim ConnectOK As Boolean
Dim ChildHDL As Variant
Dim GeleBak As Boolean
Dim pp5000 As ADODB.Connection
Dim KoppelBak As ADODB.Command
Dim BakkenPerKleur As ADODB.Command
Dim PakOrder As ADODB.Command
Dim ConnStrPP5000 As String
Dim winTop As Integer
Dim winLeft As Integer
Dim winHeight As Integer
Dim winWidth As Integer
Dim wavBlauweBak As String
Dim wavGeleBak As String
Dim wavNeeGELEBak As String
Dim wavNietVoorLegborden As String
Dim wavOrderOnbekend As String
Dim wavOngeldigBakNummer As String
Private Declare Function GetPrivateProfileString _
Lib "kernel32" _
Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString _
Lib "kernel32" _
Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Private Declare Function sndPlaySound _
Lib "winmm.dll" _
Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
Private Sub Form_Load()
StartDate = Date
meBakBlauw.Text = "-"
meBakGeel.Text = "-"
INIfile = App.Path & "\KoppelBak.ini"
GetSettings
ConnectOK = False
connectDB
If Not ConnectOK Then
MsgBox "ERROR: Geen verbinding met de database", vbCritical, "Koppel Bak"
Unload Me
End
End If
Me.Top = winTop
Me.Left = winLeft
TelBakken
Timer1.Enabled = True
End Sub
Private Sub Form_Resize()
If (frmKoppelBak.WindowState <> vbMinimized) Then
If (frmKoppelBak.Width <> 13710) Then
frmKoppelBak.Width = 13710
End If
If (frmKoppelBak.Height <> 10095) Then
frmKoppelBak.Height = 10095
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim INIresult As Long
disconnectDB
If (frmKoppelBak.WindowState <> vbMinimized) Then
INIresult = WritePrivateProfileString("Settings", "winTop", CStr(Me.Top), INIfile)
INIresult = WritePrivateProfileString("Settings", "winLeft", CStr(Me.Left), INIfile)
End If
End Sub
Sub Geluidje(GeluidNR As Long)
Dim SoundName As String
Dim wFlags, playRes As Long
wFlags = SND_ASYNC Or SND_NODEFAULT
SoundName = ""
Select Case GeluidNR
Case glBlauweBak
SoundName = wavBlauweBak
Case glGeleBak
SoundName = wavGeleBak
Case glNeeGELEBak
SoundName = wavNeeGELEBak
Case glOrderOnbekend
SoundName = wavOrderOnbekend
Case glNietVoorLegborden
SoundName = wavNietVoorLegborden
Case glOngeldigBakNummer
SoundName = wavOngeldigBakNummer
Case Else
SoundName = "Windows XP Hardwarefout.wav"
End Select
If (SoundName <> "") Then
playRes = sndPlaySound(SoundName, wFlags)
End If
End Sub
Private Sub mnuExit_Click()
Unload frmKoppelBak
End Sub
Private Sub Timer1_Timer()
Dim INIresult As Long
Timer1.Enabled = False
If (Timer > 18000) Then '05:00
If Not ConnectOK Then
connectDB
End If
TelBakken
Else
If ConnectOK Then
disconnectDB
End If
If (StartDate < Date) Then 'nieuwe instance starten en zelf stoppen i.v.m memory leaks
If (frmKoppelBak.WindowState <> vbMinimized) Then
INIresult = WritePrivateProfileString("Settings", "winTop", CStr(Me.Top), INIfile)
INIresult = WritePrivateProfileString("Settings", "winLeft", CStr(Me.Left), INIfile)
End If
ChildHDL = Shell(App.Path & "\" & App.EXEName, vbNormalNoFocus)
If ChildHDL <> 0 Then
Unload frmKoppelBak
End
End If
End If
End If
Timer1.Enabled = True
End Sub
Private Sub TelBakken()
meBakBlauw.Text = "-"
meBakGeel.Text = "-"
BakkenPerKleur.Execute , , adExecuteNoRecords
meBakBlauw.Text = CStr(BakkenPerKleur.Parameters("@o_BlauweBakken").Value)
meBakGeel.Text = CStr(BakkenPerKleur.Parameters("@o_GeleBakken").Value)
End Sub
Private Sub meScanOrder_GotFocusEvent()
meScanOrder.Text = ""
End Sub
Private Sub meScanOrder_KeyPress(KeyAscii As Integer)
Dim FoutCode As Long
If KeyAscii = 13 Then
' Zoek de order en bepaal de bakkleur
meScanBak.Text = ""
Timer1.Enabled = False
PakOrder.Parameters("@i_AUFTRAG").Value = meScanOrder.Text
PakOrder.Execute , , adExecuteNoRecords
Timer1.Enabled = True
FoutCode = PakOrder.Parameters("@o_FoutCode").Value
GeleBak = PakOrder.Parameters("@o_GeleBak").Value
'MsgBox CStr(FoutCode) & "; " & CStr(GeleBak)
If (FoutCode = 0) Then
If GeleBak Then
meScanBak.ForeColor = &H0&
meScanBak.BackColor = &HFFFF&
Call Geluidje(glGeleBak)
Else
meScanBak.ForeColor = &HFFFFFF
meScanBak.BackColor = &HFF0000
Call Geluidje(glBlauweBak)
End If
' Nu naar het baknummer
meScanBak.SetFocus
Else
If (FoutCode = 1) Then
Call Geluidje(glOrderOnbekend)
Else
Call Geluidje(glNietVoorLegborden)
End If
meScanOrder.Text = ""
meScanOrder.SetFocus
End If
End If
End Sub
Private Sub meScanBak_GotFocusEvent()
meScanBak.Text = ""
End Sub
Private Sub meScanBak_KeyPress(KeyAscii As Integer)
Dim sBakNR As String
Dim iBakNR As Long
If KeyAscii = 13 Then
sBakNR = meScanBak.Text
If (Len(sBakNR) = 4) And IsNumeric(sBakNR) Then
iBakNR = CLng(sBakNR)
If GeleBak And (iBakNR > 1049) Then
Geluidje (glNeeGELEBak)
meScanBak.Text = ""
meScanBak.SetFocus
ElseIf (iBakNR < 1000) Or (iBakNR > 1450) Then
Geluidje (glOngeldigBakNummer)
meScanBak.Text = ""
meScanBak.SetFocus
Else
'pp5000.BeginTrans
Timer1.Enabled = False
With KoppelBak
.Parameters("rVal").Value = 0
.Parameters("@terminal_id").Value = ""
.Parameters("@i_Ordernr").Value = meScanOrder.Text
.Parameters("@i_HuidigeBak").Value = ""
.Parameters("@i_NieuweBak").Value = sBakNR
.Parameters("@i_HuidigeZone").Value = ""
.Execute , , adExecuteNoRecords
End With
'pp5000.CommitTrans
TelBakken
Timer1.Enabled = True
meScanBak.Text = ""
meScanOrder.Text = ""
meScanOrder.SetFocus
End If
End If
End If
End Sub
Sub connectDB()
Dim iloop As Integer
On Error GoTo CheckConnectError
If (pp5000 Is Nothing) Then
Set pp5000 = New ADODB.Connection
ElseIf (pp5000.State <> adStateClosed) Then
pp5000.Close
End If
pp5000.ConnectionString = ConnStrPP5000
'pp5000.Properties("Multiple Connections") = True
'pp5000.ConnectionString = "Driver={SQL Native Client};Server=LT-KTS\SQLEXPRESS;Database=PP5000-v36;Uid=eks;Pwd=kardex."
pp5000.Open
Set KoppelBak = New ADODB.Command
With KoppelBak
.ActiveConnection = pp5000
.CommandText = "EKS_Koppel_Bak"
.CommandType = adCmdStoredProc
.NamedParameters = False
.Parameters.Append .CreateParameter("rVal", adInteger, adParamReturnValue, 8, 0)
.Parameters.Append .CreateParameter("@terminal_id", adVarChar, adParamInput, 24, "")
.Parameters.Append .CreateParameter("@i_Ordernr", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@i_HuidigeBak", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@i_NieuweBak", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@i_HuidigeZone", adVarChar, adParamInput, 20, "")
End With
Set BakkenPerKleur = New ADODB.Command
With BakkenPerKleur
.ActiveConnection = pp5000
.CommandText = "EKS_BakkenPerKleur"
.CommandType = adCmdStoredProc
.NamedParameters = True
.Parameters.Append .CreateParameter("@o_BlauweBakken", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@o_GeleBakken", adInteger, adParamOutput)
End With
Set PakOrder = New ADODB.Command
With PakOrder
.ActiveConnection = pp5000
.CommandText = "EKS_PakOrder"
.CommandType = adCmdStoredProc
.NamedParameters = True
.Parameters.Append .CreateParameter("@i_AUFTRAG", adVarChar, adParamInput, 20, "")
.Parameters.Append .CreateParameter("@o_FoutCode", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("@o_GeleBak", adBoolean, adParamOutput)
End With
ConnectOK = True
Exit Sub
CheckConnectError:
If Not (pp5000 Is Nothing) Then
If (pp5000.Errors.Count > 0) Then
For iloop = 1 To pp5000.Errors.Count
MsgBox "ERROR:" & vbCrLf & _
"Description = " & pp5000.Errors.Item(iloop - 1).Description & vbCrLf & _
"NativeError = " & CStr(pp5000.Errors.Item(iloop - 1).NativeError) & vbCrLf & _
"Number = " & CStr(pp5000.Errors.Item(iloop - 1).Number) & vbCrLf & _
"Source = " & pp5000.Errors.Item(iloop - 1).Source & vbCrLf & _
"SQLState = " & pp5000.Errors.Item(iloop - 1).SQLState, vbCritical, "PP database"
Next iloop
End If
End If
End Sub
Sub disconnectDB()
If Not (pp5000 Is Nothing) Then
If Not (KoppelBak Is Nothing) Then
Set KoppelBak.ActiveConnection = Nothing
Set KoppelBak = Nothing
End If
If Not (BakkenPerKleur Is Nothing) Then
Set BakkenPerKleur.ActiveConnection = Nothing
Set BakkenPerKleur = Nothing
End If
If (pp5000.State = adStateOpen) Then
pp5000.Close
End If
Set pp5000 = Nothing
End If
ConnectOK = False
End Sub
Public Sub GetSettings()
Dim INIresult As Long
Dim INIvalue As String
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Settings", "winTop", "0", INIvalue, 255, INIfile)
If (INIresult > 0) Then
winTop = CInt(Left(INIvalue, INIresult))
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Settings", "winLeft", "0", INIvalue, 255, INIfile)
If (INIresult > 0) Then
winLeft = CInt(Left(INIvalue, INIresult))
End If
' INIvalue = String(255, vbNullChar)
' INIresult = GetPrivateProfileString("Settings", "winHeight", "3600", INIvalue, 255, INIfile)
' If (INIresult > 0) Then
' winHeight = CInt(Left(INIvalue, INIresult))
' End If
'
' INIvalue = String(255, vbNullChar)
' INIresult = GetPrivateProfileString("Settings", "winWidth", "4680", INIvalue, 255, INIfile)
' If (INIresult > 0) Then
' winWidth = CInt(Left(INIvalue, INIresult))
' End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Connection", "ConnStrPP5000", "Driver={SQL Native Client};Server=schuurkx\sqlexpress;Database=PP5000-v36;Uid=eks;Pwd=kardex.", INIvalue, 255, INIfile)
If (INIresult > 0) Then
ConnStrPP5000 = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "BlauweBak", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavBlauweBak = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "GeleBak", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavGeleBak = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "NeeGELEBak", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavNeeGELEBak = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "OrderOnbekend", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavOrderOnbekend = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "NietVoorLegborden", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavNietVoorLegborden = Left(INIvalue, INIresult)
End If
INIvalue = String(255, vbNullChar)
INIresult = GetPrivateProfileString("Geluiden", "OngeldigBakNummer", "", INIvalue, 255, INIfile)
If (INIresult > 0) Then
wavOngeldigBakNummer = Left(INIvalue, INIresult)
End If
End Sub
我希望这能更清楚地说明它是什么和做什么？
该表单上的每个 单个 控件都是一个 PictureBox。如果在加载项目时 VB 无法解析项目文件 (*.vbp) 中的 (COM) 引用，通常会发生这种情况。在这种情况下，VB 会在启动时抛出一条错误消息，并将任何控件替换为 PictureBox 作为占位符。
它还应该在表单所在的文件夹中创建一个名为 frmKoppelBak.log 的文件，以提供更多信息。
我希望你没有保存那个表格的更改（或有备份），否则你会被 PictureBoxes 困住。这 可能 已经发生，因为您在 OS > XP 上以普通用户帐户启动 VB6。尝试启动 VB IDE 'As Administrator'