$include "include\rapidq2.inc"
$typecheck on
DECLARE SUB cherche_click (Sender AS QBUTTON)
declare sub enreg_grille2 (sender as qmenuitem)
declare sub efface_grille2
CREATE Form AS QFORM
Caption = "Chercheur"
Width = 494
' Borderstyle = -4
Height = 433
Center
CREATE grille1 AS QSTRINGGRID ' listing
Left = 8
Top = 8
Height = 192
Width = 472
Hint = "grille1"
Separator = ";"
addoptions (goediting) ' pour pouvoir copier un nom, une reférence ...
FixedCols = 0
DefaultColWidth = 74
DefaultRowHeight = 16
Colcount = 3
Rowcount = 2
align = 1
END CREATE
CREATE Panel1 AS QPANEL
Left = 8
Top = 208
Width = 473
align = 1
Height = 65
TabOrder = 2
CREATE Label1 AS QLABEL
Caption = "Chercher :"
Left = 8
Top = 16
Width = 49
Transparent = 1
END CREATE
CREATE Label2 AS QLABEL
Caption = "Dans :"
Left = 8
Top = 40
Width = 31
Transparent = 1
END CREATE
CREATE Edit1 AS QEDIT
Left = 64
Top = 8
Width = 225
END CREATE
CREATE ComboBox1 AS QCOMBOBOX
Left = 64
Top = 32
Width = 225
style=3 '--- Pas d'entrée manuelle
TabOrder = 1
END CREATE
CREATE Btn_cherch AS QBUTTON
Caption = "Chercher"
Left = 336
Top = 8
Width = 131
Height = 49
TabOrder = 2
OnClick = cherche_click
END CREATE
END CREATE
CREATE grille2 AS QSTRINGGRID ' résultat de la recherche
Left = 8
Top = 280
Width = 472
Hint = "grille2"
TabOrder = 1
separator = ";"
FixedCols = 0
DefaultColWidth = 74
DefaultRowHeight = 16
align = 5 '--- A revoir...
create menu as qpopupmenu
create mnu_enreg as qmenuitem
caption = "Enregistrer la recherche"
onclick = enreg_grille2
end create
end create
END CREATE
create statusbar as qstatusbar
simpletext = true
end create
END CREATE
'--- Charger la grille des données
grille1.loadfromfile("fichier.csv",0,0,9999)
'--- Effacer le combobox
dim I as integer
for I = 0 to grille1.colcount-1
combobox1.additems grille1.cell(I,0)
next
combobox1.itemindex=0
'--- Afficher la fenêtre principale
setfocus(Btn_cherch)
Form.ShowModal
'--------- Subroutines ---------
SUB cherche_click (Sender AS QBUTTON)
dim nbre as integer : nbre = 0 '--- Variable pour le nombre de ligne trouvée
call efface_grille2 '--- Appel de la fonction d'éffacement de la grille2 a chaque nouvelle recherche.
dim lign_cherche as integer, colo_cherche as integer '--- Variables pour la boucle de recherche
dim colo as integer, lign as integer '--- Variables pour la boucle d'envoi des donnée dans grille2
'--- Afficher un message d'information
showmessage "a chercher " & chr$(34) & edit1.text & chr$(34) & "dans la colonne "& chr$(34) & combobox1.text
'--- La boucle de recherche
for lign_cherche = 1 to grille1.rowcount-1
if ucase$(grille1.cell(combobox1.itemindex,lign_cherche)) = ucase$(edit1.text) then
'--- Vérifier qu'il y ait plus de deux ligne pour en ajouter une.
if grille2.rowcount >=2 then grille2.rowcount = grille2.rowcount +1
'--- La boucle d'injection des données dans grille2
for colo = 0 to grille2.colcount
grille2.cell(colo,grille2.rowcount-1) = grille1.cell(colo,lign_cherche)
next
nbre++ '--- Ajouter 1
end if
next
'--- Effacer la seconde ligne car non utilisée (Débrouille pour avoir quelquechose de beau)
grille2.deleterow(1)'--- N'oublie pas que les ligne ou colonnes commencent par zéro ! d'ou le (1) pour la seconde ligne
statusbar.simpletext = str$(nbre) & " lignes trouvée(s)"
'--- FIN de la boucle de recherche
END SUB
sub enreg_grille2 (sender as qmenuitem)
dim savedial as qsavedialog
if savedial.execute then
grille2.savetofile(savedial.filename,0,0,grille2.rowcount)
end if
end sub
sub efface_grille2
dim efface_lign as integer, efface_col as integer
'--- Boucle d'effacement de la grille
'--- Attention toutes les données serons perdue !
for efface_lign = 0 to grille2.rowcount
for efface_col = 0 to grille2.colcount
grille2.cell(efface_col,efface_lign) = ""
next
next
'--- Affichage de deux lignes seulement
grille2.rowcount = 2
'--- Mise a jour des entêtes
'--- déterminer le nombre de colonne dans grille2 (selon le fichier ouvert)
'--- Ici cette valeur est statique car on n'a pas de menu ouvrir une grille.
'--- je te la met au cas ou.
dim maj_colo as integer '--- Variable pour metre à jour les colonnes
grille2.colcount = grille1.colcount
for maj_colo = 0 to grille1.colcount
grille2.cell(maj_colo,0)= grille1.cell(Maj_colo,0)
next
end sub
mardi 27 avril 2010
jeudi 25 mars 2010
recherche dans une grille
$APPTYPE GUI
$typecheck on
$include "include/rapidq2.inc"
DECLARE SUB cherche_click
DECLARE SUB ouvre_click
DECLARE SUB remplir_combobox
DECLARE SUB Quit_click
DECLARE SUB efface_grille
CREATE Form AS QFORM
Caption = "test de recherche"
Width = 728
Height = 394
Center
CREATE mainmenu as QMAINMENU
CREATE men_file as qmenuitem
caption = "Fichier"
create mnu_file_ouvre as qmenuitem
caption = "Ouvrir"
onclick = ouvre_click
end create
create mnu_file_brek as qmenuitem
caption = "-"
end create
create mnu_file_quit as qmenuitem
caption = "Quitter"
onclick = Quit_click
end create
end create
END CREATE
CREATE Panel1 AS QPANEL
Width = 720
Align = 1
visible = false
CREATE Label1 AS QLABEL
Caption = "Chercher :"
Left = 16
Top = 12
Width = 64
Transparent = 1
END CREATE
CREATE Label2 AS QLABEL
Caption = "Dans :"
Left = 200
Top = 12
Transparent = 1
END CREATE
CREATE Edit1 AS QEDIT
Text = "texte a chercher"
Left = 72
Top = 8
END CREATE
CREATE ComboBox1 AS QCOMBOBOX
AddItems "reprendre les entête de la grille"
Text = "ComboBox1"
Left = 240
Top = 8
END CREATE
CREATE BTN1 AS QBUTTON
Caption = "Chercher"
Left = 400
Top = 8
Height = 21
OnClick = cherche_click
END CREATE
END CREATE
CREATE Grille AS QSTRINGGRID
'Left = 0
'Top = 41
'Height = 320
'Width = 720
Align = 5
DefaultColWidth = 80
DefaultRowHeight = 16
FixedCols = 0
ColCount = 3
editormode=true
addoptions(7,10,13)
visible = false
END CREATE
END CREATE
Form.ShowModal
SUB cherche_click
if edit1.text = "" then
showmessage "Aucun texte à chercher !"
exit sub
end if
if combobox1.text = "" then
showmessage "Aucune colonne de recherche déterminée !"
exit sub
end if
' deux option celle ci (plus facile)
' ou celle avec INSTR
DIM ligne_grille as integer
showmessage "chercher le texte " & chr$(34) & edit1.text & chr$(34) & " dans la colonne intitulée : " & grille.cell(val(combobox1.text),0)
for ligne_grille = 1 to grille.rowcount-1
if grille.cell(val(combobox1.text),ligne_grille)= edit1.text then
showmessage "Le texte à été trouvé !" &chr$(10) & "Dans la ligne n° : " &chr$(34) & str$(ligne_grille) & chr$(34)
grille.col = val(combobox1.text)
grille.row = ligne_grille
'grille.selectedcell(combobox1.text)
exit sub
end if
next
showmessage "Le terme " & chr$(34) & edit1.text & " Ne figure pas dans cette colonne."
END SUB
SUB ouvre_click
DIM nombre_ligne as integer
dim opendial as qopendialog
opendial.filter = "*.csv et *.ini |*.csv;*.ini|Tous (*.*)|*.*"
opendial.filterindex = 0
opendial.initialdir = application.path
if opendial.execute then
call efface_grille
grille.loadfromfile(opendial.filename,0,0,99999)
Showmessage "ouvrir une grille"
combobox1.clear
call remplir_combobox
end if
panel1.visible = true
grille.visible = true
END SUB
sub remplir_combobox
dim i as integer
for I = 0 to grille.colcount-1
combobox1.additems(grille.cell(I,0))
next
end sub
sub effacer_grille
dim lign as integer, colo as integer
for colo = 0 to grille.colcount-1
for lign = 0 to grille.rowcount-1
grille.cell(colo,lign)=""
next
next
end sub
SUB Quit_click
application.terminate
END SUB
$typecheck on
$include "include/rapidq2.inc"
DECLARE SUB cherche_click
DECLARE SUB ouvre_click
DECLARE SUB remplir_combobox
DECLARE SUB Quit_click
DECLARE SUB efface_grille
CREATE Form AS QFORM
Caption = "test de recherche"
Width = 728
Height = 394
Center
CREATE mainmenu as QMAINMENU
CREATE men_file as qmenuitem
caption = "Fichier"
create mnu_file_ouvre as qmenuitem
caption = "Ouvrir"
onclick = ouvre_click
end create
create mnu_file_brek as qmenuitem
caption = "-"
end create
create mnu_file_quit as qmenuitem
caption = "Quitter"
onclick = Quit_click
end create
end create
END CREATE
CREATE Panel1 AS QPANEL
Width = 720
Align = 1
visible = false
CREATE Label1 AS QLABEL
Caption = "Chercher :"
Left = 16
Top = 12
Width = 64
Transparent = 1
END CREATE
CREATE Label2 AS QLABEL
Caption = "Dans :"
Left = 200
Top = 12
Transparent = 1
END CREATE
CREATE Edit1 AS QEDIT
Text = "texte a chercher"
Left = 72
Top = 8
END CREATE
CREATE ComboBox1 AS QCOMBOBOX
AddItems "reprendre les entête de la grille"
Text = "ComboBox1"
Left = 240
Top = 8
END CREATE
CREATE BTN1 AS QBUTTON
Caption = "Chercher"
Left = 400
Top = 8
Height = 21
OnClick = cherche_click
END CREATE
END CREATE
CREATE Grille AS QSTRINGGRID
'Left = 0
'Top = 41
'Height = 320
'Width = 720
Align = 5
DefaultColWidth = 80
DefaultRowHeight = 16
FixedCols = 0
ColCount = 3
editormode=true
addoptions(7,10,13)
visible = false
END CREATE
END CREATE
Form.ShowModal
SUB cherche_click
if edit1.text = "" then
showmessage "Aucun texte à chercher !"
exit sub
end if
if combobox1.text = "" then
showmessage "Aucune colonne de recherche déterminée !"
exit sub
end if
' deux option celle ci (plus facile)
' ou celle avec INSTR
DIM ligne_grille as integer
showmessage "chercher le texte " & chr$(34) & edit1.text & chr$(34) & " dans la colonne intitulée : " & grille.cell(val(combobox1.text),0)
for ligne_grille = 1 to grille.rowcount-1
if grille.cell(val(combobox1.text),ligne_grille)= edit1.text then
showmessage "Le texte à été trouvé !" &chr$(10) & "Dans la ligne n° : " &chr$(34) & str$(ligne_grille) & chr$(34)
grille.col = val(combobox1.text)
grille.row = ligne_grille
'grille.selectedcell(combobox1.text)
exit sub
end if
next
showmessage "Le terme " & chr$(34) & edit1.text & " Ne figure pas dans cette colonne."
END SUB
SUB ouvre_click
DIM nombre_ligne as integer
dim opendial as qopendialog
opendial.filter = "*.csv et *.ini |*.csv;*.ini|Tous (*.*)|*.*"
opendial.filterindex = 0
opendial.initialdir = application.path
if opendial.execute then
call efface_grille
grille.loadfromfile(opendial.filename,0,0,99999)
Showmessage "ouvrir une grille"
combobox1.clear
call remplir_combobox
end if
panel1.visible = true
grille.visible = true
END SUB
sub remplir_combobox
dim i as integer
for I = 0 to grille.colcount-1
combobox1.additems(grille.cell(I,0))
next
end sub
sub effacer_grille
dim lign as integer, colo as integer
for colo = 0 to grille.colcount-1
for lign = 0 to grille.rowcount-1
grille.cell(colo,lign)=""
next
next
end sub
SUB Quit_click
application.terminate
END SUB
mercredi 15 octobre 2008
bankor3
' BANKOR 3 de DEVIERS FABIEN
$INCLUDE "objets\RAPIDQ.INC"
$TYPECHECK on
$APPTYPE GUI
$RESOURCE ICON AS "Z:\rapidq\projets\BANKOR\data\ICON.ICO"
$RESOURCE LOGO AS "Z:\rapidq\projets\BANKOR\data\logo.bmp"
CONST titre = "BANKOR v.0.3" ' EST une constante ; A modifier lors de la modification de la version.
DIM Fichier AS qfilestream 'pour les sauvegardes
DIM FichLog AS qfilestream 'pour les LOG
DIM MagList AS string
DIM Chemin AS STRING
DIM Colo AS INTEGER ' pour la colonne
DIM Lign AS INTEGER 'pour la ligne
' déclarations pour les boites de dialogues d'ouverture de fichiers et d'enregistrement
DIM savedial AS QSaveDialog
DIM ouvredial AS QOpenDialog
DIM filtre AS string 'pour n'ouvrir que les fichier avec l'extension choisie
filtre =("Fichiers Bankor (*.bank)|*.bank|Tous les fichiers (*.*)|*.*")
' si la liste des libellé n'existe pas ;
if fileexists("liste.txt")= false then
' la créer
fichier.open("Liste.txt",fmcreate)
' et y ajouter quesques exemples...
fichier.writeline "INTERMARCHE" : fichier.writeline "LIDER PRICE" : fichier.writeline "CASINO"
fichier.writeline "CHAMPION" : fichier.writeline "INTERSPORT"
fichier.WriteLine "PAYE MOI" : fichier.WriteLine "PAYE TOI"
' ne pas oublier de fermer le fichier.
fichier.close
' ne pas oublier d'informer l'utilisateur.
showmessage "Le fichier Liste.txt à été crée avec succes. Vous Pouvez ajouter dans ce fichier texte la liste des options afin de gérér au mieux vos dépences et entrée d'argent."+chr$(13)+_
+"EXEMPLE : "+chr$(13)+"INTERMARCHE"+chr$(13)+"PAYE MOI"+chr$(13)+"PAYE TOI"+chr$(13)+"CASINO"+chr$(13)+"..."+chr$(13)+chr$(13)+"Vous pourez le modifier autant de fois que vous le souhaitez. Ce dernier peut être ouvert avec le simple bloc note."
end if
'ouvrir la liste des libellés
Fichier.open("liste.txt",fmopenread)
'charger les libellés
MagList = Fichier.readstr(Fichier.size)
' ne pas oublier de fermer le fichier.
Fichier.close
'fenêtre principale
DECLARE SUB affiche_liste_comptes
DECLARE SUB sauvegarde_rapide
DECLARE SUB Ferme_grille
DECLARE SUB Quit_Click
DECLARE SUB EllipsisClick (Col AS LONG, Row AS LONG, Sender AS QSTRINGGRID)
DECLARE SUB Apropos_click
'fenêtre liste comptes
DECLARE SUB charge_click (Sender AS QBUTTON)
DECLARE SUB new_click (Sender AS QBUTTON)
DECLARE SUB del_click (Sender AS QBUTTON)
DECLARE SUB Annule_Click (Sender AS QBUTTON)
DECLARE SUB effacetout 'pour le chargement de fichiers....
DECLARE SUB fermeapropo
DECLARE SUB efface_ligne(Row as long, Sender AS QSTRINGGRID)
DECLARE SUB supprime_ligne(Row as long, Sender AS QSTRINGGRID)
DECLARE SUB insert_Ligne(Row as long,r as integer)
DECLARE SUB affich_fen_libel
DECLARE SUB charge_liste_libel
DECLARE SUB enreg_liste_click
DECLARE SUB Ferme_liste_click
'gestion de la grille
DECLARE SUB AffichSolde (montant as double)
DECLARE SUB AffichSelectCell(Col%, Row%)
' fenêtre liste des libellés
DECLARE SUB ajout_libel
DECLARE SUB supprime_libel
DECLARE SUB btn_annul_libel_click
DECLARE SUB btn_valid_libel_click
DECLARE SUB demande_enreg_libel
DECLARE SUB imprim_compte
CREATE Fenetreprincipale AS QFORM
Caption = titre
ICOHandle = ICON
' La variable 'titre' est une constante qui ne peut pas etre modifié tout au long du programme.
Width = 790
Height = 590
Center ' on centre la fenetre dans l'écran
CREATE menu AS QMAINMENU
CREATE mnufichier AS QMENUITEM
Caption = "Fichier"
CREATE mnu_nouveau AS QMENUITEM
Caption = "&Liste des comptes"
Onclick = affiche_liste_comptes
Shortcut = "Ctrl+L"
END CREATE
CREATE mnu_Sauv_rapid AS QMENUITEM
Caption = "&Sauvegarder"
Onclick = sauvegarde_rapide
Shortcut = "Ctrl+S"
Enabled = false
END CREATE
CREATE mnu_ferme_grille AS QMENUITEM
Caption = "&Fermer"
Onclick = Ferme_grille
enabled = false
Shortcut = "Ctrl+F"
END CREATE
CREATE mnu_brek AS QMENUITEM
Caption = "-"
END CREATE
CREATE mnu_imprime AS QMENUITEM
Caption = "Imprimer"
OnClick = imprim_compte
Enabled = False
END CREATE
CREATE mnu_brek2 AS QMENUITEM
Caption = "-"
END CREATE
CREATE mnu_Quit AS QMENUITEM
Caption ="&Quitter"
Onclick = quit_click
Shortcut = "Ctrl+Q"
END CREATE
END CREATE
CREATE System AS QMENUITEM
Caption = "Système"
CREATE mnuAfichSolde AS QMENUITEM
Caption = "Afficher le solde"
onclick = affichsolde
Enabled = False
END CREATE
CREATE mnuMofi_liste AS QMENUITEM
Caption = "Modifier la liste des libellés"
onclick = affich_fen_libel
END CREATE
END CREATE
CREATE mnuaide AS QMENUITEM
Caption = "Aide"
CREATE mnu_apropo AS QMENUITEM
Caption = "A propos de ..."
Onclick = Apropos_click
END CREATE
END CREATE
END CREATE
CREATE grilleB as qstringgrid 'pour l'insertion de lignes...
align = 2
fixedCols=0
colcount=3
visible = false ' (Doit être invisible pour l'utilisateur final.)
END CREATE
CREATE Grille AS QSTRINGGRID
Visible = false
Align = alClient
addoptions(5,6,7,9,10,11,14)
FixedRows = 1
FixedCols = 0
ColCount = 3
RowCount = 51
Separator = "|" ' Utile pour LoadFromFile et SaveToFile
' Il s'agit du caractère de séparations des données.
DefaultRowHeight = 20
DefaultColWidth = 120
ColumnStyle(1) = gcsList
' ColumnStyle(0) = gcsEllipsis
' supression car version anglaise de la date ; risque de
' mauvaise donnée si l'utilisateur ne donne pas toutes les dates en anglais.
ColumnList(1) = MagList
Cell(0,0) = " Date"
Cell(1,0) = " Libellé"
Cell(2,0) = " Montant"
ColWidths(0)= 100
ColWidths(1)= 500
' ColWidths(2)= 200
Font.name = "Courier New"
'font.name = "arial"
font.size = 10
OnEllipsisClick = EllipsisClick
onselectcell = AffichSelectCell
create pop_menu as qpopupmenu
create pop_mnu_solde as qmenuitem
Caption = "Afficher le solde"
onclick = affichsolde
end create
create mnu_popup_brek as qmenuitem
Caption = "-"
end create
create mnu_ajoute_ligne_av as qmenuitem
Caption = "Inserer une ligne"
Onclick = insert_Ligne
end create
create mnu_popup_brek2 as qmenuitem
Caption = "-"
end create
create mnu_efface_ligne as qmenuitem
Caption = "Effacer la ligne"
Onclick = efface_ligne
end create
create mnu_popup_brek3 as qmenuitem
Caption = "-"
end create
create mnu_supprime_ligne as qmenuitem
Caption = "Supprimer la ligne"*
OnClick = supprime_ligne
end create
end create
END CREATE
CREATE StatusBar AS QSTATUSBAR
AddPanels(Date$,"")
Panel(0).Width = 80
Panel(0).Alignment = TaCenter
hint = "Mois / Jour / Année"
END CREATE
OnCLose = Quit_Click
END CREATE
CREATE frm_liste_compte AS QFORM
Caption = titre + " - Liste des comptes -"
Width = 325
Height = 228
BorderStyle = -2
Center
CREATE Lbl_copyright AS QLABEL
Caption = "COPYRIGHT TO"+chr$(13)+"DEVIERS F."
Left = 230
Top = 150
Cursor = -21
' Utilisation d'un curseur en forme de main afin de faire réagir l'utilisateur afin qu'il
'Clique dessu a la façon d'un lien hypertexte.
OnClick = Apropos_click
Transparent = 1
END CREATE
CREATE liste_comptes AS QFILELISTBOX
Left = 8
Top = 8
Width = 217
Mask="*.bank"
' N'affiche ques les fichiers dont l'extention est : ".bank"
ShowIcons = true
' affiche les icones (plus professionnel ???)
Height = 185
onDblClick = Charge_Click
END CREATE
CREATE Btn_charge AS QBUTTON
Caption = "Charger"
Left = 232
Top = 8
TabOrder = 1
OnClick = charge_click
END CREATE
CREATE Btn_Nouveau AS QBUTTON
Caption = "Nouveau"
Left = 232
Top = 40
TabOrder = 2
OnClick = new_click
END CREATE
CREATE Btn_Supprimer AS QBUTTON
Caption = "Supprimer"
Left = 232
Top = 72
TabOrder = 3
OnClick = del_click
END CREATE
CREATE Btn_Annuler AS QBUTTON
Caption = "Annuler"
Left = 232
Top = 104
TabOrder = 3
OnClick = Annule_Click
END CREATE
END CREATE
CREATE Frm_apropos AS QFORM
Caption = "A propos de " + titre
' voila une preuve de l'utilité d'utiliser une constante...
Width = 243
Height = 262
Center
CREATE Panel1 AS QPANEL
Left = 8
Top = 8
Width = 225
Height = 65
BevelInner = 1
CREATE Label1 AS QLABEL
Caption = titre
Left = 8
Top = 8
Width = 200
Alignment = 2
Transparent = 1
END CREATE
CREATE Label2 AS QLABEL
Caption = "Une application de DEVIERS Fabien"
Left = 8
Top = 40
Width = 200
Alignment = 2
Transparent = 1
END CREATE
END CREATE
CREATE Button1 AS QBUTTON
Caption = "&OK"
Left = 78
Top = 201
TabOrder = 1
OnClick = FermeApropo
END CREATE
CREATE Panel2 AS QPANEL
Left = 7
Top = 80
Width = 225
Height = 113
BevelInner = 1
TabOrder = 2
CREATE Image1 AS QIMAGE
BMPHANDLE = LOGO
Left = 12
Top = 9
Width = 200
Height = 94
showhint = true
hint = "Application créé avec le compilateur gratuit RAPID-Q"
AutoSize = 1
END CREATE
END CREATE
END CREATE
create fen_libel as qform
BorderStyle = -2
Caption = titre +" - Liste des libellés"
' titre est tu là ???? ;-)
center
Height = 300
create liste_libel as qlistbox
align=5
create main_menu2 as qpopupmenu
create mnu_ajoute as qmenuitem
Caption = "Ajouter un libellé
onclick = ajout_libel
end create
create mnu_supprime as qmenuitem
Caption = "Supprimer"
onclick = supprime_libel
end create
create mnu_sauve as qmenuitem
Caption = "Sauvegarder"
onclick = enreg_liste_click
end create
create mnu_coupe as qmenuitem
Caption = "-"
end create
create mnu_ferme as qmenuitem
Caption = "Fermer"
onclick = Ferme_liste_click
end create
end create
end create
onclose = demande_enreg_libel
end create
create frm_ajout_libel as qform
center
borderstyle = -2
Caption = titre + " - Ajouter un libellé"
' titre est décidement présent partout...
Width = 300
Height = 105
create nom_libel as qedit
text = ""
top = 10
left = 10
Width = 280
end create
create btn_valid_libel as qbutton
Caption = "Valider"
Top = 40
Left = 130
OnClick = btn_valid_libel_click
end create
create btn_annul_libel as qbutton
Caption = "Annuler"
Top = 40
Left = 215
OnClick = btn_annul_libel_click
end create
end create
IF FILEEXISTS("Bankor.log")=false THEN
FichLog.open("Bankor.log",fmcreate) : FichLog.CLose : end if
FichLog.open("Bankor.log",fmopenwrite)
FichLog.Position = FichLog.Size
Fichlog.writeline("Démarrage de BANKOR2 le :"+date$+" à "+Time$)
FichLog.CLose
DIM r as integer
Fenetreprincipale.Showmodal
SUB affiche_liste_comptes
frm_liste_compte.showmodal
END SUB
SUB sauvegarde_rapide
Grille.SaveToFile(chemin,0,0,51)
END SUB
SUB EllipsisClick (Col AS LONG, Row AS LONG, Sender AS QSTRINGGRID)
'affiche la date (date$) dans la cellule sible.
Sender.cell(col,row) = date$
END SUB
SUB Quit_Click
FichLog.open("Bankor.log",fmopenwrite)
FichLog.position=FichLog.Size
Fichlog.writeline("Arret de BANKOR2 le :"+date$+" à "+Time$)
' Ecrit une petite phrase dans un LOG...
' Utile pour savoir si quelqu'un utilise votre prog lors de vos absences...
' le MUST serai une demande de mot de passe...
' ce n'est pas impossible que je l'insère dans la version suivante...
' ne pas oublier de modifier la constante titre.
FichLog.CLose
' ne pas oublier de fermer le fichier...
Application.Terminate
END SUB
SUB AffichSelectCell(Col%, Row%)
statusbar.Panel(1).Caption = str$(row%)+ "° Ligne."
' Petit must. Pratiquement inutile.
END SUB
SUB charge_click (Sender AS QBUTTON)
call effacetout
grille.visible = true
Chemin = liste_comptes.filename
grille.loadfromfile(liste_comptes.filename,0,0,51)
frm_liste_compte.CLose
'Showmessage "Chargement réussi."+chr$(13)+liste_comptes.filename
mnu_sauv_rapid.Enabled = True
mnuAfichSolde.Enabled = True
' Rendre l'impression possible par le biais du menu
mnu_imprime.enabled = true
mnu_ferme_grille.enabled = true
END SUB
SUB new_click (Sender AS QBUTTON)
Showmessage ("Attention, Lors de la création de votre sauvegarde, n'oubliez pas d'ajouter "+chr$(34)+".bank"+chr$(34)+chr$(13)+" Pour voir votre compte apparaitre dans la liste.")
' On peut rajouter un code afin de détecter si le .BANK a bien été rajouté.
' du style :
savedial.filter = filtre
if savedial.execute then
if ucase$(right$(savedial.filename,5))<>".BANK" then
savedial.filename= savedial.filename + ".bank"
end if
fichier.open(savedial.filename,fmcreate)
fichier.close
end if
liste_comptes.mask="*.*" : liste_comptes.mask="*.bank"
' Cette ligne de code est une sorte de mise à jours des fichier portant l'extentions .BANK
END SUB
SUB del_click (Sender AS QBUTTON)
kill(liste_comptes.filename)
liste_comptes.mask="*.*" : liste_comptes.mask="*.bank"
END SUB
SUB Annule_Click (Sender AS QBUTTON)
frm_liste_compte.close
END SUB
sub effacetout
For lign = 0 To grille.RowCount -1
For Colo = 0 To grille.ColCount -1
grille.Cell(colo, lign) = ""
Next colo
Next lign
Grille.Cell(0,0) = " Date"
Grille.Cell(1,0) = " Libellé"
Grille.Cell(2,0) = " Montant"
end sub
SUB AffichSolde (montant as double)
Dim I as integer
montant = 0
for i = 1 to 50
montant = montant + val(grille.cell(2,i))
next
if montant < 0 then
showmessage "Votre solde est négatif."
end if
showmessage "Le solde est de : "+ Format$("%8.2m", str$(montant))
END SUB
SUB apropos_Click
frm_apropos.showmodal
END SUB
SUB fermeapropo
frm_apropos.close
END SUB
SUB Ferme_grille
call sauvegarde_rapide
showmessage "Grille enregistrée"
call effacetout
grille.visible = false
mnu_Sauv_rapid.enabled = false
mnu_imprime.enabled = false
mnu_ferme_grille.enabled = false
mnuAfichSolde.enabled = false
END SUB
SUB efface_ligne(Row as long, sender as QSTRINGGRID)
' showmessage "Effacement de la ligne n°: "+str$(grille.row)
grille.cell(0,grille.Row)=""
grille.cell(1,grille.Row)=""
grille.cell(2,grille.Row)=""
END SUB
SUB supprime_ligne(Row as long, Sender AS QSTRINGGRID)
'+simple
grille.deleterow(grille.row)
'dim i as grille.row
'for i=grille.row to grille.rowcount
' grille.cell(0,i)=grille.cell(0,i+1)
' grille.cell(1,i)=grille.cell(1,i+1)
' grille.cell(2,i)=grille.cell(2,i+1)
'next
END SUB
SUB insert_Ligne(Row as long)
r=grille.row
for r=grille.row to 50 ' simple copie.
' if MESSAGEDLG("Si la valeur de "+chr$(34)+"r"+chr$(34)+" ne varie pas vous pouvez cliquer sur le bouton "+chr$(34)+"annuler"+chr$(34)+"."+chr$(13)+chr$(13)+"r="+str$(r)+chr$(13)+chr$(13)+"Désirez-vous continuer ?" , mtconfirmation, 1+2, 1)=mrno then
' exit sub
' end if
GrilleB.cell(0,r) = grille.cell(0,r)
GrilleB.cell(1,r) = grille.cell(1,r)
GrilleB.cell(2,r) = grille.cell(2,r)
r=r+1
next
efface_ligne(grille.row,grille)
r=grille.row
for r=grille.row to 50
Grille.cell(0,r+1) = grilleB.cell(0,r)
Grille.cell(1,r+1) = grilleB.cell(1,r)
Grille.cell(2,r+1) = grilleB.cell(2,r)
r=r+1
next
'remise à zéro de la grille invisible.
r=0
for r=0 to 50
grilleB.cell(0,r)=""
grilleB.cell(1,r)=""
grilleB.cell(2,r)=""
r=r+1
next
END SUB
SUB affich_fen_libel
Liste_libel.LoadFromFile("liste.txt")
fen_libel.ShowModal
END SUB
SUB enreg_liste_click
Liste_libel.SaveToFile("liste.txt")
maglist=""
'Fichier.open("liste.txt",fmopenread)
'MagList = Fichier.readstr(Fichier.size)
'Fichier.close
END SUB
SUB Ferme_liste_click
fen_libel.Close
call enreg_liste_click
END SUB
SUB ajout_libel
nom_libel.text=""
frm_ajout_libel.showmodal
end sub
SUB supprime_libel
showmessage "Item à supprimer : "+liste_libel.item(liste_libel.itemindex)
liste_libel.delitems(liste_libel.itemindex)
END SUB
SUB btn_annul_libel_click
nom_libel.text=""
frm_ajout_libel.close
END SUB
SUB btn_valid_libel_click
showmessage nom_libel.text
liste_libel.additems(nom_libel.text)
frm_ajout_libel.close
END SUB
SUB demande_enreg_libel
if MESSAGEDLG("Désirez-vous enregistrer les changements ?", mtconfirmation, 1+2, 1)=mryes then
call enreg_liste_click
showmessage "Modification(s) enregistré(es).
end if
END SUB
SUB imprim_compte
dim vali
if MESSAGEDLG("Désirez-vous enregistrer les changements ?", mtconfirmation, 1+2, 1)=mryes then
dim i as integer
lprint "Nom du Compte : " + liste_comptes.filename
lprint "Impression du : "+DATE$ +" à "+ TIME$
lprint
lprint
lprint
'lprint grille.handle ' n° interne du composant
for i = 0 to grille.rowcount
' grille.cell (col,row)
' SPACE$(Num) Retourne une chaîne composée de Num espaces
lprint grille.Cell(0,i) & space$(10)& grille.cell(1,i) & space$(50 - val(len(grille.cell(1,i)))) & grille.cell(2,i)
next
lflush
end if
END SUB
' VERSION TERMINEE LE 6 février 2006 à 18:04 - 585 lignes.
' VERSION TERMINEE LE 17 octobre 2006 à 10:52 - 595 lignes.
$INCLUDE "objets\RAPIDQ.INC"
$TYPECHECK on
$APPTYPE GUI
$RESOURCE ICON AS "Z:\rapidq\projets\BANKOR\data\ICON.ICO"
$RESOURCE LOGO AS "Z:\rapidq\projets\BANKOR\data\logo.bmp"
CONST titre = "BANKOR v.0.3" ' EST une constante ; A modifier lors de la modification de la version.
DIM Fichier AS qfilestream 'pour les sauvegardes
DIM FichLog AS qfilestream 'pour les LOG
DIM MagList AS string
DIM Chemin AS STRING
DIM Colo AS INTEGER ' pour la colonne
DIM Lign AS INTEGER 'pour la ligne
' déclarations pour les boites de dialogues d'ouverture de fichiers et d'enregistrement
DIM savedial AS QSaveDialog
DIM ouvredial AS QOpenDialog
DIM filtre AS string 'pour n'ouvrir que les fichier avec l'extension choisie
filtre =("Fichiers Bankor (*.bank)|*.bank|Tous les fichiers (*.*)|*.*")
' si la liste des libellé n'existe pas ;
if fileexists("liste.txt")= false then
' la créer
fichier.open("Liste.txt",fmcreate)
' et y ajouter quesques exemples...
fichier.writeline "INTERMARCHE" : fichier.writeline "LIDER PRICE" : fichier.writeline "CASINO"
fichier.writeline "CHAMPION" : fichier.writeline "INTERSPORT"
fichier.WriteLine "PAYE MOI" : fichier.WriteLine "PAYE TOI"
' ne pas oublier de fermer le fichier.
fichier.close
' ne pas oublier d'informer l'utilisateur.
showmessage "Le fichier Liste.txt à été crée avec succes. Vous Pouvez ajouter dans ce fichier texte la liste des options afin de gérér au mieux vos dépences et entrée d'argent."+chr$(13)+_
+"EXEMPLE : "+chr$(13)+"INTERMARCHE"+chr$(13)+"PAYE MOI"+chr$(13)+"PAYE TOI"+chr$(13)+"CASINO"+chr$(13)+"..."+chr$(13)+chr$(13)+"Vous pourez le modifier autant de fois que vous le souhaitez. Ce dernier peut être ouvert avec le simple bloc note."
end if
'ouvrir la liste des libellés
Fichier.open("liste.txt",fmopenread)
'charger les libellés
MagList = Fichier.readstr(Fichier.size)
' ne pas oublier de fermer le fichier.
Fichier.close
'fenêtre principale
DECLARE SUB affiche_liste_comptes
DECLARE SUB sauvegarde_rapide
DECLARE SUB Ferme_grille
DECLARE SUB Quit_Click
DECLARE SUB EllipsisClick (Col AS LONG, Row AS LONG, Sender AS QSTRINGGRID)
DECLARE SUB Apropos_click
'fenêtre liste comptes
DECLARE SUB charge_click (Sender AS QBUTTON)
DECLARE SUB new_click (Sender AS QBUTTON)
DECLARE SUB del_click (Sender AS QBUTTON)
DECLARE SUB Annule_Click (Sender AS QBUTTON)
DECLARE SUB effacetout 'pour le chargement de fichiers....
DECLARE SUB fermeapropo
DECLARE SUB efface_ligne(Row as long, Sender AS QSTRINGGRID)
DECLARE SUB supprime_ligne(Row as long, Sender AS QSTRINGGRID)
DECLARE SUB insert_Ligne(Row as long,r as integer)
DECLARE SUB affich_fen_libel
DECLARE SUB charge_liste_libel
DECLARE SUB enreg_liste_click
DECLARE SUB Ferme_liste_click
'gestion de la grille
DECLARE SUB AffichSolde (montant as double)
DECLARE SUB AffichSelectCell(Col%, Row%)
' fenêtre liste des libellés
DECLARE SUB ajout_libel
DECLARE SUB supprime_libel
DECLARE SUB btn_annul_libel_click
DECLARE SUB btn_valid_libel_click
DECLARE SUB demande_enreg_libel
DECLARE SUB imprim_compte
CREATE Fenetreprincipale AS QFORM
Caption = titre
ICOHandle = ICON
' La variable 'titre' est une constante qui ne peut pas etre modifié tout au long du programme.
Width = 790
Height = 590
Center ' on centre la fenetre dans l'écran
CREATE menu AS QMAINMENU
CREATE mnufichier AS QMENUITEM
Caption = "Fichier"
CREATE mnu_nouveau AS QMENUITEM
Caption = "&Liste des comptes"
Onclick = affiche_liste_comptes
Shortcut = "Ctrl+L"
END CREATE
CREATE mnu_Sauv_rapid AS QMENUITEM
Caption = "&Sauvegarder"
Onclick = sauvegarde_rapide
Shortcut = "Ctrl+S"
Enabled = false
END CREATE
CREATE mnu_ferme_grille AS QMENUITEM
Caption = "&Fermer"
Onclick = Ferme_grille
enabled = false
Shortcut = "Ctrl+F"
END CREATE
CREATE mnu_brek AS QMENUITEM
Caption = "-"
END CREATE
CREATE mnu_imprime AS QMENUITEM
Caption = "Imprimer"
OnClick = imprim_compte
Enabled = False
END CREATE
CREATE mnu_brek2 AS QMENUITEM
Caption = "-"
END CREATE
CREATE mnu_Quit AS QMENUITEM
Caption ="&Quitter"
Onclick = quit_click
Shortcut = "Ctrl+Q"
END CREATE
END CREATE
CREATE System AS QMENUITEM
Caption = "Système"
CREATE mnuAfichSolde AS QMENUITEM
Caption = "Afficher le solde"
onclick = affichsolde
Enabled = False
END CREATE
CREATE mnuMofi_liste AS QMENUITEM
Caption = "Modifier la liste des libellés"
onclick = affich_fen_libel
END CREATE
END CREATE
CREATE mnuaide AS QMENUITEM
Caption = "Aide"
CREATE mnu_apropo AS QMENUITEM
Caption = "A propos de ..."
Onclick = Apropos_click
END CREATE
END CREATE
END CREATE
CREATE grilleB as qstringgrid 'pour l'insertion de lignes...
align = 2
fixedCols=0
colcount=3
visible = false ' (Doit être invisible pour l'utilisateur final.)
END CREATE
CREATE Grille AS QSTRINGGRID
Visible = false
Align = alClient
addoptions(5,6,7,9,10,11,14)
FixedRows = 1
FixedCols = 0
ColCount = 3
RowCount = 51
Separator = "|" ' Utile pour LoadFromFile et SaveToFile
' Il s'agit du caractère de séparations des données.
DefaultRowHeight = 20
DefaultColWidth = 120
ColumnStyle(1) = gcsList
' ColumnStyle(0) = gcsEllipsis
' supression car version anglaise de la date ; risque de
' mauvaise donnée si l'utilisateur ne donne pas toutes les dates en anglais.
ColumnList(1) = MagList
Cell(0,0) = " Date"
Cell(1,0) = " Libellé"
Cell(2,0) = " Montant"
ColWidths(0)= 100
ColWidths(1)= 500
' ColWidths(2)= 200
Font.name = "Courier New"
'font.name = "arial"
font.size = 10
OnEllipsisClick = EllipsisClick
onselectcell = AffichSelectCell
create pop_menu as qpopupmenu
create pop_mnu_solde as qmenuitem
Caption = "Afficher le solde"
onclick = affichsolde
end create
create mnu_popup_brek as qmenuitem
Caption = "-"
end create
create mnu_ajoute_ligne_av as qmenuitem
Caption = "Inserer une ligne"
Onclick = insert_Ligne
end create
create mnu_popup_brek2 as qmenuitem
Caption = "-"
end create
create mnu_efface_ligne as qmenuitem
Caption = "Effacer la ligne"
Onclick = efface_ligne
end create
create mnu_popup_brek3 as qmenuitem
Caption = "-"
end create
create mnu_supprime_ligne as qmenuitem
Caption = "Supprimer la ligne"*
OnClick = supprime_ligne
end create
end create
END CREATE
CREATE StatusBar AS QSTATUSBAR
AddPanels(Date$,"")
Panel(0).Width = 80
Panel(0).Alignment = TaCenter
hint = "Mois / Jour / Année"
END CREATE
OnCLose = Quit_Click
END CREATE
CREATE frm_liste_compte AS QFORM
Caption = titre + " - Liste des comptes -"
Width = 325
Height = 228
BorderStyle = -2
Center
CREATE Lbl_copyright AS QLABEL
Caption = "COPYRIGHT TO"+chr$(13)+"DEVIERS F."
Left = 230
Top = 150
Cursor = -21
' Utilisation d'un curseur en forme de main afin de faire réagir l'utilisateur afin qu'il
'Clique dessu a la façon d'un lien hypertexte.
OnClick = Apropos_click
Transparent = 1
END CREATE
CREATE liste_comptes AS QFILELISTBOX
Left = 8
Top = 8
Width = 217
Mask="*.bank"
' N'affiche ques les fichiers dont l'extention est : ".bank"
ShowIcons = true
' affiche les icones (plus professionnel ???)
Height = 185
onDblClick = Charge_Click
END CREATE
CREATE Btn_charge AS QBUTTON
Caption = "Charger"
Left = 232
Top = 8
TabOrder = 1
OnClick = charge_click
END CREATE
CREATE Btn_Nouveau AS QBUTTON
Caption = "Nouveau"
Left = 232
Top = 40
TabOrder = 2
OnClick = new_click
END CREATE
CREATE Btn_Supprimer AS QBUTTON
Caption = "Supprimer"
Left = 232
Top = 72
TabOrder = 3
OnClick = del_click
END CREATE
CREATE Btn_Annuler AS QBUTTON
Caption = "Annuler"
Left = 232
Top = 104
TabOrder = 3
OnClick = Annule_Click
END CREATE
END CREATE
CREATE Frm_apropos AS QFORM
Caption = "A propos de " + titre
' voila une preuve de l'utilité d'utiliser une constante...
Width = 243
Height = 262
Center
CREATE Panel1 AS QPANEL
Left = 8
Top = 8
Width = 225
Height = 65
BevelInner = 1
CREATE Label1 AS QLABEL
Caption = titre
Left = 8
Top = 8
Width = 200
Alignment = 2
Transparent = 1
END CREATE
CREATE Label2 AS QLABEL
Caption = "Une application de DEVIERS Fabien"
Left = 8
Top = 40
Width = 200
Alignment = 2
Transparent = 1
END CREATE
END CREATE
CREATE Button1 AS QBUTTON
Caption = "&OK"
Left = 78
Top = 201
TabOrder = 1
OnClick = FermeApropo
END CREATE
CREATE Panel2 AS QPANEL
Left = 7
Top = 80
Width = 225
Height = 113
BevelInner = 1
TabOrder = 2
CREATE Image1 AS QIMAGE
BMPHANDLE = LOGO
Left = 12
Top = 9
Width = 200
Height = 94
showhint = true
hint = "Application créé avec le compilateur gratuit RAPID-Q"
AutoSize = 1
END CREATE
END CREATE
END CREATE
create fen_libel as qform
BorderStyle = -2
Caption = titre +" - Liste des libellés"
' titre est tu là ???? ;-)
center
Height = 300
create liste_libel as qlistbox
align=5
create main_menu2 as qpopupmenu
create mnu_ajoute as qmenuitem
Caption = "Ajouter un libellé
onclick = ajout_libel
end create
create mnu_supprime as qmenuitem
Caption = "Supprimer"
onclick = supprime_libel
end create
create mnu_sauve as qmenuitem
Caption = "Sauvegarder"
onclick = enreg_liste_click
end create
create mnu_coupe as qmenuitem
Caption = "-"
end create
create mnu_ferme as qmenuitem
Caption = "Fermer"
onclick = Ferme_liste_click
end create
end create
end create
onclose = demande_enreg_libel
end create
create frm_ajout_libel as qform
center
borderstyle = -2
Caption = titre + " - Ajouter un libellé"
' titre est décidement présent partout...
Width = 300
Height = 105
create nom_libel as qedit
text = ""
top = 10
left = 10
Width = 280
end create
create btn_valid_libel as qbutton
Caption = "Valider"
Top = 40
Left = 130
OnClick = btn_valid_libel_click
end create
create btn_annul_libel as qbutton
Caption = "Annuler"
Top = 40
Left = 215
OnClick = btn_annul_libel_click
end create
end create
IF FILEEXISTS("Bankor.log")=false THEN
FichLog.open("Bankor.log",fmcreate) : FichLog.CLose : end if
FichLog.open("Bankor.log",fmopenwrite)
FichLog.Position = FichLog.Size
Fichlog.writeline("Démarrage de BANKOR2 le :"+date$+" à "+Time$)
FichLog.CLose
DIM r as integer
Fenetreprincipale.Showmodal
SUB affiche_liste_comptes
frm_liste_compte.showmodal
END SUB
SUB sauvegarde_rapide
Grille.SaveToFile(chemin,0,0,51)
END SUB
SUB EllipsisClick (Col AS LONG, Row AS LONG, Sender AS QSTRINGGRID)
'affiche la date (date$) dans la cellule sible.
Sender.cell(col,row) = date$
END SUB
SUB Quit_Click
FichLog.open("Bankor.log",fmopenwrite)
FichLog.position=FichLog.Size
Fichlog.writeline("Arret de BANKOR2 le :"+date$+" à "+Time$)
' Ecrit une petite phrase dans un LOG...
' Utile pour savoir si quelqu'un utilise votre prog lors de vos absences...
' le MUST serai une demande de mot de passe...
' ce n'est pas impossible que je l'insère dans la version suivante...
' ne pas oublier de modifier la constante titre.
FichLog.CLose
' ne pas oublier de fermer le fichier...
Application.Terminate
END SUB
SUB AffichSelectCell(Col%, Row%)
statusbar.Panel(1).Caption = str$(row%)+ "° Ligne."
' Petit must. Pratiquement inutile.
END SUB
SUB charge_click (Sender AS QBUTTON)
call effacetout
grille.visible = true
Chemin = liste_comptes.filename
grille.loadfromfile(liste_comptes.filename,0,0,51)
frm_liste_compte.CLose
'Showmessage "Chargement réussi."+chr$(13)+liste_comptes.filename
mnu_sauv_rapid.Enabled = True
mnuAfichSolde.Enabled = True
' Rendre l'impression possible par le biais du menu
mnu_imprime.enabled = true
mnu_ferme_grille.enabled = true
END SUB
SUB new_click (Sender AS QBUTTON)
Showmessage ("Attention, Lors de la création de votre sauvegarde, n'oubliez pas d'ajouter "+chr$(34)+".bank"+chr$(34)+chr$(13)+" Pour voir votre compte apparaitre dans la liste.")
' On peut rajouter un code afin de détecter si le .BANK a bien été rajouté.
' du style :
savedial.filter = filtre
if savedial.execute then
if ucase$(right$(savedial.filename,5))<>".BANK" then
savedial.filename= savedial.filename + ".bank"
end if
fichier.open(savedial.filename,fmcreate)
fichier.close
end if
liste_comptes.mask="*.*" : liste_comptes.mask="*.bank"
' Cette ligne de code est une sorte de mise à jours des fichier portant l'extentions .BANK
END SUB
SUB del_click (Sender AS QBUTTON)
kill(liste_comptes.filename)
liste_comptes.mask="*.*" : liste_comptes.mask="*.bank"
END SUB
SUB Annule_Click (Sender AS QBUTTON)
frm_liste_compte.close
END SUB
sub effacetout
For lign = 0 To grille.RowCount -1
For Colo = 0 To grille.ColCount -1
grille.Cell(colo, lign) = ""
Next colo
Next lign
Grille.Cell(0,0) = " Date"
Grille.Cell(1,0) = " Libellé"
Grille.Cell(2,0) = " Montant"
end sub
SUB AffichSolde (montant as double)
Dim I as integer
montant = 0
for i = 1 to 50
montant = montant + val(grille.cell(2,i))
next
if montant < 0 then
showmessage "Votre solde est négatif."
end if
showmessage "Le solde est de : "+ Format$("%8.2m", str$(montant))
END SUB
SUB apropos_Click
frm_apropos.showmodal
END SUB
SUB fermeapropo
frm_apropos.close
END SUB
SUB Ferme_grille
call sauvegarde_rapide
showmessage "Grille enregistrée"
call effacetout
grille.visible = false
mnu_Sauv_rapid.enabled = false
mnu_imprime.enabled = false
mnu_ferme_grille.enabled = false
mnuAfichSolde.enabled = false
END SUB
SUB efface_ligne(Row as long, sender as QSTRINGGRID)
' showmessage "Effacement de la ligne n°: "+str$(grille.row)
grille.cell(0,grille.Row)=""
grille.cell(1,grille.Row)=""
grille.cell(2,grille.Row)=""
END SUB
SUB supprime_ligne(Row as long, Sender AS QSTRINGGRID)
'+simple
grille.deleterow(grille.row)
'dim i as grille.row
'for i=grille.row to grille.rowcount
' grille.cell(0,i)=grille.cell(0,i+1)
' grille.cell(1,i)=grille.cell(1,i+1)
' grille.cell(2,i)=grille.cell(2,i+1)
'next
END SUB
SUB insert_Ligne(Row as long)
r=grille.row
for r=grille.row to 50 ' simple copie.
' if MESSAGEDLG("Si la valeur de "+chr$(34)+"r"+chr$(34)+" ne varie pas vous pouvez cliquer sur le bouton "+chr$(34)+"annuler"+chr$(34)+"."+chr$(13)+chr$(13)+"r="+str$(r)+chr$(13)+chr$(13)+"Désirez-vous continuer ?" , mtconfirmation, 1+2, 1)=mrno then
' exit sub
' end if
GrilleB.cell(0,r) = grille.cell(0,r)
GrilleB.cell(1,r) = grille.cell(1,r)
GrilleB.cell(2,r) = grille.cell(2,r)
r=r+1
next
efface_ligne(grille.row,grille)
r=grille.row
for r=grille.row to 50
Grille.cell(0,r+1) = grilleB.cell(0,r)
Grille.cell(1,r+1) = grilleB.cell(1,r)
Grille.cell(2,r+1) = grilleB.cell(2,r)
r=r+1
next
'remise à zéro de la grille invisible.
r=0
for r=0 to 50
grilleB.cell(0,r)=""
grilleB.cell(1,r)=""
grilleB.cell(2,r)=""
r=r+1
next
END SUB
SUB affich_fen_libel
Liste_libel.LoadFromFile("liste.txt")
fen_libel.ShowModal
END SUB
SUB enreg_liste_click
Liste_libel.SaveToFile("liste.txt")
maglist=""
'Fichier.open("liste.txt",fmopenread)
'MagList = Fichier.readstr(Fichier.size)
'Fichier.close
END SUB
SUB Ferme_liste_click
fen_libel.Close
call enreg_liste_click
END SUB
SUB ajout_libel
nom_libel.text=""
frm_ajout_libel.showmodal
end sub
SUB supprime_libel
showmessage "Item à supprimer : "+liste_libel.item(liste_libel.itemindex)
liste_libel.delitems(liste_libel.itemindex)
END SUB
SUB btn_annul_libel_click
nom_libel.text=""
frm_ajout_libel.close
END SUB
SUB btn_valid_libel_click
showmessage nom_libel.text
liste_libel.additems(nom_libel.text)
frm_ajout_libel.close
END SUB
SUB demande_enreg_libel
if MESSAGEDLG("Désirez-vous enregistrer les changements ?", mtconfirmation, 1+2, 1)=mryes then
call enreg_liste_click
showmessage "Modification(s) enregistré(es).
end if
END SUB
SUB imprim_compte
dim vali
if MESSAGEDLG("Désirez-vous enregistrer les changements ?", mtconfirmation, 1+2, 1)=mryes then
dim i as integer
lprint "Nom du Compte : " + liste_comptes.filename
lprint "Impression du : "+DATE$ +" à "+ TIME$
lprint
lprint
lprint
'lprint grille.handle ' n° interne du composant
for i = 0 to grille.rowcount
' grille.cell (col,row)
' SPACE$(Num) Retourne une chaîne composée de Num espaces
lprint grille.Cell(0,i) & space$(10)& grille.cell(1,i) & space$(50 - val(len(grille.cell(1,i)))) & grille.cell(2,i)
next
lflush
end if
END SUB
' VERSION TERMINEE LE 6 février 2006 à 18:04 - 585 lignes.
' VERSION TERMINEE LE 17 octobre 2006 à 10:52 - 595 lignes.
Faire une horloge
$apptype gui '--- Avertir RAPIDQ du caractère Fenêtré de notre application (Il ne s'agit pas d'une application en mode CONSOLE)
$include "objets\rapidq2.inc" '--- Ajouter les modus de base à RAPIDQ.
$include "objets\minimize.inc" '--- Ajout du module de réduction de l'application dans la barre de tache.
declare sub heure '--- Déclaration de la subroutine qui servira a afficher l'heure
dim fonta as qfont '--- Police d'écriture du label
fonta.bold = true '--- En gras
fonta.size = 20 '--- En gros caractère
fonta.name = "comic sans MS" '--- Avec la police comic sans MS
dim hor as qtimer '--- Horloge.
hor.interval = 1000 '--- Intervalle du minuteur.
hor.enabled = true '--- activer le minuteur.
hor.ontimer = heure '--- Aller vers la sub "heure" dès que l'intervalle est atteinte.
CREATE Form AS QFORM
Caption = "Initialisation de l'horloge" '--- texte affiché pendant la première seconde
Width = 130
Height = 70
Center '--- Centrer la fenêtre au centre de l'écran
delbordericons(2) '--- Masquer le bouton d'agrandissement.
Borderstyle = 1 '--- Pas de redimentionnement possible.
CREATE Label_heure AS QLABEL
Caption = "..." '--- Afficher "..." pendant la première seconde.
Alignment = 2 '--- Aligment du texte du label
Align = 5 '--- Aligment du composant dans la fenêtre
Autosize = true '--- Activer l'ajustage du composant au texte qu'il contient
'--- N'est pas obligatoire
font = fonta '--- Notre police d'écriture dêjà programmée
Transparent = 1 '--- Afficher la fentre derrière le texte
END CREATE
END CREATE
setminimize(form) '--- Si l'utilisateur appui sur le bouton de minimisation de la fenêtre.
Form.ShowModal '--- Afficher la fenêtre
'--- LES SUBROUTINES ---
sub heure
label_heure.caption = time$ '--- Attibuer l'heure courrante du PC au label
form.caption = label_heure.caption '--- Attribuer le texte du label au titre de la fenêtre
'--- Pour pouvoir lire l'heure dans la barre de tache de Windows
end sub
$include "objets\rapidq2.inc" '--- Ajouter les modus de base à RAPIDQ.
$include "objets\minimize.inc" '--- Ajout du module de réduction de l'application dans la barre de tache.
declare sub heure '--- Déclaration de la subroutine qui servira a afficher l'heure
dim fonta as qfont '--- Police d'écriture du label
fonta.bold = true '--- En gras
fonta.size = 20 '--- En gros caractère
fonta.name = "comic sans MS" '--- Avec la police comic sans MS
dim hor as qtimer '--- Horloge.
hor.interval = 1000 '--- Intervalle du minuteur.
hor.enabled = true '--- activer le minuteur.
hor.ontimer = heure '--- Aller vers la sub "heure" dès que l'intervalle est atteinte.
CREATE Form AS QFORM
Caption = "Initialisation de l'horloge" '--- texte affiché pendant la première seconde
Width = 130
Height = 70
Center '--- Centrer la fenêtre au centre de l'écran
delbordericons(2) '--- Masquer le bouton d'agrandissement.
Borderstyle = 1 '--- Pas de redimentionnement possible.
CREATE Label_heure AS QLABEL
Caption = "..." '--- Afficher "..." pendant la première seconde.
Alignment = 2 '--- Aligment du texte du label
Align = 5 '--- Aligment du composant dans la fenêtre
Autosize = true '--- Activer l'ajustage du composant au texte qu'il contient
'--- N'est pas obligatoire
font = fonta '--- Notre police d'écriture dêjà programmée
Transparent = 1 '--- Afficher la fentre derrière le texte
END CREATE
END CREATE
setminimize(form) '--- Si l'utilisateur appui sur le bouton de minimisation de la fenêtre.
Form.ShowModal '--- Afficher la fenêtre
'--- LES SUBROUTINES ---
sub heure
label_heure.caption = time$ '--- Attibuer l'heure courrante du PC au label
form.caption = label_heure.caption '--- Attribuer le texte du label au titre de la fenêtre
'--- Pour pouvoir lire l'heure dans la barre de tache de Windows
end sub
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
$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.
'---
'-------------------
'--- 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.
'---
'-------------------
mardi 25 mars 2008
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
' 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
Inscription à :
Articles (Atom)