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
» Immortaliser les photos de famille
par Jean Claude Hier à 21:24

» Concours de Morpions
par jjn4 Hier à 16:34

» Tout est tranquille
par Jean Claude Ven 22 Sep 2017 - 21:41

» Texte en gif animé
par JL35 Ven 22 Sep 2017 - 13:29

» BasicEditor
par Yannick Mer 20 Sep 2017 - 17:17

» Simuler l’appui d'une touche ou combinaison de touches.
par pascal10000 Lun 18 Sep 2017 - 19:30

» Utilisation de HVIEWER pour afficher des images
par papydall Lun 18 Sep 2017 - 17:43

» Panoramic et les gifs animés.
par papydall Lun 18 Sep 2017 - 16:32

» recover source
par pascal10000 Dim 17 Sep 2017 - 14:21

» Recent dans vos menu
par Jean Claude Sam 16 Sep 2017 - 11:41

» Comment centrer un texte 3D.
par pascal10000 Ven 15 Sep 2017 - 20:20

» Carte interface 16 entrées et 16 sorties
par Jicehel Ven 15 Sep 2017 - 16:30

» Version instantanée V 0.9.28i9 possédant l'objet SYNEDIT
par pascal10000 Ven 15 Sep 2017 - 16:20

» Compilateur FBPano
par jean_debord Ven 15 Sep 2017 - 9:59

» 1 (en analyse): 3D_TARGET_IS ne fonctionne pas sur 3D_TEXT
par Jack Jeu 14 Sep 2017 - 19:52

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Septembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
252627282930 
CalendrierCalendrier

Partagez | 
 

 dbf_Maker

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

avatar

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

MessageSujet: dbf_Maker   Jeu 16 Mar 2017 - 5:13

Un petit utilitaire que je me suis créé pour éditer des fichiers *.dbf.
Ces fichiers sont destinés à être utilisé dans des programmes sans 
avoir besoin d' inclure un processus de création qui ne servirait qu' une fois.
Cet utilitaire ce sert de KGF.dll et Cheetah4.dll. Seul la première est nécessaire
puisque l' autre est embarqué avec elle.
Pour ceux qui veulent tout (images, sources,ressources et la crémière... Laughing)
il y a un zip sur mon webdav.

Code:
hide 0
Variables()
Constantes()
Labels()
Init()
Form_0()
show 0
end

' ==============================================================================
'  DECLARATION DES VARIABLES
' ==============================================================================

  sub Variables()
  '  INCREMENTATION DES OBJETS
      dim no%
      dim nbbtn%
  '  POSITION DE LA SOURIS
      dim Xmenu%
      dim Ymenu%
  '  BOUTON MENU ACTIF
      dim Active_btn%
  '  ETATS
      dim Etat_appli% :' 0/1/2
  '  HANDLE
      dim Hnd_base%
  '  APPLICATION
      dim NomBase$
      dim OutputBase$
      dim NomChamp$
      dim TypeChamp$
      dim DefChamp1$
      dim DefChamp2$
  end_sub

' ==============================================================================
'  DECLARATION DES CONSTANTES
' ==============================================================================

  sub Constantes()
      dim_local i%
     
  '  nombre de boutons de la toolbar
      nbbtn%=8
     
  '  Titre de l' application
      dim Titre$    : Titre$ = "dbf_Maker"
      Application_title Titre$
 
  '  Dossier racine
      dim Path$    : Path$ = dir_current$
      if right$(Path$,1)="\" : Path$=left$(Path$,len(Path$)-1) : end_if
      Path$=Path$+"\"

  '  Dossiers systeme
      dim Dir_img$  : Dir_img$ = Path$+"img\"

  '  Dossiers appli
      dim Dir_Doc$  :' sera défini dans init()
     
  '  Fichiers paramètres
      dim DBM_param$ : DBM_param$ = Path$+"Param.inf"

  '  Fichiers dll
      dim Cheetah$  : Cheetah$ = Path$+"Cheetah4.dll"
      dim Kgf$      : Kgf$ = Path$+"KGF.dll"
     
  '  Fichiers image
      dim Tb_img$          : Tb_img$ = Dir_img$+"Tb.bmp"
      dim Btn1_img$(nbbtn%): for i%=1 to nbbtn% : Btn1_img$(i%)= Dir_img$+"1"+str$(i%)+".bmp" : next i%
      dim Btn2_img$(nbbtn%): for i%=1 to nbbtn% : Btn2_img$(i%)= Dir_img$+"2"+str$(i%)+".bmp" : next i%
      dim Btn3_img$(nbbtn%): for i%=1 to nbbtn% : Btn3_img$(i%)= Dir_img$+"3"+str$(i%)+".bmp" : next i%
      dim Picto$(10)      : for i%=1 to 10 : Picto$(i%)= Dir_img$+"Picto"+str$(i%)+".bmp" : next i%

  '  Objets panoramic
  '  >> Fichier en lecture/écriture
      dim f_ow%        : no%=no%+1 : f_ow%=no%
      dim f_or%        : no%=no%+1 : f_or%=no%
  '  >> Boites de dialogue
      dim Odial%      : no%=no%+1 : Odial%=no%
      dim Sdial%      : no%=no%+1 : Sdial%=no%
  '  >> Form 0
      dim Tb%          : no%=no%+1 : Tb%=no%
      dim PictTb%      : no%=no%+1 : PictTb%=no%
      dim Btn1%(nbbtn%): for i%=1 to nbbtn% : no%=no%+1 : Btn1%(i%)=no% : next i%
      dim Btn2%(nbbtn%): for i%=1 to nbbtn% : no%=no%+1 : Btn2%(i%)=no% : next i%
      dim PictEtat%    : no%=no%+1 : PictEtat%=no%
      dim corps%      : no%=no%+1 : corps%=no%
      dim AlphCorp%(3) : for i%=1 to 3 : no%=no%+1 : AlphCorp%(i%)=no% : next i%
      dim EdiCorp%(2)  : for i%=1 to 2 : no%=no%+1 : EdiCorp%(i%)=no% : next i%
      dim Listcorp%    : no%=no%+1 : ListCorp%=no%
      dim PictBut%(7)  : for i%=1 to 7 : no%=no%+1 : PictBut%(i%)=no% : next i%
      dim Sb%          : no%=no%+1 : Sb%=no%
      dim AlphSb%      : no%=no%+1 : AlphSb%=no%
      dim Pb%          : no%=no%+1 : Pb%=no%
      dim mem%        : no%=no%+1 : mem%=no%
  '  >> Form Fen_init
      dim Fen_AddChamp%    : no%=no%+1 : Fen_AddChamp%=no%
      dim PanAddChamp%    : no%=no%+1 : PanAddChamp%=no%
      dim AlphaddChamp%(4) : for i%=1 to 4 : no%=no%+1 : AlphaddChamp%(i%)=no% : next i%
      dim EdiAddChamp%(2)  : for i%=1 to 2 : no%=no%+1 : EdiaddChamp%(i%)=no%  : next i%
      dim CombAddChamp%(2) : for i%=1 to 2 : no%=no%+1 : CombAddChamp%(i%)=no% : next i%
      dim SpinAddChamp%(2) : for i%=1 to 2 : no%=no%+1 : SpinAddChamp%(i%)=no% : next i%
  end_sub

' ==============================================================================
'  DECLARATION DES LABELS
' ==============================================================================

  sub Labels()
  '  Evénements application
      label Clic
      label Change
      label Dclic
      label CloseApp
  '  Evénements visuels
      label Resize
      label MoveTb
      label MovePictTb
      label DownBtn
      label UpBtn
  end_sub

' ==============================================================================
'  INITIALISATIONS
' ==============================================================================

  sub Init()
      dim_local res%,m%,file$,mess$
     
    ' Activation de kgf
      if file_exists(Kgf$)=1
        dll_on Kgf$
      else
        if file_exists(DBM_param$)=1
            file_open_read f_or%,DBM_param$
            file_readln f_or%,Kgf$
            file_readln f_or%,Cheetah$
            file_close f_or%
            dll_on Kgf$
        else
            m% = message_warning_yes_no("KGF.dll n' a pas été trouvée !"+chr$(13)+"Voulez renseigner son emplacement sur votre ordinateur ?..." )
            if m% = 1
              Open_dialog Odial%
              dir_dialog Odial%,":\"
              filter Odial%,"*.dll|*.dll"
              file$=file_name$(Odial%)
              delete Odial%
              if file$<>"_"
                  kgf$ = file$
                  file_open_write f_ow%,DBM_param$
                  file_writeln f_ow%,kgf$
                  Cheetah$ = file_extract_path$(kgf$)+"Cheetah4.dll"
                  file_writeln f_ow%,Cheetah$
                  file_close f_ow%
                  dll_on kgf$
              end_if
            else
              mess$ = "Désolé..."+chr$(13)+"...cette application va se fermer."+chr$(13)
              mess$ = mess$+"Vous pouvez télécharger KGF.dll sur ce site :"+chr$(13)
              mess$ = mess$+"http://klauspanoramic.comxa.com/index.html"
              m% = message_information_ok(mess$)
              Quitter_simple()
            end_if
        end_if
      end_if
     
    ' initialisation de Dir_Doc$
      Dir_Doc$ = string$(511," ")
      res% = dll_call2("GetWindowsFoldersPath",5,adr(Dir_Doc$))
      Dir_Doc$ = trim$(Dir_Doc$)+"\DBM_documents\"
      if dir_exists(Dir_Doc$)=0 then dir_make Dir_Doc$

    ' connexion à cheetah
      res% = dll_call1("CheetahLoadDll",adr(Cheetah$))
  end_sub

' ==============================================================================
'  INTERFACE
' ==============================================================================

'  FORM 0
  sub Form_0()
      dim_local i%,l%,t%,h$
     
      height 0,350
      width 0,500
      top 0,(screen_y-height(0))/2
      left 0,(screen_x-width(0))/2
      color 0,230,230,230
     
      font_name 0,"Arial"
      font_size 0,8
      font_bold 0
      font_color 0,85,85,127
     
      caption 0,Titre$
     
      panel Tb%
      height Tb%,32
      width Tb%,width_client(0)-10
      top Tb%,5
      left Tb%,5
      on_mouse_move Tb%,MoveTb
     
      picture PictTb%
      parent PictTb%,Tb%
      height PictTb%,24
      width PictTb%,24*nbbtn%
      top PictTb%,4
      left PictTb%,4
      if file_exists(Tb_img$)=1 : file_load PictTb%,Tb_img$  : end_if
      on_mouse_move PictTb%,MovePictTb
     
      picture PictEtat%
      parent PictEtat%,Tb%
      height PictEtat%,24
      width PictEtat%,24
      top PictEtat%,4
      left PictEtat%,width(Tb%)-width(PictEtat%)-5
      if file_exists(picto$(8))=1 : file_load PictEtat%,picto$(8) : end_if
     
      create_hide
      h$="Nouveau,Ouvrir,Fermer,Enregistrer,Créer,Quitter,"
      l%=4
      for i%=1 to nbbtn%
        picture Btn1%(i%)
        parent Btn1%(i%),Tb%
        height Btn1%(i%),24
        width  Btn1%(i%),24
        top Btn1%(i%),4
        left Btn1%(i%),l%
        if file_exists(Btn1_img$(i%))=1 : file_load Btn1%(i%),Btn1_img$(i%) : else : color Btn1%(i%),0,0,0 : end_if
        if i%<>4 and i%<>7
            hint Btn1%(i%),left$(h$,instr(h$,",")-1)
            if i%<nbbtn% : h$=right$(h$,len(h$)-instr(h$,",")) : end_if
        end_if
        cursor_point Btn1%(i%)
        on_mouse_down Btn1%(i%),DownBtn
        on_mouse_up Btn1%(i%),UpBtn
        on_click Btn1%(i%),Clic

        picture Btn2%(i%)
        parent Btn2%(i%),Tb%
        height Btn2%(i%),24
        width  Btn2%(i%),24
        top Btn2%(i%),4
        left Btn2%(i%),l%
        if file_exists(Btn3_img$(i%))=1 : file_load Btn2%(i%),Btn3_img$(i%) : end_if
       
        l%=l%+24
      next i%
     
      panel corps%
      height corps%,height_client(0)-47
      width corps%,width_client(0)-10
      top corps%,top(Tb%)+height(Tb%)+5
      left corps%,5

      create_show
     
    ' corps
      alpha AlphCorp%(1)
      parent AlphCorp%(1),corps%
      top AlphCorp%(1),10
      left AlphCorp%(1),10
      caption AlphCorp%(1),"Nom de la base"
     
      edit EdiCorp%(1)
      parent EdiCorp%(1),corps%
      width EdiCorp%(1),200
      top EdiCorp%(1),top(AlphCorp%(1))+height(AlphCorp%(1))+2
      left EdiCorp%(1),10
      color EdiCorp%(1),235,235,235
      text EdiCorp%(1),NomBase$
      inactive EdiCorp%(1)

      alpha AlphCorp%(2)
      parent AlphCorp%(2),corps%
      top AlphCorp%(2),top(EdiCorp%(1))+height(EdiCorp%(1))+5
      left AlphCorp%(2),10
      caption AlphCorp%(2),"Destination"

      edit EdiCorp%(2)
      parent EdiCorp%(2),corps%
      width EdiCorp%(2),400
      top EdiCorp%(2),top(AlphCorp%(2))+height(AlphCorp%(2))+2
      left EdiCorp%(2),10
      font_color EdiCorp%(2),200,115,245
     
      button_picture PictBut%(1)
      parent PictBut%(1),corps%
      height PictBut%(1),22
      width PictBut%(1),22
      top PictBut%(1),top(EdiCorp%(2))
      left PictBut%(1),left(EdiCorp%(2))+width(EdiCorp%(2))+5
      if file_exists(picto$(1))=1 : file_load PictBut%(1),Picto$(1) : end_if
      cursor_point PictBut%(1)
      on_click PictBut%(1),clic
     
      alpha AlphCorp%(3)
      parent AlphCorp%(3),corps%
      top AlphCorp%(3),top(EdiCorp%(2))+height(EdiCorp%(2))+5
      left AlphCorp%(3),10
      caption AlphCorp%(3),"Champs"
     
      list ListCorp%
      parent ListCorp%,corps%
      height ListCorp%,height(corps%)-top(AlphCorp%(3))-height(AlphCorp%(3))-10
      width ListCorp%,400
      top ListCorp%,height(corps%)-height(ListCorp%)-8
      left ListCorp%,10
     
      t%= top(ListCorp%)
      for i%=2 to 6
        button_picture PictBut%(i%)
        parent PictBut%(i%),corps%
        height PictBut%(i%),22
        width PictBut%(i%),22
        top PictBut%(i%),t%
        left PictBut%(i%),left(ListCorp%)+width(ListCorp%)+5
        if file_exists(picto$(i%))=1 : file_load PictBut%(i%),Picto$(i%) : end_if
        cursor_point PictBut%(i%)
        on_click PictBut%(i%),clic
        t%=t%+27
      next i%

      dlist mem%
      on_resize 0,Resize
      on_close 0,CloseApp
  end_sub
' ------------------------------------------------------------------------------

'  FORM ADD CHAMP
  sub Form_AddChamp()
      dim_local res%
     
      if object_exists(Fen_AddChamp%)=1
        show Fen_AddChamp%
      else
        form Fen_AddChamp%
        border_small Fen_AddChamp%
        height Fen_AddChamp%,200
        width Fen_AddChamp%,400
        top Fen_AddChamp%,(screen_y-height(Fen_AddChamp%))/2
        left Fen_AddChamp%,(screen_x-width(Fen_AddChamp%))/2
        color Fen_AddChamp%,230,230,230
       
        font_name Fen_AddChamp%,"Arial"
        font_size Fen_AddChamp%,8
        font_bold Fen_AddChamp%
        font_color Fen_AddChamp%,85,85,127
       
        caption Fen_AddChamp%,"Ajouter un champ"
       
        panel PanAddChamp%
        parent PanAddChamp%,Fen_AddChamp%
        height PanAddChamp%,height_client(Fen_AddChamp%)-10
        width PanAddChamp%,width_client(Fen_AddChamp%)-10
        top PanAddChamp%,5
        left PanAddChamp%,5
       
        alpha AlphAddChamp%(1)
        parent AlphAddChamp%(1),PanAddChamp%
        top AlphAddChamp%(1),5
        left AlphAddChamp%(1),5
        caption AlphAddChamp%(1),"Nom du champ"
       
        edit EdiAddChamp%(1)
        parent EdiAddChamp%(1),PanAddChamp%
        width EdiAddChamp%(1),150
        top EdiAddChamp%(1),top(AlphAddChamp%(1))+height(AlphAddChamp%(1))+2
        left EdiAddChamp%(1),5
       
        alpha AlphAddChamp%(2)
        parent AlphAddChamp%(2),PanAddChamp%
        top AlphAddChamp%(2),top(EdiAddChamp%(1))+height(EdiAddChamp%(1))+5
        left AlphAddChamp%(2),5
        caption AlphAddChamp%(2),"Type"

        combo CombAddChamp%(1)
        parent CombAddChamp%(1),PanAddChamp%
        width CombAddChamp%(1),100
        top CombAddChamp%(1),top(AlphAddChamp%(2))+height(AlphAddChamp%(2))+2
        left CombAddChamp%(1),5
        on_click CombAddChamp%(1),clic
       
            item_add CombAddChamp%(1),"TEXTE"
            item_add CombAddChamp%(1),"NUMERIQUE"
            item_add CombAddChamp%(1),"DATE"
            item_add CombAddChamp%(1),"LOGIQUE"
            item_add CombAddChamp%(1),"MEMO"

        create_hide
       
        alpha AlphAddChamp%(3)
        parent AlphAddChamp%(3),PanAddChamp%
        top AlphAddChamp%(3),top(AlphAddChamp%(2))
        left AlphAddChamp%(3),left(CombAddChamp%(1))+width(CombAddChamp%(1))+5
        caption AlphAddChamp%(3),"Caractères"
       
        combo CombAddChamp%(2)
        parent CombAddChamp%(2),PanAddChamp%
        width CombAddChamp%(2),100
        top CombAddChamp%(2),top(CombAddChamp%(1))
        left CombAddChamp%(2),left(CombAddChamp%(1))+width(CombAddChamp%(1))+5
        on_click CombAddChamp%(2),clic
       
            item_add CombAddChamp%(2),"Vrai"
            item_add CombAddChamp%(2),"Faux"
            item_add CombAddChamp%(2),"Indéfini"
       
        spin spinAddChamp%(1)
        parent spinAddChamp%(1),PanAddChamp%
        width spinAddChamp%(1),100
        top spinAddChamp%(1),top(CombAddChamp%(1))
        left spinAddChamp%(1),left(CombAddChamp%(1))+width(CombAddChamp%(1))+5
        on_change spinAddChamp%(1),change
           
        alpha AlphAddChamp%(4)
        parent AlphAddChamp%(4),PanAddChamp%
        top AlphAddChamp%(4),top(AlphAddChamp%(2))
        left AlphAddChamp%(4),left(CombAddChamp%(1))+width(CombAddChamp%(1))+110
        caption AlphAddChamp%(4),"Nbre de décimals"
       
        spin spinAddChamp%(2)
        parent spinAddChamp%(2),PanAddChamp%
        width spinAddChamp%(2),100
        top spinAddChamp%(2),top(CombAddChamp%(1))
        left spinAddChamp%(2),left(CombAddChamp%(1))+width(CombAddChamp%(1))+110
        on_change spinAddChamp%(2),change
       
        create_show
       
        button_picture PictBut%(7)
        parent PictBut%(7),PanAddChamp%
        height PictBut%(7),22
        width PictBut%(7),22
        top PictBut%(7),height(PanAddChamp%)-height(PictBut%(7))-5
        left PictBut%(7),width(PanAddChamp%)-width(PictBut%(7))-5
        if file_exists(picto$(2))=1 : file_load PictBut%(7),Picto$(2) : end_if
        cursor_point PictBut%(7)
        on_click PictBut%(7),clic
       
      end_if
     
      text EdiAddChamp%(1),""
      text CombAddChamp%(1),""
      hide AlphAddChamp%(3)
      hide CombAddChamp%(2)
      hide spinAddChamp%(1)
      hide AlphAddChamp%(4)
      hide spinAddChamp%(1)
     
      res% = DLL_call2("WindowTopMost",handle(Fen_AddChamp%),1)
  end_sub

' ==============================================================================
'  MENU EVENEMENTS APPLICATION
' ==============================================================================

  Clic:
      if number_click = Btn1%(1)
        Nouveau()
        return
      end_if
     
      if number_click = Btn1%(2)
        Ouvrir()
        return
      end_if
     
      if number_click = Btn1%(3)
        if Etat_appli%<>0
            VerifEtatAppli()
            if Ret_VerifEtatAppli%=1
              return
            end_if
            Fermer()
            hide corps%
        end_if
        return
      end_if
     
      if number_click = Btn1%(5)
        Enregistrer()
        return
      end_if
     
      if number_click = Btn1%(6)
        Creer()
        return
      end_if
     
      if number_click = Btn1%(8)
        if Etat_appli%<>0
            VerifEtatAppli()
            if Ret_VerifEtatAppli%=1
              return
            end_if
        end_if
        Quitter()
        return
      end_if
     
      if number_click = PictBut%(1)
        SelectDestination()
        return
      end_if
     
      if number_click = PictBut%(2)
        Form_AddChamp()
        return
      end_if
     
      if number_click = PictBut%(3)
        if item_index(ListCorp%)>0
            item_delete ListCorp%,item_index(ListCorp%)
            if file_exists(picto$(10))=1 : file_load PictEtat%,picto$(10) : end_if
            Etat_appli%=2
        end_if
        return
      end_if
     
      if number_click = PictBut%(4)
        message "Modifier le champ [Inactif]"
        return
      end_if
     
      if number_click = PictBut%(5)
        RemonterDescendreItem(item_index(ListCorp%),0)
        return
      end_if
     
      if number_click = PictBut%(6)
        RemonterDescendreItem(item_index(ListCorp%),1)
        return
      end_if
     
      if object_exists(Fen_AddChamp%)=1
        if number_click = CombAddChamp%(1)
            AffichageFormAddChamp(item_index(CombAddChamp%(1)))
            return
        end_if
        if number_click = CombAddChamp%(2)
            if item_index(CombAddChamp%(2))=1
              DefChamp1$="T"
            else
              if item_index(CombAddChamp%(2))=2
                  DefChamp1$="F"
              else
                  DefChamp1$=""
              end_if
            end_if
            return
        end_if
        if number_click = PictBut%(7)
            NomChamp$ = text$(EdiAddChamp%(1))
            if NomChamp$<>""
              item_add ListCorp%,NomChamp$+" | "+TypeChamp$+" | "+DefChamp1$+" | "+DefChamp2$
              hide Fen_AddChamp%
              if file_exists(picto$(10))=1 : file_load PictEtat%,picto$(10) : end_if
              Etat_appli%=2
            else
              message "Vous n' avez pas nommé le champ !"
              return
            end_if
            return
        end_if
      end_if
  return
' ------------------------------------------------------------------------------

  Change:
      if object_exists(Fen_AddChamp%)=1
        if number_change = spinAddChamp%(1)
            DefChamp1$= str$(position(spinAddChamp%(1)))
            return
        end_if
        if number_change = spinAddChamp%(2)
            DefChamp2$= str$(position(spinAddChamp%(2)))
            return
        end_if
      end_if
  return
' ------------------------------------------------------------------------------

  Dclic:
  return
' ------------------------------------------------------------------------------

  CloseApp:
      if Etat_appli%=2
        if message_warning_yes_no("Des modications n' ont pas été enregistrées !"+chr$(13)+"Voulez vous les enregistrer avant de quitter ?...")=1
            Enregistrer()
        end_if
      end_if
  return
 
' ==============================================================================
'  MENU EVENEMENTS VISUELS
' ==============================================================================

'  Redimensionnement du forrmulaire principal
  Resize:
      height 0,350
      width 0,500
      top 0,(screen_y-height(0))/2
      left 0,(screen_x-width(0))/2
  return
' ------------------------------------------------------------------------------

'  Souris sur le container de la toolbar
  MoveTb:
      off_mouse_move Tb%
      ResetTb()
  return
' ------------------------------------------------------------------------------

'  Souris sur toolbar
  MovePictTb:
      off_mouse_move PictTb%
      Xmenu% = mouse_x_position(PictTb%)
      ResetTb()
      DetectBtn()
      if Active_btn%<>4 and Active_btn%<>7
        show Btn1%(Active_btn%)
      end_if
      on_mouse_move PictTb%,MovePictTb
      on_mouse_move Tb%,MoveTb
  return
' ------------------------------------------------------------------------------

'  Souris enfonçée sur bouton
  DownBtn:
      off_mouse_down Btn1%(Active_btn%)
      if file_exists(Btn2_img$(Active_btn%))=1 : file_load Btn1%(Active_btn%),Btn2_img$(Active_btn%)  : end_if
      on_mouse_up Btn1%(Active_btn%),UpBtn
  return
' ------------------------------------------------------------------------------

'  Souris relevée sur bouton
  UpBtn:
      off_mouse_up Btn1%(Active_btn%)
      hide Btn1%(Active_btn%)
      if file_exists(Btn1_img$(Active_btn%))=1 : file_load Btn1%(Active_btn%),Btn1_img$(Active_btn%)  : end_if
      on_mouse_down Btn1%(Active_btn%),DownBtn
  return
 
' ==============================================================================
'  FONCTIONS
' ==============================================================================

'  ACTIVATION/INACTIVATION DE LA TOOLBAR
  sub ActiveInactiveTb(act%)
      dim_local i%
     
      if act%=1
        for i%=1 to nbbtn% : if i%<>4 and i%<>7 : hide Btn2%(i%) : end_if : next i%
      else
        for i%=1 to nbbtn% : if i%<>4 and i%<>7 : show Btn2%(i%) : end_if : next i%
      end_if
  end_sub
' ------------------------------------------------------------------------------

'  REMISE A ZERO DE LA TOOLBAR
  sub ResetTb()
      dim_local i%

      for i%=1 to nbbtn%
        hide Btn1%(i%)
        if file_exists(Btn1_img$(i%))=1 : file_load Btn1%(i%),Btn1_img$(i%) : end_if
      next i%
  end_sub
' ------------------------------------------------------------------------------

'  DETECTION DU BOUTON CLIQUE
  sub DetectBtn()
      dim_local i%,p1%,p2%

      p2% = 25
      for i%=1 to nbbtn%
        if Xmenu%>p1% and Xmenu%<p2%
            Active_btn%=i%
            exit_for
        end_if
        p1%=p2%-1
        p2%=p2%+24
      next i%
  end_sub
' ------------------------------------------------------------------------------

'  NOUVELLE BASE
  sub Nouveau()
      dim_local i%,m%
     
      if Etat_appli%<>0
        VerifEtatAppli()
        if Ret_VerifEtatAppli%=1 : exit_sub : end_if
        Fermer()
      end_if
     
      m% = message_input("Nouveau","Nom de la nouvelle base : ","")
      if m%=1
        NomBase$ = message_text$
        caption 0,Titre$+" - ["+NomBase$+"]"
        if file_exists(picto$(9))=1 : file_load PictEtat%,picto$(9) : end_if
        Etat_appli%=1
        text EdiCorp%(1),NomBase$
        show corps%
      end_if
  end_sub
' ------------------------------------------------------------------------------

'  OUVRIR UN FICHIER dbm
  sub Ouvrir()
      dim_local i%,file$
     
      if Etat_appli%<>0
        VerifEtatAppli()
        if Ret_VerifEtatAppli%=1 : exit_sub : end_if
        Fermer()
      end_if
     
      Open_dialog Odial%
      dir_dialog Odial%,Dir_Doc$
      filter Odial%,"*.dbm|*.dbm"
      file$ = file_name$(Odial%)
      delete Odial%
     
      if file$<>"_"
        file_load mem%,file$
        if count(mem%)>0
            NomBase$    = item_read$(mem%,1) : text EdiCorp%(1),NomBase$
            OutputBase$ = item_read$(mem%,2) : text EdiCorp%(2),OutputBase$
            if count(mem%)>2
              for i%=3 to count(mem%)
                  item_add ListCorp%,item_read$(mem%,i%)
              next i%
            end_if
            show corps%
            if file_exists(picto$(9))=1 : file_load PictEtat%,picto$(9) : end_if
            Etat_appli%=1
        end_if
      end_if
  end_sub
' ------------------------------------------------------------------------------

'  FERMER LA BASE EN COURS
  sub Fermer()
      text EdiCorp%(1),""
      text EdiCorp%(2),""
      clear ListCorp%
      clear mem%
      NomBase$=""
      OutputBase$=""
      caption 0,Titre$
      if file_exists(picto$(8))=1 : file_load PictEtat%,picto$(8) : end_if
      Etat_appli%=0
  end_sub
' ------------------------------------------------------------------------------

'  ENREGISTRER LA BASE EN COURS
  sub Enregistrer()
      dim_local i%

      clear mem%
      item_add mem%,NomBase$
      item_add mem%,OutputBase$
      if count(ListCorp%)>0
        for i%=1 to count(ListCorp%)
            item_add mem%,item_read$(ListCorp%,i%)
        next i%
      end_if
      file_save mem%,Dir_Doc$+NomBase$+".dbm"
      if file_exists(picto$(9))=1 : file_load PictEtat%,picto$(9) : end_if
      Etat_appli%=1
  end_sub
' ------------------------------------------------------------------------------

'  CREER LA BASE DE DONNEES EN COURS
  sub Creer()
      dim_local cmd$,i%,a$,c$,chp$,res%,m%
     
      cmd$ = "Disk="+OutputBase$+NomBase$+".dbf;"
      cmd$ = cmd$+"Type=dbase;"
      cmd$ = cmd$+"memosize=512;"
      for i%=3 to count(mem%)
        c$= ""
        a$= item_read$(mem%,i%)
        chp$= left$(a$,instr(a$,"|")-1)
        a$= right$(a$,len(a$)-instr(a$,"|"))
        c$= "field="+trim$(chp$)+","
        chp$= left$(a$,instr(a$,"|")-1)
        a$= right$(a$,len(a$)-instr(a$,"|"))
        if trim$(chp$)="TEXTE" then chp$="C"
        if trim$(chp$)="NUMERIQUE" then chp$="N"
        if trim$(chp$)="DATE" then chp$="D"
        if trim$(chp$)="LOGIQUE" then chp$="L"
        if trim$(chp$)="MEMO" then chp$="M"
        c$= c$+trim$(chp$)+","
        chp$= left$(a$,instr(a$,"|")-1)
        a$= right$(a$,len(a$)-instr(a$,"|"))
        c$= c$+trim$(chp$)+","+trim$(a$)+";"
        cmd$ = cmd$+c$
      next i%
      res% = dll_call1("CheetahCreateDatabase",adr(cmd$))
      if res%<>0 : m%=message_warning_ok("Erreur lors de la création !"+chr$(13)+str$(res%)) : end_if
  end_sub
' ------------------------------------------------------------------------------

'  QUITTER
  sub Quitter()
      dim_local res%

      res% = dll_call0("CheetahShutdown")
      res% = dll_call1("KillProcessByHandle",handle(0))
  end_sub
' ------------------------------------------------------------------------------

'  QUITTER SIMPLE
  sub Quitter_simple()
      terminate
  end_sub
' ------------------------------------------------------------------------------

'  VERIFICATION DE L ETAT DE L APPLICATION
  sub VerifEtatAppli()
      dim_local m%,mess$
     
      if variable("Ret_VerifEtatAppli%")=0 then dim Ret_VerifEtatAppli%
      Ret_VerifEtatAppli%=0
 
      if Etat_appli%=1
        mess$ = "Une base est en ouverte !"+chr$(13)
        mess$ = mess$+"Etes vous sûr de vouloir fermer cette base ?..."
        m%=message_warning_yes_no(mess$)
        if m%<>1
            Ret_VerifEtatAppli%=1
        end_if
      else
        if Etat_appli%=2
            mess$ = "Une base est en ouverte !"+chr$(13)
            mess$ = mess$+"Des modifications n' ont pas été enregistrer."+chr$(13)
            mess$ = mess$+"Si vous fermer, vos modifications seront perdues."+chr$(13)
            mess$ = mess$+"Etes vous sûr de vouloir fermer cette base ?..."
            m%=message_warning_yes_no(mess$)
            if m%<>1
              Ret_VerifEtatAppli%=1
            end_if
        end_if
      end_if
  end_sub
' ------------------------------------------------------------------------------

'  SELECTION DE LA DESTINATION
  sub SelectDestination()
      dim_local res%,d$,r$

      r$=":\"
      d$=string$(255," ")
      res% = DLL_call4("FolderSelect",adr(r$),adr(d$),len(d$),0)
      d$=trim$(d$)
      if d$<>""
        d$=d$+"\"
        OutputBase$=d$
        text EdiCorp%(2),OutputBase$
        if file_exists(picto$(10))=1 : file_load PictEtat%,picto$(10) : end_if
        Etat_appli%=2
      end_if
  end_sub
' ------------------------------------------------------------------------------

'  AFFICHAGE DU FORM ADDCHAMP
  sub AffichageFormAddChamp(it%)

      hide AlphAddChamp%(3)
      hide CombAddChamp%(2)
      hide spinAddChamp%(1)
      hide AlphAddChamp%(4)
      hide spinAddChamp%(2)

      select it%
      case 1
      ' texte
        caption AlphAddChamp%(3),"Caractères {1 à 254}"
        min spinAddChamp%(1),1 :  max spinAddChamp%(1),254 : position spinAddChamp%(1),1
        show AlphAddChamp%(3)
        show spinAddChamp%(1)
        TypeChamp$ = item_read$(CombAddChamp%(1),1)
        defChamp2$ ="0"
      case 2
      ' numerique
        caption AlphAddChamp%(3),"Entiers"
        min spinAddChamp%(1),1 :  max spinAddChamp%(1),9 : position spinAddChamp%(1),1
        caption AlphAddChamp%(4),"Décimaux"
        min spinAddChamp%(2),1 :  max spinAddChamp%(2),9 : position spinAddChamp%(2),1
        show AlphAddChamp%(3)
        show spinAddChamp%(1)
        show AlphAddChamp%(4)
        show spinAddChamp%(2)
        TypeChamp$ = item_read$(CombAddChamp%(1),2)
      case 3
      ' date
        TypeChamp$ = item_read$(CombAddChamp%(1),3)
        defChamp1$ ="8"
        defChamp2$ ="0"
      case 4
      ' boleen
        caption AlphAddChamp%(3),"Valeur"
        show AlphAddChamp%(3)
        show CombAddChamp%(2)
        TypeChamp$ = item_read$(CombAddChamp%(1),4)
        defChamp2$ ="0"
      case 5
      ' memo
        TypeChamp$ = item_read$(CombAddChamp%(1),5)
        defChamp1$ ="4"
        defChamp2$ ="0"
      end_select
  end_sub
' ------------------------------------------------------------------------------

'  REMONTER UN ITEM
    sub RemonterDescendreItem(it%,sens%)
      dim_local a$,nit%
     
      if count(ListCorp%)=0 then exit_sub

      a$=item_read$(ListCorp%,it%)
      if sens%=0
          if it%>1
            nit%=it%-1
            item_delete ListCorp%,it%
            item_insert ListCorp%,nit%,a$
            item_select ListCorp%,nit%
          end_if
      else
          if it%<count(ListCorp%)
            nit%=it%+1
            item_delete ListCorp%,it%
            item_insert ListCorp%,nit%,a$
            item_select ListCorp%,nit%
          end_if
      end_if
      if file_exists(picto$(10))=1 : file_load PictEtat%,picto$(10) : end_if
      Etat_appli%=2
    end_sub

Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
 
dbf_Maker
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1

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: