FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» un nouveau editeur panobasic
par Jean Claude Aujourd'hui à 10:18

» Compilateur FBPano
par jean_debord Aujourd'hui à 10:07

» Le compilateur.
par Pedro Alvarez Aujourd'hui à 8:36

» COMPILATEUR V 0.9 beta 7 du 10 aout 2017
par Jack Hier à 20:23

» Pb 16 (en analyse): ON_CLOSE plante à l'exécution
par Jack Hier à 20:00

» Pb 15 (en analyse): TIMER_ON plante à l'exécution
par Jack Hier à 19:58

» KGF_dll - nouvelles versions
par Yannick Dim 13 Aoû 2017 - 17:35

» probleme d'outil
par Yannick Dim 13 Aoû 2017 - 17:32

» Carte de France des régions
par Yannick Sam 12 Aoû 2017 - 21:33

» Pb 14 (en analyse): PRINT_LOCATE plante à l'exécution
par Jack Ven 11 Aoû 2017 - 22:37

» Petit avertissement [Mots réservés]
par papydall Ven 11 Aoû 2017 - 13:45

» Distances sur plan
par JL35 Jeu 10 Aoû 2017 - 21:29

» Tracé : Triangle, Carrée, Dents de scie, Sinusoïde redressée
par papydall Jeu 10 Aoû 2017 - 14:52

» Troncature dans une image
par JL35 Mer 9 Aoû 2017 - 13:45

» A chacun son point de vue
par papydall Mar 8 Aoû 2017 - 17:20

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Août 2017
LunMarMerJeuVenSamDim
 123456
78910111213
14151617181920
21222324252627
28293031   
CalendrierCalendrier

Partagez | 
 

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

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Yannick

avatar

Nombre de messages : 7961
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: Et du côté de chez Archimède...   Ven 8 Mai 2015 - 15:55

Pendant cette coupure de connexion internet,
je suis allé faire un tour chez ce bon vieil Archimède qui n' a pas joué qu' avec de l' eau.
Je suis tombé sur une formule pour calculer le point d' équilibre et j' en ai fait cà :
Code:

' 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 : "
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5849
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Et du côté de chez Archimède...   Ven 8 Mai 2015 - 17:30

Pas mal
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

Nombre de messages : 7961
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Ven 8 Mai 2015 - 20:04

On peut aller plus loin dans la précision mais cela devient long...très long... Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5501
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Et du côté de chez Archimède...   Ven 8 Mai 2015 - 21:34

Jicehel a dit : Pas mal
Je dirais même plus : pas mal !
Certes Archimède n’a pas fait que barboter dans son bain : il a aussi roulé sa bosse un peut partout.
C’est bien lui qui a dit :  "Donnez-moi un point d'appui, et je soulèverai le monde."

Revenons au code :
Si à la demande du programme de saisir les variables, j’entre ce qui me passe à la tête : (et bien des choses insensées peuvent passer par la tête de papydall) :
Un poids négatif par exemple fera boucler le programme jusqu’à la fin des siècles !
Une valeur non numérique et devinez ce qui se passera
Une longueur du levier nulle et une erreur fatale : division par zéro.

Morale de l’histoire : blindez vos programmes !
Avant d’oublier : cet inesthétique GOTO : je parie un dinar tunisien contre un Euro que tu n’as même pas consacré une nanoseconde de réflexion pour l’éviter !

Avant de sortir, voici mes modifications (suivies de ‘ REM)
Pour les calculs qui peuvent être assez longs, je n’ai rien modifiés)

Code:
' 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 : "
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Yannick

avatar

Nombre de messages : 7961
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Ven 8 Mai 2015 - 21:47

Je suis d' accord avec toi sur le blindage, j' ai fait cela vite fait.
Par contre, désolé, je ne partage pas ton allergie à "goto" et ajouter des variables
il m' arrive de manquer d' inspiration pour les nommer... Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: Et du côté de chez Archimède...   

Revenir en haut Aller en bas
 
Et du côté de chez Archimède...
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» soldes chez free !!
» Abonnement gratuit chez Free
» Spam et cheval de troie chez FREE et les autres FAI
» Visite chez Capitole
» "Oregon 450T en test gràce à un prêt chez Décathlon" vs Oziexplorer

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC 32 bits :: Les inutilitaires-
Sauter vers: