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
» Le Forum est en vacances.
par JL35 Aujourd'hui à 21:20

» Une autre façon de terminer une application.
par JL35 Hier à 14:27

» Compilateur FBPano
par Mike Lun 21 Aoû 2017 - 23:17

» Pb 20 (en analyse): plantage à l'appel d'un SUB
par Jack Lun 21 Aoû 2017 - 21:58

» Pb 19 (en analyse): libellé d'erreur dans des IF imbriqués
par Jack Lun 21 Aoû 2017 - 21:55

» Copier / coller du texte à partir de la fenêtre de commandes
par jean_debord Lun 21 Aoû 2017 - 9:46

» COMPILATEUR V 0.9 beta 8 du 18 aout 2017
par papydall Lun 21 Aoû 2017 - 5:01

» Mettre en windows en veille
par papydall Lun 21 Aoû 2017 - 4:15

» Stretch_on ne stretch plus...
par papydall Dim 20 Aoû 2017 - 15:22

» Pb 18 (en analyse): RESTORE_LABEL avec DATA à la fin
par Jack Dim 20 Aoû 2017 - 13:21

» Problème de traitement des opérateurs avec le compilateur.
par Pedro Alvarez Sam 19 Aoû 2017 - 20:01

» Pb 17 (résolu): ITEM_SELECT ne fonctionne pas
par Jack Jeu 17 Aoû 2017 - 19:26

» un nouveau editeur panobasic
par Jean Claude Jeu 17 Aoû 2017 - 10:18

» Le compilateur.
par Pedro Alvarez Jeu 17 Aoû 2017 - 8:36

» Pb 16 (résolu): ON_CLOSE plante à l'exécution
par Jack Mer 16 Aoû 2017 - 20:00

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 | 
 

 Des Subs pour des petits effets.

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

avatar

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

MessageSujet: Des Subs pour des petits effets.   Sam 13 Déc 2014 - 20:44

Peut être que ceci a déjà été fait mais tant pis je vous mets deux petites Sub pour des effets sur des objets Panoramic.
Code:
dim no%,objet%(10)
dim clic%
label clic

no%=no%+1 : objet%(1)=no%
button no% : top no%,0 : left no%,0
Caption no%,"Simple V" :on_click no%,clic : cursor_point no%

no%=no%+1 : objet%(2)=no%
button no% : top no%,0 : left no%,100
Caption no%,"Simple H" :on_click no%,clic : cursor_point no%

no%=no%+1 : objet%(5)=no%
button no% : top no%,0 : left no%,200
Caption no%,"Simple D" :on_click no%,clic : cursor_point no%

no%=no%+1 : objet%(3)=no%
button no% : top no%,100 : left no%,0
Caption no%,"AR V " :on_click no%,clic : cursor_point no%

no%=no%+1 : objet%(4)=no%
button no% : top no%,100 : left no%,100
Caption no%,"AR H" :on_click no%,clic : cursor_point no%

no%=no%+1 : objet%(6)=no%
button no% : top no%,100 : left no%,200
Caption no%,"AR D" :on_click no%,clic : cursor_point no%

no%=no%+1
Alpha no% : top no%,280 : left no%,200 : caption no%,"Zoom Simple"

no%=no%+1 : objet%(7)=no%
Panel no% : top no%,300 : left no%,200 :height no%,10 : width no%,10
color no%,0,0,0 :on_click no%,clic : cursor_point no%

no%=no%+1
Alpha no% : top no%,280 : left no%,400 : caption no%,"Zoom AR"

no%=no%+1 : objet%(8)=no%
Panel no% : top no%,300 : left no%,400 :height no%,10 : width no%,10
color no%,0,0,0 :on_click no%,clic : cursor_point no%
end

clic:
   clic%=number_click
   if clic%=objet%(1):Slide_Effect(objet%(1),"v",10,"s"): end_if
   if clic%=objet%(2):Slide_Effect(objet%(2),"H",10,"s"): end_if
   if clic%=objet%(3):Slide_Effect(objet%(3),"v",10,"ar"):end_if
   if clic%=objet%(4):Slide_Effect(objet%(4),"h",10,"ar"):end_if
   if clic%=objet%(5):Slide_Effect(objet%(5),"d",10,"s") : end_if
   if clic%=objet%(6):Slide_Effect(objet%(6),"d",10,"ar"): end_if
   if clic%=objet%(7):Zoom_Effect(objet%(7),Top(no%),Left(no%),100,10,"s"):end_if
   if clic%=objet%(8):Zoom_Effect(objet%(8),Top(no%),Left(no%),100,10,"ar"):end_if
return

Sub Slide_Effect(No%,Type$,D%,type2$)
'  fait glisser l'objet No% sélectionné
'  selon l' axe type$ ( V,H ou D ) voulu
'  sur une distance d% (pixels)
'  de type2$ S ou AR
   dim_local x%
  if variable("etat%")=0 then dim etat%(number_objects)
   if upper$(type2$)="AR"
      if etat%(no%)=0
         etat%(no%)=1
      else
         etat%(no%)=0
         d%=d%*-1
      end_if
   else
      if upper$(type2$)<>"S"
         if message_warning_ok("Type2$ - Mouvement inconnu !")=1:end_if
         exit_sub
      end_if
   end_if
   if upper$(type$)="V"
      if d%>0
         for x%=0 to d% :top no%,top(no%)+1:display:next x%
      else
         for x%=0 to d% step -1:top no%,top(no%)-1:display:next x%
      end_if
   End_if
   if upper$(type$)="H"
      if d%>0
         for x%=0 to d%:left no%,left(no%)+1:display:next x%
      else
         for x%=0 to d% step -1:left no%,left(no%)-1:display:next x%
      end_if
   End_if
   if upper$(type$)="D"
      if d%>0
         for x%=0 to d%:left no%,left(no%)+1:top no%,top(no%)+1:display:next x%
      else
         for x%=0 to d% step -1:left no%,left(no%)-1:top no%,top(no%)-1:display:next x%
      end_if
   end_if
   if upper$(type$)<>"V" and upper$(type$)<>"H" and upper$(type$)<>"D"
      if message_warning_ok("Type de déplacement inconnu !!!...")=1
      end_if
      exit_sub
   end_if
End_sub

Sub Zoom_Effect(no%,T%,L%,Tmax%,Tmin%,type$)
'  effet zoom sur un objet no%
'  placé en Top T% et Left L% de taille maximum Tmax% et minimum Tmin% ( taille d'origine)
'  de type$ simple S ou Aller-Retour AR
'  Zoom + au premier clic et zoom - au second
'  Peut être inversé en inversant les tailles Tmax% et Tmin%
   dim_local x%
  if variable("etat%")=0 then dim etat%(number_objects)
   if Upper$(Type$)="S"
      if Width(no%)<Tmax%
         for x%=Tmin% to Tmax% step 2
            top no%,top(no%)-1 : left no%,left(no%)-1
            height no%,height(no%)+2
            width no%,width(no%)+2
            display
         next x%
      else
         message "Taille maximum atteinte !"
         exit_sub
      end_if
   else
      if Upper$(type$)="AR"
         if etat%(7)=0
            etat%(7)=1
            if Width(no%)<Tmax%
               for x%=Tmin% to Tmax% step 2
                  top no%,top(no%)-1 : left no%,left(no%)-1
                  height no%,height(no%)+2
                  width no%,width(no%)+2
                  display
               next x%
            else
               message "Taille maximum atteinte !"
               exit_sub
            end_if
         else
            etat%(7)=0
            if Width(no%)>Tmin%
               for x%=Tmax% to Tmin% step -2
                  top no%,top(no%)+1 : left no%,left(no%)+1
                  height no%,height(no%)-2
                  width no%,width(no%)-2
                  display
               next x%
            else
               message "Taille minimum atteinte !"
               exit_sub
            end_if
         end_if
      else
         if message_warning_ok("Erreur de paramètre type$ !")=1:end_if
         exit_sub
      end_if
   end_if
End_sub


Dernière édition par ygeronimi le Dim 14 Déc 2014 - 18:28, édité 1 fois (Raison : petite modif : la variable etat%(x%) est créé dans la sub.)
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

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

MessageSujet: Re: Des Subs pour des petits effets.   Dim 14 Déc 2014 - 2:51

Salut Ygeronimi

Même si ça a déjà été fait (ce dont je ne suis pas sûr), le rappel est toujours bénéfique.
En tous cas, merci du partage.
Ça pourrait peut-être réanimer un tant soit peu ce Forum étrangement silencieux !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Yannick

avatar

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

MessageSujet: re   Dim 14 Déc 2014 - 17:50

Le code suivant ne reprend les deux Sub au dessus 
mais qui est une application possible d' un effet slide (glissé).
Code:
dim no%
dim clic%,nslide%,i%
nslide%=26
label clic

height 0,(nslide%*20)+38 : width 0,750
font_name 0,"arial"

create_interface()
create_slide_menu(nslide%)

end

Sub create_slide_menu(n%)
  dim_local x%
  if variable("Pan%")=0 then dim Pan%(n%)
  if variable("TPan%")=0 then dim TPan%(n%)
  if variable("LPan%")=0 then dim LPan%(n%)
  for x%=1 to n%
      no%=no%+1 : Pan%(x%)=no%
      Panel no% : height no%,20 : width no%,250 :top no%,(x%*20)-20 : left no%,0-width(no%)+20
      no%=no%+1 : TPan%(x%)=no%
      Alpha no% : parent no%,Pan%(x%) : top no%,1 : left no%,width(Pan%(x%))-15 : Caption no%,chr$(64+x%)
      Cursor_point no% : font_bold no% : on_click no%,clic
      no%=no%+1 : LPan%(x%)=no%
      List no%  : parent no%,Pan%(x%) : top no%,5 : left no%,5 :width no%,width(Pan%(x%))-30 : height no%,height(0)-48
  next x%
End_sub

Sub Create_interface()
  if variable("Nom%")  =0 then dim Nom%
  if variable("Login%")=0 then dim Login%
  if variable("MdP%")  =0 then dim MdP%
  if variable("Secu%") =0 then dim Secu%
  no%=no%+1
  Alpha no% : top no%,10 : left no%,30 : caption no%,"Nom :" :font_bold no%
  no%=no%+1 : Nom%=no%
  Edit no%  : top no%,25 : left no%,30 : width no%,150
  no%=no%+1
  Alpha no% : top no%,50 : left no%,30 : caption no%,"Login :" :font_bold no%
  no%=no%+1 : Nom%=no%
  Edit no%  : top no%,65 : left no%,30 : width no%,150
  no%=no%+1
  Alpha no% : top no%,90 : left no%,30 : caption no%,"Mot de passe :" :font_bold no%
  no%=no%+1 : Nom%=no%
  Edit no%  : top no%,105 : left no%,30 : width no%,150
End_sub

clic:
  clic%=number_click
  for i%=1 to nslide%
      if clic%=TPan%(i%):ShowSlideMenu(Pan%(i%),i%):exit_for :end_if
  next i%
return


Sub ShowSlideMenu(SM%,place%)
  dim_local x%
  if left(sm%)=0
      for x%=1 to width(sm%)-20 : left sm%,left(sm%)-1 :display: next x%
      top sm%,(place%*20)-20
      height sm%,20
      top TPan%(place%),1
      if place%=1
        for x%=2 to nslide% : show Pan%(x%): next x%
      else
        if place%=nslide%
            for x%=1 to nslide%-1 : show Pan%(x%): next x%
        else
            for x%=1 to place%-1      : show Pan%(x%) : next x%
            for x%=place%+1 to nslide% : show Pan%(x%) : next x%
        end_if
      end_if
  else
      if place%=1
        for x%=2 to nslide% : hide Pan%(x%): next x%
      else
        if place%=nslide%
            for x%=1 to nslide%-1 : hide Pan%(x%): next x%
        else
            for x%=1 to place%-1      : hide Pan%(x%) : next x%
            for x%=place%+1 to nslide% : hide Pan%(x%) : next x%
        end_if
      end_if
      top sm%,0
      height sm%,height(0)-38
      top TPan%(place%),(place%*20)-20
      for x%=1 to width(sm%)-20 : left sm%,left(sm%)+1 :display: next x%
  end_if
End_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

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

MessageSujet: Re   Dim 14 Déc 2014 - 18:31

J' ai modifié la création de la variable etat%(x%) dans le code des sub.
Maintenant, ce tableau est créé par la sub si besoin.

et voilà une application de la sub :
Code:
Dim no%,i%,MM%,SM%(6),Menu$,clic%
label clic

no%=no%+1 : MM%=no%
Main_menu no%

restore
for i%=1 to 6
  no%=no%+1 : SM%(i%)=no%
  read Menu$
  Sub_menu no% : parent no%,MM% : Caption no%,Menu$ : on_click no%,clic
next i%

Create_Hide_Box(6)

end

data "Fichier","Edition","Outils","Paramètres","A Propos","Aide"

Sub Create_hide_box(n%)
  dim_local x%,g%
  if variable("Pan%")=0 then dim Pan%(n%)
  for x%=1 to 6
      no%=no%+1 : Pan%(x%)=no%
      Panel no% : height no%,200 : width no%,width(0)-16 :top no%,top(0)-height(no%) : left no%,0
      g%=g%+20
      color no%,0,g%,0
  next x%
End_sub

clic:
  clic%=number_click
  for i%=1 to 6
      if clic%=SM%(i%): Slide_Effect(Pan%(i%),"v",height(Pan%(i%))-10,"ar"): end_if
  next i%
return

Sub Slide_Effect(No%,Type$,D%,type2$)
'  fait glisser l'objet No% sélectionné
'  selon l' axe type$ ( V,H ou D ) voulu
'  sur une distance d% (pixels)
'  de type2$ S ou AR
  dim_local x%
  if variable("etat%")=0 then dim etat%(number_objects)
  if upper$(type2$)="AR"
      if etat%(no%)=0
        etat%(no%)=1
      else
        etat%(no%)=0
        d%=d%*-1
      end_if
  else
      if upper$(type2$)<>"S"
        if message_warning_ok("Type2$ - Mouvement inconnu !")=1:end_if
        exit_sub
      end_if
  end_if
  if upper$(type$)="V"
      if d%>0
        for x%=0 to d% :top no%,top(no%)+1:display:next x%
      else
        for x%=0 to d% step -1:top no%,top(no%)-1:display:next x%
      end_if
  End_if
  if upper$(type$)="H"
      if d%>0
        for x%=0 to d%:left no%,left(no%)+1:display:next x%
      else
        for x%=0 to d% step -1:left no%,left(no%)-1:display:next x%
      end_if
  End_if
  if upper$(type$)="D"
      if d%>0
        for x%=0 to d%:left no%,left(no%)+1:top no%,top(no%)+1:display:next x%
      else
        for x%=0 to d% step -1:left no%,left(no%)-1:top no%,top(no%)-1:display:next x%
      end_if
  end_if
  if upper$(type$)<>"V" and upper$(type$)<>"H" and upper$(type$)<>"D"
      if message_warning_ok("Type de déplacement inconnu !!!...")=1
      end_if
      exit_sub
  end_if
End_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 4989
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Des Subs pour des petits effets.   Dim 14 Déc 2014 - 20:06

Un menu sympathique !

Bravo Ygeronimi, je garde sous le coude, çà peut servir.

La SUB est facile à mettre en oeuvre.

A+

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: Des Subs pour des petits effets.   Dim 14 Déc 2014 - 23:13

et j'imagine que tu vas les ajouter dans les sub du mag ... Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

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

MessageSujet: re   Lun 15 Déc 2014 - 1:59

Avant de mettre sur le mag, je voudrais faire une seule sub pour tous les déplacements
à moins que les Panoramiciens préfèrent une librairie avec une Sub par mouvement...
Car, ce ne sont que des déplacements incrémentés d' objet.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
mindstorm

avatar

Nombre de messages : 530
Age : 48
Localisation : charente
Date d'inscription : 13/02/2013

MessageSujet: Re: Des Subs pour des petits effets.   Lun 15 Déc 2014 - 10:19

merci ygeronimi
fait comme tu le sent
bounce bounce bounce
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

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

MessageSujet: re   Lun 15 Déc 2014 - 22:28

Mes derniers travaux sur l' effet "slide" appliqué à des objets... Laughing

J' ai fait 4 Sub : 

- Horizontal
- Vertical
- Diagonal
- Zoom

Code:
Dim No%,Comb%,Objet%,Clic%
Label clic

font_name 0,"arial"

No%=No%+1
Alpha no% : top no%,5 : left no%,10 : Caption no%,"Effets :"

No%=No%+1 : Comb%=no%
Combo no% : top no%,20 : left no%,10 : width no%,300

item_add Comb%,"HORIZONTAL_SLIDE_EFFECT  G > D"
item_add Comb%,"HORIZONTAL_SLIDE_EFFECT  D > G"
item_add Comb%,"HORIZONTAL_SLIDE_EFFECT  AR D <> G"
item_add Comb%,"HORIZONTAL_SLIDE_EFFECT  AR G <> D"

item_add Comb%,"VERTICAL_SLIDE_EFFECT    B > H"
item_add Comb%,"VERTICAL_SLIDE_EFFECT    H > B"
item_add Comb%,"VERTICAL_SLIDE_EFFECT    AR B <> H"
item_add Comb%,"VERTICAL_SLIDE_EFFECT    AR H <> B"

item_add Comb%,"DIAGONAL_SLIDE_EFFECT    HG > BD"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    BD > HG"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    HD > BG"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    BG > HD"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    AR HG <> BD"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    AR BD <> HG"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    AR HD <> BG"
item_add Comb%,"DIAGONAL_SLIDE_EFFECT    AR BG <> HD"

item_add Comb%,"ZOOM_SLIDE_EFFECT        I > E"
item_add Comb%,"ZOOM_SLIDE_EFFECT        E > I"
item_add Comb%,"ZOOM_SLIDE_EFFECT        AR IE > EI"
item_add Comb%,"ZOOM_SLIDE_EFFECT        AR EI > IE"

No%=No%+1 : Objet%=No%
Panel no% : top no%,100 : left no%,100 : height no%,50 : width no%,50
color no%,250,250,0 : cursor_point no% : on_click no%,clic

End

Clic:
  clic%=number_click
  if clic%=objet% and item_index(Comb%)=1:HORIZONTAL_SLIDE_EFFECT(objet%,50,"D") :end_if
  if clic%=objet% and item_index(Comb%)=2:HORIZONTAL_SLIDE_EFFECT(objet%,50,"G") :end_if
  if clic%=objet% and item_index(Comb%)=3:HORIZONTAL_SLIDE_EFFECT(objet%,50,"GD") :end_if
  if clic%=objet% and item_index(Comb%)=4:HORIZONTAL_SLIDE_EFFECT(objet%,50,"DG") :end_if

  if clic%=objet% and item_index(Comb%)=5:VERTICAL_SLIDE_EFFECT(objet%,50,"H") :end_if
  if clic%=objet% and item_index(Comb%)=6:VERTICAL_SLIDE_EFFECT(objet%,50,"B") :end_if
  if clic%=objet% and item_index(Comb%)=7:VERTICAL_SLIDE_EFFECT(objet%,50,"BH") :end_if
  if clic%=objet% and item_index(Comb%)=8:VERTICAL_SLIDE_EFFECT(objet%,50,"HB") :end_if
 

  if clic%=objet% and item_index(Comb%)=9:DIAGONAL_SLIDE_EFFECT(objet%,50,"HG") :end_if
  if clic%=objet% and item_index(Comb%)=10:DIAGONAL_SLIDE_EFFECT(objet%,50,"BD") :end_if
  if clic%=objet% and item_index(Comb%)=11:DIAGONAL_SLIDE_EFFECT(objet%,50,"HD") :end_if
  if clic%=objet% and item_index(Comb%)=12:DIAGONAL_SLIDE_EFFECT(objet%,50,"BG") :end_if
  if clic%=objet% and item_index(Comb%)=13:DIAGONAL_SLIDE_EFFECT(objet%,50,"HG-BD") :end_if
  if clic%=objet% and item_index(Comb%)=14:DIAGONAL_SLIDE_EFFECT(objet%,50,"BD-HG") :end_if
  if clic%=objet% and item_index(Comb%)=15:DIAGONAL_SLIDE_EFFECT(objet%,50,"HD-BG") :end_if
  if clic%=objet% and item_index(Comb%)=16:DIAGONAL_SLIDE_EFFECT(objet%,50,"BG-HD") :end_if

  if clic%=objet% and item_index(Comb%)=17:ZOOM_SLIDE_EFFECT(objet%,1.5,"IE")  :end_if
  if clic%=objet% and item_index(Comb%)=18:ZOOM_SLIDE_EFFECT(objet%,1.5,"EI")  :end_if
  if clic%=objet% and item_index(Comb%)=19:ZOOM_SLIDE_EFFECT(objet%,1.5,"IE-EI"):end_if
  if clic%=objet% and item_index(Comb%)=20:ZOOM_SLIDE_EFFECT(objet%,1.5,"EI-IE"):end_if
return
' ##############################################################################
'          LIBRAIRIE D EFFET SLIDE SUR MOUVEMENT D' OBJETS
'                          PAR Y.GERONIMI
'                          LE 15/12/2014
' ##############################################################################

'  Déplacements horizontaux
Sub HORIZONTAL_SLIDE_EFFECT(No%,Dist%,Sens$)
  Dim_Local x%,d%,s$
  If variable("Etat%")=0 then dim Etat%(Number_Objects)
  d%=Dist%
  s$=Sens$
  If Upper$(Sens$)="DG"
      if etat%(objet%)=0
        etat%(objet%)=1
        s$="D"
      Else
        etat%(objet%)=0
        s$="G"
      end_if
  Else
      If Upper$(Sens$)="GD"
        if etat%(objet%)=0
            etat%(objet%)=1
            s$="G"
        Else
            etat%(objet%)=0
            s$="D"
        end_if
      Else
        If len(Sens$)=2
            if Sens$<>"DG" or Sens$<>"GD"
              if message_warning_ok("Sens$ doit être DG ou GD")=1:end_if
              exit_sub
            end_if
        end_if
      End_if
  End_if
  If Upper$(s$)="D"
      If d%>0
        For x%=1 To Dist%
            Left No%,Left(No%)+1
            display
        Next x%
      Else
        If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
        Exit_sub
      End_if
  Else
      If Upper$(s$)="G"
        If d%>0
            d%=d%*-1
            For x%=1 to d% step -1
              Left no%,Left(no%)-1
              Display
            Next x%
        Else
            If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
            Exit_sub
        End_if
      Else
        If message_warning_ok("Paramètre Sens$ erronné !"+chr$(13)+"Le Sens doit êtres ''D'' ou ''G''")=1:End_if
        Exit_sub
      End_if
  End_if
End_Sub

'  Déplacements veticaux
Sub VERTICAL_SLIDE_EFFECT(No%,Dist%,Sens$)
  Dim_Local x%,d%,s$
  If variable("Etat%")=0 then dim Etat%(Number_Objects)
  d%=Dist%
  s$=Sens$
  If Upper$(Sens$)="BH"
      if etat%(objet%)=0
        etat%(objet%)=1
        s$="B"
      Else
        etat%(objet%)=0
        s$="H"
      end_if
  Else
      If Upper$(Sens$)="HB"
        if etat%(objet%)=0
            etat%(objet%)=1
            s$="H"
        Else
            etat%(objet%)=0
            s$="B"
        end_if
      Else
        If len(Sens$)=2
            if Sens$<>"HB" or Sens$<>"BH"
              if message_warning_ok("Sens$ doit être HB ou BH")=1:end_if
              exit_sub
            end_if
        end_if
      End_if
  End_if
  If Upper$(s$)="B"
      If d%>0
        For x%=1 To d%
            Top No%,Top(No%)+1
            display
        Next x%
      Else
        If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
        Exit_sub
      End_if
  Else
      If Upper$(s$)="H"
        If d%>0
            d%=d%*-1
            For x%=1 to d% step -1
              Top no%,Top(no%)-1
              Display
            Next x%
        Else
            If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
            Exit_sub
        End_if
      Else
        If message_warning_ok("Paramètre Sens$ erronné !"+chr$(13)+"Le Sens doit êtres ''B'' ou ''H''")=1:End_if
        Exit_sub
      End_if
  End_if
End_Sub

'  Déplacements Diagonaux
Sub DIAGONAL_SLIDE_EFFECT(No%,Dist%,Sens$)
  Dim_Local x%,d%,s$
  If variable("Etat%")=0 then dim Etat%(Number_Objects)
  d%=Dist%
  s$=Sens$
  If Upper$(Sens$)="HG-BD"
      if etat%(objet%)=0
        etat%(objet%)=1
        s$="HG"
      Else
        etat%(objet%)=0
        s$="BD"
      end_if
  Else
      If Upper$(Sens$)="HD-BG"
        if etat%(objet%)=0
            etat%(objet%)=1
            s$="HD"
        Else
            etat%(objet%)=0
            s$="BG"
        end_if
      Else
        If Upper$(Sens$)="BD-HG"
            if etat%(objet%)=0
              etat%(objet%)=1
              s$="BD"
            Else
              etat%(objet%)=0
              s$="HG"
            end_if
        else
            If Upper$(Sens$)="BG-HD"
              if etat%(objet%)=0
                  etat%(objet%)=1
                  s$="BG"
              Else
                  etat%(objet%)=0
                  s$="HD"
              end_if
            else
              If len(Sens$)=4
                  if Sens$<>"HG-BD" or Sens$<>"HD-BG" or Sens$<>"BD-HG" or Sens$<>"BG-HD"
                    if message_warning_ok("Sens$ doit être ''HG-BD'' ou ''HD-BG'' ou ''BD-HG'' ou ''BG-HD''")=1:end_if
                    exit_sub
                  end_if
              end_if
            end_if
        end_if
      End_if
  End_if
  If Upper$(s$)="HG"
      If d%>0
        For x%=1 To d%
            Top No%,Top(No%)+1 : left no%,left(no%)+1
            display
        Next x%
      Else
        If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
        Exit_sub
      End_if
  Else
      If Upper$(s$)="BD"
        If d%>0
            d%=d%*-1
            For x%=1 to d% step -1
              Top no%,Top(no%)-1 : left no%,left(no%)-1
              Display
            Next x%
        Else
            If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
            Exit_sub
        End_if
      Else
        If Upper$(s$)="HD"
            If d%>0
              d%=d%*-1
              For x%=1 to d% step -1
                  Top no%,Top(no%)+1 : left no%,left(no%)-1
                  Display
              Next x%
            Else
              If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
              Exit_sub
            End_if
        else
            if Upper$(s$)="BG"
              If d%>0
                  d%=d%*-1
                  For x%=1 to d% step -1
                    Top no%,Top(no%)-1 : left no%,left(no%)+1
                    Display
                  Next x%
              Else
                  If Message_warning_ok("Paramètre Dist% erronné !"+chr$(13)+"Le nombre doit être supérieur à 0.")=1:End_if
                  Exit_sub
              End_if
            else
              If message_warning_ok("Paramètre Sens$ erronné !"+chr$(13)+"Le Sens doit êtres ''B'' ou ''H''")=1:End_if
              Exit_sub
            end_if
        end_if
      End_if
  End_if
End_Sub

'  Effet de Zoom
Sub ZOOM_SLIDE_EFFECT(No%,Coef,Sens$)
  dim_local x%,s$
  If Variable("Etat%")=0 then dim Etat%(Number_objects)
  If Variable("H_min%")=0 then dim H_min%(Number_objects)
  If Variable("H_max%")=0 then dim H_max%(Number_objects)
  If Variable("W_min%")=0 then dim W_min%(Number_objects)
  If Variable("W_max%")=0 then dim W_max%(Number_objects)
  s$=Sens$
  if s$="IE-EI"
      if Etat%(no%)=0
        Etat%(no%)=1
        s$="IE"
      else
        Etat%(no%)=0
        s$="EI"
      end_if
  else
      if s$="EI-IE"
        if Etat%(no%)=0
            Etat%(no%)=1
            s$="EI"
        else
            Etat%(no%)=0
            s$="IE"
        end_if
      else
        If len(s$)=5
            If s$<>"EI-IE" and s$<>"IE-EI"
              if message_warning_ok("Sens$ doit être ''IE-EI'' ou ''EI-IE''")=1: end_if
              exit_sub
            end_if
        end_if
      end_if
  end_if
 
  if s$="EI" or s$="IE"
      if len(Sens$)<5 : Etat%(no%)=0 : end_if
  end_if

  if Coef<1 and Etat%(no%)=0
      H_max%(no%) = Height(no%)
      W_max%(no%) = Width(no%)
      H_min%(no%) = int(Height(no%)*Coef)
      if odd(H_min%(no%))=1 :H_min%(no%)=H_min%(no%)+1 : end_if
      W_min%(no%) = int(Width(no%)*coef)
      if odd(W_min%(no%))=1 :W_min%(no%)=W_min%(no%)+1 : end_if
  else
      if coef>1 and Etat%(no%)=0
        H_min%(no%) = Height(no%)
        W_min%(no%) = Width(no%)
        H_max%(no%) = int(Height(no%)*Coef)
        if odd(H_max%(no%))=1 :H_max%(no%)=H_max%(no%)+1 : end_if
        W_max%(no%) = int(Width(no%)*coef)
        if odd(W_max%(no%))=1 :W_max%(no%)=W_max%(no%)+1 : end_if
      end_if
  end_if
 
  if s$="IE"
      if W_max%(no%) > H_max%(no%)
        for x%=W_min%(no%) to W_max%(no%) step 2
            top no%,top(no%)-1
            left no%,left(no%)-1
            width no%,width(no%)+2
            height no%,height(no%)+2
        next x%
      else
        for x%=H_min%(no%) to H_max%(no%) step 2
            top no%,top(no%)-1
            left no%,left(no%)-1
            width no%,width(no%)+2
            height no%,height(no%)+2
        next x%
      end_if
  else
      if s$="EI"
        if W_max%(no%) >H_max%(no%)
            for x%=W_max%(no%) to W_min%(no%) step -2
              top no%,top(no%)+1
              left no%,left(no%)+1
              width no%,width(no%)-2
              height no%,height(no%)-2
            next x%
        else
            for x%=H_max%(no%) to H_min%(no%) step -2
              top no%,top(no%)+1
              left no%,left(no%)+1
              width no%,width(no%)-2
              height no%,height(no%)-2
            next x%
        end_if
      else
        if len(Sens$)=2
            if message_warning_ok("Sens$ doit être ''IE'' ou ''EI''")=1:end_if
            exit_sub
        end_if
      end_if
  end_if
 
  caption 0,str$(height(no%))+" - "+str$(width(no%))
End_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

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

MessageSujet: Re: Des Subs pour des petits effets.   Mar 16 Déc 2014 - 0:59

Salut Ygeronimi

Je viens de voir ton code et tu as bien fait  :   il y a des idées qui peuvent donner d’autres idées qui peuvent donner etc…

J’ai quelques remarques concernant le sous-programme Clic :

• L’appel à ce sous-programme est déclenché par on_click no%,clic de la ligne 38.
 Comme no% est le numéro de Objet%, le number_click est forcément égale à objet% : il n’y a donc pas besoin  de le tester par :
clic% = number_click
If clic% = objet% and …

Ce qui alourdit le codage.
• Voici comment j’ai recodé ce sous-programme en question :

Code:

Clic:

' clic%=number_click
' clic% est forcement égale à objet%
  select item_index(Comb%)
    case 1:HORIZONTAL_SLIDE_EFFECT(objet%,50,"D")
    case 2:HORIZONTAL_SLIDE_EFFECT(objet%,50,"G")
    case 3:HORIZONTAL_SLIDE_EFFECT(objet%,50,"GD")

    case 5:VERTICAL_SLIDE_EFFECT(objet%,50,"H")
    case 6:VERTICAL_SLIDE_EFFECT(objet%,50,"B")
    case 7:VERTICAL_SLIDE_EFFECT(objet%,50,"BH")
    case 8:VERTICAL_SLIDE_EFFECT(objet%,50,"HB")

    case 9:DIAGONAL_SLIDE_EFFECT(objet%,50,"HG")
    case 10:DIAGONAL_SLIDE_EFFECT(objet%,50,"BD")
    case 11:DIAGONAL_SLIDE_EFFECT(objet%,50,"HD")
    case 12:DIAGONAL_SLIDE_EFFECT(objet%,50,"BG")
    case 13:DIAGONAL_SLIDE_EFFECT(objet%,50,"HG-BD")
    case 14:DIAGONAL_SLIDE_EFFECT(objet%,50,"BD-HG")
    case 15:DIAGONAL_SLIDE_EFFECT(objet%,50,"HD-BG")
    case 16:DIAGONAL_SLIDE_EFFECT(objet%,50,"BG-HD")

    case 17:ZOOM_SLIDE_EFFECT(objet%,1.5,"IE")
    case 18:ZOOM_SLIDE_EFFECT(objet%,1.5,"EI")
    case 19:ZOOM_SLIDE_EFFECT(objet%,1.5,"IE-EI")
    case 20:ZOOM_SLIDE_EFFECT(objet%,1.5,"EI-IE")
  end_select
return

Qu’en penses-tu ?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Yannick

avatar

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

MessageSujet: re   Mar 16 Déc 2014 - 1:14

Dans le cas présenté, ta réflexion est juste.
Pour la petite histoire, c' est une partie d' un code, 
qui au départ avait plusieurs objets et que j' ai raccourci pour le forum ( objet% était objet%(50) )...
...et comme je suis un peu fainéant.  Embarassed

Mais il est très juste de faire comme tu l' as fait pour cette présentation.
Et, je n' en pense que du bien... Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

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

MessageSujet: Re: Des Subs pour des petits effets.   Mar 16 Déc 2014 - 1:52

Laughing Laughing Laughing Laughing Laughing Laughing Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Yannick

avatar

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

MessageSujet: re   Jeu 18 Déc 2014 - 1:28

Encore une application d'effet slide :
Code:
dim NbMenuItem% : NbMenuItem%=20
dim no%,pict%(NbMenuItem%),pan_g%,pan_d%,flec_g%,flec_d%,Scene%,clic%,pan%(NbMenuItem%)
dim nos%,S%(NbMenuItem%,2)
label clic,close

height 0,500 : width 0,(12*50)+20+16

Create_Tiroirs(NbMenuItem%)
if file_exists("pict_1.bmp")=0
  create_picture_color()
end_if
create_diaporama(NbMenuItem%,0)

on_close 0,close
end

Sub create_picture_color()
  dim_local c$,x%,r%,g%,b%
  no%=no%+1
  picture no% : hide no% : height no%,50 :width no%,50
  restore
  for x%=1 to 20
      read c$
      r%=val(left$(c$,3))
      g%=val(mid$(c$,5,3))
      b%=val(right$(c$,3))
      color no%,r%,g%,b%
      file_save no%,"pict_"+str$(x%)+".bmp"
  next x%

  data "200,200,200"
  data "200,250,200"
  data "250,200,200"
  data "200,200,250"
  data "250,250,250"
  data "250,250,000"
  data "000,000,200"
  data "000,200,000"
  data "200,000,000"
  data "100,000,000"
  data "000,100,000"
  data "000,000,100"
  data "000,000,150"
  data "000,150,000"
  data "150,000,100"
  data "050,000,000"
  data "000,050,000"
  data "000,000,050"
  data "000,050,100"
  data "050,000,100"
end_sub


Sub create_diaporama(n%,t%)
  dim_local x%
  if variable("Place%")=0 then dim place%(n%)

  no%=no%+1 : Pan_g%=no%
  panel no% : top no%,t% : left no%,0 : height no%,50 : width no%,10

  no%=no%+1 : flec_g%=no%
  Alpha no% : parent no%,pan_g% : top no%,20 : caption no%,"<" : font_bold no%
  font_color no%,255,0,0 : cursor_point no% :on_click no%,clic

  no%=no%+1 : Pan_d%=no%
  panel no% : top no%,t% : left no%,width(0)-26 : height no%,50 : width no%,10

  no%=no%+1 : flec_d%=no%
  Alpha no% : parent no%,pan_d% : top no%,20 : caption no%,">" : font_bold no%
  font_color no%,255,0,0 : cursor_point no% :on_click no%,clic

  no%=no%+1 : Scene%=no%
  Scene2d no% : top no%,t% : left no%,10 : height no%,50 : width no%,width(0)-36
  cursor_point no% :on_click no%,clic

  for x%=1 to n%
      nos%=nos%+1 : pict%(x%)=nos%
      Sprite nos% :Sprite_target_is scene% :Sprite_file_load nos%,"Pict_"+str$(x%)+".bmp": sprite_position nos%,(x%*50)-50,0
      S%(x%,1)=(x%*50)-50 :S%(x%,2)=S%(x%,1)+49
      place%(x%)=sprite_x_position(x%)
  next x%
end_sub


clic:
  clic%=number_click
  if clic%=Flec_d% :Deplace_sprite(1,20):end_if
  if clic%=Flec_g% :Deplace_sprite(2,20):end_if
  if clic%=scene%  :Detect_sprite():end_if
return

Sub Deplace_sprite(e%,n%)
  dim_local x%,y%
  if e%=1
  '  -deplacement vers la droite-
      if sprite_x_position(1)<0
        for y%=1 to 50
            if sprite_x_position(1)<0
              for x%=1 to n%
                  sprite_position x%,sprite_x_position(x%)+1,0
              next x%
            else
              exit_sub
            end_if
        next y%
        for y%=1 to n%
            Place%(y%)=Place%(y%)+50
        next y%
      end_if
  else
  '  -deplacement vers la gauche-
      if sprite_x_position(n%)>width(scene%)-50
        for y%=1 to 50
            if sprite_x_position(n%)>width(scene%)-50
              for x%=1 to n%
                  sprite_position x%,sprite_x_position(x%)-1,0
              next x%
            else
              exit_sub
            end_if
        next y%
        for y%=1 to n%
            Place%(y%)=Place%(y%)-50
        next y%
      end_if
  end_if
end_sub

Sub Create_Tiroirs(n%)
  dim_local x%
  for x%=1 to n%
      no%=no%+1 : pan%(x%)=no%
      panel no% : height no%,height(0)-105 : width no%,width(0)-16 :top no%,50:left no%,left(no%)-width(no%)
      color no%,225,225,225
      no%=no%+1
      alpha no% :parent no%,pan%(x%): top no%,10 : left no%,10 : caption no%,str$(x%): font_bold no%
  next x%
end_sub

Sub Detect_sprite()
    dim_local x%,mp%,S%
    mp%=mouse_x_position(scene%)
    for x%=1 to NbMenuItem%
      if mp% > Place%(x%) and mp% < Place%(x%+1)
        exit_for
      end_if
    next x%
    Open_tiroirs(x%)
end_sub

Sub Open_tiroirs(n%)
  dim_local y% ,d%,z%
  d%=width(pan%(n%))

  for z%=1 to NbMenuItem%
      if left(Pan%(z%))=0
        for y%=1 to d%
            left Pan%(z%),left(Pan%(z%))-1
            display
        next y%
      end_if
  next z%

  if left(pan%(n%))<0
      for y%=1 to d%
        left Pan%(n%),left(Pan%(n%))+1
        display
      next y%
  else
      for y%=1 to d%
        left Pan%(n%),left(Pan%(n%))-1
        display
      next y%
  end_if
End_sub

close:
  Auto_clean(NbMenuItem%)
return


Sub Auto_clean(n%)
  dim_local x%
  for x%=1 to n%
      if file_exists(dir_current$+"\pict_"+str$(x%)+".bmp")=1
        file_delete dir_current$+"\pict_"+str$(x%)+".bmp"
      end_if
  next x%
end_sub


Dernière édition par ygeronimi le Jeu 18 Déc 2014 - 22:17, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 4989
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Des Subs pour des petits effets.   Jeu 18 Déc 2014 - 19:00

HAAA ! What a Face drunken

@Ygeronimi,

Je t'invite à venir faire le ménage sur mon bureau,

IL EST REMPLI DE CARRE DE TOUTES LES COULEURS cherry
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

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

MessageSujet: re   Jeu 18 Déc 2014 - 22:04

Embarassed  je n' ai pas mis la fonction d' auto-nettoyage...
...ça c' est c.. alors...



Promis, je sors...


Edit : J' ai édité avec une fonction d' auto-nettoyage en fermant par la croix. Laughing
Attention : Ce code fonctionne avec la version i3 qui reprend le clic sur le scene2d mais pas avec la i2 dont la commande bug
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 4989
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Des Subs pour des petits effets.   Jeu 18 Déc 2014 - 22:48

Là, ça va bien mieux, le nettoyage est éfficace ,

lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

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

MessageSujet: re   Jeu 18 Déc 2014 - 23:23

J' hésite un peu sur le nom à donner à cette fonction :

Sub Mr_Propre() ou Sub Saint_Marc()... scratch


lol! lol! lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 4989
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Des Subs pour des petits effets.   Ven 19 Déc 2014 - 0:01

La SUB tornade_blanche_Ygeronimi(), çà me parait bien ! Very Happy
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: Des Subs pour des petits effets.   

Revenir en haut Aller en bas
 
Des Subs pour des petits effets.
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Pour mes petits-enfants et pour les vôtres
» MA NOUVELLE VITRINE POUR MES "PETITS TRAINS".
» Haribo, c'est beau la vie pour les grands et les petits ♥
» Tuto pour modifier les couleurs/effets des rangs
» Un plug-in pour des Effets spéciaux en Wisiwig

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 :: Vos sources, vos utilitaires à partager-
Sauter vers: