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
» Demande urgente en maths.
par JL35 Aujourd'hui à 22:26

» Compilateur FBPano
par jean_debord Aujourd'hui à 11:24

» Problème de math
par braveen Aujourd'hui à 10:53

» A propos des attributs de fichier
par papydall Hier à 14:33

» Problème de math
par Marc37 Sam 21 Oct 2017 - 23:04

» I Love You
par papydall Sam 21 Oct 2017 - 19:22

» Un petit "coucou" à tous les Panoramiciens !
par mindstorm Sam 21 Oct 2017 - 17:06

» MARK_ON déclenche un événement ON_CLICK à la place de ...
par Jean Claude Mer 18 Oct 2017 - 18:08

» mise a jour calculatrice
par joeeee2017 Mer 18 Oct 2017 - 15:57

» [solved] 3D_LINE How to ?
par Jicehel Mer 18 Oct 2017 - 11:01

» Convertisseur de base 10 de 2 à 36
par gigi75 Mar 17 Oct 2017 - 18:49

» calculatrice avec touches movibles
par joeeee2017 Dim 15 Oct 2017 - 1:11

» CORTANA
par gigi75 Sam 14 Oct 2017 - 16:32

» Calculatrice
par Jean Claude Sam 14 Oct 2017 - 12:30

» KGF_dll - nouvelles versions
par Klaus Mar 10 Oct 2017 - 18:49

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Octobre 2017
LunMarMerJeuVenSamDim
      1
2345678
9101112131415
16171819202122
23242526272829
3031     
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 : 5858
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 : 1086
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 : 5858
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
» Expiration de la date de téléchargement
» Je devine votre date anniversaire.
» Convertisseur date vers jour Julien et inversement

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: