📄 frmtoolselect.frm
字号:
VERSION 5.00
Begin VB.Form frmToolSelect
BorderStyle = 1 'Fixed Single
Caption = "Tool Library"
ClientHeight = 6270
ClientLeft = 45
ClientTop = 435
ClientWidth = 5880
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 418
ScaleMode = 3 'Pixel
ScaleWidth = 392
StartUpPosition = 2 'CenterScreen
Begin VB.FileListBox FileList
Height = 3600
Left = 135
Pattern = "*.bmp"
TabIndex = 3
Top = 2160
Width = 2550
End
Begin VB.ComboBox cmbTools
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
ItemData = "frmToolSelect.frx":0000
Left = 135
List = "frmToolSelect.frx":0002
TabIndex = 1
Top = 1380
Width = 2625
End
Begin VB.CommandButton cmdAssign
Caption = "&Assign"
Height = 390
Left = 3615
TabIndex = 4
Top = 5700
Width = 990
End
Begin VB.CommandButton cmdClose
Caption = "&Close"
Height = 390
Left = 4755
TabIndex = 5
Top = 5685
Width = 990
End
Begin VB.Frame Frame1
Caption = "Details"
Height = 4545
Left = 2880
TabIndex = 6
Top = 975
Width = 2895
Begin VB.PictureBox picTool
Appearance = 0 'Flat
BackColor = &H00000000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 2565
Left = 210
ScaleHeight = 169
ScaleMode = 3 'Pixel
ScaleWidth = 164
TabIndex = 7
TabStop = 0 'False
Top = 315
Width = 2490
Begin VB.Image imgTool
Height = 1065
Left = 480
Top = 390
Width = 1230
End
End
Begin VB.Label Label1
Caption = "Name:"
ForeColor = &H00000040&
Height = 255
Left = 225
TabIndex = 15
Top = 3120
Width = 1020
End
Begin VB.Label Label2
Caption = "Tool Width:"
ForeColor = &H00000040&
Height = 255
Left = 225
TabIndex = 14
Top = 3405
Width = 1020
End
Begin VB.Label Label3
Caption = "Tool Height:"
ForeColor = &H00000040&
Height = 255
Left = 225
TabIndex = 13
Top = 3705
Width = 1020
End
Begin VB.Label Label4
Caption = "Cutting Point:"
ForeColor = &H00000040&
Height = 255
Left = 225
TabIndex = 12
Top = 3990
Width = 1020
End
Begin VB.Label lblName
Caption = "Name:"
Height = 255
Left = 1320
TabIndex = 11
Top = 3120
Width = 1485
End
Begin VB.Label lblToolWidth
Caption = "Tool Width:"
Height = 255
Left = 1320
TabIndex = 10
Top = 3420
Width = 1485
End
Begin VB.Label lblToolHeight
Caption = "Tool Height:"
Height = 255
Left = 1320
TabIndex = 9
Top = 3720
Width = 1485
End
Begin VB.Label lblCuttingPoint
Caption = "Cutting Point:"
Height = 255
Left = 1320
TabIndex = 8
Top = 3990
Width = 1485
End
End
Begin VB.Label Label6
Caption = "Tool &List"
Height = 255
Left = 135
TabIndex = 2
Top = 1860
Width = 2085
End
Begin VB.Label Label5
Caption = "&Tool Number"
Height = 255
Left = 135
TabIndex = 0
Top = 1065
Width = 2085
End
Begin VB.Image Image1
Height = 705
Left = 165
Picture = "frmToolSelect.frx":0004
Top = 45
Width = 3600
End
Begin VB.Shape Shape1
BackStyle = 1 'Opaque
Height = 945
Left = -30
Top = -75
Width = 6135
End
End
Attribute VB_Name = "frmToolSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type Tool
Name As String
Width As Integer
Height As Integer
BitmapPath As String
' CuttingPoint As Point
End Type
Private Sub cmbTools_Click()
Dim txt As String
txt = ToolListArray(cmbTools.ListIndex)
Dim i As Integer
For i = 0 To FileList.ListCount - 1
If UCase(FileList.List(i)) = UCase(txt) Then
FileList.ListIndex = i
Exit Sub
End If
Next i
End Sub
Private Sub cmdAssign_Click()
ToolListArray(cmbTools.ListIndex) = FileList.List(FileList.ListIndex)
End Sub
Private Sub cmdClose_Click()
Dim fNum, i As Integer
Dim txt As String
Dim Var
Kill App.path & "\Tools\ToolList.ini"
fNum = FreeFile
Open App.path & "\Tools\ToolList.ini" For Output As #fNum
For i = 0 To 20
txt = i & "=" & ToolListArray(i)
Print #fNum, txt
Next i
Close #fNum
Unload Me
End Sub
Private Sub FileList_Click()
ShowTool FileList.path & "\" & FileList.List(FileList.ListIndex)
End Sub
Private Sub ShowTool(ByVal path As String)
imgTool.Picture = LoadPicture(path)
imgTool.Left = picTool.ScaleWidth / 2 - imgTool.Width / 2
imgTool.Top = picTool.ScaleHeight / 2 - imgTool.Height / 2
Dim fNum, i As Integer
Dim txt As String
Dim Var
fNum = FreeFile
Open Left(path, Len(path) - 3) & "ini" For Input As #fNum
Do While Not EOF(fNum)
Line Input #fNum, txt
If Not txt = "" Then
Var = Split(txt, "=")
Select Case UCase(Var(0))
Case "TOOLNAME":
lblName.Caption = Trim(Var(1))
Case "TOOLWIDTH":
lblToolWidth.Caption = Trim(Var(1))
Case "TOOLHEIGHT":
lblToolHeight.Caption = Trim(Var(1))
Case "CUTTINGPOINT":
lblCuttingPoint.Caption = Trim(Var(1))
End Select
End If
Loop
End Sub
Private Sub Form_Load()
FileList.Pattern = "*.bmp"
FileList.path = App.path & "\tools"
GetToolList
'cmbTools.ListIndex = 0
End Sub
Public Sub GetToolList()
Dim fNum, i, j As Integer
Dim txt As String
Dim Var As Variant
fNum = FreeFile
Open App.path & "\Tools\ToolList.ini" For Input As #fNum
Do While Not EOF(fNum)
Line Input #fNum, txt
If Not txt = "" Then
Var = Split(txt, "=")
ToolListArray(CInt(Var(0))) = Var(1)
cmbTools.AddItem "Tool " & CInt(Var(0))
i = i + 1
End If
Loop
Close #fNum
' For j = i To 20
' cmbTools.AddItem "Tool " & j
' ToolListArray(j) = "Empty.bmp"
' Next j
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -