Des EDIT filtrés paramétrables

dim no%              : ' pour pouvoir définir les objets automatiquement
dim no_container%    : ' numéro d'objet du container

dim chiffres$ : chiffres$ = "01234567890"
dim MF$      : MF$      = "MmFf"

xAlpha(10,10,0,10,"Chiffres uniquement:")
xEditFilter(10,150,80,0,0,chiffres$)

xContainer(40,10,400,200,"Un container") : no_container% = no%

xAlpha(20,20,no_container%,10,"M,F,m,f uniquement:")
xEditFilter(20,180,30,no_container%,0,MF$)

xAlpha(50,20,no_container%,10,"Affichage uniquement:")
xEdit(50,180,100,no_container%,1)
text no%,"Coucou !"

end





' *********************************************
' *    procédures extraites de KGF_OBJ.bas    *
' *********************************************
' paramètres: (top,left,width,height,caption)
sub xContainer(t%,l%,w%,h%,c$)
  if variable("no%")=0 then dim no%
  no% = no% + 1 : container no%
    top no%,t% : left no%,l% : width no%,w% : height no%,h%
    caption no%,c$
end_sub

' paramètres: (top,left,parent,font_size,caption)
sub xAlpha(t%,l%,p%,s%,c$)
  if variable("no%")=0 then dim no%
  no% = no% + 1 : alpha no% : font_size no%,s%
    if p%>0 then parent no%,p%
    top no%,t% : left no%,l% : caption no%,c$
end_sub

' paramètres: (top,left,width,parent,inactive)
sub xEdit(t%,l%,w%,p%,a%)
  if variable("no%")=0 then dim no%
  no% = no% + 1 : edit no%
    top no%,t% : left no%,l% : width no%,w%
    if p%>0 then parent no%,p%
    if a%=1 then inactive no%
end_sub

' paramètres: (top,left,width,parent,inactive,filtre)
sub xEditFilter(t%,l%,w%,p%,a%,f$)
  if f$<>""  : ' au premier appel, création de tout ce qu'il faut
    if variable("filter_list%")=0
      dim filter_list%(3),  filter_temp$, filter_n%
      dim filter_i%, filter_f$, filter_s$
      no% = no% + 1 : dlist no% : filter_list%(1) = no%  : ' liste des numéros d'objet
      no% = no% + 1 : dlist no% : filter_list%(2) = no%  : ' liste des filtres
      no% = no% + 1 : dlist no% : filter_list%(3) = no%  : ' liste des valeurs anciennes
    end_if
    if label("filter_change")=0 then label filter_change
  end_if      : ' ici, on a fini de créer tout ce qu'il faut
  if variable("no%")=0 then dim no%
  no% = no% + 1 : edit no%
  top no%,t% : left no%,l% : width no%,w% : ' créer l'objet Panoramic
  if p%>0 then parent no%,p%              : ' autre parent que form 0 ?
  if a%=1 then inactive no%              : ' le EDIT doit être inactif au début ?
  if f$<>""                            : ' si un filtre est demandé, alors
    on_change no%,filter_change        : ' on utilise l'évènement On_CHANGE
    item_add filter_list%(1),str$(no%)  : ' on ajoute le numéro d'objet dans une 1ère liste
    item_add filter_list%(2),f$        : ' on ajoute le filtre dans une 2ème liste
    item_add filter_list%(3),""        : ' on crée une ligne vide dans une 3ème liste
  end_if                                : ' fin du traitement du filtre
end_sub
filter_change:                          : ' évènement ON_CHANGE sur EDITs filtrés
  filter_temp$ = str$(number_change)    : ' prendre le numéro de l'objet
  for filter_n%=1 to count(filter_list%(1))          : ' chercher cet objet dans la liste '
    filter_s$ = item_read$(filter_list%(1),filter_n%)
    if filter_temp$=filter_s$ then exit_for          : ' est-ce que l'objet est trouvé ?
  next filter_n%                                      : ' fin de recherche
  filter_temp$ = trim$(text$(number_change))          : ' prendre le texte du EDIT
  if filter_temp$=""                                  : ' si le EDIT est vide:
    item_delete filter_list%(3),filter_n%            : ' alors vider la ligne de la 3ème liste
    item_insert filter_list%(3),filter_n%,""
    return                                            : ' on a fini
  end_if
  filter_s$ = item_read$(filter_list%(2),filter_n%)  : ' prendre le filtre
  for filter_i%=1 to len(filter_temp$)                : ' pour tous les caractères du EDIT:
    if instr(filter_s$,mid$(filter_temp$,filter_i%,1))=0    : ' est-ce que le car n'est pas dans le filtre ?
      filter_s$ = item_read$(filter_list%(3),filter_n%)    : ' alors reprendre l'état précédent
      off_change number_change                              : ' désactiver ON_CHANGE
      text number_change,item_read$(filter_list%(3),filter_n%)  : ' remplacer le contenu de l'EDIT
      on_change number_change,filter_change                : ' réactiver le ON_CHANGE
      return                                                : ' et sortir
    end_if
  next filter_i%                                      : ' fin de la boucle sur le contenu de l'EDIT
  item_delete filter_list%(3),filter_n%              : ' ici, tous les caractères sont valides,
  item_insert filter_list%(3),filter_n%,filter_temp$  : ' donc on sauvegarde le contenu de l'EDIT
  return                                              : ' ouf !

dim no%              : ' pour pouvoir définir les objets automatiquement
dim no_container%    : ' numéro d'objet du container

dim chiffres$ : chiffres$ = "01234567890"
dim MF$      : MF$      = "MmFf"

xAlpha(10,10,0,10,"Chiffres uniquement:")
xEditFilter(10,150,80,0,0,chiffres$)

xContainer(40,10,400,200,"Un container") : no_container% = no%

xAlpha(20,20,no_container%,10,"M,F,m,f uniquement:")
xEditFilter(20,180,30,no_container%,0,MF$)

xAlpha(50,20,no_container%,10,"Affichage uniquement:")
xEdit(50,180,100,no_container%,1)
text no%,"Coucou !"

end





' *********************************************
' *    procédures extraites de KGF_OBJ.bas    *
' *********************************************
' paramètres: (top,left,width,height,caption)
sub xContainer(t%,l%,w%,h%,c$)
  if variable("no%")=0 then dim no%
  no% = no% + 1 : container no%
    top no%,t% : left no%,l% : width no%,w% : height no%,h%
    caption no%,c$
end_sub

' paramètres: (top,left,parent,font_size,caption)
sub xAlpha(t%,l%,p%,s%,c$)
  if variable("no%")=0 then dim no%
  no% = no% + 1 : alpha no% : font_size no%,s%
    if p%>0 then parent no%,p%
    top no%,t% : left no%,l% : caption no%,c$
end_sub

' paramètres: (top,left,width,parent,inactive)
sub xEdit(t%,l%,w%,p%,a%)
  if variable("no%")=0 then dim no%
  no% = no% + 1 : edit no%
    top no%,t% : left no%,l% : width no%,w%
    if p%>0 then parent no%,p%
    if a%=1 then inactive no%
end_sub

' paramètres: (top,left,width,parent,inactive,filtre)
sub xEditFilter(t%,l%,w%,p%,a%,f$)
  if f$<>""  : ' au premier appel, création de tout ce qu'il faut
    if variable("filter_list%")=0
      dim filter_list%(3),  filter_temp$, filter_n%
      dim filter_i%, filter_f$, filter_s$
      no% = no% + 1 : dlist no% : filter_list%(1) = no%  : ' liste des numéros d'objet
      no% = no% + 1 : dlist no% : filter_list%(2) = no%  : ' liste des filtres
      no% = no% + 1 : dlist no% : filter_list%(3) = no%  : ' liste des valeurs anciennes
    end_if
    if label("filter_change")=0 then label filter_change
  end_if      : ' ici, on a fini de créer tout ce qu'il faut
  if variable("no%")=0 then dim no%
  no% = no% + 1 : edit no%
  top no%,t% : left no%,l% : width no%,w% : ' créer l'objet Panoramic
  if p%>0 then parent no%,p%              : ' autre parent que form 0 ?
  if a%=1 then inactive no%              : ' le EDIT doit être inactif au début ?
  if f$<>""                            : ' si un filtre est demandé, alors
    on_change no%,filter_change        : ' on utilise l'évènement On_CHANGE
    item_add filter_list%(1),str$(no%)  : ' on ajoute le numéro d'objet dans une 1ère liste
    item_add filter_list%(2),f$        : ' on ajoute le filtre dans une 2ème liste
    item_add filter_list%(3),""        : ' on crée une ligne vide dans une 3ème liste
  end_if                                : ' fin du traitement du filtre
end_sub
filter_change:                          : ' évènement ON_CHANGE sur EDITs filtrés
  filter_temp$ = str$(number_change)    : ' prendre le numéro de l'objet
  for filter_n%=1 to count(filter_list%(1))          : ' chercher cet objet dans la liste '
    filter_s$ = item_read$(filter_list%(1),filter_n%)
    if filter_temp$=filter_s$ then exit_for          : ' est-ce que l'objet est trouvé ?
  next filter_n%                                      : ' fin de recherche
  filter_temp$ = trim$(text$(number_change))          : ' prendre le texte du EDIT
  if filter_temp$=""                                  : ' si le EDIT est vide:
    item_delete filter_list%(3),filter_n%            : ' alors vider la ligne de la 3ème liste
    item_insert filter_list%(3),filter_n%,""
    return                                            : ' on a fini
  end_if
  filter_s$ = item_read$(filter_list%(2),filter_n%)  : ' prendre le filtre
  for filter_i%=1 to len(filter_temp$)                : ' pour tous les caractères du EDIT:
    if instr(filter_s$,mid$(filter_temp$,filter_i%,1))=0    : ' est-ce que le car n'est pas dans le filtre ?
      filter_s$ = item_read$(filter_list%(3),filter_n%)    : ' alors reprendre l'état précédent
      off_change number_change                              : ' désactiver ON_CHANGE
      text number_change,item_read$(filter_list%(3),filter_n%)  : ' remplacer le contenu de l'EDIT
      caret_position number_change,filter_i%-1             : ' restaurer la position du curseur
      on_change number_change,filter_change              : ' réactiver le ON_CHANGE
      return                                                : ' et sortir
    end_if
  next filter_i%                                            : ' fin de la boucle sur le contenu de l'EDIT
  item_delete filter_list%(3),filter_n%              : ' ici, tous les caractères sont valides,
  item_insert filter_list%(3),filter_n%,filter_temp$  : ' donc on sauvegarde le contenu de l'EDIT
  return                                              : ' ouf !

label edite
dim L$,R$,list$,curs
   list$="0123456789.+-*/=()":' liste des caractères autorisés dans l'edit
   edit 1:set_focus 1:on_change 1,edite
end

edite:
   L$=""
   if len(text$(1))>1 then L$=left$(text$(1),len(text$(1))-1)
   R$=right$(text$(1),1)
   curs=instr(list$,R$)
   if curs=0 then text 1,L$:caret_position 1,len(text$(1))
return

label edite
dim C$,L$,R$,V$,q,i,n%
   V$="0123456789.+-*/=()":' liste des caractères autorisés dans l'edit
   n%=1
   edit n%:set_focus n%:on_change n%,edite
end

edite:
   L$="":R$=""
   for i=1 to len(text$(n%))
      C$=mid$(text$(n%),i,1)
      q=instr(V$,C$)
      if q=0 then exit_for
   next i
   L$=left$(text$(n%),i-1)
   if len(text$(n%))>i then R$=right$(text$(n%),len(text$(n%))-i)
   text 1,L$+R$:caret_position 1,len(text$(n%))
return