dbf_Maker

Sujet: dbf_Maker Jeu 16 Mar 2017 - 3: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