' 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.
mercredi 15 octobre 2008
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
mercredi 19 mars 2008
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.
$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.
vendredi 7 mars 2008
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
‘ 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
jeudi 6 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
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
jeudi 7 février 2008
RUN
la commande 'RUN' est utile pour executer un autre programme en parrallele ; tout les programme peuvent être executé du genre 'notepad.exe' ou encore 'calc.exe'
Son utilisation est très simple :
Run "notepad.exe " & "c:\monfichier.txt"
facile non ?
Son utilisation est très simple :
Run "notepad.exe " & "c:\monfichier.txt"
facile non ?
MesasgeDlg
'MessageDlg' est un mot-clef qui affiche un message un peut comme 'ShowMessage' mais en beaucoup plus perfectionné.
En effet, l'utilisateur pourra cliquer sur des boutons du style OK/CANCEL/HELP/YES/NO/HELP/...
L'utilisation ce fait comme cela :
MESSAGEDLG(Msg$, MsgType, MsgBoutons, HelpContext)
Voir RAPIDQ2.inc (anciennement RAPIDQ.INC) pour les types et boutons appropriés.
En effet, l'utilisateur pourra cliquer sur des boutons du style OK/CANCEL/HELP/YES/NO/HELP/...
L'utilisation ce fait comme cela :
MESSAGEDLG(Msg$, MsgType, MsgBoutons, HelpContext)
Voir RAPIDQ2.inc (anciennement RAPIDQ.INC) pour les types et boutons appropriés.
Showmessage
'Showmessasge' est un mot-clef qui affiche un message à l'écran.
l'utilisation ce fait :
Showmessage "Coucou !"
ce n'est pas plus dur !!
l'utilisation ce fait :
Showmessage "Coucou !"
ce n'est pas plus dur !!
Inscription à :
Articles (Atom)