Bonjour tous le monde voici un appercu du programme que j'essais de confectionner
Pour les 24 Tirants, le PC met 2H11min pour me sortir une solution très acceptable (On doit avoir < 1 gr.m)
Code : Tout sélectionner
;********************************************
;*Logiciel de calcul pour Beck Technologies *
;*Cree avec PureBasic 5.41LTS x64 *
;*Le 08.01.2016 *
;********************************************
;
Enumeration
#Fenetre
#Tableau_Tirants
#Tableau_resultat
#Start_calcul
#Stop_calcul
#Progression
#Resultatgrm
#Resultatgr
#Text1
#Text2
#Text3
#Font1
#Debugage
#AddTirant
#T_Poid
#Piece
#T_Num_Piece
#T_Rayon
#Touche_entree
#Menu
#Popup
#M_Ouvrir
#M_Sauve
#M_SauveSous
#M_Export
#M_ImportPoid
#M_ImportPiece
#M_ImportRayon
#M_Efface
#M_Info
#M_Trie
#M_Aide
#TirantsQZ
#TirantsVG
#TirantsVQ
#TirantsTR
EndEnumeration
Global NbrLigne
Global m$,m3$,Text$,Liste$
Global Stop_calcul = #False
Global Dim Tableau.d(1,3),CoefAngle
Global Dim mo$(1), Dim p(1),m$,Possiblilite$
Declare ClearTableau(GadgetID,NbrLigne)
Declare LoadListIcon(Gadget.l,Filname.s)
Declare SaveListIcon(Gadget.l,Filname.s)
Declare.s Alphabet(Numero)
Declare.l Numero(Alphabet.s)
Declare.l VerifElementTableau(Gadget.l,NbrLigne)
Declare Stop_calcul()
Declare Info()
Declare.d Factoriel(NbrFactoriel)
Declare TriePoid(GadgetID)
Declare Calcul(Permut)
Declare.s DecaleString(Sting.s)
Declare.s FusionString(String1.s,String2.s)
#Bureau = 0
#Poid = 1
#Num_Piece = 2
#Rayon = 3
#Simple = 1
#Double = 2
Procedure ClearTableau(GadgetID,NbrLigne)
ClearGadgetItems(GadgetID)
For T = 1 To NbrLigne
AddGadgetItem(GadgetID, -1, Alphabet(T))
Next T
EndProcedure
Procedure LoadListIcon(Gadget.l,FileName.s)
ClearGadgetItems(Gadget)
If OpenPreferences(FileName)
PreferenceGroup("Tableau")
ExaminePreferenceKeys()
While NextPreferenceKey()
Text$ = ReplaceString(PreferenceKeyValue(),Chr(9),Chr(10))
AddGadgetItem(Gadget ,-1,Text$)
Wend
PreferenceGroup("Initialisation")
NbrLigne = ReadPreferenceLong("Nbr de ligne",0)
If NbrLigne = 15
SetMenuItemState(#Menu,#TirantsQZ, #True)
EndIf
If NbrLigne = 20
SetMenuItemState(#Menu,#TirantsVG, #True)
EndIf
If NbrLigne = 24
SetMenuItemState(#Menu,#TirantsVQ, #True)
EndIf
If NbrLigne = 30
SetMenuItemState(#Menu,#TirantsTR, #True)
EndIf
Liste$ = ReadPreferenceString("Resultat_calcul","")
If Liste$ <> ""
AddGadgetItem(#Debugage,-1,"Dernier calcul: "+Liste$)
EndIf
ClosePreferences()
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure SaveListIcon(Gadget.l,FileName.s)
Fichier = CreatePreferences (FileName )
If Fichier
PreferenceGroup("Tableau")
NbrElement = CountGadgetItems(Gadget)
NbrColone = 0
QuitNbrColone = 0
Repeat
If GetGadgetItemText(Gadget,-1,NbrColone) = ""
QuitNbrColone = 1
Else
NbrColone =NbrColone +1
EndIf
Until QuitNbrColone = 1
For Element= 0 To NbrElement -1
For Colone = 0 To NbrColone -1
If Colone = 0
Ligne$ = GetGadgetItemText(Gadget,element,Colone)
Else
Ligne$ = Ligne$ + Chr(9) + GetGadgetItemText(Gadget,element,Colone)
EndIf
Next Colone
WritePreferenceString(Str(Element),Ligne$)
Next Element
PreferenceGroup("Initialisation")
WritePreferenceLong("Nbr de ligne",NbrLigne)
WritePreferenceString("Resultat_calcul",Liste$)
ClosePreferences()
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.s Alphabet(Numero)
If Numero > 36
MessageRequester("Erreur","Le logiciel n'est que prévu pour 36 comparaison possible")
ProcedureReturn "Erreur"
EndIf
If Numero <= 26
ProcedureReturn Chr(Numero+64)
EndIf
If Numero > 26
ProcedureReturn Chr(Numero+21)
EndIf
EndProcedure
Procedure.l Numero(Alphabet.s)
ACSII = Asc(Alphabet)
If ACSII > 64
ProcedureReturn ACSII-64
EndIf
If ACSII > 47
ProcedureReturn ACSII-21
EndIf
EndProcedure
Procedure.l VerifElementTableau(Gadget.l,NbrLigne)
Element = 1
For N=1 To CountGadgetItems(Gadget)
If GetGadgetItemText(Gadget,N,2) <> ""
Element +1
Else
Break
EndIf
Next N
If Element <> NbrLigne
MessageRequester("Erreur","Le nombre d'éléments ne correspond pas au tableau")
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure Stop_calcul()
Stop_calcul = #True
EndProcedure
Procedure Info()
MessageRequester("Info","Vous ete à: "+Possiblilite$+Chr(10)+StrD(NbrEffectuer)+" de "+StrD(Possiblilite))
EndProcedure
Procedure.d Factoriel(NbrFactoriel)
Protected a,b.d
b = 1
For a=1 To NbrFactoriel
b = b * a
Next a
ProcedureReturn b
EndProcedure
Procedure TriePoid(GadgetID)
Structure Piece
NumSerie$
Poid.l
Rayon.d
EndStructure
NewList Piece.Piece()
For n=0 To NbrLigne-1
AddElement(Piece())
Piece()\Poid.l = Val(GetGadgetItemText(GadgetID,n,1))
Piece()\NumSerie$ = GetGadgetItemText(GadgetID,n,2)
Piece()\Rayon.d = ValD(GetGadgetItemText(GadgetID,n,3))
Next n
ClearTableau(GadgetID,NbrLigne)
SortStructuredList(Piece(), #PB_Sort_Ascending, OffsetOf(Piece\Poid),TypeOf(Piece\Poid))
Element = 0
ForEach Piece()
SetGadgetItemText(GadgetID,Element,Str(Piece()\Poid),1)
SetGadgetItemText(GadgetID,Element,Piece()\NumSerie$,2)
SetGadgetItemText(GadgetID,Element,StrD(Piece()\Rayon),3)
Element = Element +1
Next
EndProcedure
Procedure Calcul(Permut)
If Permut = 1
PremiereLettre$=Left(m$,1)
m$=RemoveString(m$,PremiereLettre$)
EndIf
MeilleurResultat.d = 100
n= Len(m$)
Dim mo$(n)
Dim p(n)
mo$(n)=m$
Z=n
rt:
p(Z)=1
dt:
mo$(Z-1)=Right(mo$(Z),Z-1)
Z=Z-1
If Z>1
Goto rt
EndIf
m$=""
For w=1 To n
m$=Left(mo$(w),1)+m$
Next w
If Permut = 2
Possiblilite$ = FusionString(m3$,m$)
Else
Possiblilite$ = PremiereLettre$+m$
EndIf
If Stop_calcul = #True
Goto Fin
EndIf
SommeProjectionX.d = 0
SommeProjectionY.d = 0
For Decoupage=1 To Len(Possiblilite$)
Poids.d = Tableau(Numero(Mid(Possiblilite$,Decoupage, 1)),#Poid)
Rayon.d = Tableau(Numero(Mid(Possiblilite$,Decoupage, 1)),#Rayon)
Angle = ((Decoupage-1)*CoefAngle)+((Permut-1)*15)
SommeProjectionX.d = SommeProjectionX + Poids*Rayon*Cos(Radian(Angle))
SommeProjectionY.d = SommeProjectionY + Poids*Rayon*Sin(Radian(Angle))
Next Decoupage
Balgrm.d = Sqr(SommeProjectionX*SommeProjectionX+SommeProjectionY*SommeProjectionY)
Balgr.d = Balgrm/Rayon
WindowEvent()
If Balgrm < MeilleurResultat
MeilleurResultat = Balgrm
AddGadgetItem(#Debugage,-1,"Meilleur résultat trouvé Calcul"+Str(Permut)+":")
AddGadgetItem(#Debugage,-1,StrD(Balgrm)+"Bal grm")
AddGadgetItem(#Debugage,-1,StrD(Balgr)+"Bal gr")
AddGadgetItem(#Debugage,-1,"Position :"+Possiblilite$)
AddGadgetItem(#Debugage,-1,"***************************")
Liste$ = Possiblilite$
ClearGadgetItems(#Tableau_resultat)
For A=1 To Len(Liste$)
AddGadgetItem(#Tableau_resultat,-1,Mid(Liste$,A, 1)+Chr(10)+StrD(Tableau(Numero(Mid(Liste$,A, 1)),1))+Chr(10)+StrD(Tableau(Numero(Mid(Liste$,A, 1)),2))+Chr(10)+StrD(Tableau(Numero(Mid(Liste$,A, 1)),3)) )
Next A
SetGadgetText(#Resultatgrm,"Balour= " +StrD(Balgrm) + " gr.m")
SetGadgetText(#Resultatgr,"Balour= " +StrD(Balgr) + " gr")
If Balgrm = 0
Goto Fin
EndIf
EndIf
gt:
mo$(Z+1)=mo$(Z)+Left(mo$(Z+1),1)
Z=Z+1
p(Z)=p(Z)+1
If p(Z)<=Z
Goto dt
EndIf
If Z<n
Goto gt
EndIf
; By Dobro
Fin:
AddGadgetItem(#Debugage,-1,"Fin de calcul")
EndProcedure
Procedure.s DecaleString(String.s)
Lettre.s=Left(String,1)
String=RemoveString(String,Lettre)
ProcedureReturn String+Lettre
EndProcedure
Procedure.s FusionString(String1.s,String2.s)
Long1 = Len(String1)
Long2 = Len(String2)
If Long1 <> Long2
Debug long1
Debug long2
EndIf
For n=1 To Long1
Lettre.s = Left(String2,1)
String2 = RemoveString(String2,Lettre)
String1 = InsertString(String1,Lettre,n*2)
Next n
ProcedureReturn string1
EndProcedure
LoadFont (#Font1, "Arial", 30,#PB_Font_Bold)
;-Fenetre Windows
;{
If OpenWindow(#Fenetre, 0, 0, 940,510 , "Calcul équilibre", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered )
If CreateMenu(#Menu,WindowID(#Fenetre))
MenuTitle("Fichier")
MenuItem( #M_Ouvrir, "Ouvrir")
MenuItem( #M_Sauve, "Sauvegarder"):DisableMenuItem(#Menu,#M_Sauve,#True)
MenuItem( #M_SauveSous, "Sauvegarder sous")
MenuTitle("Logiciel")
MenuItem(#M_Efface,"Effacer la liste du tableau")
MenuItem(#M_Info,"Information"):DisableMenuItem(#Menu,#M_Info,#True):BindMenuEvent(#Menu,#M_Info,@Info())
MenuBar()
MenuItem(#M_Trie,"Partir sur des valeurs croissante avant calcul"):SetMenuItemState(#Menu,#M_Trie,#True)
MenuBar()
OpenSubMenu("Nombre de Tirant")
MenuItem( #TirantsQZ, "15 Tirants")
MenuItem( #TirantsVG, "20 Tirants")
MenuItem( #TirantsVQ, "24 Tirants")
MenuItem( #TirantsTR, "30 Tirants")
CloseSubMenu()
MenuTitle("Aide")
MenuItem(#M_Aide,"Aide")
EndIf
If CreatePopupImageMenu(#Popup, #PB_Menu_ModernLook)
MenuItem(#M_Export,"Exporter resultat vers Exel"):DisableMenuItem(#Menu,#M_Export,#True)
MenuItem(#M_ImportPoid,"Import Poids depuis Exel"):DisableMenuItem(#Menu,#M_ImportPoid,#True)
MenuItem(#M_ImportPiece,"Import N° pièce depuis Exel"):DisableMenuItem(#Menu,#M_ImportPiece,#True)
MenuItem(#M_ImportRayon,"Import Rayon depuis Exel"):DisableMenuItem(#Menu,#M_ImportRayon,#True)
EndIf
AddKeyboardShortcut(#Fenetre,#PB_Shortcut_Return,#Touche_entree)
TextGadget(#Text1, 0, 0, 365, 30, "Liste des Tirants",#PB_Text_Center):SetGadgetFont(#Text1,#Font1)
ListIconGadget(#Tableau_Tirants, 0, 30, 365, 370, "Position de montage", 40,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
TextGadget(#Text2, 370, 0, 365, 30, "Résultat",#PB_Text_Center):SetGadgetFont(#Text2,#Font1)
ListIconGadget(#Tableau_resultat, 370, 30, 365, 390, "Position de montage", 40,#PB_ListIcon_GridLines ):SetGadgetColor(#Tableau_resultat,#PB_Gadget_BackColor,$DCDCDC)
TextGadget(#Text3,740,0,200,30,"Debugage",#PB_Text_Center):SetGadgetFont(#Text3,#Font1)
EditorGadget(#Debugage,740,30,200,390,#PB_Editor_ReadOnly):SetGadgetColor(#Debugage,#PB_Gadget_BackColor,$000000):SetGadgetColor(#Debugage,#PB_Gadget_FrontColor,$FFFFFF)
ButtonGadget(#Start_calcul, 0, 430, 90, 30, "Start calcul",#PB_Button_Default)
ButtonGadget(#Stop_calcul, 870, 430, 70, 30, "Arret calcul"):BindGadgetEvent(#Stop_calcul,@Stop_calcul())
ProgressBarGadget(#Progression, 0, 470, 940, 20, 0, 100)
TextGadget(#Resultatgrm, 370, 430, 365, 20, "Balour= XXXXX gr.m")
TextGadget(#Resultatgr, 370, 450, 365, 20, "Balour= XXXXX gr")
;Preparation des tableaux
For Tableau = #Tableau_Tirants To #Tableau_resultat
AddGadgetColumn(Tableau, 1, "POIDS en gramme", 100)
AddGadgetColumn(Tableau, 2, "N° de série des tirants", 100)
AddGadgetColumn(Tableau, 3, "Rayon", 100)
Next Tableau
If Not LoadListIcon(#Tableau_Tirants,"Temp_tableau_tirants.sav")
ClearTableau(#Tableau_Tirants,NbrLigne)
EndIf
TextGadget(#Piece,0,400,40,30,"A",#PB_Text_Center)
StringGadget(#T_Poid,40,400,100,20,"")
StringGadget(#T_Num_Piece,140,400,100,20,"")
StringGadget(#T_Rayon,240,400,100,20,"")
;}
;Action sur les événemets
Repeat
Evenement = WaitWindowEvent()
Select Evenement
Case #PB_Event_CloseWindow
Quit = #True
;-Menu
;{
Case #PB_Event_Menu
Select EventMenu()
Case #Touche_entree
SetGadgetItemText(#Tableau_Tirants,Select_Element,GetGadgetText(#T_Poid),#Poid)
SetGadgetItemText(#Tableau_Tirants,Select_Element,GetGadgetText(#T_Num_Piece),#Num_Piece)
SetGadgetItemText(#Tableau_Tirants,Select_Element,GetGadgetText(#T_Rayon),#Rayon)
Case #M_Aide
MessageRequester("Aide","Il n'y as pas d'aide de pévus pour ce logiciel"+Chr(10)+"Logiciel créer pour BECK Technologies le 08.01.2016")
Case #M_Efface
ClearTableau(#Tableau_Tirants,NbrLigne)
Case #M_Trie
If GetMenuItemState(#Menu,#M_Trie) <> 0
SetMenuItemState(#Menu,#M_Trie, #False)
Else
SetMenuItemState(#Menu,#M_Trie, #True)
EndIf
Case #TirantsQZ
SetMenuItemState(#Menu,#TirantsQZ, #True)
SetMenuItemState(#Menu,#TirantsVG, #False)
SetMenuItemState(#Menu,#TirantsVQ, #False)
SetMenuItemState(#Menu,#TirantsTR, #False)
NbrLigne = 15
ClearTableau(#Tableau_Tirants,NbrLigne)
Case #TirantsVG
SetMenuItemState(#Menu,#TirantsQZ, #False)
SetMenuItemState(#Menu,#TirantsVG, #True)
SetMenuItemState(#Menu,#TirantsVQ, #False)
SetMenuItemState(#Menu,#TirantsTR, #False)
NbrLigne = 20
ClearTableau(#Tableau_Tirants,NbrLigne)
Case #TirantsVQ
SetMenuItemState(#Menu,#TirantsQZ, #False)
SetMenuItemState(#Menu,#TirantsVG, #False)
SetMenuItemState(#Menu,#TirantsVQ, #True)
SetMenuItemState(#Menu,#TirantsTR, #False)
NbrLigne = 24
ClearTableau(#Tableau_Tirants,NbrLigne)
Case #TirantsTR
SetMenuItemState(#Menu,#TirantsQZ, #False)
SetMenuItemState(#Menu,#TirantsVG, #False)
SetMenuItemState(#Menu,#TirantsVQ, #False)
SetMenuItemState(#Menu,#TirantsTR, #True)
NbrLigne = 30
ClearTableau(#Tableau_Tirants,NbrLigne)
Case #M_Ouvrir
Fichier$=OpenFileRequester("Ouverture fichier Tirants","","Tirants (*.tir)|*.tir",0)
If Fichier$
LoadListIcon(#Tableau_Tirants,Fichier$)
DisableMenuItem(#Menu,#M_Sauve,#False)
EndIf
Case #M_Sauve
If Fichier$
SaveListIcon(#Tableau_Tirants,Fichier$+".tir")
EndIf
Case #M_SauveSous
Fichier$= SaveFileRequester("Sauvegarde fichier Tirants","","Tirants (*.tir)|*.tir",0)
If Fichier$
SaveListIcon(#Tableau_Tirants,Fichier$+".tir")
DisableMenuItem(#Menu,#M_Sauve,#False)
EndIf
Case #M_Export
Case #M_ImportPiece
Case #M_ImportPoid
Case #M_ImportRayon
EndSelect
;}
Case #PB_Event_Gadget
Select EventGadget()
Case #Start_calcul
;Initialisation avant calcul
If Not SaveListIcon(#Tableau_Tirants,"Temp_tableau_tirants.sav")
MessageRequester("Erreur","Impossible de pouvoir sauvegarder le fichier temporaire")
EndIf
DisableGadget(#Tableau_Tirants,#True);Désactive le touché du tableau pièce
DisableMenuItem(#Menu,#M_Info,#False);Active le menu info
m$="" ;Efface la chaine de caractère
Stop_calcul = #False
If GetMenuItemState(#Menu,#M_Trie)
TriePoid(#Tableau_Tirants)
EndIf
;Creation de la chaine de caractère suivant le tableau
Chaine$ = "" ;Annulation de la chaine de caractere
If VerifElementTableau(#Tableau_Tirants,NbrLigne) ;Combien d'element ce trouve
Dim Tableau.d(NbrLigne,3) ;Dimention du tableau
For Alphabet = 1 To NbrLigne ;Remplissage du tableau
m$ = m$+Alphabet(Alphabet) ;Liste des noms valide pour traitement
Tableau(Alphabet,#Poid) = ValD(GetGadgetItemText(#Tableau_Tirants,Alphabet-1,#Poid))
Tableau(Alphabet,#Num_Piece) = ValD(GetGadgetItemText(#Tableau_Tirants,Alphabet-1,#Num_Piece))
Tableau(Alphabet,#Rayon) = ValD(GetGadgetItemText(#Tableau_Tirants,Alphabet-1,#Rayon))
Next Alphabet
;Type de calcul (Double ou simple)
If NbrLigne = 15
Calcul = #Simple
Else
Calcul = #Double
EndIf
MessageRequester("Validation",Str(Nbr_Element_valide)+" élément du tableau vont etre calculer"+Chr(10)+"Soyer patient pour obtenir le meilleur résultat"+Chr(10)+"NE PAS OUBLIER DE DESACTIVER LA MISE EN VEILLE")
Date$ = FormatDate("%yyyy/%mm/%dd", Date())
Time$ = FormatDate("%hh:%ii:%ss", Date())
AddGadgetItem(#Debugage,-1,"***Debut du calcul***")
AddGadgetItem(#Debugage,-1,"Date: "+Date$)
AddGadgetItem(#Debugage,-1,"à: "+Time$)
Delay(200)
;*****************************************************************************
If m$<>""
If Calcul = #Simple
CoefAngle = 360/NbrLigne
Calcul(#Simple)
Else ; Calcul double
CoefAngle = (360/NbrLigne)*2
longeurString = Len(m$)/2
m1$ = m$
m$=Left(m1$,longeurString)
m2$ = m$
Calcul(#Simple)
m3$ = Liste$
CoefAngle = 360/NbrLigne
m$=Left(RemoveString(m1$,m2$),longeurString)
Calcul(#Double)
EndIf
DisableGadget(#Tableau_Tirants,#False)
DisableMenuItem(#Menu,#M_Info,#True)
Stop_calcul = #False
Date$ = FormatDate("%yyyy/%mm/%dd", Date())
Time$ = FormatDate("%hh:%ii:%ss", Date())
AddGadgetItem(#Debugage,-1,"***Fin du calcul!***")
AddGadgetItem(#Debugage,-1,"Date: "+Date$)
AddGadgetItem(#Debugage,-1,"à: "+Time$)
EndIf
Else
AddGadgetItem(#Debugage,-1,"Manque des éléments dans le tableau")
EndIf
Case #Tableau_Tirants
Select_Element=GetGadgetState(#Tableau_Tirants)
SetGadgetText(#Piece,GetGadgetItemText(#Tableau_Tirants,Select_Element,0))
SetGadgetText(#T_Poid,GetGadgetItemText(#Tableau_Tirants,Select_Element,#Poid)):SetActiveGadget(#T_Poid)
SetGadgetText(#T_Num_Piece,GetGadgetItemText(#Tableau_Tirants,Select_Element,#Num_Piece))
SetGadgetText(#T_Rayon,GetGadgetItemText(#Tableau_Tirants,Select_Element,#Rayon))
EndSelect
EndSelect
Until Quit = #True
If Not SaveListIcon(#Tableau_Tirants,"Temp_tableau_tirants.sav")
MessageRequester("Erreur","Impossible de pouvoir sauvegarder le fichier temporaire")
EndIf
EndIf