lundi 29 septembre 2008

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

Aucun commentaire: