📄 htjd.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form htjd
Caption = "合同解冻"
ClientHeight = 9255
ClientLeft = 60
ClientTop = 600
ClientWidth = 11880
Icon = "htjd.frx":0000
LinkTopic = "Form4"
MDIChild = -1 'True
Picture = "htjd.frx":0442
ScaleHeight = 9255
ScaleWidth = 11880
WindowState = 2 'Maximized
Begin VB.CommandButton Command4
BackColor = &H8000000A&
Caption = "关闭"
Height = 375
Left = 7560
Style = 1 'Graphical
TabIndex = 22
Top = 4800
Width = 855
End
Begin MSAdodcLib.Adodc datPrimaryRS
Height = 330
Left = 4200
Top = 8160
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=dzqch"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "dzqch"
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "select hth,fhdw,htl,yfl,wfl,hwm,fhr from htk"
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 5880
Top = 8160
Visible = 0 'False
Width = 1935
_ExtentX = 3413
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=dzqch"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "dzqch"
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "select hth from htk where djj=-1 and hth<>''"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
Caption = "提示"
Height = 5055
Index = 1
Left = 120
TabIndex = 6
Top = 1320
Width = 4215
Begin VB.TextBox txtFields
DataField = "hth"
DataSource = "datPrimaryRS"
Height = 285
Index = 0
Left = 1920
TabIndex = 13
Top = 947
Width = 2000
End
Begin VB.TextBox txtFields
DataField = "htl"
DataSource = "datPrimaryRS"
Height = 285
Index = 1
Left = 1920
TabIndex = 12
Top = 1294
Width = 2000
End
Begin VB.TextBox txtFields
DataField = "yfl"
DataSource = "datPrimaryRS"
Height = 285
Index = 2
Left = 1920
TabIndex = 11
Top = 1641
Width = 2000
End
Begin VB.TextBox txtFields
DataField = "wfl"
DataSource = "datPrimaryRS"
Height = 285
Index = 3
Left = 1920
TabIndex = 10
Top = 1988
Width = 2000
End
Begin VB.TextBox txtFields
DataField = "hwm"
DataSource = "datPrimaryRS"
Height = 285
Index = 4
Left = 1920
TabIndex = 9
Top = 2335
Width = 2000
End
Begin VB.TextBox txtFields
DataField = "fhr"
DataSource = "datPrimaryRS"
Height = 285
Index = 5
Left = 1920
TabIndex = 8
Top = 2685
Width = 2000
End
Begin VB.TextBox txtFields
DataField = "fhdw"
DataSource = "datPrimaryRS"
Height = 285
Index = 6
Left = 1920
TabIndex = 7
Top = 600
Width = 2000
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "票 号:"
Height = 255
Index = 0
Left = 360
TabIndex = 20
Top = 947
Width = 1200
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "合同量:"
Height = 255
Index = 1
Left = 360
TabIndex = 19
Top = 1294
Width = 1200
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "已发量:"
Height = 255
Index = 2
Left = 360
TabIndex = 18
Top = 1641
Width = 1200
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "欠存量:"
Height = 255
Index = 3
Left = 360
TabIndex = 17
Top = 1988
Width = 1200
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "媒 种:"
Height = 255
Index = 4
Left = 360
TabIndex = 16
Top = 2335
Width = 1200
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "提货人:"
Height = 255
Index = 5
Left = 360
TabIndex = 15
Top = 2685
Width = 1200
End
Begin VB.Label lblLabels
Alignment = 1 'Right Justify
Caption = "提货单位:"
Height = 255
Index = 6
Left = 360
TabIndex = 14
Top = 600
Width = 1200
End
End
Begin VB.CommandButton Command3
BackColor = &H00C0C0C0&
Caption = "解冻"
Height = 375
Left = 7560
Style = 1 'Graphical
TabIndex = 5
Top = 4200
Width = 855
End
Begin VB.CommandButton Command2
DisabledPicture = "htjd.frx":333E
DownPicture = "htjd.frx":4258
Height = 375
Left = 7560
Picture = "htjd.frx":5172
Style = 1 'Graphical
TabIndex = 4
Top = 3240
Width = 855
End
Begin VB.Frame Frame2
BackColor = &H00C0C0C0&
Caption = "欲冻结合同列表"
Height = 5055
Left = 8640
TabIndex = 2
Top = 1320
Width = 3135
Begin VB.ListBox List2
Height = 4260
Left = 240
Sorted = -1 'True
Style = 1 'Checkbox
TabIndex = 3
Top = 240
Width = 2775
End
End
Begin VB.CommandButton Command1
DisabledPicture = "htjd.frx":608C
DownPicture = "htjd.frx":6FA6
Height = 375
Left = 7560
Picture = "htjd.frx":7EC0
Style = 1 'Graphical
TabIndex = 1
Top = 2400
Width = 855
End
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
Caption = "已冻结合同列表"
Height = 5055
Index = 0
Left = 4560
TabIndex = 0
Top = 1320
Width = 2655
Begin VB.ListBox List1
Height = 4470
Left = 240
Sorted = -1 'True
Style = 1 'Checkbox
TabIndex = 21
Top = 240
Width = 2175
End
End
End
Attribute VB_Name = "htjd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'On Error Resume Next
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
Me.List2.AddItem (List1.List(ii))
End If
Next ii
20:
For ii = 0 To listcount - 1
List1.refresh
If List1.Selected(ii) = True Then
List1.RemoveItem (ii)
listcount = listcount - 1
GoTo 20
End If
Next ii
'Command1.Enabled = False
End Sub
Private Sub Command2_Click()
'On Error Resume Next
Dim listcount As Integer
Dim sqlstr As String
sqlstr = ""
listcount = Me.List2.listcount
For ii = 0 To listcount - 1
If List2.Selected(ii) = True Then
Me.List1.AddItem (List2.List(ii))
End If
Next ii
30:
For ii = 0 To listcount - 1
If List2.Selected(ii) = True Then
List2.RemoveItem (List2.ListIndex)
listcount = listcount - 1
GoTo 30
End If
Next ii
End Sub
Private Sub Command3_Click()
MsgBox "试用版，未有该功能"
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
Adodc1.ConnectionString = "dsn=dzqch"
Adodc1.refresh
Dim dfr As Integer
Dim fg As Integer
dfr = Adodc1.Recordset.RecordCount
If dfr > 1 Then
Adodc1.Recordset.MoveFirst
For fg = 1 To dfr
If IsNull(Adodc1.Recordset.Fields("hth")) = False Then
Me.List1.AddItem Adodc1.Recordset.Fields(0)
Adodc1.Recordset.MoveNext
End If
Next fg
End If
End Sub
Private Sub List1_Click()
Dim hhth As String
hhth = List1.List(List1.ListIndex)
Me.datPrimaryRS.RecordSource = "select hth,fhdw,htl,yfl,wfl,hwm,fhr from htk where hth like '%" & Trim(hhth) & "%'"
Me.datPrimaryRS.refresh
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -