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
» Pb 16 (en analyse): ON_CLOSE plante à l'exécution
par Jack Aujourd'hui à 20:00

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

» Compilateur FBPano
par jean_debord Aujourd'hui à 8:49

» un nouveau editeur panobasic
par Jean Claude Hier à 20:05

» COMPILATEUR V 0.9 beta 7 du 10 aout 2017
par Pedro Alvarez Hier à 19:31

» 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

» Problème avec les chaines de caractères
par bignono Dim 6 Aoû 2017 - 9:33

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 | 
 

 A propos de date...

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

avatar

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

MessageSujet: A propos de date...   Mar 20 Nov 2012 - 12: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 : 5849
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 15: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 : 1085
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 19: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 : 49
Localisation : Valence
Date d'inscription : 02/07/2010

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 23: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 : 5849
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: A propos de date...   Mar 20 Nov 2012 - 23: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...
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» [Résolu] Date automatique dans Word 2003
» changement date GPS 62 S
» Classer par date les sujets
» Date des citations
» comment connaitre la date d'expiration de mon nom de domaine ?

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: