📄 htdj.frm
字号:
Width = 855
End
Begin VB.CommandButton Command3
Caption = "全部冻结"
Height = 375
Left = 240
TabIndex = 5
Top = 960
Width = 855
End
Begin VB.CommandButton Command1
Caption = "选定冻结"
Height = 375
Left = 240
TabIndex = 4
Top = 360
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "合同列表"
Height = 5535
Index = 0
Left = 2640
TabIndex = 1
Top = 1680
Width = 2295
Begin VB.ListBox List1
Height = 4680
Left = 240
Style = 1 'Checkbox
TabIndex = 2
Top = 240
Width = 1815
End
End
Begin VB.Frame Frame1
Caption = "选择查询条件"
Height = 5775
Index = 0
Left = 0
TabIndex = 0
Top = 1680
Width = 6375
Begin TabDlg.SSTab SSTab2
Height = 5415
Left = 120
TabIndex = 39
Top = 240
Width = 2325
_ExtentX = 4101
_ExtentY = 9551
_Version = 393216
Tabs = 2
Tab = 1
TabsPerRow = 2
TabHeight = 520
BackColor = 16777215
TabCaption(0) = "按时间索引 "
TabPicture(0) = "htdj.frx":5881
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "Label4"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "Label5"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).Control(2)= "Combo2"
Tab(0).Control(2).Enabled= 0 'False
Tab(0).Control(3)= "Text2"
Tab(0).Control(3).Enabled= 0 'False
Tab(0).Control(4)= "DTPicker3"
Tab(0).Control(4).Enabled= 0 'False
Tab(0).Control(5)= "Command8"
Tab(0).Control(5).Enabled= 0 'False
Tab(0).ControlCount= 6
TabCaption(1) = "按单价索引"
TabPicture(1) = "htdj.frx":589D
Tab(1).ControlEnabled= -1 'True
Tab(1).Control(0)= "Label7"
Tab(1).Control(0).Enabled= 0 'False
Tab(1).Control(1)= "Label8"
Tab(1).Control(1).Enabled= 0 'False
Tab(1).Control(2)= "Combo3"
Tab(1).Control(2).Enabled= 0 'False
Tab(1).Control(3)= "Text4"
Tab(1).Control(3).Enabled= 0 'False
Tab(1).Control(4)= "Command9"
Tab(1).Control(4).Enabled= 0 'False
Tab(1).Control(5)= "Combo1"
Tab(1).Control(5).Enabled= 0 'False
Tab(1).Control(6)= "Text1"
Tab(1).Control(6).Enabled= 0 'False
Tab(1).ControlCount= 7
Begin VB.TextBox Text1
Height = 290
Left = 1200
TabIndex = 52
Text = "0"
Top = 1680
Width = 735
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "htdj.frx":58B9
Left = 360
List = "htdj.frx":58CC
TabIndex = 51
Text = "="
Top = 1680
Width = 735
End
Begin VB.CommandButton Command9
Caption = "确定"
Height = 255
Left = 600
TabIndex = 50
Top = 2520
Width = 1095
End
Begin VB.TextBox Text4
Height = 290
Left = 1200
TabIndex = 48
Text = "0"
Top = 960
Width = 735
End
Begin VB.ComboBox Combo3
Height = 300
ItemData = "htdj.frx":58E1
Left = 360
List = "htdj.frx":58F4
TabIndex = 47
Text = "="
Top = 960
Width = 735
End
Begin VB.CommandButton Command8
Caption = "确定"
Height = 255
Left = -74400
TabIndex = 45
Top = 2640
Width = 975
End
Begin MSComCtl2.DTPicker DTPicker3
Height = 255
Left = -74640
TabIndex = 44
Top = 1800
Width = 1575
_ExtentX = 2778
_ExtentY = 450
_Version = 393216
Format = 24772609
CurrentDate = 38027
End
Begin VB.TextBox Text2
Height = 290
Left = -73800
TabIndex = 42
Top = 960
Width = 735
End
Begin VB.ComboBox Combo2
Height = 300
ItemData = "htdj.frx":5909
Left = -74640
List = "htdj.frx":591C
TabIndex = 41
Text = "="
Top = 960
Width = 735
End
Begin VB.Label Label8
Caption = "价格条件："
Height = 255
Left = 360
TabIndex = 49
Top = 1440
Width = 1215
End
Begin VB.Label Label7
Caption = "结存量："
Height = 255
Left = 360
TabIndex = 46
Top = 600
Width = 1335
End
Begin VB.Label Label5
Caption = "截止时间："
Height = 255
Left = -74640
TabIndex = 43
Top = 1560
Width = 1215
End
Begin VB.Label Label4
Caption = "结存量："
Height = 255
Left = -74760
TabIndex = 40
Top = 600
Width = 1335
End
End
End
End
Attribute VB_Name = "htdj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim jl_sqlwfl As String
Private Sub Command2_Click()
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
jl_sqlwfl = "wfl" & Me.Combo1.Text & Val(Text3.Text)
List1.Clear
Adodc1.RecordSource = "select hth from htk where " & jl_sqlwfl & " order by hth"
Adodc1.Refresh
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
List1.AddItem Adodc1.Recordset.Fields(0)
Adodc1.Recordset.MoveNext
Next ii
End If
End Sub
Private Sub Command3_Click()
Dim listcount As Integer
Dim sqlstr As String
sqlstr = ""
listcount = Me.List1.listcount
For ii = 0 To listcount - 1
List1.Selected(ii) = True
'sqlstr = "'" & List1.List(ii) & "'," & sqlstr
Next ii
End Sub
Private Sub Command4_Click()
Dim listcount As Integer
Dim sqlstr As String
sqlstr = ""
listcount = Me.List1.listcount
For ii = 0 To listcount - 1
List1.Selected(ii) = False
'sqlstr = "'" & List1.List(ii) & "'," & sqlstr
Next ii
End Sub
Private Sub Command7_Click()
Dim listcount As Integer
Dim sqlstr As String
sqlstr = ""
listcount = Me.List1.listcount
For ii = 0 To listcount - 1
If List1.Selected(ii) = True Then
sqlstr = "'" & List1.List(ii) & "'," & sqlstr
End If
Next ii
ll.datPrimaryRS.Refresh
ll.Show
End Sub
Private Sub Command8_Click()
Dim sqlstrl As String
List1.Clear
sqlstrl = "htk.wfl" & Me.Combo2.Text & Val(Me.Text2.Text) & " and htk.sj>'" & Format(Me.DTPicker3.Value, "yyyy-mm-dd") & "'"
Adodc1.RecordSource = "select DISTINCT hth from htk where " & sqlstrl & " order by hth"
Adodc1.Refresh
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
'If Adodc1.Recordset.Fields(0)> Null Then
List1.AddItem Adodc1.Recordset.Fields(0)
'End If
Adodc1.Recordset.MoveNext
Next ii
End If
End Sub
Private Sub Command9_Click()
Dim sqlstrl As String
sqlstrl = "htk.wfl" & Me.Combo2.Text & Val(Me.Text2.Text) & " and htk.dj" & Me.Combo3.Text & Val(Me.Text4.Text)
Adodc1.RecordSource = "select DISTINCT hth from htk where " & sqlstrl & " order by hth"
Adodc1.Refresh
List1.Clear
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
'If Adodc1.Recordset.Fields(0)> Null Then
List1.AddItem Adodc1.Recordset.Fields(0)
'End If
Adodc1.Recordset.MoveNext
Next ii
End If
End Sub
Private Sub Form_Load()
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
jl_sqlwfl = "wfl>0"
Adodc1.ConnectionString = connetstr
Me.datPrimaryRS.ConnectionString = connetstr
Adodc1.RecordSource = "select DISTINCT fhr from htk where " & jl_sqlwfl & " and fhr is not null order by fhr"
Adodc1.Refresh
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
'If Adodc1.Recordset.Fields(0)> Null Then
'End If
Adodc1.Recordset.MoveNext
Next ii
End If
End Sub
Private Sub List1_Click()
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
Dim hhth As String
hhth = List1.List(List1.ListIndex)
Me.datPrimaryRS.RecordSource = "select * from htk where " & jl_sqlwfl & " and hth like '%" & Trim(hhth) & "%'"
Me.datPrimaryRS.Refresh
Me.Command7.Enabled = True
End Sub
Private Sub List2_Click()
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
Dim fhrr As String
fhrr = List2.List(List2.ListIndex)
List1.Clear
Adodc1.RecordSource = "select hth,djj,fhr from htk where " & jl_sqlwfl & " and fhr like'%" & Trim(fhrr) & "%' order by hth"
Adodc1.Refresh
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
List1.AddItem Adodc1.Recordset.Fields(0)
If Adodc1.Recordset.Fields(1) = -1 Then
List1.Selected(ii - 1) = True
End If
Adodc1.Recordset.MoveNext
Next ii
End If
End Sub
Private Sub SSTab1_DblClick()
End Sub
Private Sub Text1_Change()
If KeyAscii = 13 Then
Dim dar As String
dar = Text1.Text
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
Dim fhrr As String
List1.Clear
Adodc1.RecordSource = "select hth,djj fhr from htk where hth like '%" & dar & "%' order by hth"
Adodc1.Refresh
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
List1.AddItem Adodc1.Recordset.Fields(0)
Adodc1.Recordset.MoveNext
Next ii
End If
End If
End Sub
'##################################################################
'## 过程名称：Text2_Change
'## 参数： 无
'##################################################################
Private Sub DTPicker2_Change()
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
List1.Clear
datPrimaryRS.RecordSource = "select hth from htk where wfl>0 and sj>='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and sj <= '" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'and je>0 order by hth"
datPrimaryRS.Refresh
recc = datPrimaryRS.Recordset.RecordCount
If recc > 1 Then
datPrimaryRS.Recordset.MoveFirst
For ii = 1 To recc
List1.AddItem datPrimaryRS.Recordset.Fields(0)
datPrimaryRS.Recordset.MoveNext
Next ii
End If
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim dar As String
dar = Text1.Text
'On Error Resume Next
Dim recc As Integer
Dim ii As Integer
Dim fhrr As String
List1.Clear
Adodc1.RecordSource = "select hth,djj fhr from htk where hth l='" & dar & "'"
Adodc1.Refresh
recc = Adodc1.Recordset.RecordCount
If recc > 1 Then
Adodc1.Recordset.MoveFirst
For ii = 1 To recc
List1.AddItem Adodc1.Recordset.Fields(0)
If Adodc1.Recordset.Fields(1) = -1 Then
List1.Selected(ii) = True
End If
Adodc1.Recordset.MoveNext
Next ii
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -