Attribute VB_Name = "Global" Option Explicit Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Const SW_SHOWNORMAL = 1 Type MuVsB Mu As Single B As Single End Type Dim TbMu() As MuVsB Type section Ratio As Integer Wires As Integer End Type Dim Sections() As section Type Winding Id As Integer Name As String Volts As Integer Amps As Integer Sections() As section ' Wires As Integer End Type Dim Windings() As Winding Global NbWinding As Integer Type Bobin Id As Integer Name As String W As Integer H As Integer End Type Dim Bobins() As Bobin Global Fichier As String Global Changed As Boolean Global T As Single Global Tmax As Single Global SPVolt As Single Global CoreTbl() Global CoreData As String 'Le nom du fichier Global CoreChanged As Boolean Public Sub FillTbMu() Dim S As String Dim T As String Dim I As Integer Dim J As Integer Tmax = Val(GetIniString(CoreData, "GENERAL", "MaxB")) If Tmax = 0 Then Tmax = 1.25 S = GetKeysInSection(CoreData, "PERM") I = 1 T = Substring(S, I, ",") Do While Len(T) ReDim Preserve TbMu(J + 1) TbMu(J).B = Val(T) TbMu(J).Mu = Val(GetIniString(CoreData, "PERM", T)) I = I + 1 J = J + 1 T = Substring(S, I, ",") Loop End Sub Public Function Extrapol(X As Single) As Single Dim I As Integer Dim NX As Single Dim PX As Single Dim NY As Single Dim PY As Single For I = LBound(TbMu) To UBound(TbMu) If TbMu(I).B >= X Then 'Trouvé ou trop loin NX = TbMu(I).B PX = NX NY = TbMu(I).Mu PY = NY If I > LBound(TbMu) Then 'Il y a un précédent PX = TbMu(I - 1).B PY = TbMu(I - 1).Mu End If Extrapol = PY + ((NY - PY) / ((NX - PX) / (X - PX))) Exit Function 'Ca baigne ! End If Next I Extrapol = TbMu(I - 2).Mu 'X trop grand,on renvoie le plafond ! End Function Public Function SpawnObject(Fichier As String) Dim X As Long If FileExists(Fichier) Then X = ShellExecute(0, "Open", Fichier, "", App.Path, SW_SHOWNORMAL) DoEvents End If End Function Function AskForSave() As Boolean If Len(Fichier) = 0 Then AskForSave = True Exit Function End If If Changed Then Select Case MsgBox("Save current project ?", vbYesNoCancel + vbDefaultButton1 + vbQuestion, Fichier) Case vbYes Enregistrer Fichier = "" AskForSave = True Case vbNo Changed = False AskForSave = True Fichier = "" Case Else AskForSave = False End Select Else AskForSave = True Fichier = "" End If End Function Public Sub Enregistrer() Dim I As Integer Dim S As String WUnlock If Len(Fichier) = 0 Then S = GetIniString(INIFILE, "GLOBAL", "Mru") Fichier = GetFileSpecs(CmDlg, GetPath(S), "New.mox", "Save as ...", "Save") If Len(Fichier) = 0 Then ShowCaption Exit Sub End If End If If FileExists(Fichier) Then If MsgBox("Overwrite " & Fichier, vbYesNo + vbQuestion) = vbNo Then S = GetIniString(INIFILE, "GLOBAL", "Mru") Fichier = GetFileSpecs(CmDlg, GetPath(S), "New.mox", "Save as ...", "Save") If Len(Fichier) = 0 Then ShowCaption Exit Sub Else Exit Sub End If End If End If Changed = False ShowCaption WriteIniString INIFILE, "GLOBAL", "Mru", Fichier Save (Fichier) End Sub Function GetCoreData(Min) As Single 'Retourne section réèlle du noyau trouvé Dim S As String Dim I As Integer Dim X WriteIniString INIFILE, "GLOBAL", "DataBase", Database LbFeSect.Caption = "?" LbFeMasse.Caption = "?" LbSectCuMax = "?" LbTrueFeLoss.Caption = "?" Hcu = 0 Lcu = 0 If CoreFixed And Len(LbNoyau.Caption) <> 0 Then S = GetIniString(App.Path & "\core.tbx", "EI", LbNoyau.Caption) Else TrieTableau CoreTbl, 2, 2 'Selon le poids du fer For I = 1 To UBound(CoreTbl, 1) X = CoreTbl(I, 1) LbNoyau.Caption = CoreTbl(I, 0) If X >= Min Then Exit For End If Next I S = GetIniString(App.Path & "\core.tbx", "EI", LbNoyau.Caption) End If Hcu = Substring(S, 4, ",") Lcu = Substring(S, 5, ",") LbFeSect.Caption = Substring(S, 1, ",") FeSect = Substring(S, 1, ",") GetCoreData = FeSect LbFeMasse.Caption = Substring(S, 2, ",") LbSectCuMax = Hcu LSpMoy = Substring(S, 6, ",") FeLen = Substring(S, 3, ",") LbMPL.Caption = FeLen FillTbMu End Function Sub Ouvrir(Check As Boolean) Dim I As Integer Dim S As String Dim Last As String WUnlock Last = GetIniString(INIFILE, "GLOBAL", "Mru") If Check Then If Not AskForSave Then Exit Sub End If If Len(Fichier) = 0 Then Fichier = GetFileSpecs(CmDlg, GetPath(Last), GetFname(Last), "Open project", "Open") If Len(Fichier) = 0 Then Fichier = Last ShowCaption Exit Sub End If End If AllowCompute = False WriteIniString INIFILE, "GLOBAL", "Mru", Fichier ShowCaption Restore Fichier End Sub Sub Compute() End Sub