Forum Liberty Basic France

Jeux » Câble-Tension-Flèche Cable / Tension / Flèche
Le 13/05/2013 à 12h21

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2099
La précision n'est pas énorme, mais ça donne une idée.
On peut modifier les paramètres après un calcul (un paramètre à la fois).
Et bien sûr on peut optimiser le code.

Code VB :
 
    NOMAINWIN
    WindowWidth=420
    WindowHeight=330
    UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
 
     'TEXTBOX #w.testa, 60 , 200, 70, 20

    TEXTBOX #w.L, 170 , 27, 50, 20
    TEXTBOX #w.h, 280 , 60, 50, 20
    TEXTBOX #w.w, 160 , 170, 50, 20
    TEXTBOX #w.fk, 160 , 60, 50, 20
    BUTTON #w.go, "calcule", [go], UL, 150, 230, 70, 25
    GRAPHICBOX #w.g, 5, 5, 400, 285
 
    open "Cable / Poids...Je calcule le 4ème Paramètre" FOR WINDOW AS #w
     print #w, "trapclose [quit]"  ' Le print est facultatif
     #w.g, "down"
     #w.g, "fill black"
 
      #w.g "color green;backcolor green"
      #w.g "place 20 60":#w.g "boxfilled 30 240"
      #w.g "place 350 60":#w.g "boxfilled 360 240"
 
      #w.g, "color red; backcolor black"
      #w.g, "font courier_new 14 bold"
      #w.g, "place 263 68":#w.g, "\>"
      #w.g, "place 325 68":#w.g, "\<"
      #w.g, "place 255 90":#w.g, "\force kg"
      #w.g "size 2"
      #w.g "color red":#w.g "line 25 62 290 62"
      #w.g "color red":#w.g "line 325 62 355 62"
 
      #w.g "size 1"
      #w.g "color yellow"
      #w.g "line 25 59 25 25"
      #w.g "line 355 59 355 20"
      #w.g, "place 27 35":#w.g, "\<"
      #w.g, "place 343 35":#w.g, "\>"
      #w.g, "place 230 25":#w.g, "\m"
 
      #w.g, "place 105 90":#w.g, "\flèche"
      #w.g, "place 190 90":#w.g, "\m"
      #w.g "line 26 30 165 30"
      #w.g "line 215 30 355 30"
 
      #w.g "size 2"
      #w.g "color pink;backcolor pink"
      #w.g "place 180 180"
      #w.g "circlefilled 35"
      #w.g "line 180 180 180 61"
      #w.g "color black;backcolor pink"
      #w.g, "place 168 203":#w.g, "\kg"
      #w.g, "flush"
  wait
  [go]
     #w.L, "!contents? L$":L=val(L$)
     #w.h, "!contents? h$":h=val(h$)
     #w.w, "!contents? w$":w=val(w$)
     #w.fk, "!contents? fk$":fk=val(fk$)
 
     if h$="" and L$<>"" and w$<>"" and fk$<>"" then goto [calch]
      if h$<>oldh$ and L$<>"" and w$<>"" and fk$<>"" then goto [calch]
     if L$="" and h$<>"" and w$<>"" and fk$<>"" then goto [calcL]
      if L$<>oldL$ and h$<>"" and w$<>"" and fk$<>"" then goto [calcL]
     if w$="" and L$<>"" and h$<>"" and fk$<>"" then goto [calcw]
      if w$<>oldw$ and L$<>"" and h$<>"" and fk$<>"" then goto [calcw]
     if fk$="" and L$<>"" and w$<>"" and h$<>"" then goto [calcfk]
      if fk$<>oldfk$ and L$<>"" and w$<>"" and h$<>"" then goto [calcfk]
     if h$="" then
        if L$="" or w$="" or fk$="" then gosub [what]
     end if
     if L$="" then
        if h$="" or w$="" or fk$="" then gosub [what]
     end if
     if w$="" then
        if h$="" or L$="" or fk$="" then gosub [what]
     end if
     if fk$="" then
        if h$="" or L$="" or w$="" then gosub [what]
     end if
  wait
  [calch]
     gosub [eff]
     rh=(w*L^2)/(8*fk):#w.h, str$(rh):oldh$=h$
  wait
  [calcL]
     gosub [eff]
     rL=sqr(h*(8*fk)/w):#w.L, str$(rL):oldL$=L$
  wait
  [calcw]
     gosub [eff]
     rw=h*(8*fk)/(L^2):#w.w, str$(rw):oldw$=w$
  wait
  [calcfk]
     gosub [eff]
     rfk=((w*L^2)/h)/8:#w.fk, str$(rfk):oldfk$=fk$
  wait
  [what]
     #w.g, "font courier_new 12 bold"
     #w.g "color white;backcolor black"
     #w.g, "place 70 270":#w.g, "\Donnée(s) manquante(s)"
  return
  [eff]
     #w.g "color black; backcolor black"
     #w.g, "place 70 255":#w.g, "boxfilled 300 275"
  return
  ' 0.8  0.05  56  89.6
  wait
  [quit]
    CLOSE #w
    END
 
 




Edité par Roland Le 13/05/2013 à 18h43
____________________
Roro

   
Le 07/08/2013 à 11h35

Libertynaute Avancé

Groupe: Membre

Inscrit le: 08/06/2012
Messages: 270
Beau programme ! :D
____________________
Si le meilleurs langage de programmation existe, alors le Just Basic est loin devant.
Ne me tappez pas dessus ! Je débute :D

Web    
Jeux » Câble-Tension-Flèche Cable / Tension / Flèche  

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie