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 | 
 

 PhoneBook ( ISAM Database )

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Yannick

avatar

Nombre de messages : 7994
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: PhoneBook ( ISAM Database )   Dim 2 Aoû 2015 - 16:57

Voilà le résultat de mon apprentissage de ISAM database
mis à notre disposition par Klaus via KGF.dll.

Un petit PhoneBook. J' en avais assez des carnets d' adresses
où on nous propose de stocker des tonnes d' infos plus inutiles
les unes que les autres.

C' est une base simple, apprentissage oblige, les champs sont :
Id(4 caractères),Nom(30 caractères),Prénom(30 caractères),Tel fixe(10 caractères), Tel Portable(10 caractères), Mail(255 caractères).

Des sécurisations sont en cours mais il est utilisable en faisant attention de ne pas dépasser le nombre de caractères alloués à chaque champ.
Code:
hide 0
Variables_ISAM()
Variables_fichiers()
Variables_objets()
Variables_application()
Labels()
Init()
Gui()
show 0
end

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES VARIABLES APPLICATION
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_application()

'  nombre d' enregistrements
  dim inbase%
 
'  nombre de clés
  dim keyinbase%

'  mode
  dim mode%
 
'  bouton toolbar cliqué
  dim tbchoix%

'  Evénements
  dim clic%
  dim change%
  dim dclic%

'  Caractères
  dim CarPlus$
  dim CarMoins$
  dim Car$
END_SUB
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' VARIABLES FICHIERS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_fichiers()

  dim Path$
  path$=".\"
 
  dim kgf$ : kgf$ = Path$+"fic\KGF.dll"

  dim ico1$: ico1$= Path$+"ico\Add.ico"
  dim ico2$: ico2$= Path$+"ico\Save.ico"
  dim ico3$: ico3$= Path$+"ico\Trash.ico"
  dim ico4$: ico4$= Path$+"ico\Previous.ico"
  dim ico5$: ico5$= Path$+"ico\Next.ico"
  dim ico6$: ico6$= Path$+"ico\Search.ico"
 
  dim carte$ : carte$  = Path$+"fic\carte.jpg"

  dim police$: police$ = "C:\Windows\Fonts\PhoneBook.ttf"
END_SUB
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' VARIABLES OBJETS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_objets()
  dim_local i%

  dim no%
 
  dim mm%    : no% = no%+1 : mm%    = no%
  dim sm%(6)  : for i% = 0 to 6 : no% = no%+1 : sm%(i%) = no% : next i%
 
  dim frame0% : no% = no%+1 : frame0% = no%
  dim frame1% : no% = no%+1 : frame1% = no%
  dim frame2% : no% = no%+1 : frame2% = no%
  dim frame3% : no% = no%+1 : frame3% = no%
 
  dim tbedit% : no% = no%+1 : tbedit% = no%
 
  dim Class%  : no% = no%+1 : Class%  = no%
  dim Feuil1% : no% = no%+1 : Feuil1% = no%
  dim Feuil2% : no% = no%+1 : Feuil2% = no%
 
  dim Alph%(6): for i% = 1 to 6 : no% = no%+1 : alph%(i%) = no% : next i%
  dim ID%    : no% = no%+1 : ID%    = no%
  dim Nom%    : no% = no%+1 : Nom%    = no%
  dim Prenom% : no% = no%+1 : Prenom% = no%
  dim Tel%    : no% = no%+1 : Tel%    = no%
  dim Port%  : no% = no%+1 : Port%  = no%
  dim Mail%  : no% = no%+1 : Mail%  = no%
 
  dim carte%  : no% = no%+1 : carte%  = no%
 
  dim Group%
  dim Butt%(4): for i% = 1 to 4 : no% = no%+1 : Butt%(i%) = no% : next i%
 
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' VARIABLES DATABASE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Variables_ISAM()
  dim support$
  dim ISAM_vers$
  dim ISAM_IdentSize%
  dim ISAM_id%
  dim ISAM_nam$
  dim ISAM_exist%
  dim ISAM_RecLen%
  dim ISAM_Record$
  dim ISAM_NbRec%
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES LABELS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Labels()
  Label Clic
  Label Change
  Label DClic
  Label VisuTab
  Label Close
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INITIALISATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Init()
  dim_local res%,def$,defkey$,kgf_vers$,version%,a$,b$
  a$="Le fichier de police PhoneBook.ttf n' est pas sur votre ordinateur"
  b$="Voulez vous l' installer maintenant ?"
  if file_exists(Police$)=0
      if message_information_yes_no(a$+chr$(13)+b$)=1
        execute_wait Path$+"fic\PhoneBook.ttf"
        Police$="PhoneBook"
        CarPlus$ ="A"
        CarMoins$="B"
        Car$    ="C"
      else
        Police$  ="Arial"
        CarPlus$ =">"
        CarMoins$="<"
        Car$    ="R"
      end_if
  else
      Police$  ="PhoneBook"
      CarPlus$ ="A"
      CarMoins$="B"
      Car$    ="C"
  end_if

'  activation de kgf
  dll_on kgf$
  kgf_vers$= string$(25," ")
  version% = DLL_call1("KGFdllVersion",adr(kgf_vers$))
'  message kgf_vers$

'  initialisation de l' environnement isam
  res% = dll_call0("InitIsam")

'  recup de le version isam
  ISAM_vers$ = string$(25," ")
  res% = dll_call1("GetIsamVersion",adr(ISAM_vers$))

'  création de l' identifiant isam
  ISAM_IdentSize% = dll_call0("GetIsamIdentifierSize")
  support$ = string$(ISAM_IdentSize%," ")
  ISAM_id% = dll_call1("CreateIsamIdentifier",adr(support$))

'  vérif de l' existence de la base ou pas
  ISAM_nam$ =Path$+"fic\PhoneBook"
  ISAM_exist% = dll_call1("IsamFileExists",adr(ISAM_nam$))


  if ISAM_exist% <0
'    création des champs
      def$ ="6,4,30,30,10,10,255"
      res% = dll_call2("SetIsamFields",Isam_ID%,adr(def$))
'    création des cles
'    par ID
      defkey$ ="1,1,1"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if
'    Par Nom
      defkey$ ="2,0,2"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if
'    Par Prenom
      defkey$ ="3,0,3"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if
'    Par Tel_fixe
      defkey$ ="4,0,4"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if
'    Par Tel_Portable
      defkey$ ="5,0,5"
      res% = dll_call2("SetIsamKeyFields",Isam_ID%,adr(defkey$))
      res% = dll_call0("GetIsamOk")
      if res%<0 : MessageErreur(res%) : end_if
'    Création des fichiers ISAM
      res% = dll_call2("CreateIsamFile",Isam_ID%,adr(ISAM_nam$))
  else
'    Ouverture des fichiers ISAM
      res% = dll_call2("OpenIsamFile",Isam_ID%,adr(ISAM_nam$))
  end_if
 
'  recup de la longueur d' un enregistrement
  ISAM_RecLen% = dll_call1("GetIsamRecordLength",Isam_ID%)
  ISAM_record$ = string$(ISAM_RecLen%," ")

'  recup du nombre d' enregistrements dans la base
  inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)

'  recup du nombre de clés
  keyinbase% = dll_call1("GetIsamKeyCount",Isam_ID%)

'  détermination du mode (visualisation ou création)
  if inbase% = 0
      mode% = 1
  else
      if inbase% < 0
        message str$(inbase%)
      else
        mode% = 3
      end_if
  end_if
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INTERFACE UTILISATEUR
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Gui()
  dim_local h%,w%,res%,hint$,icon$,vID%

  height 0,330
  width 0,440
  top 0,(screen_y-height(0))/2
  left 0,(screen_x-width(0))/2
  font_name 0,"Arial"
  font_size 0,8
  caption 0,"My Phone Book"
  on_close 0,close
 
  main_menu mm%
  sub_menu sm%(0) : parent sm%(0),mm%  : caption sm%(0),"Mode"
  sub_menu sm% (1): parent sm%(1),sm%(0) : caption sm%(1),"Enregistrer" : on_click sm%(1),clic
  sub_menu sm% (2): parent sm%(2),sm%(0) : caption sm%(2),"Modifier / Supprimer"  : on_click sm%(2),clic
  sub_menu sm% (3): parent sm%(3),sm%(0) : caption sm%(3),"Voir"  : on_click sm%(3),clic
  sub_menu sm% (4): parent sm%(4),sm%(0) : caption sm%(4),"Rechercher"      : on_click sm%(4),clic
  sub_menu sm% (5): parent sm%(5),sm%(0) : caption sm%(5),"-"
  sub_menu sm% (6): parent sm%(6),sm%(0) : caption sm%(6),"Quitter"        : on_click sm%(6),clic
 
  Panel frame0%
  full_space frame0%
  h% = height(frame0%)
  w% = width(frame0%)
 
  Panel frame1%
  parent frame1%,frame0%
  height frame1%,26
  width frame1%,w%
 
  Panel frame2%
  parent frame2%,frame0%
  height frame2%,h%-52
  width frame2%,w%
  top frame2%,26
 
  Panel frame3%
  parent frame3%,frame0%
  height frame3%,26
  width frame3%,w%
  top frame3%,height(frame1%)+height(frame2%)
 
  edit tbedit%
  hide tbedit%
  on_change tbedit%,change
 
  res% = dll_call4("CreateToolbar",handle(frame1%),handle(tbedit%),handle(frame2%),0)
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("ModifyToolbar",2,0,0,0)
  res% = dll_call4("ModifyToolbar",4,0,1,2)
  hint$= "Nouveau"
  icon$= ico1$
  res% = dll_call4("AddButtonToToolbar",1,0,adr(hint$),adr(icon$))
  hint$= "Enregistrer"
  icon$= ico2$
  res% = dll_call4("AddButtonToToolbar",2,1,adr(hint$),adr(icon$))
  hint$= "Supprimer"
  icon$= ico3$
  res% = dll_call4("AddButtonToToolbar",3,2,adr(hint$),adr(icon$))
  hint$= "Precedent"
  icon$= ico4$
  res% = dll_call4("AddButtonToToolbar",4,3,adr(hint$),adr(icon$))
  hint$= "Suivant"
  icon$= ico5$
  res% = dll_call4("AddButtonToToolbar",5,4,adr(hint$),adr(icon$))
  hint$= "Nouvelle recherche"
  icon$= ico6$
  res% = dll_call4("AddButtonToToolbar",6,5,adr(hint$),adr(icon$))
 
 
  Group%  = dll_call0("CreateObjectGroup")

  alpha alph%(1)
  parent alph%(1),frame2%
  top alph%(1),15
  left alph%(1),5
  font_bold alph%(1)
  caption alph%(1),"Nom :"
 
  edit Nom%
  parent Nom%,frame2%
  width Nom%,200
  top Nom%,30
  left Nom%,5
 
  Button Butt%(1)
  parent Butt%(1),frame2%
  height Butt%(1),20
  width Butt%(1),20
  top Butt%(1),30
  left Butt%(1),210
  font_name Butt%(1),police$
  font_bold Butt%(1)
  caption Butt%(1),Car$
  cursor_point Butt%(1)
  on_click Butt%(1),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(1)))
 
  alpha alph%(2)
  parent alph%(2),frame2%
  top alph%(2),55
  left alph%(2),5
  font_bold alph%(2)
  caption alph%(2),"Prénom :"
 
  edit Prenom%
  parent Prenom%,frame2%
  width Prenom%,200
  top Prenom%,70
  left Prenom%,5
 
  Button Butt%(2)
  parent Butt%(2),frame2%
  height Butt%(2),20
  width Butt%(2),20
  top Butt%(2),70
  left Butt%(2),210
  font_name Butt%(2),police$
  font_bold Butt%(2)
  caption Butt%(2),Car$
  cursor_point Butt%(2)
  on_click Butt%(2),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(2)))

  alpha alph%(3)
  parent alph%(3),frame2%
  top alph%(3),95
  left alph%(3),5
  font_bold alph%(3)
  caption alph%(3),"Tel (domicile) :"
 
  edit Tel%
  parent Tel%,frame2%
  width Tel%,85
  top Tel%,110
  left Tel%,5
 
  Button Butt%(3)
  parent Butt%(3),frame2%
  height Butt%(3),20
  width Butt%(3),20
  top Butt%(3),110
  left Butt%(3),95
  font_name Butt%(3),police$
  font_bold Butt%(3)
  caption Butt%(3),Car$
  cursor_point Butt%(3)
  on_click Butt%(3),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(3)))

  alpha alph%(4)
  parent alph%(4),frame2%
  top alph%(4),135
  left alph%(4),5
  font_bold alph%(4)
  caption alph%(4),"Tel (portable) :"
 
  edit Port%
  parent Port%,frame2%
  width Port%,85
  top Port%,150
  left Port%,5
 
  Button Butt%(4)
  parent Butt%(4),frame2%
  height Butt%(4),20
  width Butt%(4),20
  top Butt%(4),150
  left Butt%(4),95
  font_name Butt%(4),police$
  font_bold Butt%(4)
  caption Butt%(4),Car$
  cursor_point Butt%(4)
  on_click Butt%(4),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(4)))

  alpha alph%(5)
  parent alph%(5),frame2%
  top alph%(5),175
  left alph%(5),5
  font_bold alph%(5)
  caption alph%(5),"Mail :"
 
  edit Mail%
  parent Mail%,frame2%
  width Mail%,350
  top Mail%,190
  left Mail%,5
 
  edit ID%
  hide ID%
  if text$(ID%)<>"" : vID%=val(text$(ID%)): else : vID%=0 : end_if
 
  picture carte%
  parent carte%,frame2%
  height carte%,200
  width carte%,210
  top carte%,5
  left carte%,210
  file_load carte%,carte$
  stretch_on carte%

 
  alpha alph%(6)
  parent alph%(6),frame3%
  top alph%(6),5
  font_bold alph%(6)
  caption alph%(6),"Enregistrement : "+str$(vID%)+" / "+str$(inbase%)
  left alph%(6),w%-(width(alph%(6))+5)

  SelectMode(mode%)
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MENUS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Clic:
  clic% = number_click

  if clic% = sm%(1) : SelectMode(1) : mode%=1 : return : end_if
  if clic% = sm%(2) : SelectMode(2) : mode%=2 : return : end_if
  if clic% = sm%(3) : SelectMode(3) : mode%=3 : return : end_if
  if clic% = sm%(4) : SelectMode(4) : mode%=4 : return : end_if
  if clic% = sm%(6) : Quitter()    : end_if

  if clic% = butt%(1) :AffichRecordbyKey(Nom%,2,30)    : return : end_if
  if clic% = butt%(2) :AffichRecordbyKey(Prenom%,3,30) : return : end_if
  if clic% = butt%(3) :AffichRecordbyKey(Tel%,4,10)    : return : end_if
  if clic% = butt%(4) :AffichRecordbyKey(Port%,5,10)  : return : end_if
return

Change:
  change% = number_change
  if change% = tbedit%
      tbchoix% = val(text$(tbedit%))
      select tbchoix%
      case 1 : NewRecord()
      case 2 : if mode%=1 :SaveRecord():else : ModifRecord():end_if
      case 3 : DeleteRecord()
      case 4 : NextPreviousRecord("P")
      case 5 : NextPreviousRecord("N")
      case 6 : EffaceChamps()
      end_select
      return
  end_if
return

DClic:
return

VisuTab:
return

Close:
  Quitter()
return

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' FONCTIONS ET PROCEDURES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB SelectMode(m%)
  dim_local i%,res%
  for i% = 1 to 4 : mark_off sm%(i%) : next i%
  mark_on sm%(m%)
  select m%
  case 1
      caption sm%(0),"Enregistrer"
      res% = dll_call4("ModifyToolbar",4,1,1,0)
      res% = dll_call4("ModifyToolbar",4,2,1,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,0,0)
      res% = dll_call4("ModifyToolbar",4,5,0,0)
      res% = dll_call4("ModifyToolbar",4,6,0,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,0)
      inactive frame2%
  case 2
      caption sm%(0),"Modifier / Supprimer"
      res% = dll_call4("ModifyToolbar",4,1,0,0)
      res% = dll_call4("ModifyToolbar",4,2,1,0)
      res% = dll_call4("ModifyToolbar",4,3,1,0)
      res% = dll_call4("ModifyToolbar",4,4,0,0)
      res% = dll_call4("ModifyToolbar",4,5,0,0)
      res% = dll_call4("ModifyToolbar",4,6,0,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,0)
      active frame2%
  case 3
      caption sm%(0),"Visionner"
      res% = dll_call4("ModifyToolbar",4,1,0,0)
      res% = dll_call4("ModifyToolbar",4,2,0,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,1,0)
      res% = dll_call4("ModifyToolbar",4,5,1,0)
      res% = dll_call4("ModifyToolbar",4,6,0,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,0)
      AffichRecord()
      active frame2%
  case 4
      caption sm%(0),"Rechercher"
      res% = dll_call4("ModifyToolbar",4,1,0,0)
      res% = dll_call4("ModifyToolbar",4,2,0,0)
      res% = dll_call4("ModifyToolbar",4,3,0,0)
      res% = dll_call4("ModifyToolbar",4,4,0,0)
      res% = dll_call4("ModifyToolbar",4,5,0,0)
      res% = dll_call4("ModifyToolbar",4,6,1,0)
      res% = dll_call3("ObjectGroupFunction",Group%,1,1)
      EffaceChamps()
      active frame2%
  end_select
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB NewRecord()
  dim_local x%
  active frame2%
  x% = len(text$(id%))
  if x%=0
      text ID%,string$(3," ")+"1"
  else
      text ID%,right$(string$(4," ")+str$(val(text$(id%))+1),4)
  end_if
'  message text$(id%)
  text Nom%,""
  text Prenom%,""
  text Tel%,""
  text Port%,""
  text Mail%,""
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB ModifRecord()
  dim_local res%,s$,sf$,err%,a$

  res% = dll_call1("IsamFileIsOpen",Isam_ID%)
  if res%<0
      message "Le fichier ISAM est fermé !"
      exit_sub
  end_if
 
  ISAM_record$ = string$(ISAM_RecLen%,"*")

  s$  =trim$(text$(ID%))    : if len(s$)=0 : message "Le champ ID est vide !"            : exit_sub : end_if
  s$  =trim$(text$(ID%))    : if len(s$)>4 : message "Vous avez atteint le nombre maximum d' enregistrement !" : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,1,1,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Nom%))  : if len(s$)=0 : message "Le champ Nom est vide !"          : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,2,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Prenom%)): if len(s$)=0 : message "Le champ Prenom est vide !"        : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,3,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Tel%))  : if len(s$)=0 : message "Le champ Tel-fixe est vide !"      : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,4,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Port%))  : if len(s$)=0 : message "Le champ Tel-Portable est vide !"  : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,5,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Mail%))  : if len(s$)=0 : message "Le champ Mail est vide !"          : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,6,0,adr(ISAM_Record$),adr(s$),adr(sf$))
 
  res% = dll_call3("UpdateIsamRecord",Isam_ID%,adr(ISAM_Record$),ISAM_NbRec%)
  if res%<0
      err% = dll_call0("GetIsamError")
      message "Erreur en création "+str$(res%)+": "+str$(err%)
      exit_sub
  end_if

  inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
  caption alph%(6),"Enregistrement "+str$(res%)+" / "+str$(inbase%)
  left alph%(6),width(frame0%)-(width(alph%(6))+5)
 
  message "Modification Enregistré !
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB SaveRecord()
  dim_local res%,s$,sf$,err%,a$

  res% = dll_call1("IsamFileIsOpen",Isam_ID%)
  if res%<0
      message "Le fichier ISAM est fermé !"
      exit_sub
  end_if

  ISAM_record$ = string$(ISAM_RecLen%,"*")

  s$  =trim$(text$(ID%))    : if len(s$)=0 : message "Le champ ID est vide !"            : exit_sub : end_if
  s$  =trim$(text$(ID%))    : if len(s$)>4 : message "Vous avez atteint le nombre maximum d' enregistrement !" : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,1,1,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Nom%))  : if len(s$)=0 : message "Le champ Nom est vide !"          : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,2,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Prenom%)): if len(s$)=0 : message "Le champ Prenom est vide !"        : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,3,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Tel%))  : if len(s$)=0 : message "Le champ Tel-fixe est vide !"      : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,4,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Port%))  : if len(s$)=0 : message "Le champ Tel-Portable est vide !"  : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,5,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  s$  =trim$(text$(Mail%))  : if len(s$)=0 : message "Le champ Mail est vide !"          : exit_sub : end_if
  sf$ =" "
  res% = dll_call6("FillIsamField",Isam_ID%,6,0,adr(ISAM_Record$),adr(s$),adr(sf$))

  a$="ID : "+text$(id%)+chr$(13)+"Nom : "+text$(nom%)+chr$(13)+"Prenom : "+text$(Prenom%)+chr$(13)
  a$=a$+"Tel : "+text$(tel%)+chr$(13)+"Port : "+text$(port%)+chr$(13)+"mail : "+text$(mail%)
  message a$

  res% = dll_call2("AddIsamRecord",Isam_ID%,adr(ISAM_Record$))
  if res%<0
      err% = dll_call0("GetIsamError")
      message "Erreur en création "+str$(res%)+": "+str$(err%)
      exit_sub
  end_if

  inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
  caption alph%(6),"Enregistrement "+str$(res%)+" / "+str$(inbase%)
  left alph%(6),width(frame0%)-(width(alph%(6))+5)
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB AffichRecord()
  dim_local res%,key$,v$,fill$

  res% = dll_call1("IsamFileIsOpen",Isam_ID%)
  if res%<0
      message "Le fichier ISAM est fermé !"
      exit_sub
  end_if

  ISAM_record$ = string$(ISAM_RecLen%," ")

  if len(text$(ID%))=0
      text ID%,string$(3," ")+"1"
      key$ = string$(3," ")+"1"
  else
      key$ = right$(string$(4," ")+trim$(text$(id%)),4)
  end_if
  ISAM_NbRec% = dll_call4("ReadIsamRecordByKey",Isam_ID%,adr(ISAM_record$),1,adr(key$))
  res% = dll_call0("GetIsamOk")
  if res% = 0
'    nom
      v$=string$(30," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,2,adr(ISAM_record$),adr(v$),adr(fill$))
      text Nom%,v$
'    prenom
      v$=string$(30," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,3,adr(ISAM_record$),adr(v$),adr(fill$))
      text Prenom%,v$
'    Tel
      v$=string$(10," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,4,adr(ISAM_record$),adr(v$),adr(fill$))
      text Tel%,v$
'    Port
      v$=string$(10," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,5,adr(ISAM_record$),adr(v$),adr(fill$))
      text Port%,v$
'    Mail
      v$=string$(255," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,6,adr(ISAM_record$),adr(v$),adr(fill$))
      text Mail%,v$

      inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
      caption alph%(6),"Enregistrement "+str$(val(text$(id%)))+" / "+str$(inbase%)
      left alph%(6),width(frame0%)-(width(alph%(6))+5)
  else
      res% = dll_call0("GetIsamError")
      message str$(res%)
  end_if
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB DeleteRecord()
  dim_local res%,key$,v$,fill$

  res% = dll_call1("IsamFileIsOpen",Isam_ID%)
  if res%<0
      message "Le fichier ISAM est fermé !"
      exit_sub
  end_if

  ISAM_record$ = string$(ISAM_RecLen%," ")
  key$ = right$(string$(4," ")+trim$(text$(id%)),4)
  ISAM_NbRec% = dll_call4("ReadIsamRecordByKey",Isam_ID%,adr(ISAM_record$),1,adr(key$))
  res% = dll_call0("GetIsamOk")
  if res% = 0
    res% = dll_call4("CreateIsamKey",Isam_ID%,adr(ISAM_record$),1,adr(key$))
    if message_confirmation_yes_no("Etes vous sûr de vouloir supprimer cet enregistrement : "+chr$(13)+trim$(text$(nom%))+" ?")<>1 then return
    res% = dll_call3("DeleteIsamRecord",Isam_ID%,adr(ISAM_record$),ISAM_NbRec%)
  end_if
 
  inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
  caption alph%(6),"Enregistrement 0 / "+str$(inbase%)
  text id%,"" : text Nom%,"" : Text Prenom%,"" : Text Tel%,"" : text Port%,"" : text mail%,""
  left alph%(6),width(frame0%)-(width(alph%(6))+5)
 
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB NextPreviousRecord(npr$)
  dim_local res%,key$,v$,fill$,rpi%,rni%,a$

  res% = dll_call1("IsamFileIsOpen",Isam_ID%)
  if res%<0
      message "Le fichier ISAM est fermé !"
      exit_sub
  end_if

  key$ = string$(4," ")
  res% = dll_call4("CreateIsamKey",Isam_ID%,adr(ISAM_record$),1,adr(key$))

  if npr$="P"
      rpi% = dll_call4("ReadPreviousIsamRecord",Isam_ID%,adr(ISAM_record$),1,adr(key$))
      ISAM_NbRec% = rpi%
  else
      rni% = dll_call4("ReadNextIsamRecord",Isam_ID%,adr(ISAM_record$),1,adr(key$))
      ISAM_NbRec% = rni%
  end_if

  if ISAM_NbRec% >0
'    id
      v$=string$(4," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,1,adr(ISAM_record$),adr(v$),adr(fill$))
      text id%,v$
'    nom
      v$=string$(30," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,2,adr(ISAM_record$),adr(v$),adr(fill$))
      text Nom%,v$
'    prenom
      v$=string$(30," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,3,adr(ISAM_record$),adr(v$),adr(fill$))
      text Prenom%,v$
'    Tel
      v$=string$(10," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,4,adr(ISAM_record$),adr(v$),adr(fill$))
      text Tel%,v$
'    Port
      v$=string$(10," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,5,adr(ISAM_record$),adr(v$),adr(fill$))
      text Port%,v$
'    Mail
      v$=string$(255," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,6,adr(ISAM_record$),adr(v$),adr(fill$))
      text Mail%,v$
  else
    message "Oups... fin de fichier !"
  end_if

  inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
  caption alph%(6),"Enregistrement "+str$(val(text$(id%)))+" / "+str$(inbase%)
  left alph%(6),width(frame0%)-(width(alph%(6))+5)
END_SUB


' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB EffaceChamps()
  text id%,""
  text nom%,""
  text prenom%,""
  text tel%,""
  text port%,""
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB AffichRecordbyKey(o%,k%,kcar%)
  dim_local res%,key$,v$,fill$

  res% = dll_call1("IsamFileIsOpen",Isam_ID%)
  if res%<0
      message "Le fichier ISAM est fermé !"
      exit_sub
  end_if

  ISAM_record$ = string$(ISAM_RecLen%," ")
  key$ = left$(trim$(text$(o%))+string$(kcar%," "),kcar%)

  ISAM_NbRec% = dll_call4("ReadIsamRecordByKey",Isam_ID%,adr(ISAM_record$),k%,adr(key$))
  res% = dll_call0("GetIsamOk")
 
  if res% = 0
'    ID
      v$=string$(4," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,1,adr(ISAM_record$),adr(v$),adr(fill$))
      text ID%,v$
'    nom
      v$=string$(30," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,2,adr(ISAM_record$),adr(v$),adr(fill$))
      text Nom%,v$
'    prenom
      v$=string$(30," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,3,adr(ISAM_record$),adr(v$),adr(fill$))
      text Prenom%,v$
'    Tel
      v$=string$(10," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,4,adr(ISAM_record$),adr(v$),adr(fill$))
      text Tel%,v$
'    Port
      v$=string$(10," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,5,adr(ISAM_record$),adr(v$),adr(fill$))
      text Port%,v$
'    Mail
      v$=string$(255," ")  : fill$ =" "
      res% = dll_call5("ExtractIsamField",Isam_ID%,6,adr(ISAM_record$),adr(v$),adr(fill$))
      text Mail%,v$

      inbase% = dll_call1("GetIsamRecordCount",Isam_ID%)
      caption alph%(6),"Enregistrement "+str$(val(text$(id%)))+" / "+str$(inbase%)
      left alph%(6),width(frame0%)-(width(alph%(6))+5)
  else
      res% = dll_call0("GetIsamError")
      message str$(res%)
  end_if
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Quitter()
  dim_local fin%
  fin% = dll_call1("CloseIsamFile",Isam_ID%)
  wait 100
  fin% = dll_call0("FreeIsam")
  wait 100
  fin% = dll_call1("KillProcessByHandle",handle(0))
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB MessageErreur(e%)
  dim_local a$,i%
  i%=e%*-1
  select i%
  case 1 : a$="[1] La chaîne de définition es incohérente"
  case 2 : a$="[2] Le numéro de la clé est non numérique"
  case 3 : a$="[3] Le nombre de clés est invalide (<1 ou >(nombre de clés)+1))"
  case 4 : a$="[4] Le flag ''pas de doublons'' est non numérique"
  case 5 : a$="[5] Un numéro de champ est non numérique"
  case 6 : a$="[6] Un numéro de champ est invalide (<1 ou >(nombre de champ))"
  case 7 : a$="[7] Clé > 30 caractères"
  end_select
  message str$(res%)+chr$(13)+a$
END_SUB

Un zip sera dispo d' ici 5 minutes sur mon webdav.
Si Klaus voit des erreurs ou des choses qui pourrait en produire dans le code...
...je suis tout ouïe Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5041
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: PhoneBook ( ISAM Database )   Dim 2 Aoû 2015 - 21:34

Testé !

ça marche bien, Windows 8.1 m'a demandé d'installer DirectPlay Question J'ai accepté... et pas de problème.

Constatation: Je n'ai pas de téléphone portable (et j'en veux pas), j'ai été obligé de mettre 06 pour pour pouvoir m'enregistrer.

2 Suggestions: Dans le menu voir, un petit bouton pour envoyer un mail directos, ça serait bien.
Remplacé ton menu par une toolbar.

Mon avis: C'est très simple et il n'y a que l'essentiel. Comme toi, j'aime les choses simples.
Bravo cheers , ça ressemble à "MyDriveConnector.exe" et cela pourrait être fusionné.

Approuvé. Very Happy

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

Nombre de messages : 7994
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Dim 2 Aoû 2015 - 21:45

Pour le portable, c' est une sécurité mal t à propos.
Pour renvoyer vers le client de messagerie, pourquoi pas ?
Pour la toolbar, il y en a déjà une et comme on ne peut en avoir qu' une... Crying or Very sad

En tout cas merci d' avoir testé et, approuvé... Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: PhoneBook ( ISAM Database )   

Revenir en haut Aller en bas
 
PhoneBook ( ISAM Database )
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» probleme maj " database for fm traffic providers " sur dezl 560lt
» Plus de réception trafic sur 1490
» Mise à jour système.
» Base de données de type ISAM par Excel sous PANORAMIC
» Mise à jour système nuivi 3790LMT

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: