gestion d'un formulaire avec fichier CSV

'pour un seul enregistrement actuellement ;
' pour plusieurs enreg, créer des boutons de navigation ... etc ...
$typecheck on
$optimize on

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

DECLARE SUB lire_click
DECLARE SUB enreg_click

CREATE Form AS QFORM
Caption = "test lecture/enreg 'data.csv'"
Width = 449
Height = 277
Center
Borderstyle = 1
DelBorderIcons (2)
CREATE Label1 AS QLABEL
Caption = "Label1"
Left = 16
Top = 24
Transparent = 1
END CREATE
CREATE Label2 AS QLABEL
Caption = "Label2"
Left = 16
Top = 48
Transparent = 1
END CREATE
CREATE Label3 AS QLABEL
Caption = "Label3"
Left = 16
Top = 72
Transparent = 1
END CREATE
CREATE Label4 AS QLABEL
Caption = "Label4"
Left = 16
Top = 96
Transparent = 1
END CREATE
CREATE Edit1 AS QEDIT
Text = "Edit1"
Left = 64
Top = 16
Width = 273
TabOrder = 1
END CREATE
CREATE Edit2 AS QEDIT
Text = "Edit2"
Left = 64
Top = 40
Width = 273
TabOrder = 2
END CREATE
CREATE Edit3 AS QEDIT
Text = "Edit3"
Left = 64
Top = 64
Width = 273
TabOrder = 3
END CREATE
CREATE Edit4 AS QEDIT
Text = "Edit4"
Left = 64
Top = 88
Width = 273
TabOrder = 4
END CREATE
CREATE Button1 AS QBUTTON
Caption = "Charger"
Left = 360
Top = 16
TabOrder = 5
OnClick = lire_click
END CREATE
CREATE Button2 AS QBUTTON
Caption = "Enregistrer"
Left = 360
Top = 56
TabOrder = 6
OnClick = enreg_click
END CREATE
CREATE grille AS QSTRINGGRID
Left = 8
Top = 120
Width = 424
separator = ";"
FixedCols = 0
FixedRows = 1
Visible = false ' metre 1 ou true pour affiche la grille
END CREATE
END CREATE

setminimize (form)

call lire_click

Form.ShowModal

'--------- Subroutines ---------

SUB lire_click
'chargement de la grille
grille.loadfromfile (command$()-application.exename + "data.csv",0,0,9999)
'remplissage de la fenêtre
edit1.text = grille.cell(0,1)
edit2.text = grille.cell(1,1)
edit3.text = grille.cell(2,1)
edit4.text = grille.cell(3,1)
END SUB

SUB enreg_click
'remplissage de la grille
grille.cell(0,1) = edit1.text
grille.cell(1,1) = edit2.text
grille.cell(2,1) = edit3.text
grille.cell(3,1) = edit4.text
'enregistrement de la grille
grille.savetofile (command$()-application.exename + "data.csv",0,0,9999)
END SUB

Petite horloge en RAPIDQ (avec 1 qtimer ; 1 qform ; 1 qlabel !)

$optimize on
$typecheck on

declare sub timera_time

CREATE Form AS QFORM
Caption = "Horloge v0.1"
Width = 305
Height = 105
Delbordericons(1,2)
Center
CREATE Label AS QLABEL
Caption = "00:00:00"
Align = 5
Font.size = 35
Font.name = "comic sans MS"
Alignment = 2
END CREATE
END CREATE

dim timera as qtimer

timera.interval = 1000 '--- 1 sec ---
timera.onTimer = timera_time

Form.ShowModal

SUB timera_time
label.caption = left$(time$,2) & ":" & mid$(time$,4,2) & ":" & right$(time$,2)
END SUB

' petite horloge toute simple.

une application de demo sur la gestion des fichier .csv

' Une application de DEVIERS Fabien
‘ le 07 mars 2008

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

$typecheck on
$optimize on

DECLARE SUB Mnu_Sauvegarde_Click
DECLARE SUB Mnu_restaure_Click
DECLARE SUB Quit_Click
DECLARE SUB APropos_Click

DECLARE SUB pop_Ajoute_click
DECLARE SUB pop_Modifie_click
DECLARE SUB pop_Efface_click
DECLARE SUB pop_cherche_click
DECLARE SUB Enregistre_Grille
DECLARE SUB edit_boucle_keypress (KEY as WORD)
DECLARE SUB Btn_cherche_click

'fenetre de saisie
DECLARE SUB enreg_click (Sender AS QBUTTON)
DECLARE SUB ferme_click (Sender AS QBUTTON)
DECLARE SUB efface_grille

const DateDuJour = mid$(date$,4,2) &"/"& left$(date$,2) &"/"& right$(date$,4)
const version = "V0.2"
const app_titre = "B.J. TREMBLANTE"

CREATE MainForm AS QFORM
Caption = app_titre & " " & version
Width = 700
Height = 500
Center
CREATE MAINMENU AS QMAINMENU
CREATE MNUFICH AS QMENUITEM
Caption = "Base de donnée"
CREATE mnu_d_restaure AS QMENUITEM
Caption = "Restaurer une sauvegarde"
OnClick = Mnu_restaure_Click
END CREATE
CREATE mnu_d_sauvegarde AS QMENUITEM
Caption = "Créer une sauvegarde"
OnClick = Mnu_Sauvegarde_Click
END CREATE
CREATE mnu_d_brek AS QMENUITEM
Caption = "-"
END CREATE
CREATE Mnu_d_quit AS QMENUITEM
Caption = "Quitter"
onclick = Quit_Click
END CREATE
END CREATE
CREATE Mnu_Aide AS QMENUITEM
Caption = "Aide"
CREATE Mnu_apropos AS QMENUITEM
Caption = "A propos..."
OnClick = APropos_Click
ShortCut = "F1"
END CREATE
END CREATE
END CREATE
CREATE Grille AS QSTRINGGRID
Align = 5
FixedCols = 1
Rowcount = 2
ColCount = 3
DefaultRowHeight = 16
Separator = ";"
ColWidths(0) = 90
ColWidths(1) = 50
ColWidths(2) = 50
AddOptions(7,12)
create pop_mnu as qpopupmenu
create mnu_p_nouveau as qmenuitem
Caption = "Ajouter"
OnClick = pop_Ajoute_Click
ShortCut = "CTRL+A"
end create
create mnu_p_modifier as qmenuitem
Caption = "Modifier"
OnClick = pop_modifie_click
ShortCut = "CTRL+Q"
end create
create mnu_p_supprimer as qmenuitem
Caption = "Supprimer"
OnClick = pop_Efface_Click
ShortCut = "CTRL+X"
end create
create mnu_p_brek as qmenuitem
Caption = "-"
end create
create mnu_p_chercher as qmenuitem
Caption = "Chercher une boucle"
OnClick = pop_cherche_click
ShortCut = "CTRL+F"
end create
end create
END CREATE
CREATE STATUSBAR AS QSTATUSBAR
AddPanels(DateDuJour,"","Chemin")
panel(0).width = 80
Panel(0).alignment = 2
END CREATE
END CREATE

CREATE Frm_Enreg AS QFORM
Caption = "Form1"
Width = 174
Height = 190
Center
CREATE Label_cheptel AS QLABEL
Caption = "Cheptel n° :"
Left = 8
Top = 8
Width = 56
Transparent = 1
END CREATE
CREATE Edit_cheptel AS QEDIT
Text = "Edit1"
Left = 8
Top = 24
Width = 145
END CREATE
CREATE GroupBox_boucles AS QGROUPBOX
Caption = "N° des Boucles attribuées"
Left = 8
Top = 48
Width = 145
Height = 73
TabOrder = 3
CREATE Label_de AS QLABEL
Caption = "De :"
Left = 16
Top = 20
Transparent = 1
END CREATE
CREATE Label_a AS QLABEL
Caption = "à :"
Left = 24
Top = 43
Width = 20
Transparent = 1
END CREATE
CREATE Edit_debut AS QEDIT
Left = 48
Top = 16
Width = 81
END CREATE
CREATE Edit_fin AS QEDIT
Left = 48
Top = 40
Width = 81
TabOrder = 1
END CREATE
END CREATE
CREATE Btn_Enreg AS QBUTTON
Caption = "Enregistrer"
Left = 8
Top = 128
Width = 67
TabOrder = 1
OnClick = enreg_click
END CREATE
CREATE Btn_Ferme AS QBUTTON
Caption = "Fermer"
Left = 88
Top = 128
Width = 67
TabOrder = 2
OnClick = ferme_click
END CREATE
END CREATE

CREATE Frm_cherche AS QFORM
Caption = "Chercher"
Width = 100
Height = 100
Borderstyle = -1
Center
CREATE Label_ch_num AS QLABEL
Caption = "N° de la boucle :"
Left = 10
Transparent = 1
END CREATE
CREATE Edit_boucle_cherchee AS QEDIT
Text = ""
Left = 8
BorderStyle = bsnone
Top = 20
Width = 81
Height = 15
MaxLength = 5
Onkeypress = edit_boucle_keypress
END CREATE
CREATE Btn_frm_cherche AS QCOOLBTN
Caption = "Chercher"
Left = 8
Top = 43
Width = 83
Flat = true
OnClick = btn_cherche_click
END CREATE
END CREATE

DIM CHEMIN AS String
DIM file as QFILESTREAM
dim opendialog as QOPENDIALOG
Dim savedialog as QSAVEDIALOG
DIM Fonta as QFONT
Fonta.AddStyles(fsBold)

'grille.font = fonta

dim Operation as integer
'operation ser pour savoir s'il s'agit d'une modification ou d'un nouvel enregistrement
' 0=ajoute
' 1=Modifier

CONST Filtre = "Fichier .CSV|*.CSV|Tous (*.*)|*.*"
opendialog.filter = filtre
opendialog.InitialDir = command$()
savedialog.filter = filtre
savedialog.InitialDir = command$()

SetMinimize(Mainform)
' showmessage "debug fichier: " & command$() -application.exename
' vérification de l'existance du fichier data.csv
if fileexists("data.csv")<>1 then
' showmessage "fichier innexistant"
file.open("data.csv", fmcreate)
else
' showmessage "fichier existant"
end if
file.close

' chargement du fichier data.csv
grille.LoadFromFile("data.csv",,,9999)
StatusBar.panel(1).caption = str$(grille.rowcount-1)
StatusBar.Panel(2).Caption = command$() - application.exename & "data.csv"

MainForm.ShowModal

' --- SAUVEGARDE ---
SUB Mnu_Sauvegarde_Click()
'ouvrir la fenetre de sauvegarde
if savedialog.execute then
' vérifier que le nom du fichier ne soit pas vide
if savedialog.filename <> "" then
' Vérifier que l'extention du nom de fichier soit valide à savoir '.CSV'
if UCASE$(right$(savedialog.filename,4)) <> ".CSV" then
savedialog.filename = savedialog.filename + ".csv"
END IF
showmessage savedialog.filename
else
ShowMessage "Veuillez donner un nom correct au fichier de sauvegarde"
exit sub
end if
end if

statusbar.panel(2).caption = SaveDialog.FileName
if fileexists(SaveDialog.FileName) <>1 then
file.open(SaveDialog.FileName,fmcreate)
file.close
end if

grille.savetofile(SaveDialog.FileName,0,0,9999)
StatusBar.panel(1).caption = str$(grille.rowcount-1)
StatusBar.Panel(2).Caption = SaveDialog.FileName
END SUB


' --- RESTAURATION ---
SUB Mnu_restaure_Click()
if opendialog.execute then
' vérifier que le nom du fichier ne soit pas vide
if OpenDialog.FileName <> "" then
' showmessage OpenDialog.FileName
call efface_grille
grille.loadfromFile (OpenDialog.FileName,0,0,9999)
StatusBar.panel(1).caption = str$(grille.rowcount-1)
StatusBar.Panel(2).Caption = OpenDialog.FileName
else
Showmessage "Nom de fichier incorrect"
end if
end if
END SUB

' --- QUITTER ---
SUB Quit_Click()
Application.terminate
END SUB

' --- A PROPOS ---
SUB APropos_Click()
Showmessage app_titre & chr$(13) & chr$(13) & " Est une application créer avec RAPIDQ de WILLIAM YU" & chr$(13) & _
"Par DEVIERS Fabien " & chr$(13) & "(C) 2008"
END SUB

' --- AJOUTER (popup) ---
SUB pop_Ajoute_click()
edit_cheptel.text = ""
edit_debut.text = ""
edit_fin.text = ""
frm_enreg.caption = "Ajouts..."
Frm_enreg.ShowModal
StatusBar.panel(1).caption = str$(grille.rowcount-1)
END SUB

' --- MODIFIER (popup) ---
SUB pop_Modifie_click()
edit_cheptel.text = grille.cell(0,grille.row)
edit_debut.text = grille.cell(1,grille.row)
edit_fin.text = grille.cell(2,grille.row)
frm_enreg.caption = "Modifications..."
operation = 1
frm_Enreg.showmodal
END SUB

' --- EFFACER (popup) ---
SUB pop_efface_click()
dim reponse as integer
reponse = messagebox("Voulez-vous réellement supprimer la ligne sélectionnée ?","Validation",1)
' showmessage str$(reponse)
if reponse = 1 then
if grille.rowcount <= 2 then
showmessage "Impossible d'effacer la dernière ligne." & chr$(13) & "Vous ne pouvez que la modifier."
else
grille.deleterow(grille.row)
end if
else
exit sub
end if
StatusBar.panel(1).caption = str$(grille.rowcount-1)
END SUB

' --- CHERCHER (popup) ---
SUB pop_cherche_click()
'mise à jour des infos
edit_boucle_cherchee.text = ""
'affichage de la fenetre 'chercher'
frm_cherche.showmodal
END SUB

' --- FERMER (frm_enreg) ---
SUB ferme_click
Frm_enreg.close
END SUB

' --- ENREGISTRER (frm_enreg) ---
SUB enreg_click
dim no_lign as integer
select case Operation
case 0
' Ajouter enreg
grille.rowcount = grille.rowcount +1
no_lign = grille.rowcount-1
case 1
' Modifier enreg
no_lign = grille.row
Case else
showmessage "Opération non conforme"
exit sub
end select
' Remplissage de la ligne avec les info précédemment renseignées.
' showmessage str$(no_lign)
grille.cell(0,no_lign) = edit_cheptel.text
grille.cell(1,no_lign) = edit_debut.text
grille.cell(2,no_lign) = edit_fin.text
frm_enreg.close
Grille.SaveToFile(statusbar.panel(1).caption,0,0,9999)
END SUB

' --- ENREGISTRER (la grille) ---
SUB Enregistre_Grille()
' Enregistrement du fichier data.csv
grille.SaveToFile("data.csv",,,9999)
END SUB

SUB efface_grille() 'Complette
dim X as integer,Y as integer
for Y = 0 to grille.rowCount
for X = 0 to grille.colCount
grille.cell(X,Y) = ""
next
next
END SUB

SUB btn_cherche_click
if Edit_boucle_cherchee.text = "" then
ShowMessage "La valeur recherchée ne peut pas être vide." & chr$(13) & "Le module de recherche vas ce fermer."
frm_cherche.close
exit sub
end if

dim nb_lign as integer, num_chept_correspondant as string

for nb_lign=1 to grille.rowcount-1
if val(edit_boucle_cherchee.text) >= val(grille.cell(1,nb_lign)) then
if val(edit_boucle_cherchee.text) <= val(grille.cell(2,nb_lign)) then
' showmessage "la boucle '" & edit_boucle_cherchee.text & "' est dans la ligne " & str$(nb_lign) & chr$(13) & _
' "Ce qui correspond au cheptel n° " & grille.cell(0,nb_lign)
showmessage "La boucle '" & edit_boucle_cherchee.text & " à été attribuée au cheptel n° " & grille.cell(0,nb_lign)
frm_cherche.close
exit sub
end if
end if

next
showmessage showmessage "la boucle '" & edit_boucle_cherchee.text & "' n'a pas été trouvée dans la liste."
frm_cherche.close
END SUB

SUB edit_boucle_keypress(KEY as WORD)
' showmessage "DEBUG " & str$(KEY)
select case KEY
case 13 'entré
call btn_cherche_click '(Btn_frm_cherche)
case 27 'eschap
frm_cherche.close
end select
END SUB

' fin le 7 mars 2008

une pitite source, modifier le texte sélectionné avec un qrichedit et un qbutton

' de moi ! hihi !

declare sub click_btn

create mainform as qform
caption = "test modifier texte"
create btn as qbutton
onClick = click_btn
align = 1
caption = "Clique moi dessu et tu vas voir ! NON MAIS !"
end create
create richedit as qrichedit
align = 5 'alclient
text = "Bonjour tout le monde "&chr$­­(10) & "Comment allez vous ? bien ? bah moi aussi !"
end create
end create

dim fonta as qfont
fonta.size = 32
' fonta.bold = true
' fonta.color = "bleu" ' ???

mainform.showmodal

sub click_btn
Richedit.selattributes = fonta
end sub