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
» Synedit Parameters
par Yannick Aujourd'hui à 0:27

» Code à vérifier SVP (Oups ! résolu)
par Jean Claude Hier à 21:16

» Compilateur FBPano
par jean_debord Hier à 9:56

» Bienvenue à Virtualalan !
par UltraVox Hier à 9:18

» Concours de Morpions
par jjn4 Hier à 0:04

» ShortName$(F) [Cloturé]
par papydall Mer 21 Juin 2017 - 16:19

» Remplacer espace par tiret dans noms des dossiers / fichiers
par papydall Mer 21 Juin 2017 - 15:27

» Menu personalisé avec icones et menu contextuel
par Laurent (Minibug) Mer 21 Juin 2017 - 12:44

» La liste des choses à faire ...
par Jack Mar 20 Juin 2017 - 22:49

» Quoi de neuf à propos de Goric 3D ? (@Jack)
par UltraVox Mar 20 Juin 2017 - 21:06

» Nom court et anti fenetre dos
par silverman Mar 20 Juin 2017 - 18:31

» Ludothèque Panoramic
par jjn4 Mar 20 Juin 2017 - 18:09

» Proposition à la communauté
par Yannick Mar 20 Juin 2017 - 15:02

» >199
par maelilou Mar 20 Juin 2017 - 14:13

» NUMBER_FOCUS
par Yannick Lun 19 Juin 2017 - 15:25

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Juin 2017
LunMarMerJeuVenSamDim
   1234
567891011
12131415161718
19202122232425
2627282930  
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 : 5837
Age : 44
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 : 1079
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 : 5837
Age : 44
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: