📄 frmpoly.frm
字号:
VERSION 5.00
Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.1#0"; "COMCT232.OCX"
Begin VB.Form frmpoly
Caption = "化学用剂注入表"
ClientHeight = 7680
ClientLeft = 2055
ClientTop = 1635
ClientWidth = 12915
Icon = "frmpoly.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7680
ScaleWidth = 12915
Begin Threed.SSCommand SSCommand2
Height = 735
Left = 9000
TabIndex = 8
Top = 6720
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1296
_StockProps = 78
Caption = "数据保存"
ForeColor = 255
Picture = "frmpoly.frx":030A
End
Begin ComCtl2.UpDown UpDown1
Height = 495
Left = 5160
TabIndex = 7
Top = 6840
Width = 255
_ExtentX = 450
_ExtentY = 873
_Version = 327681
Enabled = -1 'True
End
Begin VB.TextBox TxtNianXian
Alignment = 2 'Center
BackColor = &H00C0E0FF&
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 495
Left = 4320
TabIndex = 6
Text = "10"
Top = 6840
Width = 855
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 6000
Top = 6840
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin Threed.SSCommand SSCommand1
Height = 735
Left = 7320
TabIndex = 0
Top = 6720
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1296
_StockProps = 78
Caption = "调用数据"
ForeColor = 255
Picture = "frmpoly.frx":0984
End
Begin Threed.SSCommand SSCommand3
Height = 735
Left = 10680
TabIndex = 1
Top = 6720
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1296
_StockProps = 78
Caption = "退 出"
ForeColor = 255
Picture = "frmpoly.frx":125E
End
Begin Threed.SSPanel SSPanel2
Height = 495
Left = 480
TabIndex = 2
Top = 6840
Width = 3735
_Version = 65536
_ExtentX = 6588
_ExtentY = 873
_StockProps = 15
Caption = "化学剂使用年限修改："
ForeColor = 255
BackColor = 16777152
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderWidth = 2
BevelOuter = 1
FloodColor = 8421631
End
Begin Threed.SSPanel SSPanel1
Height = 6495
Left = 0
TabIndex = 3
Top = 0
Width = 12735
_Version = 65536
_ExtentX = 22463
_ExtentY = 11456
_StockProps = 15
Caption = "SSPanel1"
BackColor = -2147483643
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderWidth = 2
BevelInner = 1
Font3D = 3
Begin VB.TextBox Text1
BackColor = &H00C0E0FF&
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 495
Left = 720
TabIndex = 4
Top = 1560
Visible = 0 'False
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 6135
Left = 120
TabIndex = 5
Top = 120
Width = 12495
_ExtentX = 22040
_ExtentY = 10821
_Version = 393216
Cols = 3
FixedCols = 2
RowHeightMin = 500
BackColor = 16777215
BackColorFixed = 12632256
ForeColorFixed = 12582912
BackColorBkg = 13487565
TextStyleFixed = 4
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin VB.Menu operate
Caption = "aa"
Visible = 0 'False
Begin VB.Menu ins_line
Caption = "插入行"
End
Begin VB.Menu del_line
Caption = "删除行"
End
Begin VB.Menu cls_line
Caption = "清除内容"
End
Begin VB.Menu allcls_line
Caption = "全部清除"
End
End
End
Attribute VB_Name = "frmpoly"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private mTotalRows& ' Contains the total rows in the set of records
Dim jsq, bb, insline_max As Integer
Dim mq_index As Integer
Dim del1$, del2$, col1$, col2$
Dim selx, sely, selzbx, tt As Integer
Dim xx(50), yy(50) As Single
Dim tval As Single
Dim kr_frt$(1 To 10)
' Dim Count As Integer '生产年限 或 要写入数据库的记录数量
Private Sub allcls_line_Click()
Beep
msg$ = "是否清除所有的设置信息？"
Title$ = "警告"
xchoose = MsgBox(msg$, 49, Title$)
If xchoose = 2 Then Exit Sub
mTotalRows& = Val(TxtNianXian.Text)
For m = 1 To mTotalRows&
For n = 1 To MSFlexGrid1.Cols - 1
MSFlexGrid1.TextMatrix(m, n) = ""
Next n
Next m
If MSFlexGrid1.TextMatrix(MSFlexGrid1.row, MSFlexGrid1.col) = "" Then Text1.Text = ""
Call blank_MSFlexGridshow
MSFlexGrid1.row = MSFlexGrid1.FixedRows: MSFlexGrid1.col = MSFlexGrid1.FixedCols
MSFlexGrid1.TopRow = MSFlexGrid1.FixedRows: MSFlexGrid1.LeftCol = MSFlexGrid1.FixedCols
' Call draw_line
End Sub
Private Sub cls_line_Click()
For i = Val(del1$) To Val(del2$)
For j = Val(col1$) To Val(col2$)
MSFlexGrid1.TextMatrix(i + MSFlexGrid1.FixedRows - 1, j + MSFlexGrid1.FixedCols - 1) = ""
Next j
Next i
If MSFlexGrid1.TextMatrix(MSFlexGrid1.row, MSFlexGrid1.col) = "" Then Text1.Text = ""
' Call draw_line
End Sub
Private Sub Form_Load()
kr_frt$(1) = "#0.000": kr_frt$(2) = "#0.0000": kr_frt$(3) = "#0.0000"
kr_frt$(4) = "#0.0000": kr_frt$(5) = "#0.0000"
formbl_x = 1: formbl_y = 1
If flag(1) = 1 Then
Call MSFlexGridshow
'Else
' If OpeningDatabase = "" Then
'MsgBox "数据库无记录"
'Unload Me
'Me.Hide
Else
MousePointer = 11
Call opendiaoyong(OpeningDatabase)
Call MSFlexGridshow
'End If
End If
MousePointer = 0
Me.Enabled = -1
Me.MousePointer = 1
' Call MSFlexGridshow
End Sub
'定义调用函数
Private Sub opendiaoyong(s As String)
Dim Count
Count = 0 '表中的记录数
' MsgBox OpeningDatabase
On Error GoTo myerrr
''******************修改纪录***********************
Set Data1 = New ADODB.Connection
Data1.CursorLocation = adUseClient
Data1.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & s
Set adozjyyyhg = New ADODB.Recordset
adozjyyyhg.Open "select * from 化学剂用量参数表", Data1, adOpenStatic, adLockOptimistic
'Data1.Refresh
With adozjyyyhg
' .OpenRecordset
.Update
If (.EOF = True) And (.BOF = True) Then
'MsgBox "数据库无记录"
.MoveLast
Else
.MoveFirst
Do While .EOF = False
Count = Count + 1
.MoveNext
Loop
'MsgBox "数据库共有" & Count & "条记录"
End If
End With
VarPingJiaQi = Count
TxtNianXian.Text = Str(Count + 1)
'Data1.Refresh
adozjyyyhg.MoveFirst
For i = 1 To Count
For k = 1 To 10
'MsgBox Data1.Recordset.Fields(k).
TempS = adozjyyyhg.Fields(k).Value
VarHuaXueji(i, k + 1) = Val(TempS)
Next k
adozjyyyhg.MoveNext
Next i
adozjyyyhg.Close
For i = 1 To Count
VarHuaXueji(i, 1) = i
Next i
myerrr:
MousePointer = 0
Me.Enabled = -1
Me.MousePointer = 1
End Sub
Private Sub ins_line_Click()
MSFlexGrid1.Text = Text1.Text
Beep
4 msg$ = "注意：输入增加行数应在1～" & Trim$(Str$(insline_max)) & "之间！" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "请输入增加行数："
wgxx$ = InputBox$(msg$, "信息输入")
If wgxx$ = "" Then Exit Sub
AddLine = Int(Val(Trim$(wgxx$)))
If AddLine < 1 Or AddLine > insline_max Then
Beep
msg$ = "输入信息错误。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "输入增加行数应在1～" & Trim$(Str$(insline_max)) & "之间。"
Title$ = "警告"
xchoose = MsgBox(msg$, 48, Title$)
GoTo 4
End If
For i = MSFlexGrid1.Rows - 1 To MSFlexGrid1.row + AddLine Step -1
For k = 1 To MSFlexGrid1.Cols - 1
MSFlexGrid1.TextMatrix(i, k) = MSFlexGrid1.TextMatrix(i - AddLine, k)
Next k
Next i
For i = MSFlexGrid1.row To MSFlexGrid1.row + AddLine - 1
For k = 1 To MSFlexGrid1.Cols - 1
MSFlexGrid1.TextMatrix(i, k) = ""
Next k
Next i
Call blank_MSFlexGridshow
MSFlexGrid1.RowSel = MSFlexGrid1.row
End Sub
Private Sub MSFlexGrid1_DblClick()
MSFlexGrid1_keypress 13
End Sub
Private Sub MSFlexGrid1_LeaveCell()
If bb = 2 And MSFlexGrid1.Text <> Text1.Text Then
MSFlexGrid1.Text = Text1.Text
' Call draw_line
End If
End Sub
Private Sub showtextbox()
Dim testx, testy As Long
' frmpro.Show 1
Text1.Visible = 0
Text1.Height = MSFlexGrid1.CellHeight
Text1.Width = MSFlexGrid1.CellWidth
testx = MSFlexGrid1.Left + MSFlexGrid1.CellLeft
testy = MSFlexGrid1.Top + MSFlexGrid1.CellTop
Text1.Left = testx: Text1.Top = testy
Text1.ZOrder 'make sure it's on top!
Text1.Visible = -1 'show it
Text1.SetFocus 'make it active
End Sub
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If Text1.Text <> MSFlexGrid1.Text Then MSFlexGrid1.Text = Text1.Text
If MSFlexGrid1.row > MSFlexGrid1.RowSel Then
del1$ = Trim$(Str$(MSFlexGrid1.RowSel - MSFlexGrid1.FixedRows + 1)): del2$ = Trim$(Str$(MSFlexGrid1.row - MSFlexGrid1.FixedRows + 1))
Else
del1$ = Trim$(Str$(MSFlexGrid1.row - MSFlexGrid1.FixedRows + 1)): del2$ = Trim$(Str$(MSFlexGrid1.RowSel - MSFlexGrid1.FixedRows + 1))
End If
If MSFlexGrid1.col > MSFlexGrid1.ColSel Then
col1$ = Trim$(Str$(MSFlexGrid1.ColSel - MSFlexGrid1.FixedCols + 1)): col2$ = Trim$(Str$(MSFlexGrid1.col - MSFlexGrid1.FixedCols + 1))
Else
col1$ = Trim$(Str$(MSFlexGrid1.col - MSFlexGrid1.FixedCols + 1)): col2$ = Trim$(Str$(MSFlexGrid1.ColSel - MSFlexGrid1.FixedCols + 1))
End If
jbz = 0
If Val(del2$) + 1 <= MSFlexGrid1.Rows - 1 Then
For i = Val(del2$) + 1 To MSFlexGrid1.Rows - 1
For j = 1 To MSFlexGrid1.Cols - 1
If MSFlexGrid1.TextMatrix(i, j) <> "" Then jbz = 1: GoTo 2
Next j
Next i
End If
2 If jbz = 0 Then del_line.Enabled = 0 Else del_line.Enabled = -1
seli = 0
For i = MSFlexGrid1.Rows - 1 To MSFlexGrid1.row Step -1
For j = 1 To MSFlexGrid1.Cols - 1
If MSFlexGrid1.TextMatrix(i, j) <> "" Then seli = i: GoTo 3
Next j
Next i
3 If seli <> 0 Then insline_max = MSFlexGrid1.Rows - 1 - seli Else insline_max = 0
If insline_max > 0 Then ins_line.Enabled = -1 Else ins_line.Enabled = 0
PopupMenu operate
End If
End Sub
Private Sub MSFlexGrid1_Scroll()
If MSFlexGrid1.col < MSFlexGrid1.LeftCol Or MSFlexGrid1.row < MSFlexGrid1.TopRow Then Text1.Visible = 0: Exit Sub
If MSFlexGrid1.col <> MSFlexGrid1.Cols - 1 And MSFlexGrid1.row <> MSFlexGrid1.Rows - 1 Then
If Not (MSFlexGrid1.ColIsVisible(MSFlexGrid1.col + 1)) Or Not (MSFlexGrid1.RowIsVisible(MSFlexGrid1.row + 1)) Then Text1.Visible = 0: Exit Sub
Else
If Not (MSFlexGrid1.ColIsVisible(MSFlexGrid1.col)) Or Not (MSFlexGrid1.RowIsVisible(MSFlexGrid1.row)) Then Text1.Visible = 0: Exit Sub
End If
If (MSFlexGrid1.CellLeft + MSFlexGrid1.CellWidth) > MSFlexGrid1.Width Then Text1.Visible = 0: Exit Sub
If (MSFlexGrid1.CellTop + MSFlexGrid1.CellHeight + Text1.Height) > MSFlexGrid1.Height Then Text1.Visible = 0: Exit Sub
Call showtextbox
End Sub
Private Sub SSCommand1_Click() '调用数据
kr_frt$(1) = "#0.000": kr_frt$(2) = "#0.0000": kr_frt$(3) = "#0.0000"
kr_frt$(4) = "#0.0000": kr_frt$(5) = "#0.0000": kr_frt$(6) = "#0.0000"
kr_frt$(7) = "#0": kr_frt$(8) = "#0"
Dim b(1 To 10)
Dim A(1 To 100, 1 To 13)
On Error GoTo myerrr
CommonDialog1.filename = ""
'CommonDialog1.Flags = 600
CommonDialog1.InitDir = workpath
CommonDialog1.Filter = "(*.xls)|*.xls|(*.mdb)|*.mdb"
CommonDialog1.ShowOpen
filename1 = CommonDialog1.filename
Dim oleExcel As Object
Set oleExcel = CreateObject("Excel.Application")
oleExcel.Visible = False
Dim Count As Integer
On Error GoTo myerrr
If Right$(filename1, 3) = "XLS" Or Right$(filename1, 3) = "xls" Then
oleExcel.Workbooks.Open filename:=filename1
i = 1
Do
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -