📄 lsjl2frm.frm
字号:
Top = 1200
Width = 1296
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "年"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2532
TabIndex = 15
Top = 132
Width = 264
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "月"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3228
TabIndex = 14
Top = 132
Width = 264
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "日"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3960
TabIndex = 13
Top = 132
Width = 216
End
Begin VB.Image Image3
BorderStyle = 1 'Fixed Single
Height = 4580
Left = 0
Top = 540
Width = 7320
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 504
Left = 0
Top = 0
Width = 4212
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "请输入查询日期："
BeginProperty Font
Name = "隶书"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 48
TabIndex = 12
Top = 132
Width = 1920
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "批次"
BeginProperty Font
Name = "隶书"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 6336
TabIndex = 11
Top = 132
Width = 516
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 16.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 324
Left = 5784
TabIndex = 10
Top = 96
Width = 192
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "本日共有"
BeginProperty Font
Name = "隶书"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 4524
TabIndex = 9
Top = 132
Width = 1020
End
Begin VB.Image Image5
BorderStyle = 1 'Fixed Single
Height = 504
Left = 4248
Top = 0
Width = 3084
End
End
Attribute VB_Name = "lsjl2frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mfDate As Date
Private Const mstrSqlDetail = "select * from [detaills2] where riqi = "
Private Const mstrSqlBatch = "select * from [batchls2] where riqi = "
Private Sub cmdFirst_Click()
On Error Resume Next
With Data2.Recordset
.MoveFirst
End With
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
With Data2.Recordset
.MoveLast
End With
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
With Data2.Recordset
If .EOF Then
.MoveFirst
Else
.MoveNext
End If
End With
End Sub
Private Sub cmdOption_Click()
With frmChartOption
.fyfIndex = 2
.Show vbModal
End With
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
With Data2.Recordset
If .BOF Then
.MoveLast
Else
.MovePrevious
End If
End With
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Data2_Reposition()
On Error Resume Next
With Data1
.RecordSource = mstrSqlDetail & "#" & 20 & mfDate & "#" & _
"and currenttime>=" & "#" & Data2.Recordset.Fields("starttime") & "#" _
& "and currenttime<=" & "#" & Data2.Recordset.Fields("endtime") & "#"
.Refresh
.Recordset.MoveFirst
End With
Text5.Text = Data2.Recordset.Fields("yjatouliaoliang")
Label14.Caption = Data2.Recordset.AbsolutePosition + 1
lblScale(0).Caption = Format(Data1.Recordset.Fields("currenttime"), "short time")
Call DrawLishiChart1(Picture1, Data1, gsngwdScale(2, 1), gsngwdScale(2, 2), _
gsngywScale(2, 1), gsngywScale(2, 2), gsngkdScale(2, 1), gsngkdScale(2, 2), _
gsngllScale(2, 1), gsngllScale(2, 2), gsngswdScale(2, 1), gsngswdScale(2, 2), _
lblScale(0), lblScale(1), lblScale(2), lblScale(3), lblScale(4), lblScale(5), _
lblScale(6))
End Sub
Private Sub Form_Load()
Width = Screen.Width - dataviewfrm.Width - dataviewfrm.Left
Left = dataviewfrm.Width + dataviewfrm.Left
Top = baojingfrm.Top + baojingfrm.Height
Height = Screen.Height - baojingfrm.Top - baojingfrm.Height
Dim i As Integer
'****************************************************************
For i = 1 To 60
Load linScale(i)
With linScale(i)
.X1 = Picture1.Left + (Picture1.Width / 60) * i
.X2 = .X1
.Y1 = Picture1.Top + Picture1.Height
Select Case i
Case 0, 10, 20, 30, 40, 50, 60
.Y2 = .Y1 + 250
Case 5, 15, 25, 35, 45, 55
.Y2 = .Y1 + 150
Case Else
.Y2 = .Y1 + 100
End Select
.Visible = True
End With
Next
'****************************************************************
For i = 1 To 6
Load lblScale(i)
With lblScale(i)
.Left = Picture1.Left - 200 + (Picture1.Width / 6) * i
.Top = Picture1.Top + Picture1.Height + 220
.Visible = True
End With
Next
For i = 1 To 20
Load linScaleV(i)
With linScaleV(i)
.X2 = Picture1.Left
.Y2 = Picture1.Top + (Picture1.Height / 20) * i
.Y1 = .Y2
Select Case i
Case 10, 20
.X1 = Picture1.Left - 250
Case 5, 15
.X1 = Picture1.Left - 150
Case Else
.X1 = Picture1.Left - 100
End Select
.Visible = True
End With
Next
'*************************
'读坐标上下限
'*************************
gsngwdScale(2, 1) = gsngfyfwdScaleTop(2)
gsngwdScale(2, 2) = gsngfyfwdScaleBottom(2)
gsngswdScale(2, 1) = gsnglqyswdScaleTop
gsngswdScale(2, 2) = gsnglqyswdScaleBottom
gsngkdScale(2, 1) = gsngtlfkdScaleTop(2)
gsngkdScale(2, 2) = gsngtlfkdScaleBottom(2)
gsngywScale(2, 1) = gsngjlgywScaleTop(2)
gsngywScale(2, 2) = gsngjlgywScaleBottom(2)
gsngllScale(2, 1) = gsngyjallScaleTop(2)
gsngllScale(2, 2) = gsngyjallScaleBottom(2)
optData.Value = True
With DBGrid1
.Height = 2760
.Visible = True
End With
End Sub
Private Sub optChart_Click()
DBGrid1.Visible = False
Picture1.Visible = True
End Sub
Private Sub optData_Click()
DBGrid1.Visible = True
Picture1.Visible = False
End Sub
Private Sub Text1_GotFocus()
Call GotFocusAgain(Text1)
End Sub
Private Sub Text2_GotFocus()
Call GotFocusAgain(Text2)
End Sub
Private Sub Text3_GotFocus()
Call GotFocusAgain(Text3)
End Sub
Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo s:
If KeyCode = vbKeyReturn Then
Dim msg As Variant
msg = Val(Text1.Text) & "-" & Val(Text2.Text) & "-" & Val(Text3.Text)
mfDate = CDate(msg)
If mfDate Then
cmdFirst.Enabled = True
cmdLast.Enabled = True
cmdPrevious.Enabled = True
cmdNext.Enabled = True
Data2.Enabled = True
End If
DoEvents
With Data2
.RecordSource = mstrSqlBatch & "#" & 20 & mfDate & "#"
.Refresh
.Recordset.MoveLast
Label6.Caption = .Recordset.RecordCount
.Recordset.MoveFirst
End With
End If
Exit Sub
s: Call Inform(131)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -