Demo gestion base de donnee UDT

$include "Objets\rapidq2.inc"
$include "Objets\minimize.inc"

$typecheck on
$Apptype GUI


DECLARE SUB Lecture
DECLARE SUB nouveau_click
DECLARE SUB enreg_click
DECLARE SUB del_click

DECLARE SUB quit_click

DECLARE SUB ouvre_fichier
DECLARE SUB ferme_fichier

DECLARE SUB trouve_nbr_enreg

DECLARE SUB mouve(sender as qcoolbtn)
DECLARE SUB combo_change
DECLARE SUB Edrno_change(key as byte, shift as byte)

CREATE Form AS QFORM
Caption = "Test enreg UDT"
Width = 396
Height = 245
BorderStyle = -1
Center
CREATE CoolBtn1 AS QCOOLBTN
Caption = "|<"
Left = 0
Top = 184
Width = 23
Height = 22
tag = 0
onclick = mouve
END CREATE
CREATE CoolBtn2 AS QCOOLBTN
Caption = "<"
Left = 24
Top = 184
Width = 23
Height = 22
tag = 1
onclick = mouve
END CREATE
CREATE CoolBtn3 AS QCOOLBTN
Caption = ">"
Left = 48
Top = 184
Width = 23
Height = 22
tag = 2
onclick = mouve
END CREATE
CREATE CoolBtn4 AS QCOOLBTN
Caption = ">|"
Left = 72
Top = 184
Width = 23
Height = 22
tag = 3
onclick = mouve
END CREATE
CREATE Panel1 AS qpanel
Left = 104
Top = 32
Width = 209
Height = 177
TabOrder = 4
CREATE Edit1 AS QEDIT
Text = "Edit1"
Left = 16
Top = 16
Width = 177
MaxLength = 25
readonly = true
END CREATE
CREATE Edit2 AS QEDIT
Text = "Edit2"
Left = 16
Top = 40
Width = 177
TabOrder = 1
MaxLength = 10
readonly = true
END CREATE
END CREATE
CREATE EdRno AS QEDIT
Left = 0
Top = 152
Width = 97
TabOrder = 5
OnKeyPress = Edrno_change
END CREATE
CREATE ComboBox1 AS QCOMBOBOX
AddItems "MENU", "Modifier", "Nouveau", "Enregistrer", "Sauvegarde", "Quitter"
Left = 104
Top = 8
ItemIndex = 0
text = "Menu"
Style = 2
OnChange = combo_change
END CREATE
OnClose = quit_click
END CREATE

type record ' long (25+10) = 35
nom as string * 25
tel as string * 10
end type

dim person as record

dim file as qfilestream
' dim mem as qmemorystream
if fileexists(application.path & "\data.txt") = false then
Showmessage "Le fichier " & chr$(34) & (application.path & "\data.txt") & chr$(34) & " n'existe pas." & chr$(13) & "Fichier sera créé."
file.open (application.path & "\data.txt",fmcreate)
call ferme_fichier
else
' showmessage "le fichier existe"
end if

dim nbr_max_enreg as integer
call ouvre_fichier

call trouve_nbr_enreg
nbr_max_enreg = edrno.text
edrno.text = "1"
call lecture

'--- *********************
setminimize(form)
Form.ShowModal
'--- *********************

SUB quit_click
call ferme_fichier
application.terminate
END SUB

SUB combo_change
' showmessage str$(combobox1.itemindex) ' debug
select case combobox1.itemindex
case 0 '--- ne rien faire... Item : MENU
case 1 '--- Modifier
showmessage "Modifier"
edit1.ReadOnly = false
edit2.ReadOnly = false
case 2 '--- nouveau
call nouveau_click
case 3 '--- enreg
showmessage "enreg"
call enreg_click
case 4 '--- supprime
showmessage "Sauvegarde du fichier"
call del_click
case 5 '--- quitter
call quit_click
case else
showmessage "Choix invalide"
end select
combobox1.itemindex = 0
END SUB

SUB nouveau_click
call trouve_nbr_enreg
showmessage edrno.text
edrno.text = str$(val(edrno.text)+1)
showmessage edrno.text
edit1.text = ""
edit2.text = ""
END SUB

SUB enreg_click
with person
.nom = edit1.text
.tel = edit2.text
end with
file.position = (val(edrno.text)-1)*35
file.writeUDT(person)
edit1.ReadOnly = true
edit2.ReadOnly = true
END SUB

SUB del_click

' A VOIR SI CETTE VERSION SE TROUVE RAPIDE LORS DE GROS FICHIERS ...

'créer un fichier temporaire
'copier le début du fichier jusqu'a la fichier a supprimer
'sauter l'enreg
'copier la suite du fichier
'femrer les fichiers
'supprimer le fichier originel
'renommer le fichier temporaire

'EXISTE T'IL UNE FONCTION POUR SUPPRIMER UNE PARTIE DU FICHIER ?
'call ferme_fichier
'Showmessage "Le fichier est fermé"

END SUB

SUB sauvegarde
dim file_temp as qfilestream
' file.position = 0
File_temp.Open(application.path & "\data.wri", fmCreate)
file_temp.copyfrom(file,val(file.size))
file_temp.close
showmessage "fichier sauvegardé !"
END SUB

SUB mouve(sender as qcoolbtn)
select case sender.tag
case 0
'showmessage "Premier"
edrno.text = "1"
call lecture

case 1
'showmessage "Précédent"
if val(edrno.text) => 2 then
edrno.text = str$(val(edrno.text) -1)
else
showmessage "Début du fichier atteint"
end if

case 2
'showmessage "suivant"
dim nb_max as integer
nb_max = nbr_max_enreg
edrno.text = str$(val(edrno.text) +1)

case 3
'showmessage "Dernier"
call trouve_nbr_enreg

case else
showmessage "choix de ''id_mouve'' invalide"
end select
call lecture
END SUB

SUB Edrno_change(key as byte, shift as byte)
if key = 13 then
showmessage "touche enter pressée" & chr$(13) & "lecture de l'enreg n° " & (edrno.text)
end if
END SUB

sub lecture
file.position = (val(edrno.text)-1)*35
file.readUDT(person)
edit1.text = person.nom
edit2.text = person.tel
end sub

sub ouvre_fichier
file.open (application.path & "\data.txt",fmOpenReadwrite)
end sub

sub ferme_fichier
file.close
end sub

SUB trouve_nbr_enreg
edrno.text = str$(file.size/35)
end sub

Gestion de fichiers CSV

'-----------------------------------------
'--- TEST DE GESTION DE FICHIERS .CSV ---
'-----------------------------------------
'--- Une application de DEVIERS Fabien ---
'-----------------------------------------
'--- plus d'Info en bas de la page ---
'--- Le 26/08/2008 à 20h30 ---
'-----------------------------------------

$include "objets\rapidq2.inc"

$typecheck on

DECLARE SUB valide_n° (Sender AS QBUTTON)
DECLARE SUB ferme_vision (Sender AS QBUTTON)
DECLARE SUB raz_grille
DECLARE SUB charge_fichier(sender as qmenuitem)

DECLARE SUB retrouve_nbcols
declare sub modif_ligne

CREATE Form AS QFORM
Caption = "Vision - v.0.1 - "
Width = 603
Height = 497
Center
CREATE Grille_vision AS QSTRINGGRID
Height = 470
Width = 498
Align = 5
separator = ";"
addoptions(7)
Fixedcols = 0
ColCount = 20
Rowcount = 2
create popup as qpopupmenu
create mnu_modif as qmenuitem
Caption = "Modifier"
onclick = modif_ligne
end create
end create
END CREATE
create main_menu as qmainmenu
create mnu_file as qmenuitem
Caption = "Fichier"
create mnu_quit as qmenuitem
Caption = "Quitter"
OnClick = ferme_vision
end create
end create
create mnu_grille as qmenuitem
Caption = "Grille"
' create mnu_charger as qmenuitem
' Caption = "Charger le fichier... "
create mnu_charg_Test as qmenuitem
Caption = "...Test"
tag = 0
onclick = charge_fichier
' onclick = charge_grille_test
end create
create mnu_charg_ovin as qmenuitem
Caption = "...Ovins"
tag = 1
onclick = charge_fichier
' onclick = charge_grille_ovins
end create
create mnu_charg_memos as qmenuitem
Caption = "...Mémos"
tag = 2
onclick = charge_fichier
' onclick = charge_grille_memos
end create
create mnu_charg_agnellages as qmenuitem
Caption = "...Agnellages"
tag = 3
onclick = charge_fichier
' onclick = charge_grille_agnellages
end create
create mnu_charg_luttes as qmenuitem
Caption = "...Luttes"
' onclick = charge_grille_luttes
tag = 4
onclick = charge_fichier
end create
end create
create mnu_G_vider as qmenuitem
Caption = "RAZ de la grille"
visible = false
onclick = raz_grille
end create
' end create
end create
CREATE Panel1 AS QPANEL
Left = 498
Top = 0
Width = 97
Height = 470
BevelOuter = 1
Align = 4
TabOrder = 1
CREATE Button1 AS QBUTTON
Caption = "Valider"
Left = 8
Top = 8
OnClick = valide_n°
END CREATE
CREATE Button2 AS QBUTTON
Caption = "Annuler"
Left = 8
Top = 40
TabOrder = 1
OnClick = ferme_vision
END CREATE
END CREATE
CREATE StatusBar AS QSTATUSBAR
Simplepanel = true
Simpletext = "Nom du fichier : "
END CREATE
END CREATE

dim liste as qstringlist

'affichage de la fenêtre principale....
Form.ShowModal

SUB valide_n° (Sender AS QBUTTON)
showmessage "ligne sélectionnée : " & str$(grille_vision.row)
END SUB

SUB ferme_vision (Sender AS QBUTTON)
form.close
END SUB

SUB raz_grille
dim i as integer
dim j as integer

for i = 0 to grille_vision.rowcount-1
for j = 0 to grille_vision.colcount-1
grille_vision.cell(J,I)=""
next
next
grille_vision.rowcount = 2
END SUB

sub charge_fichier(sender as qmenuitem)
'--- déclaration des varaible interne à la SUB
dim i as integer : i = 0
dim old_posit as integer : old_posit = 0
dim posit as integer : posit = 0
dim nbcols as integer : nbcols = 0
dim chemin as string : chemin = ""

'--- Remise à zéro de la grille
call raz_grille
'--- showmessage "grille vidée"

select case sender.tag
case 0
'showmessage "test"
chemin = "\test.csv"
case 1
'--- showmessage "ovin"
chemin = "\data\ovin.csv"
case 2
'--- showmessage "memo"
chemin = "\data\memo.csv"
case 3
'--- showmessage "agnellages"
chemin = "\data\agnellages.csv"
case 4
'--- showmessage "lutte"
chemin = "\data\mise_lutte.csv"
case else
'--- showmessage "erreur de sélection de fichier"
end select
'--- chargement du fichier en méméoire avec qstringlist
'--- pour déterminer le nombre de ligne que contient le fichier...
'--- showmessage application.path & chemin

'--- charge le fichier en mémoire
liste.loadfromfile(application.path & chemin)

'--- showmessage (liste.item(0)) & chr$(13) '---> Ok

for i=0 to len(liste.item(0))
'--- position = trouve la position du ";" dans liste.item(0) à partir de position
posit = instr(old_posit+1,liste.item(0),";")
'--- retourne zéro si non trouvé
'--- showmessage str$(posit) '---> Ok
if posit > old_posit then
nbcols = nbcols+1
else
'--- showmessage "Fin de la recherche dans la chaine de caractère : " & str$(liste.item(0))
EXIT FOR
end if
old_posit = posit
next

'--- showmessage str$(nbcols)
'--- mise a jour du nombre de colonnes
grille_vision.colcount = nbcols+1

'--- remplissage de la grille_vision
grille_vision.loadfromfile(application.path & chemin,,0,liste.itemcount-1)

'--- libération de la mémoire...
liste.clear
'--- form.caption = "Vision 0.1 - "& chemin
statusbar.Simpletext = "Nom du fichier : " & application.path & chemin
grille_vision.deloptions (10)
mnu_modif.checked = false
end sub


sub modif_ligne
if mnu_modif.checked = true then
grille_vision.deloptions (10)
mnu_modif.checked = false
else
grille_vision.addoptions (10)
mnu_modif.checked = true
end if
end sub

'-------------------
'--- plus d'infos :
'--- ==============
'---
'--- Test pour une application en projet sur la gestion de base de donnée en CSV
'--- Vous trouverez beaucoup de ...SHOWMESSAGE..., en effet, je me sers
'--- de cette fonction très pratique afin de débugger mon application.
'---
'-------------------