Et du côté de chez Archimède...

' Equilibriste
' Par ygeronimi
' Sur une idée originale de Mr ARCHIMEDE

hide 0
Application_title "Equilibriste"
Variables()
Labels()
Gui()
show 0
End

SUB Variables()
   dim_local i%
'  version
   dim vers$ : vers$ = "0.1"
'  objets
   dim no%
   dim Alph%(10) : for i%=1 to 10 : no%=no%+1 : Alph%(i%)=no% : next i%
   dim Ed%(10)   : for i%=1 to 10 : no%=no%+1 : Ed%(i%)=no%   : next i%
   dim But%      : no%=no%+1      : But%     =no%
   dim FormMess% : no%=no%+1      : FormMess% =no%
   dim Pb%       : no%=no%+1      : Pb%      =no%
   dim MPb%
END_SUB

SUB Labels()
   Label clic
   label Repet
END_SUB

SUB Gui()
   dim_local t%,i%,etiq$
   height 0,190 :width 0,300
   top 0,(screen_y-height(0))/2
   left 0,(screen_x-width(0))/2
   caption 0,"Equilibriste - Vs "+vers$
  
   t%=-20
   for i%=1 to 4
      t%=t%+30
      Alpha Alph%(i%)
      top Alph%(i%),t%
      left Alph%(i%),10
      read etiq$
      caption Alph%(i%),etiq$
      font_name Alph%(i%),"Arial" : font_size Alph%(i%),8 : font_bold Alph%(i%)
   next i%
  
   t%=-24
   for i%=1 to 4
      t%=t%+30
      Edit Ed%(i%)
      top Ed%(i%),t%
      left Ed%(i%),200
      width Ed%(i%),80
      font_name Ed%(i%),"Arial" : font_size Ed%(i%),8 : font_bold Ed%(i%)
   next i%
   hint ed%(2),"Dans la même unité de poids que l' objet 1"
   hint ed%(4),"Dans la même unité de poids que l' objet 1"
  
   Button But%
   top But%,height(0)-65
   read etiq$
   Caption But%,etiq$
   font_name But%,"Arial" : font_size But%,8 : font_bold But%
   left But%,(width(0)-width(but%))/2
   cursor_point But%
   On_click But%,clic
  
   Progress_bar Pb%
   hide Pb%
   top Pb%,height(0)-65
   left Pb%,(width(0)-width(Pb%))/2
END_SUB

Clic:
   hide But%
   Show Pb%
   MPb% =int(val(text$(Ed%(3))))
   min Pb%,0 : max Pb%,MPb% : Position Pb%,0
   Rechercher(text$(Ed%(1)),text$(Ed%(2)),text$(Ed%(3)),text$(Ed%(4)))
return

SUB Rechercher(p1$,p2$,L$,PL$)
   dim_local P1,P2,L,PL,d1,d2,a,b,pl1,pl2,pc,i,a$,b$,sep%,le$,ri$
   i=0.001
   d1=0
   if P1$<>"" : P1=val(P1$) : else : P1=0 : end_if
   if P1$<>"" : P2=val(P2$) : else : P2=0 : end_if
   if L$<>""  : L=val(L$)   : else : L=0  : end_if
   if PL$<>"" : PL=val(PL$) : else : PL=0 : end_if
  
   Repet:
   Repeat
      d1=d1+i
      Position Pb%,int(d1)
      display
      d2=L-d1
      Pc=(d1*100)/L
      pl1=(Pc*PL)/100
      pl2=PL-pl1

      a=d1*(P1+pl1)
      a$=str$(a)
      sep%=instr(a$,".")
      if sep%<>0
         le$=left$(a$,sep%-1)
         ri$=right$(a$,len(a$)-sep%)
         ri$=left$(ri$,2)
         a$=le$+ri$
      end_if
     
      b=d2*(P2+pl2)
      b$=str$(b)
      sep%=instr(b$,".")
      if sep%<>0
         le$=left$(b$,sep%-1)
         ri$=right$(b$,len(b$)-sep%)
         ri$=left$(ri$,2)
         b$=le$+ri$
      end_if
     
      caption 0,str$(d1)+" - "+str$(d2)
      if a$=b$
         Position Pb%,0 : hide Pb%  : show But%
         MessageFin(d1,d2)
         exit_repeat
      end_if
   Until d1=L
  
   if d2=0
      i=i/10
      d1=0
      Position Pb%,0
      goto Repet
   end_if
END_SUB

SUB MessageFin(a,b)
   dim_local etiq$
   if object_exists(FormMess%)=1
      show FormMess%
   else
      Form FormMess%
      height FormMess%,100 : width FormMess%,300
      top FormMess%,(screen_y-FormMess%)/2
      left FormMess%,(screen_x-FormMess%)/2
      caption FormMess%,"Equilibriste [ Résultat ]"
     
      Alpha Alph%(5)
      Parent Alph%(5),FormMess%
      top Alph%(5),10
      left Alph%(5),10
      read etiq$
      caption Alph%(5),etiq$
      font_name Alph%(5),"Arial" : font_size Alph%(5),8 : font_bold Alph%(5)
     
      Alpha Alph%(6)
      Parent Alph%(6),FormMess%
      top Alph%(6),30
      left Alph%(6),10
      read etiq$
      caption Alph%(6),etiq$
      font_name Alph%(6),"Arial" : font_size Alph%(6),8 : font_bold Alph%(6)
     
      Alpha Alph%(7)
      Parent Alph%(7),FormMess%
      top Alph%(7),10
      left Alph%(7),130
      font_name Alph%(7),"Arial" : font_size Alph%(7),8 : font_bold Alph%(7)
      font_color Alph%(7),0,200,0

      Alpha Alph%(8)
      Parent Alph%(8),FormMess%
      top Alph%(8),30
      left Alph%(8),130
      font_name Alph%(8),"Arial" : font_size Alph%(8),8 : font_bold Alph%(8)
      font_color Alph%(8),0,0,200

   end_if
   Caption Alph%(7),str$(a)
   Caption Alph%(8),str$(b)
END_SUB

data "Poids objet 1 : ","Poids objet 2 : ","Longueur du levier : ","Poids du levier : "
data "Rechercher","Distance de A à PE : ","Distance de PE à B : "

' Equilibriste
' Par ygeronimi
' Sur une idée originale de Mr ARCHIMEDE

hide 0
Application_title "Equilibriste"
Variables()
Labels()
Gui()
show 0
End

SUB Variables()
   dim_local i%
'  version
   dim vers$ : vers$ = "0.1"
'  objets
   dim no%
   dim Alph%(10) : for i%=1 to 10 : no%=no%+1 : Alph%(i%)=no% : next i%
   dim Ed%(10)   : for i%=1 to 10 : no%=no%+1 : Ed%(i%)=no%   : next i%
   dim But%      : no%=no%+1      : But%     =no%
   dim FormMess% : no%=no%+1      : FormMess% =no%
   dim Pb%       : no%=no%+1      : Pb%      =no%
   dim MPb%
   dim fin       : ' Variable pour tester la sortie de la boucle ====== Papydall
END_SUB

SUB Labels()
   Label clic
'   label Repet  : ' ======================================= Papydall n'aime pas
END_SUB

SUB Gui()
   dim_local t%,i%,etiq$
   height 0,190 :width 0,300
   top 0,(screen_y-height(0))/2
   left 0,(screen_x-width(0))/2
   caption 0,"Equilibriste - Vs "+vers$

   t%=-20
   for i%=1 to 4
      t%=t%+30
      Alpha Alph%(i%)
      top Alph%(i%),t%
      left Alph%(i%),10
      read etiq$
      caption Alph%(i%),etiq$
      font_name Alph%(i%),"Arial" : font_size Alph%(i%),8 : font_bold Alph%(i%)
   next i%

   t%=-24
   for i%=1 to 4
      t%=t%+30
      Edit Ed%(i%)
      top Ed%(i%),t%
      left Ed%(i%),200
      width Ed%(i%),80
      font_name Ed%(i%),"Arial" : font_size Ed%(i%),8 : font_bold Ed%(i%)
   next i%
   hint ed%(2),"Dans la même unité de poids que l' objet 1"
   hint ed%(4),"Dans la même unité de poids que l' objet 1"

   Button But%
   top But%,height(0)-65
   read etiq$
   Caption But%,etiq$
   font_name But%,"Arial" : font_size But%,8 : font_bold But%
   left But%,(width(0)-width(but%))/2
   cursor_point But%
   On_click But%,clic

   Progress_bar Pb%
   hide Pb%
   top Pb%,height(0)-65
   left Pb%,(width(0)-width(Pb%))/2
END_SUB

Clic:
   hide But%
   Show Pb%
   if numeric(text$(Ed%(3))) = 0  : ' ======== Papydall aime le blindage du code
      MPb% = 0
   else
      MPb% =int(val(text$(Ed%(3))))
   end_if                        : ' ======================================= FIN
   min Pb%,0 : max Pb%,MPb% : Position Pb%,0
   Rechercher(text$(Ed%(1)),text$(Ed%(2)),text$(Ed%(3)),text$(Ed%(4)))
return

SUB Rechercher(p1$,p2$,L$,PL$)
   dim_local P1,P2,L,PL,d1,d2,a,b,pl1,pl2,pc,i,a$,b$,sep%,le$,ri$
   i=0.001
   d1=0
   '  ======================================== Papydall aime le blindage du code
   ' P1, P2, ne doivent pas être négatives (une valeur nulle est accepté)
   ' PL doit être positive
   ' L doit être obligatoirement positive
   if P1$ <> "" and numeric(p1$) = 1 : P1 = abs(val(P1$)) : else : P1 = 0 : end_if
   if P2$ <> "" and numeric(p2$) = 1 : P2 = abs(val(P2$)) : else : P2 = 0 : end_if
   if L$  <> "" and numeric(L$)  = 1 : L  = abs(val(L$))  : else : L  = 1 : end_if
   if L = 0 then L = 1
   if PL$ <> "" and numeric(pL$) = 1 : PL = abs(val(PL$)) : else : PL = 1 : end_if
   if PL = 0 then PL = 1
   '  =================================== FIN  Papydall aime le blindage du code
'   Repet:       : ' ======================================= Papydall n'aime pas
   repeat        : ' ================= Papydall aime la programmation structurée
      Repeat
         d1=d1+i
         Position Pb%,int(d1)
         display
         d2=L-d1
         Pc=(d1*100)/L
         pl1=(Pc*PL)/100
         pl2=PL-pl1

         a=d1*(P1+pl1)
         a$=str$(a)
         sep%=instr(a$,".")
         if sep%<>0
            le$=left$(a$,sep%-1)
            ri$=right$(a$,len(a$)-sep%)
            ri$=left$(ri$,2)
            a$=le$+ri$
         end_if

         b=d2*(P2+pl2)
         b$=str$(b)
         sep%=instr(b$,".")
         if sep%<>0
            le$=left$(b$,sep%-1)
            ri$=right$(b$,len(b$)-sep%)
            ri$=left$(ri$,2)
            b$=le$+ri$
        end_if

        caption 0,str$(d1)+" - "+str$(d2)
        if a$=b$
           Position Pb%,0 : hide Pb%  : show But%
           MessageFin(d1,d2)
          exit_repeat
       end_if
      Until  d1 = L

      if d2 = 0
         i=i/10
         d1=0
         Position Pb%,0
     ' goto Repet  : ' ============================= Papydall a horreur du GOTO
                   : ' car s'en passer du GOTO est un jeu (d'enfant) de Papydall
         fin = 0   : ' Il suffit de déclarer une variable flag et la tester
      else         : ' pour décider de répeter  ou non la boucle
         fin = 1
      end_if
    until fin = 1   : ' ========================================================
END_SUB

SUB MessageFin(a,b)
   dim_local etiq$
   if object_exists(FormMess%)=1
      show FormMess%
   else
      Form FormMess%
      height FormMess%,100 : width FormMess%,300
      top FormMess%,(screen_y-FormMess%)/2
      left FormMess%,(screen_x-FormMess%)/2
      caption FormMess%,"Equilibriste [ Résultat ]"

      Alpha Alph%(5)
      Parent Alph%(5),FormMess%
      top Alph%(5),10
      left Alph%(5),10
      read etiq$
      caption Alph%(5),etiq$
      font_name Alph%(5),"Arial" : font_size Alph%(5),8 : font_bold Alph%(5)

      Alpha Alph%(6)
      Parent Alph%(6),FormMess%
      top Alph%(6),30
      left Alph%(6),10
      read etiq$
      caption Alph%(6),etiq$
      font_name Alph%(6),"Arial" : font_size Alph%(6),8 : font_bold Alph%(6)

      Alpha Alph%(7)
      Parent Alph%(7),FormMess%
      top Alph%(7),10
      left Alph%(7),130
      font_name Alph%(7),"Arial" : font_size Alph%(7),8 : font_bold Alph%(7)
      font_color Alph%(7),0,200,0

      Alpha Alph%(8)
      Parent Alph%(8),FormMess%
      top Alph%(8),30
      left Alph%(8),130
      font_name Alph%(8),"Arial" : font_size Alph%(8),8 : font_bold Alph%(8)
      font_color Alph%(8),0,0,200

   end_if
   Caption Alph%(7),str$(a)
   Caption Alph%(8),str$(b)
END_SUB

data "Poids objet 1 : ","Poids objet 2 : ","Longueur du levier : ","Poids du levier : "
data "Rechercher","Distance de A à PE : ","Distance de PE à B : "