📄 frmtrs.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 frmtcd
Caption = "Truck Calendar Master Maintenance"
ClientHeight = 6465
ClientLeft = 60
ClientTop = 345
ClientWidth = 9270
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 = 9270
WindowState = 2 'Maximized
Begin VB.Frame frminput
Height = 2415
Left = 120
TabIndex = 2
Top = 3360
Width = 7935
Begin VB.TextBox txtcost
Height = 270
Left = 5640
TabIndex = 15
Top = 1680
Width = 1335
End
Begin VB.ComboBox cmbcode
Height = 300
Left = 5640
Style = 2 'Dropdown List
TabIndex = 9
Top = 480
Width = 1335
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 345
Left = 1800
TabIndex = 10
Top = 1042
Width = 1335
_ExtentX = 2355
_ExtentY = 609
_Version = 393216
Format = 24576001
CurrentDate = 37133
End
Begin VB.ComboBox cmbstatus
Height = 300
Left = 1800
Style = 2 'Dropdown List
TabIndex = 12
Top = 1680
Width = 2535
End
Begin VB.TextBox txtentc
Height = 270
Left = 1800
TabIndex = 8
Top = 480
Width = 855
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 375
Left = 5640
TabIndex = 11
Top = 1080
Width = 1335
_ExtentX = 2355
_ExtentY = 661
_Version = 393216
Format = 24576001
CurrentDate = 37133
End
Begin VB.Label Label6
Caption = "Cost："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5040
TabIndex = 14
Top = 1680
Width = 495
End
Begin VB.Label Label5
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 = 7
Top = 1680
Width = 1575
End
Begin VB.Label Label4
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 = 4560
TabIndex = 6
Top = 1080
Width = 975
End
Begin VB.Label Label3
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 = 5
Top = 1080
Width = 1215
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "Truck Code:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4320
TabIndex = 4
Top = 480
Width = 1215
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 = 3
Top = 480
Width = 1335
End
End
Begin PrjLDS.UserControl1 UserControl1
Height = 615
Left = 0
TabIndex = 1
Top = 0
Width = 9390
_ExtentX = 16563
_ExtentY = 1085
End
Begin FPSpread.vaSpread vastrs
Height = 2535
Left = 120
TabIndex = 0
Top = 720
Width = 7935
_Version = 131077
_ExtentX = 13996
_ExtentY = 4471
_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 = "frmtrs.frx":0000
End
Begin VB.Label lblstatus
Height = 255
Left = 6600
TabIndex = 13
Top = 3480
Width = 735
End
End
Attribute VB_Name = "frmtcd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mkey As String
Dim lCurRow As Integer
Dim lCurCol As Integer
Private Sub cmbcode_LostFocus()
'Dim truckno As String
'Dim i As Long
' If lblstatus.Caption = "search" Then
' For i = 1 To vastrs.MaxRows
' truckno = GetValue(vastrs, i, 2)
' If truckno = cmbcode.Text Then
' Call vastrs_Click(1, i)
' Exit Sub
' End If
' Next
' MsgBox "There haven't this record!", vbOKOnly, "Information"
' txtentc.Text = gsEntCode
' cmbcode.ListIndex = 0
' cmbstatus.ListIndex = 0
' txtcost.Text = ""
' cmbcode.SetFocus
' End If
'
' If cmbcode.Text = "" Then
' ElseIf lblstatus.Caption = "search" Then
' Entcode = txtentc.Text
' truckno = cmbcode.Text
' sSQl = "select * from apptrs where entcode = '" & Entcode & "' and truckno = '" & truckno & "'"
' Set rsttrs = Acs_cnt.Execute(sSQl)
' If Not rsttrs.EOF Then
' txtentc.Text = gsEntCode
' cmbcode.Text = rsttrs!truckno
' cmbstatus.Text = "" & rsttrs!Astatus
' DTPicker1.Value = Mid(rsttrs!begdate, 1, 4) & "-" & Mid(rsttrs!begdate, 5, 2) & "-" & Mid(rsttrs!begdate, 7, 2)
' DTPicker2.Value = Mid(rsttrs!enddate, 1, 4) & "-" & Mid(rsttrs!enddate, 5, 2) & "-" & Mid(rsttrs!enddate, 7, 2)
' txtcost.Text = rsttrs!feecost
' Else
' MsgBox "There haven't this record !"
' txtentc.Text = gsEntCode
' cmbcode.Text = ""
' cmbstatus.Text = ""
' txtcost.Text = ""
' End If
' rsttrs.Close
' Set rsttrs = Nothing
' Else
'
' 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 truckno As String
Dim i As Long
Dim date1, date2 As Long
If lblstatus.Caption = "search" Then
For i = 1 To vastrs.MaxRows
truckno = GetValue(vastrs, i, 2)
date1 = GetValue(vastrs, i, 4)
date2 = GetValue(vastrs, i, 5)
If truckno = cmbcode.Text And date1 = ChangeDate(DTPicker1.Value) And date2 = ChangeDate(DTPicker2.Value) Then
Call vastrs_Click(1, i)
Exit Sub
End If
Next
MsgBox "There haven't this record!", vbOKOnly, "Information"
txtentc.Text = gsEntCode
cmbcode.ListIndex = 0
cmbstatus.ListIndex = 0
txtcost.Text = ""
cmbcode.SetFocus
End If
End Sub
Private Sub Form_Load()
lCurRow = 1
lCurCol = 1
Call initspread
Call InitToolBar
Call initcombobox
Call vasshow
frminput.Enabled = False
End Sub
Private Sub initspread()
With vastrs
.MaxRows = 0
.MaxCols = 7 'enuDetailCols.MaxCols
.ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
.Row = -1: .Col = -1
.BackColor = genuBACKCOLOR.CST_Grid_LostFocus
.GridColor = vbBlack
End With
Call SetSpreadHead
lockspread vastrs, True
End Sub
Private Sub SetSpreadHead()
SetColHead vastrs, 1, "Entity Code", 10
SetColHead vastrs, 2, "Truck Code", 10
SetColHead vastrs, 3, "Status", 10
SetColHead vastrs, 4, "Begin Date", 10
SetColHead vastrs, 5, "End Date", 15
SetColHead vastrs, 6, "Cost", 10
SetColHead vastrs, 7, "ID", 0, True
End Sub
Private Sub InitToolBar()
With UserControl1
.DisplayButton "New", "New", True, , "New"
.DisplayButton "Save", "Save", False, , "Save"
.DisplayButton "Cancel", "Cancel", False, , "Cancel"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -