VERSION 5.00 Begin VB.Form AddCore BorderStyle = 1 'Fixed Single Caption = "Core data" ClientHeight = 2895 ClientLeft = 1050 ClientTop = 1335 ClientWidth = 3045 ControlBox = 0 'False LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 193 ScaleMode = 3 'Pixel ScaleWidth = 203 Begin VB.CommandButton BtSave Caption = "Save" Height = 255 Left = 2040 TabIndex = 22 Top = 2400 Width = 855 End Begin VB.CommandButton BtClose Caption = "Close" Height = 255 Left = 1080 TabIndex = 9 Top = 2400 Width = 855 End Begin VB.CommandButton BtRemove Caption = "Delete" Height = 255 Left = 120 TabIndex = 1 Top = 2400 Width = 855 End Begin VB.TextBox TxName Height = 285 Left = 1440 TabIndex = 2 Top = 120 Width = 975 End Begin VB.TextBox TxCuMLen Height = 285 Left = 1440 TabIndex = 8 Top = 1800 Width = 975 End Begin VB.TextBox TxCuW Height = 285 Left = 1440 TabIndex = 7 Top = 1560 Width = 975 End Begin VB.TextBox TxCuH Height = 285 Left = 1440 TabIndex = 6 Top = 1320 Width = 975 End Begin VB.TextBox TxFeLen Height = 285 Left = 1440 TabIndex = 5 Top = 1080 Width = 975 End Begin VB.TextBox TxFeKg Height = 285 Left = 1440 TabIndex = 4 Top = 840 Width = 975 End Begin VB.TextBox TxSectFer Height = 285 Left = 1440 TabIndex = 3 Top = 600 Width = 975 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "cm" Height = 255 Index = 5 Left = 2520 TabIndex = 21 Top = 1800 Width = 495 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "mm" Height = 255 Index = 4 Left = 2520 TabIndex = 20 Top = 1560 Width = 495 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "mm" Height = 255 Index = 3 Left = 2520 TabIndex = 19 Top = 1320 Width = 495 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "cm" Height = 255 Index = 2 Left = 2520 TabIndex = 18 Top = 1080 Width = 495 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "Kg" Height = 255 Index = 1 Left = 2520 TabIndex = 17 Top = 840 Width = 495 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "cm²" Height = 255 Index = 0 Left = 2520 TabIndex = 16 Top = 600 Width = 495 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Mean turn length" Height = 195 Index = 8 Left = 120 TabIndex = 15 Top = 1800 Width = 1200 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Bobbin width" Height = 195 Index = 7 Left = 120 TabIndex = 14 Top = 1560 Width = 915 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Bobbin deepth" Height = 195 Index = 6 Left = 120 TabIndex = 13 Top = 1320 Width = 1035 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "MPL" Height = 195 Index = 4 Left = 120 TabIndex = 12 Top = 1080 Width = 330 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "mFe" Height = 195 Index = 3 Left = 120 TabIndex = 11 Top = 840 Width = 300 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "AFe" Height = 195 Index = 2 Left = 120 TabIndex = 10 Top = 600 Width = 285 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Name" Height = 195 Index = 0 Left = 240 TabIndex = 0 Top = 120 Width = 420 End End Attribute VB_Name = "AddCore" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim CoreName As String Dim Changed As Boolean Private Sub SaveCore() WriteIniString App.Path & "\Core.tbx", "EI", TxName.Text, TxSectFer.Text & "," & TxFeKg.Text & "," & TxFeLen.Text & "," & TxCuH.Text _ & "," & TxCuW.Text & "," & TxCuMLen.Text CoreChanged = False End Sub Private Sub Clear() TxName.Text = "" TxSectFer.Text = "" TxFeKg.Text = "" TxFeLen.Text = "" TxCuH.Text = "" TxCuW.Text = "" TxCuMLen.Text = "" TxName.SetFocus CoreChanged = False End Sub Private Sub FillFields(S As String) TxName.Text = Substring(S, 1, ",") TxSectFer.Text = Substring(S, 2, ",") TxFeKg.Text = Substring(S, 3, ",") TxFeLen.Text = Substring(S, 4, ",") TxCuH.Text = Substring(S, 5, ",") TxCuW.Text = Substring(S, 6, ",") TxCuMLen = Substring(S, 7, ",") CoreChanged = False End Sub Private Sub RefreshForm(Core As String) Dim S As String S = Core & "," & GetIniString(App.Path & "\Core.tbx", "EI", Core) FillFields S End Sub Private Sub BtClose_Click() Me.Hide End Sub Private Sub BtRemove_Click() Dim S As String Dim T As String If Len(TxName.Text) Then RefreshForm TxName.Text If MsgBox("Confirm deletion of this core" & vbCrLf & "Make sure no project uses it" _ , vbCritical + vbYesNo, TxName.Text) = vbYes Then S = GetKeysInSection(App.Path & "\Core.tbx", "EI") GetNextInList " ", " " T = GetNextInList(S, ",") Do While Len(T) If TxName.Text <> T Then WriteIniString App.Path & "\temp.tbx", "EI", T, GetIniString(App.Path & "\core.tbx", "EI", T) End If T = GetNextInList(S, ",") Loop Delete App.Path & "\core.tbx", 10 Rename App.Path & "\temp.tbx", App.Path & "\core.tbx", 10, True Clear End If End If End Sub Private Sub BtSave_Click() Enregistrer End Sub Private Sub Form_Activate() ' Changed = False ' RefreshForm Form1!LstCore.Text End Sub Private Sub Form_Deactivate() If Changed Then If MsgBox("Save changes", vbYesNo + vbQuestion, TxName.Text) = vbYes Then Enregistrer End If End If End Sub Private Sub Form_Load() ' CenterForm Me End Sub Private Sub TxCuH_KeyPress(KeyAscii As Integer) Changed = True End Sub Private Sub TxCuMLen_KeyPress(KeyAscii As Integer) Changed = True End Sub Private Sub TxCuW_KeyPress(KeyAscii As Integer) Changed = True End Sub Private Sub TxFeKg_KeyPress(KeyAscii As Integer) Changed = True End Sub Private Sub TxFeLen_KeyPress(KeyAscii As Integer) Changed = True End Sub Private Sub TxName_KeyPress(KeyAscii As Integer) Changed = True End Sub Private Sub TxName_Validate(Cancel As Boolean) If Len(TxName.Text) Then RefreshForm TxName.Text End Sub Private Sub TxSectFer_KeyPress(KeyAscii As Integer) Changed = True End Sub