📄 框架基本数据.frm
字号:
VERSION 5.00
Begin VB.Form kuangjia1
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "框架基本数据"
ClientHeight = 4110
ClientLeft = 3075
ClientTop = 2955
ClientWidth = 6420
Icon = "框架基本数据.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4110
ScaleWidth = 6420
Begin VB.CommandButton Comd
Caption = "刷新"
Height = 375
Index = 4
Left = 4800
TabIndex = 19
Top = 1920
Width = 975
End
Begin VB.TextBox Text1
Height = 405
Index = 3
Left = 1320
TabIndex = 18
Top = 3000
Visible = 0 'False
Width = 4455
End
Begin VB.TextBox Text1
Height = 285
Index = 2
Left = 1320
TabIndex = 13
Top = 3120
Width = 4455
End
Begin VB.Frame Frame1
Height = 3735
Left = 240
TabIndex = 0
Top = 120
Width = 5895
Begin VB.ListBox List1
Height = 2220
Left = 2280
TabIndex = 14
Top = 360
Visible = 0 'False
Width = 975
End
Begin VB.OptionButton Option2
Caption = "层数及层高"
Height = 255
Left = 360
TabIndex = 2
Top = 792
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "跨长及跨数"
Height = 255
Left = 360
TabIndex = 1
Top = 360
Value = -1 'True
Width = 1335
End
Begin VB.ListBox LstAvailable
Height = 2220
ItemData = "框架基本数据.frx":030A
Left = 2280
List = "框架基本数据.frx":030C
TabIndex = 7
Top = 360
Width = 975
End
Begin VB.ListBox LstSelect
Height = 2220
ItemData = "框架基本数据.frx":030E
Left = 3360
List = "框架基本数据.frx":0375
TabIndex = 8
Top = 360
Width = 855
End
Begin VB.TextBox Text1
Height = 285
Index = 1
Left = 1200
TabIndex = 5
Text = "3300"
Top = 1983
Width = 855
End
Begin VB.TextBox Text1
Height = 285
Index = 0
Left = 1200
TabIndex = 3
Text = "1"
Top = 1200
Width = 855
End
Begin VB.CommandButton Comd
Caption = "全清"
Height = 375
Index = 2
Left = 4560
TabIndex = 11
Top = 1320
Width = 975
End
Begin VB.CommandButton Comd
Caption = "删除"
Height = 375
Index = 1
Left = 4560
TabIndex = 10
Top = 840
Width = 975
End
Begin VB.CommandButton Comd
Caption = "确定"
Height = 375
Index = 3
Left = 4560
TabIndex = 12
Top = 2280
Width = 975
End
Begin VB.CommandButton Comd
Caption = "添加"
Height = 375
Index = 0
Left = 4560
TabIndex = 9
Top = 360
Width = 975
End
Begin VB.HScrollBar HScr1
Height = 255
Index = 1
LargeChange = 300
Left = 360
Max = 30000
SmallChange = 300
TabIndex = 6
Top = 2400
Value = 3300
Width = 1695
End
Begin VB.HScrollBar HScr1
Height = 255
Index = 0
Left = 360
Max = 1000
TabIndex = 4
Top = 1606
Value = 1
Width = 1695
End
Begin VB.Label Label2
Caption = "重复数"
Height = 195
Left = 360
TabIndex = 17
Top = 1230
Width = 555
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "结果："
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 16
Top = 3060
Width = 615
End
Begin VB.Label Label3
Caption = "尺寸(mm)"
Height = 195
Left = 360
TabIndex = 15
Top = 2025
Width = 735
End
End
End
Attribute VB_Name = "kuangjia1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private delnum, delindex, lst
Private cengtemp(1 To 36), kuatemp(1 To 36), cengtemp1(1 To 36), kuatemp1(1 To 36) As String, ceng1, kua1
Private Sub Comd_Click(Index As Integer)
Dim i As Integer, aitem
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Select Case Index
Case 0
If Val(Text1(0).Text) <> 0 And Val(Text1(1).Text) <> 0 Then
aitem = Text1(0).Text + "*" + Text1(1).Text
If Option1.Value = True Then
LstAvailable.AddItem aitem
ElseIf Option2.Value = True Then
List1.AddItem aitem
End If
End If
Call 结果
Case 1
If Option1.Value = True Then
If LstAvailable.ListCount > 0 Then
delindex = LstAvailable.ListIndex
If delindex = -1 Then delindex = LstAvailable.ListCount - 1
LstAvailable.RemoveItem delindex
kua1 = LstAvailable.ListCount
For i = 1 To LstAvailable.ListCount
kuatemp1(i) = LstAvailable.List(i - 1)
Next i
LstAvailable.Clear
If kua1 > 0 Then
For i = 1 To kua1
LstAvailable.AddItem kuatemp1(i)
Next i
End If
End If
Call 结果
ElseIf Option2.Value = True Then
If List1.ListCount > 0 Then
delindex = List1.ListIndex
If delindex = -1 Then delindex = List1.ListCount - 1
List1.RemoveItem delindex
ceng1 = List1.ListCount
For i = 1 To List1.ListCount
cengtemp1(i) = Null
cengtemp1(i) = List1.List(i - 1)
Next i
List1.Clear
If ceng1 > 0 Then
For i = 1 To ceng1
List1.AddItem cengtemp1(i)
Next i
End If
End If
Call 结果
Call 保存结果
End If
Case 2
If Option1.Value = True Then
Text1(2) = ""
LstAvailable.Clear
ElseIf Option2.Value = True Then
Text1(3) = ""
List1.Clear
End If
Case 3
If Val(Text1(2).Text) = 0 Then
Msg = "请输入程序必要的跨长及跨数！" ' 定义信息。
Style = vbOKOnly + vbInformation ' 定义按钮。
Title = "系统信息" ' 定义标题。
Response = MsgBox(Msg, Style, Title)
End If
If Val(Text1(3).Text) = 0 Then Response = MsgBox("请输入程序必要的层数及层高！", Style, Title)
If Len(Text1(2).Text) > 0 And Len(Text1(3).Text) > 0 Then
For i = 1 To 36
Lx(i) = 0
Ly(i) = 0
Next i
Call 保存结果
Call 自动生成NgnXY
tuxing1.Show
Call tuxing1.Form_Load
For i = 0 To 3
MDIForm1.jm(i).Enabled = True
Next i
gongju1.Toolbar2.Buttons("zhu").Enabled = True
gongju1.Toolbar2.Buttons("lian").Enabled = True
gongju1.Toolbar2.Buttons("zhuzhg").Enabled = True
gongju1.Toolbar2.Buttons("qiti").Enabled = True
Form5.Show
kuangjia2.Show
Unload Me
End If
Case 4
Call Form_Load
End Select
End Sub
Public Sub Form_Load()
' If Val(Ceng) > 0 And Val(Kua) > 0 Then Call 自动生成NgnXY
Me.Left = MDIForm1.Width - Me.Width - 200
If Lx(1) = 0 Then Call 自动生成NgnXY
Call 读出结果
Option1.Value = True
Option2.Value = False
End Sub
Private Sub HScr1_Change(Index As Integer)
Text1(0).Text = HScr1(0).Value
Text1(1).Text = HScr1(1).Value
End Sub
Private Sub LstSelect_Click()
Dim LstIdx As Integer, Opt As String
LstIdx = LstSelect.ListIndex
lst = "1*" + LstSelect.List(LstIdx)
If Option1.Value = True Then
LstAvailable.AddItem lst
Else
List1.AddItem lst
End If
Call 结果
End Sub
Sub 结果()
Dim i As Integer
If Option1.Value = True Then
Call textkua
ElseIf Option2.Value = True Then
Call textceng
End If
End Sub
Private Sub Option1_Click()
List1.Visible = False
LstAvailable.Visible = True
Text1(2).Visible = True
Text1(3).Visible = False
Option1.Value = True
Option2.Value = False
Call 结果
End Sub
Private Sub Option2_Click()
List1.Visible = True
LstAvailable.Visible = False
Text1(2).Visible = False
Text1(3).Visible = True
Option2.Value = True
Option1.Value = False
Call 结果
End Sub
Sub 保存结果()
Dim i
' kua1 = LstAvailable.ListCount
' If LstAvailable.ListCount > 0 Then
' For i = 1 To LstAvailable.ListCount
' kuatemp(i) = LstAvailable.List(i - 1)
' Next i
' End If
' ceng1 = List1.ListCount
' If List1.ListCount > 0 Then
' For i = 1 To List1.ListCount
' cengtemp(i) = Null
' cengtemp(i) = List1.List(i - 1)
' Next i
' End If
Kua = Text1(2).Text
Ceng = Text1(3).Text
End Sub
Sub 读出结果()
Dim i, j, K
Call Comd_Click(2)
LstAvailable.Clear
List1.Clear
For i = 1 To 36
kuatemp(i) = 0
cengtemp(i) = 0
Next i
i = 0: j = 0: K = 0
If Lx(1) > 0 Then
i = 0: j = 0: K = 0
Do
K = K + 1
j = 0
Do
j = j + 1: i = i + 1
kuatemp(K) = LTrim(Str(j)) + "*" + LTrim(Str(Int(Lx(i) * 1000 + 0.5)))
Loop While Lx(i + 1) = Lx(i)
Loop While Lx(i + 1) <> 0
For i = 1 To K
LstAvailable.AddItem kuatemp(i)
Next i
End If
i = 0: j = 0: K = 0
If Ly(1) > 0 Then
i = 0: j = 0: K = 0
Do
K = K + 1
j = 0
Do
j = j + 1: i = i + 1
cengtemp(K) = LTrim(Str(j)) + "*" + LTrim(Str(Int(Ly(i) * 1000 + 0.5)))
Loop While Ly(i + 1) = Ly(i)
Loop While Ly(i + 1) <> 0
For i = 1 To K
List1.AddItem cengtemp(i)
Next i
End If
Call textkua
Call textceng
End Sub
Private Sub textkua()
Dim i
Text1(2) = LstAvailable.List(0)
If LstAvailable.ListCount > 0 Then
For i = 1 To LstAvailable.ListCount - 1
Text1(2).Text = Text1(2).Text + "+" + LstAvailable.List(i)
Next i
End If
End Sub
Private Sub textceng()
Dim i
Text1(3) = List1.List(0)
If List1.ListCount > 0 Then
For i = 1 To List1.ListCount - 1
Text1(3).Text = Text1(3).Text + "+" + List1.List(i)
Next i
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -