📄 frmdcd.frm
字号:
VERSION 5.00
Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; "SS32X25.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmDcd
Caption = "Driver Canlendar Master Maintenance"
ClientHeight = 6465
ClientLeft = 60
ClientTop = 345
ClientWidth = 9555
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6465
ScaleWidth = 9555
WindowState = 2 'Maximized
Begin PrjLDS.UserControl1 UserControl1
Height = 615
Left = 0
TabIndex = 9
Top = 0
Width = 9675
_ExtentX = 17066
_ExtentY = 1085
End
Begin VB.Frame frminput
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2295
Left = 120
TabIndex = 0
Top = 3960
Width = 9015
Begin VB.ComboBox cmbcode
Height = 300
Left = 5040
Style = 2 'Dropdown List
TabIndex = 3
Top = 360
Width = 1455
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 300
Left = 5040
TabIndex = 5
Top = 960
Width = 1455
_ExtentX = 2566
_ExtentY = 529
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 24772609
CurrentDate = 37132
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 300
Left = 1800
TabIndex = 4
Top = 960
Width = 1575
_ExtentX = 2778
_ExtentY = 529
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 24772609
CurrentDate = 37132
End
Begin VB.ComboBox cmbstatus
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 1800
Style = 2 'Dropdown List
TabIndex = 6
Top = 1650
Width = 2655
End
Begin VB.TextBox txtentc
Height = 285
Left = 1800
MaxLength = 5
TabIndex = 2
Top = 360
Width = 735
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "End Date:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3840
TabIndex = 13
Top = 960
Width = 1095
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "Begin Date:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 12
Top = 960
Width = 1215
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "Active status:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 8
Top = 1695
Width = 1575
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "Driver Code:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3600
TabIndex = 7
Top = 360
Width = 1335
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Entity Code:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 1
Top = 390
Width = 1335
End
End
Begin FPSpread.vaSpread vasdcd
Height = 3075
Left = 120
TabIndex = 10
Top = 720
Width = 9000
_Version = 131077
_ExtentX = 15875
_ExtentY = 5424
_StockProps = 64
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaxCols = 1
MaxRows = 1
SpreadDesigner = "frmDcd.frx":0000
End
Begin VB.Label lblstatus
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 7680
TabIndex = 11
Top = 3000
Width = 975
End
End
Attribute VB_Name = "frmDcd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const iniCode = "100001"
Private mkey As String
Private lCurRow As Long '当前SPD的行
Private lCurCol As Long '当前SPD的列
Private Enum enuDetailCols
Entcode = 1
drvcode
Astatus
begdate
enddate
ID
MaxCols = ID '总的列数
End Enum
Private Sub cmbcode_LostFocus()
'Dim Entcode, drvcode As String
'Dim rstdcd As Recordset
'Dim sSQL As String
'Dim i As Long
' If lblstatus.Caption = "search" Then
' For i = 1 To vasdcd.MaxRows
' drvcode = GetValue(vasdcd, i, 2)
' If drvcode = cmbcode.Text Then
' Call vasdcd_Click(1, i)
' Exit Sub
' Else
' End If
' Next
' MsgBox "There haven't this record!", vbOKOnly, "Information"
' txtentc.Text = gsEntCode
' cmbcode.ListIndex = 0
' cmbstatus.ListIndex = 0
' cmbcode.SetFocus
' End If
' If cmbcode.Text = "" Then
' ElseIf lblstatus.Caption = "search" Then
' Entcode = txtentc.Text
' drvcode = cmbcode.Text
' sSQL = "select * from appdcd where entcode = '" & Entcode & "' and drvcode = '" & drvcode & "'"
' Set rstdcd = Acs_cnt.Execute(sSQL)
' If Not rstdcd.EOF Then
' txtentc.Text = gsEntCode
' cmbcode.Text = rstdcd!drvcode
' cmbstatus.Text = "" & rstdcd!Astatus
' DTPicker1.Value = Mid(rstdcd!begdate, 1, 4) & "-" & Mid(rstdcd!begdate, 5, 2) & "-" & Mid(rstdcd!begdate, 7, 2)
' DTPicker2.Value = Mid(rstdcd!enddate, 1, 4) & "-" & Mid(rstdcd!enddate, 5, 2) & "-" & Mid(rstdcd!enddate, 7, 2)
' Else
' MsgBox "There haven't this record !"
' txtentc.Text = gsEntCode
' cmbcode.Text = ""
' cmbstatus.Text = ""
'
' End If
' rstdcd.Close
' Set rstdcd = Nothing
' Else
'
' End If
End Sub
Private Sub cmbstatus_KeyUp(KeyCode As Integer, Shift As Integer)
'If KeyCode = vbKeyReturn Then
' If cmbstatus.Text = "" Then
' Else
' SendKeys "{tab}"
' End If
' End If
End Sub
Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
Private Sub DTPicker2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
Private Sub DTPicker2_LostFocus()
Dim drvcode As String
Dim i As Long
Dim date1, date2 As Long
If lblstatus.Caption = "search" Then
For i = 1 To vasdcd.MaxRows
drvcode = GetValue(vasdcd, i, 2)
date1 = GetValue(vasdcd, i, 4)
date2 = GetValue(vasdcd, i, 5)
If drvcode = getstr(cmbcode.Text, "/") And date1 = ChangeDate(DTPicker1.Value) And date2 = ChangeDate(DTPicker2.Value) Then
Call vasdcd_Click(1, i)
Exit Sub
Else
End If
Next
MsgBox "There haven't this record!", vbOKOnly, "Information"
txtentc.Text = gsEntCode
cmbcode.ListIndex = 0
cmbstatus.ListIndex = 0
cmbcode.SetFocus
End If
End Sub
Private Sub Form_Load()
vasdcd.Width = SpreadW
vasdcd.Height = SpreadH
lCurRow = 1
lCurCol = 1
Call InitToolBar
Call IniSpread
Call initcombobox
Call vasshow
frminput.Enabled = False
End Sub
Private Sub initcombobox()
Dim sSQL As String
Dim rstdcd As Recordset
Dim sdesc As String
Dim i As Long
sSQL = "select * from sysrea "
Set rstdcd = Acs_cnt.Execute(sSQL)
Do While Not rstdcd.EOF
sdesc = rstdcd!reacode & "/" & rstdcd!readesc
cmbstatus.AddItem (sdesc)
rstdcd.MoveNext
Loop
i = 0
sSQL = "select drvcode,drvname from appdrv where availab = " & 1
Set rstdcd = Acs_cnt.Execute(sSQL)
Do While Not rstdcd.EOF
cmbcode.AddItem (rstdcd!drvcode & "/" & rstdcd!drvname)
rstdcd.MoveNext
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -