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
» StratégoV8 et V9
par Minibug Aujourd'hui à 1:10

» Rotation d'une image d'un angle quelconque
par JL35 Hier à 23:02

» GRID_LOAD
par Jean Claude Hier à 21:04

» HVIEWER
par Yannick Hier à 20:31

» KGF_dll - nouvelles versions
par Klaus Mar 16 Jan 2018 - 21:28

» Déformation d'image en trapèze
par mindstorm Mar 16 Jan 2018 - 21:06

» Mah-Jong américain
par Jean Claude Lun 15 Jan 2018 - 19:37

» Problème avec Deepl
par Klaus Lun 15 Jan 2018 - 0:34

» Quelques nouvelles ...
par Jean Claude Ven 12 Jan 2018 - 22:40

» Renommer les instructions ITEM_... ?
par Jicehel Ven 12 Jan 2018 - 18:56

» Ludothèque Panoramic
par jjn4 Ven 12 Jan 2018 - 18:11

» sous-programmes et fonctions
par Jack Ven 12 Jan 2018 - 17:51

» Mah-Jong français
par Jean Claude Jeu 11 Jan 2018 - 22:15

» panoramic 0.9.28
par gigi75 Ven 5 Jan 2018 - 14:06

» Un jeu qui va vous énerver!
par Jean Claude Jeu 4 Jan 2018 - 22:05

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Janvier 2018
LunMarMerJeuVenSamDim
1234567
891011121314
15161718192021
22232425262728
293031    
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 : 5876
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 : 1109
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 : 5876
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] Restauration système impossible et sltt 4 dates proposées!!!
» [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.

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: