A propos de date...

Sujet: 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

Sujet: 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

Sujet: 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+

Sujet: 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

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

ne provoque pas d'erreur.... scratch

Sujet: 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

» Combo date : sélecteur de date
» Date <-> Date julienne
» à propos de Panoramic_Editor [Résolu]
» A propos des manuels
» A propos de RichEdit