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
» Dessin 2D: largeur de trait (résolu !)
par JL35 Aujourd'hui à 1:37

» PanExpress : l'éditeur Panoramic avec création d'objet
par Minibug Hier à 17:00

» Planétarium virtuel.
par Pedro Alvarez Hier à 16:59

» Nouvelle version 0.34
par jean_debord Hier à 9:39

» Quantité de mémoire utilisée par un exe
par mindstorm Jeu 21 Juin 2018 - 21:22

» Projet de planétarium virtuel.
par Jean Claude Jeu 21 Juin 2018 - 19:02

» Animation: Feux de signalisation
par Minibug Mer 20 Juin 2018 - 20:28

» Problème avec 'file_load'.
par Pedro Alvarez Lun 18 Juin 2018 - 8:12

» Version instantanée V 0.9.28i20 du 13/06/2018
par jjn4 Sam 16 Juin 2018 - 14:25

» string$(0,chr$(32)) sans erreur
par silverman Ven 15 Juin 2018 - 19:56

» Version instantanée V 0.9.28i19 du 13/06/2018
par Minibug Ven 15 Juin 2018 - 19:14

» Mes souhaits d'amélioration de Panoramic.
par Pedro Alvarez Jeu 14 Juin 2018 - 20:17

» [RÉSOLU] Message d'erreur impossible à indentifier
par Minibug Mer 13 Juin 2018 - 20:52

» Cadre pour image
par Jean Claude Mar 12 Juin 2018 - 16:31

» Créateur d'objets Panoramic
par Minibug Mar 12 Juin 2018 - 14:02

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Juin 2018
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
252627282930 
CalendrierCalendrier

Partagez | 
 

 A propos de date...

Aller en bas 
AuteurMessage
Nardo26

avatar

Nombre de messages : 2294
Age : 50
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: A propos de date...   Mar 20 Nov 2012 - 10:36

Bonjour,

A partir d'un programme de Bignono, je me suis amusé à re-coder la chose en tenant compte des dernières mise à jour...
j'utilise par exemple le POKE pour affecter une valeur de retour...



Code:
' ==============================================================================
'                Gestion de champs de saisie d'une date
'    A partir d'une procédure de bignono
' ==============================================================================

LABEL DateEvnt : DIM d
alpha 1:left 1,200:top 1,25:caption 1,"FORMAT DATE JJ/MM/AAAA"

EDIT 2:LEFT 2,200:TOP 2,50:ON_CHANGE 2,DateEvnt
EDIT 3:LEFT 3,200:TOP 3,70:ON_CHANGE 3,DateEvnt

set_focus 2
end

' ==============================================================================
'
' ==============================================================================
DateEvnt:
  OFF_CHANGE NUMBER_CHANGE
  DateCtrl(NUMBER_CHANGE,scancode)
  ON_CHANGE NUMBER_CHANGE,DateEvnt
RETURN

SUB DateCtrl(id%,c%)
DIM_LOCAL e%,ct$,v%,j%,m%,a%
  IF c%=8
    v%=LEN(TEXT$(id%))
    IF v%=2 OR v%=5 THEN TEXT id%,LEFT$(TEXT$(id%),v%-1): CARET_POSITION id%,v%-1
    EXIT_SUB
  END_IF
  IF c%=13 THEN EXIT_SUB
  if len(text$(id%))>10 then text id%,left$(text$(id%),10)

  e%=0
  SELECT LEN(TEXT$(id%))
    CASE 1 : IF c%<96 OR c%>105: e%=1: ELSE:IF c%>99 THEN e%=2: END_IF
    CASE 2
      IF C%<96 OR c%>105: e%=1
      ELSE
        IF val(TEXT$(id%))>31 or val(TEXT$(id%))<1 :e%=2:ELSE:TEXT id%,TEXT$(id%)+"/":END_IF
      END_IF
    CASE 4 : IF c%<96 OR c%>105: e%=1: ELSE:IF c%>97 THEN e%=4: END_IF
    CASE 5
      IF c%<96 OR c%>105: e%=1
      ELSE
        v%=val(right$(text$(id%),2))
        IF v%>12 or v%<1: e%=4
        ELSE
          IF (v%=4 OR v%=6 OR v%=9 OR v%=11) AND VAL(left$(text$(id%),2))>30 : e%=6
          ELSE:IF v%=2 AND VAL(left$(text$(id%),2))>29 THEN e%=6:END_IF
        END_IF
      END_IF
      IF e%=0 THEN TEXT id%,TEXT$(id%)+"/"
    CASE 10
      StrObjectId%(ADR(v%)):DLIST v%
      EXPLODE(text$(id%),"/",v%):j%=VAL(ITEM_READ$(v%,1)):m%=VAL(ITEM_READ$(v%,2)):a%=VAL(ITEM_READ$(v%,3))
      CLEAR v%:DELETE v%
      IF a%<1:e%=5
      ELSE
        IF INT(a%/4)<>a%/4 AND m%=2 AND j%>28 THEN DateMsgErr(7):TEXT id%,"28"+RIGHT$(TEXT$(id%),8)
      END_IF
  END_SELECT
  IF e%<>0
    DateMsgErr(e%) : ct$=TEXT$(id%)
    IF LEN(ct$)>1 : ct$=LEFT$(ct$,LEN(ct$)-1): ELSE: ct$="": END_IF
    TEXT id%,ct$
  END_IF
  CARET_POSITION id%,LEN(TEXT$(id%))
END_SUB

SUB DateMsgErr(t%)
  SELECT t%
    CASE 1:message "Entrez uniquement un chiffre SVP"
    CASE 2:message "De 01 à 31 SVP"
    CASE 3:message "Entrez un «/» SVP"
    CASE 4:message "De 01 à 12 SVP"
    CASE 5:message "Année non valide, recommencez SVP"
    CASE 6:message "Il y a 28 ou 29 jours en Février et 30 jours en Avril, Juin, Septembre ou Novembre."
    CASE 7:message "Il ne s'agit pas d'une année bissextile. Il n'y a que 28 jours en Février"
  END_SELECT
END_SUB

' ------------------------------------------------------------------------------
' EXPLODE(S1,S2,liste)
' @info Retourne une liste de chaînes, chacune d'elle étant une sous-chaîne du paramètre S1 extraite en utilisant le séparateur S2
' @param S1 Chaine de caractères
' @param S2 séparateur
' @param Liste N° de la liste de retour
' @@@@
' ------------------------------------------------------------------------------
SUB EXPLODE(chaine$,delimiter$,liste%)
  WHILE INSTR(chaine$,delimiter$)<>0
    ITEM_ADD liste%,LEFT$(chaine$,INSTR(chaine$,delimiter$)-1)
    chaine$=RIGHT$(chaine$,LEN(chaine$)-INSTR(chaine$,delimiter$))
  END_WHILE
  ITEM_ADD liste%,chaine$
END_SUB
' ------------------------------------------------------------------------------
' Renvoie un numéro d'objet libre
' ------------------------------------------------------------------------------
SUB StrObjectId%(p_return%)
DIM_LOCAL id%
  id% = 1 : WHILE OBJECT_EXISTS(id%) = 1 : id% = id% + 1 : END_WHILE
  POKE p_return%,id%
END_SUB
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Jicehel

avatar

Nombre de messages : 5923
Age : 45
Localisation : 77500
Date d'inscription : 18/04/2011

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 13:27

Pas mal Nardo, mais je dû le modifier un peu. En effet, sur mon portable, je n'ai pas de pavé numérique. J'utilise donc les chiffres au dessus des touches et là, les scancode ne marchent plus ...
Du coup j'ai bidouillé un peu le code:
Code:
' ==============================================================================
'                Gestion de champs de saisie d'une date
'    A partir d'une procédure de bignono
' ==============================================================================

LABEL DateEvnt : DIM d
alpha 1:left 1,200:top 1,25:caption 1,"FORMAT DATE JJ/MM/AAAA"

EDIT 2:LEFT 2,200:TOP 2,50:ON_CHANGE 2,DateEvnt
EDIT 3:LEFT 3,200:TOP 3,70:ON_CHANGE 3,DateEvnt

set_focus 2
end

' ==============================================================================
'
' ==============================================================================
DateEvnt:
  OFF_CHANGE NUMBER_CHANGE
  DateCtrl(NUMBER_CHANGE,scancode)
  ON_CHANGE NUMBER_CHANGE,DateEvnt
RETURN

SUB DateCtrl(id%,c%)

DIM_LOCAL e%,ct$,v%,j%,m%,a%,a$
  IF c%=8
    v%=LEN(TEXT$(id%))
    IF v%=2 OR v%=5 THEN TEXT id%,LEFT$(TEXT$(id%),v%-1): CARET_POSITION id%,v%-1
    EXIT_SUB
  END_IF
  IF c%=13 THEN EXIT_SUB
  if len(text$(id%))>10 then text id%,left$(text$(id%),10)
  e%=0
  IF c%<48 OR c%>105
      if (ASC(right$(Text$(id%),1)) < 48) OR (ASC(right$(Text$(id%),1)) > 57) then e%=1
  ELSE
      IF c% > 57 AND c% < 96 THEN e% = 1
  END_IF
  IF e% = 0
      c%=right$(Text$(id%),1)
      SELECT LEN(TEXT$(id%))
        CASE 1 : IF c% > 3 THEN e%=2
        CASE 2 : IF val(TEXT$(id%))>31 or val(TEXT$(id%))<1 :e%=2:ELSE:TEXT id%,TEXT$(id%)+"/":END_IF
        CASE 4 : IF c%>1 THEN e%=4
        CASE 5
          v%=val(right$(text$(id%),2))
          IF v%>12 or v%<1: e%=4
          ELSE
            IF (v%=4 OR v%=6 OR v%=9 OR v%=11) AND VAL(left$(text$(id%),2))>30 : e%=6
            ELSE:IF v%=2 AND VAL(left$(text$(id%),2))>29 THEN e%=6:END_IF
          END_IF
          IF e%=0 THEN TEXT id%,TEXT$(id%)+"/"
        CASE 10
          StrObjectId%(ADR(v%)):DLIST v%
          EXPLODE(text$(id%),"/",v%):j%=VAL(ITEM_READ$(v%,1)):m%=VAL(ITEM_READ$(v%,2)):a%=VAL(ITEM_READ$(v%,3))
          CLEAR v%:DELETE v%
          IF a%<1:e%=5
          ELSE
            IF INT(a%/4)<>a%/4 AND m%=2 AND j%>28 THEN DateMsgErr(7):TEXT id%,"28"+RIGHT$(TEXT$(id%),8)
          END_IF
      END_SELECT
  END_IF
  IF e%<>0
    DateMsgErr(e%) : ct$=TEXT$(id%)
    IF LEN(ct$)>1 : ct$=LEFT$(ct$,LEN(ct$)-1): ELSE: ct$="": END_IF
    TEXT id%,ct$
  END_IF
  CARET_POSITION id%,LEN(TEXT$(id%))
END_SUB

SUB DateMsgErr(t%)
  SELECT t%
    CASE 1:message "Entrez uniquement un chiffre SVP"
    CASE 2:message "De 01 à 31 SVP"
    CASE 3:message "Entrez un «/» SVP"
    CASE 4:message "De 01 à 12 SVP"
    CASE 5:message "Année non valide, recommencez SVP"
    CASE 6:message "Il y a 28 ou 29 jours en Février et 30 jours en Avril, Juin, Septembre ou Novembre."
    CASE 7:message "Il ne s'agit pas d'une année bissextile. Il n'y a que 28 jours en Février"
  END_SELECT
END_SUB

' ------------------------------------------------------------------------------
' EXPLODE(S1,S2,liste)
' @info Retourne une liste de chaînes, chacune d'elle étant une sous-chaîne du paramètre S1 extraite en utilisant le séparateur S2
' @param S1 Chaine de caractères
' @param S2 séparateur
' @param Liste N° de la liste de retour
' @@@@
' ------------------------------------------------------------------------------
SUB EXPLODE(chaine$,delimiter$,liste%)
  WHILE INSTR(chaine$,delimiter$)<>0
    ITEM_ADD liste%,LEFT$(chaine$,INSTR(chaine$,delimiter$)-1)
    chaine$=RIGHT$(chaine$,LEN(chaine$)-INSTR(chaine$,delimiter$))
  END_WHILE
  ITEM_ADD liste%,chaine$
END_SUB
' ------------------------------------------------------------------------------
' Renvoie un numéro d'objet libre
' ------------------------------------------------------------------------------
SUB StrObjectId%(p_return%)
DIM_LOCAL id%
  id% = 1 : WHILE OBJECT_EXISTS(id%) = 1 : id% = id% + 1 : END_WHILE
  POKE p_return%,id%
END_SUB
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1127
Age : 61
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 17:48

Merci Nardo,
Ton code est super! Klaus devrait pouvoir s'en servir pour son programme de généalogie avec la BDR. Il y a énormément de saisies de date en généalogie! Smile
A+ Wink Wink Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Nardo26

avatar

Nombre de messages : 2294
Age : 50
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 21:05

Bonsoir,

Je crois que Klaus a déjà quelque chose dans le même genre dans sa DLL...
Mon exemple est juste une alternative 100% Panoramic... Wink

@Jicehel : Shocked Shocked Shocked

Ce qui m'étonne c'est que cette ligne dans ton code
c%=right$(Text$(id%),1)

ne provoque pas d'erreur.... scratch
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://nardo26.lescigales.org
Jicehel

avatar

Nombre de messages : 5923
Age : 45
Localisation : 77500
Date d'inscription : 18/04/2011

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 21:38

Et tu as bien raison. Ca marche, mais ça ne devrait pas. Normalement, il faudrait ajouter val(...), mais bon, ça passe alors j'ai laissé ... mais dans le principe, en effet on devrait avoir une erreur sur les types de variables et leur conversion
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: A propos de date...   

Revenir en haut Aller en bas
 
A propos de date...
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» changement date GPS 62 S
» Expiration de la date de téléchargement
» Je devine votre date anniversaire.
» Convertisseur date vers jour Julien et inversement
» date Sensation fibre?

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: