Gestionnaire perso de plantes (ou d'autres types d'objets)

Pour les besoins personnels, je me suis fait un petit outil pour gérer les descriptifs, infos et photos de fleurs et plantes. Mais on peut l'utiliser pour tout type d'informations.

Tout est géré par un mennu, mais il y a aussi des boutons de fonction pour le confort des manipulations.

L'écran est divisé en plusieurs zones. En haut à gauche, on a une liste de "catégories". On peut créer autant de catégories que nécessaire, mais il en faut au moins une pour pouvoir travailler. Exemple d'une catégorie: Fleurs rustiques". Le bouton ou la ligne de menu "Créer" mène vers une fenêtre de saisie du nom de la catégorie (une simple chaîne de caractères).

En bas à gauche, sous le cadre des catégories, on a le cadre des "Produits". Créer un produit est comme créer une catégorie. Le produit se créera la la catégorie sélectionnée. Le nom d'un produit est aussi i=une simple chaîne de caractères. Exemple: "Semper vivens".

En créant un produit, ou en sélectionnant un produit dans la liste des produits existants, un grand cadre se remplit avec un texte modifiable, à partir d'un fichier maquette.txt qui peut être constituée librement. Ceci représente la fiche d'information du produit.

A la création, le programme crée aussi un répertoire avec le nom du produit. Ce répertoire servira à un "album de photos" pour le produit. En bas à droite de l'écran, une zone contient 4 miniatures dans lesquelles on peut charger, par les boutons "+", une image en format JPG ou BMP. La miniature d'affiche alors et la photo originale est copiée dans l'album. On clic dans la miniature affiche la photo en grand dans le grand cadre au-dessus de l'album. Les boutons "-" suppriment une photo de l'album. Pour remplacer une photo, il suffit d'en recharger une autre par le bouton "+"

Tout est stocké dans un répertoire fixé à "c:\MesPlantes" dans des variables du programme. Tout ça est modifiable. Le programme crée un fichier MesPlantes.txt dans lequel on trouve la liste des catégories. Il crée aussi un fichier TXT pour chaque catégorie avec le nom de la catégorie comme nom de fichier, tout en remplaçant les espaces par des "_". Chacun de ces fichiers contient la liste des produits de la catégorie. Il y a un fichier TXT pour chaque produit, contenant le descriptif du produit, initialisé à partir de maquette.txt. En enfin, il y a un répertoire automatiquement créé pour chaque produit, avec le même nom que le produit, dans lequel on trouvera de 0 à 4 photos représentant l'album du produit.

Dans tous ces fichiers TXT, la première ligne commence par "**" et est générée automatiquement. Elle est impérative pour le fonctionnement du programme.

Voici le fichier maquette.txt que j'utilise:

Code:: ** Maquette produit
Nom:
Exposition:
Terre:
Arrosage:
Semis/plantation:
Floraison:
Récolte:
Taille:

Prix:

Notes:

et voici le code du programme:

Code:: ' MesPlantes.bas
'
' Application personnelle de gestion de plantes et fleurs

label labels : gosub labels
gosub constantes
gosub variables
gosub donnees
gosub form0
gosub menu
gosub GUI
gosub initialisations
end

labels:
label constantes, variables, donnees, form0, menu, GUI, initialisations
label sortie, fini
label cat_new, cat_ren, cat_del, cat_sel, cat_abandon, cat_valider, cat_save
label prod_new, prod_ren, prod_del, prod_sel, prod_abandon
label prod_valider, prod_save
label aff_album, aff_photo, add_album, rem_album, raz_album
label file_name

return

constantes:
dim titre$ : titre$ = "Mes Graines, Fleurs et Plantes"
dim root$ : root$ = "C:\"
dim rep$ : rep$ = root$ + "MesPlantes\"
dim base$ : base$ = "MesPlantes.txt"
dim id$ : id$ = "** MesPlantes: Catégories"
dim id_cat$ : id_cat$ = "** Catégorie: "
dim id_prod$ : id_prod$ = "** Produit: "
dim maq$ : maq$ = "maquette.txt"
return

variables:
dim no%, no1%, no2%, no3%, i%, j%, n%, s$, s1$, s2$, d1$, d2$
dim file$, album$
dim no_work%, no_album%, no_picture%, no_photo%, album_file$
dim no_open%
dim no_cat_list%, no_ask_cat%, no_cat_name%
dim sel_cat%, cat_mode%, cat_file$
dim no_prod_list%, no_ask_prod%, no_prod_name%, no_prod_text%
dim sel_prod%, prod_mode%, prod_file$

return

donnees:
return

form0:
full_space 0
caption 0,titre$
on_close 0,fini
return

menu:
no% = no% + 1 : main_menu no% : no1% = no%
' menu "Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Catégories"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,cat_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,cat_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,cat_del
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Produits"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,prod_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,prod_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,prod_del

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Sortie" : on_click no%,sortie

' menu "Outils"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Outils"

' sortie du programme
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Aide"

return

GUI:
no% = no% + 1 : dlist no% : no_work% = no%
no% = no% + 1 : open_dialog no% : no_open% = no%
filter no%,"Images|*.jpg;*.bmp" : dir_dialog no%,rep$

no% = no% + 1 : container no% : top no%,10 : left no%,10 : no1% = no%
width no%,200 : height no%,300 : caption no%,"Catégories"
no% = no% + 1 : list no% : parent no%,no1% : no_cat_list% = no%
top no%,20 : left no%,20
height no%,240 : width no%,170 : on_click no%,cat_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,cat_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,cat_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,cat_del

no% = no% + 1 : container no% : top no%,320 : left no%,10 : no1% = no%
width no%,200 : height no%,400 : caption no%,"Végétaux"
no% = no% + 1 : list no% : parent no%,no1% : no_prod_list% = no%
top no%,20 : left no%,20
height no%,340 : width no%,170 : on_click no%,prod_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,prod_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,prod_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,prod_del

no% = no% + 1 : container no% : top no%,10 : left no%,220
width no%,400 : height no%,710 : caption no%,"Produit"
no% = no% + 1 : memo no% : parent no%,no%-1 : no_prod_text% = no%
top no%,20 : left no%,20 : bar_vertical no%
height no%,680 : width no%,370

no% = no% + 1 : container no% : top no%,10 : left no%,630 : no1% = no%
width no%,width(0)-650 : height no%,height(0)-250 : caption no%,"Photo"
no% = no% + 1 : picture no% : parent no%,no1% : no_photo% = no%
top no%,20 : left no%,10 : height no%,height(no1%)-30 : width no%,width(no1%)-20

no% = no% + 1 : container no% : top no%,height(0)-230 : left no%,630
width no%,width(0)-650 : height no%,height(0)-top(no%)-80 : no1% = no%
caption no%,"Album" : no_album% = no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,10 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,160 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,310 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,460 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,10 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,120 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,160 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,270 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,310 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,420 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,460 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,570 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15

' saisie du nom d'une catégorie
no% = no% + 1 : form no% : no1% = no% : no_ask_cat% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_cat_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,cat_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,cat_valider

' saisie du nom d'un produit
no% = no% + 1 : form no% : no1% = no% : no_ask_prod% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_prod_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,prod_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,prod_valider

return

initialisations:
dir_change root$
if dir_exists(rep$)=0 then dir_make rep$
if file_exists(rep$+base$)=0
file_open_write 1,rep$+base$
file_writeln 1,id$
file_close 1
end_if
if file_exists(rep$+maq$)=0
file_open_write 1,rep$+maq$
file_writeln 1,"** Maquette produit"
file_writeln 1,"Nom:"
file_writeln 1,"Exposition:"
file_writeln 1,"Terre:"
file_writeln 1,"Arrosage:"
file_writeln 1,"Semis/plantation:"
file_writeln 1,"Floraison:"
file_writeln 1,"Récolte:"
file_writeln 1,"Taille:"
file_writeln 1,""
file_writeln 1,"Prix:"
file_writeln 1,""
file_writeln 1,"Notes:"
file_close 1
end_if
file_load no_cat_list%,rep$+base$
item_add no_cat_list%,"****************"
if item_read$(no_cat_list%,1)<>id$
message "Le fichier "+rep$+base$+" n'est pas un fichier valide."
terminate
end_if
item_delete no_cat_list%,count(no_cat_list%)
item_delete no_cat_list%,1
return

sortie:
if message_confirmation_yes_no("Voulez-vous vraiment sortir du programme ?")=1
fini:
gosub cat_save
gosub prod_save
item_insert no_cat_list%,1,id$
file_save no_cat_list%,rep$+base$
terminate
end_if
return

cat_new:
caption no_ask_cat%+1,"Nom de la catégorie"
cat_mode% = 1
show no_ask_cat%
return

cat_ren:
if sel_cat%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment renommer cette catégorie ?")<>1 then return
message "Cette fonction n'est pas encore réalisée."
return
caption no_ask_cat%+1,"Nouveau nom de la catégorie"
cat_mode% = 2
show no_ask_cat%
return

cat_del:
if message_confirmation_yes_no("Voulez-vous vraiment supprimer cette catégorie ?")<>1 then return
if sel_cat%=0 then return
cat_mode% = 3
message "Cette fonction n'est pas encore réalisée."
return
' suppression à implémenter
return

cat_sel:
gosub prod_save
gosub cat_save
gosub raz_album
sel_cat% = item_index(no_cat_list%)
clear no_prod_list%
sel_prod% = 0
clear no_prod_text%
file$ = item_index$(no_cat_list%)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_load no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
return

cat_abandon:
hide no_ask_cat%
return

cat_valider:
select cat_mode%
case 1 : ' création d'une nouvelle catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
item_add no_cat_list%,s$
gosub cat_save
file$ = lower$(s$)
gosub file_name
cat_file$ = file$
file_open_write 1,rep$+cat_file$
file_writeln 1,id_cat$+s$
file_close 1
sel_prod% = 0
clear no_prod_list%
sel_cat% = count(no_cat_list%)
case 2 : ' renommer une catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nouveau nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
s1$ = item_index$(no_cat_list%)
item_delete no_cat_list%,sel_cat%
item_insert no_cat_list%,sel_cat%,s$
file$ = lower$(s1$)
gosub file_name
s2$ = album$
s1$ = file$
file$ = lower$(s$)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_rename rep$+s1$,rep$+cat_file$
clear no_work%
file_load no_work%,rep$+cat_file$
item_delete no_work%,1
item_insert no_work%,1,id_cat$+s$
file_save no_work%,rep$+cat_file$
end_select
hide no_ask_cat%
return

cat_save:
if sel_cat%>0
item_insert no_prod_list%,1,id_cat$+item_read$(no_cat_list%, sel_cat%)
file_save no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
end_if
return

file_name:
i% = instr(file$," ")
while i%>0
file$ = left$(file$,i%-1)+"_"+mid$(file$,i%+1,len(file$))
i% = instr(file$," ")
end_while
album$ = file$
file$ = file$ + ".txt"
return

prod_sel:
gosub prod_save
gosub raz_album
sel_prod% = item_index(no_prod_list%)
file$ = item_index$(no_prod_list%)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
gosub aff_album
return

prod_new:
caption no_ask_prod%+1,"Nom du produit"
prod_mode% = 1
show no_ask_prod%
return

prod_ren:
if sel_prod%=0 then return
caption no_ask_prod%+1,"Nouveau nom de produit"
prod_mode% = 2
show no_ask_prod%
return

prod_del:
if sel_prod%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment supprimer ce produit ?")<>1 then return
prod_mode% = 3
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file_delete rep$+file$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+album$+file$+".jpg")=1
file_delete rep$+album$+file$+".jpg"
end_if
if file_exists(rep$+album$+file$+".bmp")=1
file_delete rep$+album$+file$+".bmp"
end_if
next i%
dir_remove rep$+album$
gosub raz_album
sel_prod% = 0
return

prod_abandon:
hide no_ask_prod%
return

prod_valider:
select prod_mode%
case 1 : ' création d'un nouveau produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nom du produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
item_add no_prod_list%,s$
gosub prod_save
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+maq$
item_delete no_prod_text%,1
item_insert no_prod_text%,1,id_prod$+s$
file_save no_prod_text%,file_prod$
item_delete no_prod_text%,1
sel_prod% = count(no_prod_list%)
dir_make rep$+album_file$
case 2 : ' renommer un produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nouveau nom de produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
item_insert no_prod_list%,sel_prod%,s$
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
d2$ = album$
album_file$ = album$
file_rename rep$+s1$,rep$+prod_file$
clear no_work%
file_load no_work%,rep$+prod_file$
item_delete no_work%,1
item_insert no_work%,1,id_prod$+s$
file_save no_work%,rep$+prod_file$
dir_make rep$+d2$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+d1$+file$+".jpg")=1
file_copy rep$+d1$+file$+".jpg",rep$+d2$+file$+".jpg"
file_delete rep$+d1$+file$+".jpg"
end_if
if file_exists(rep$+d1$+file$+".bmp")=1
file_copy rep$+d1$+file$+".bmp",rep$+d2$+file$+".bmp"
file_delete rep$+d1$+file$+".bmp"
end_if
next i%
dir_remove rep$+d1$
end_select
hide no_ask_prod%
return

prod_save:
if sel_prod%>0
item_insert no_prod_text%,1,id_prod$+item_read$(no_prod_list%,sel_prod%)
file_save no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
end_if
return

aff_photo:
i% = number_click - no_album%
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".jpg"
else
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
return

aff_album:
if dir_exists(rep$+album_file$)=0
dir_make rep$+album_file$
return
end_if
for i%=1 to 4
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".jpg"
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
next i%
return

add_album:
if sel_prod%>0
i% = ((number_click - no_album% - 4)+1)/2
file$ = file_name$(no_open%)
if file$="_" then return
s2$ = right$(file$,4)
if file_exists(rep$+album_file$+"\album"+str$(i%)+s2$)=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
file_copy file$,rep$+album_file$+"\album"+str$(i%)+s2$
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+s2$
end_if
return

rem_album:
if sel_prod%>0
i% = ((number_click - no_album% - 5)+1)/2
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
delete no_album% + i%
picture no_album% + i% : parent no_album% + i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
end_if
return

raz_album:
if sel_prod%>0
for i%=1 to 4
delete no_album% + i%
picture no_album% + i% : parent no_album%+i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no_album%+i%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
next i%
delete no_photo%
picture no_photo% : parent no_photo%,no_photo%-1
top no_photo%,20 : left no_photo%,10
height no_photo%,height(no_photo%-1)-30 : width no_photo%,width(no_photo%-1)-20
end_if
return

Salut Klaus

Voici un programme qui promet.
Je regarderais tout à l’heure !
lol!

J'admire...

Merci Klaus pour cette bonne leçon de codage...

Une version avec une légère amélioration: on empêche de cliquer dans la form 0 tant que la form de saisie du nom d'une catégorie ou d'un produit est ouverte:

Code:: ' MesPlantes.bas
'
' Application personnelle de gestion de plantes et fleurs

label labels : gosub labels
gosub constantes
gosub variables
gosub donnees
gosub form0
gosub menu
gosub GUI
gosub initialisations
end

labels:
label constantes, variables, donnees, form0, menu, GUI, initialisations
label sortie, fini
label cat_new, cat_ren, cat_del, cat_sel, cat_abandon, cat_valider, cat_save
label prod_new, prod_ren, prod_del, prod_sel, prod_abandon
label prod_valider, prod_save
label aff_album, aff_photo, add_album, rem_album, raz_album
label file_name

return

constantes:
dim titre$ : titre$ = "Mes Graines, Fleurs et Plantes"
dim root$ : root$ = "C:\"
dim rep$ : rep$ = root$ + "MesPlantes\"
dim base$ : base$ = "MesPlantes.txt"
dim id$ : id$ = "** MesPlantes: Catégories"
dim id_cat$ : id_cat$ = "** Catégorie: "
dim id_prod$ : id_prod$ = "** Produit: "
dim maq$ : maq$ = "maquette.txt"
return

variables:
dim no%, no1%, no2%, no3%, i%, j%, n%, s$, s1$, s2$, d1$, d2$
dim file$, album$
dim no_work%, no_album%, no_picture%, no_photo%, album_file$
dim no_open%
dim no_cat_list%, no_ask_cat%, no_cat_name%
dim sel_cat%, cat_mode%, cat_file$
dim no_prod_list%, no_ask_prod%, no_prod_name%, no_prod_text%
dim sel_prod%, prod_mode%, prod_file$

return

donnees:
return

form0:
full_space 0
caption 0,titre$
on_close 0,fini
return

menu:
no% = no% + 1 : main_menu no% : no1% = no%
' menu "Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Catégories"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,cat_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,cat_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,cat_del
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Produits"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,prod_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,prod_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,prod_del

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Sortie" : on_click no%,sortie

' menu "Outils"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Outils"

' sortie du programme
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Aide"

return

GUI:
no% = no% + 1 : dlist no% : no_work% = no%
no% = no% + 1 : open_dialog no% : no_open% = no%
filter no%,"Images|*.jpg;*.bmp" : dir_dialog no%,rep$

no% = no% + 1 : container no% : top no%,10 : left no%,10 : no1% = no%
width no%,200 : height no%,300 : caption no%,"Catégories"
no% = no% + 1 : list no% : parent no%,no1% : no_cat_list% = no%
top no%,20 : left no%,20
height no%,240 : width no%,170 : on_click no%,cat_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,cat_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,cat_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,cat_del

no% = no% + 1 : container no% : top no%,320 : left no%,10 : no1% = no%
width no%,200 : height no%,400 : caption no%,"Végétaux"
no% = no% + 1 : list no% : parent no%,no1% : no_prod_list% = no%
top no%,20 : left no%,20
height no%,340 : width no%,170 : on_click no%,prod_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,prod_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,prod_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,prod_del

no% = no% + 1 : container no% : top no%,10 : left no%,220
width no%,400 : height no%,710 : caption no%,"Produit"
no% = no% + 1 : memo no% : parent no%,no%-1 : no_prod_text% = no%
top no%,20 : left no%,20 : bar_vertical no%
height no%,680 : width no%,370

no% = no% + 1 : container no% : top no%,10 : left no%,630 : no1% = no%
width no%,width(0)-650 : height no%,height(0)-250 : caption no%,"Photo"
no% = no% + 1 : picture no% : parent no%,no1% : no_photo% = no%
top no%,20 : left no%,10 : height no%,height(no1%)-30 : width no%,width(no1%)-20

no% = no% + 1 : container no% : top no%,height(0)-230 : left no%,630
width no%,width(0)-650 : height no%,height(0)-top(no%)-80 : no1% = no%
caption no%,"Album" : no_album% = no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,10 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,160 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,310 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,460 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,10 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,120 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,160 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,270 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,310 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,420 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,460 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,570 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15

' saisie du nom d'une catégorie
no% = no% + 1 : form no% : no1% = no% : no_ask_cat% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_cat_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,cat_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,cat_valider

' saisie du nom d'un produit
no% = no% + 1 : form no% : no1% = no% : no_ask_prod% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_prod_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,prod_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,prod_valider

return

initialisations:
dir_change root$
if dir_exists(rep$)=0 then dir_make rep$
if file_exists(rep$+base$)=0
file_open_write 1,rep$+base$
file_writeln 1,id$
file_close 1
end_if
if file_exists(rep$+maq$)=0
file_open_write 1,rep$+maq$
file_writeln 1,"** Maquette produit"
file_writeln 1,"Nom:"
file_writeln 1,"Exposition:"
file_writeln 1,"Terre:"
file_writeln 1,"Arrosage:"
file_writeln 1,"Semis/plantation:"
file_writeln 1,"Floraison:"
file_writeln 1,"Récolte:"
file_writeln 1,"Taille:"
file_writeln 1,""
file_writeln 1,"Prix:"
file_writeln 1,""
file_writeln 1,"Notes:"
file_close 1
end_if
file_load no_cat_list%,rep$+base$
item_add no_cat_list%,"****************"
if item_read$(no_cat_list%,1)<>id$
message "Le fichier "+rep$+base$+" n'est pas un fichier valide."
terminate
end_if
item_delete no_cat_list%,count(no_cat_list%)
item_delete no_cat_list%,1
return

sortie:
if message_confirmation_yes_no("Voulez-vous vraiment sortir du programme ?")=1
fini:
gosub cat_save
gosub prod_save
item_insert no_cat_list%,1,id$
file_save no_cat_list%,rep$+base$
terminate
end_if
return

cat_new:
caption no_ask_cat%+1,"Nom de la catégorie"
cat_mode% = 1
inactive 0
show no_ask_cat%
return

cat_ren:
if sel_cat%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment renommer cette catégorie ?")<>1 then return
message "Cette fonction n'est pas encore réalisée."
return
caption no_ask_cat%+1,"Nouveau nom de la catégorie"
cat_mode% = 2
show no_ask_cat%
return

cat_del:
if message_confirmation_yes_no("Voulez-vous vraiment supprimer cette catégorie ?")<>1 then return
if sel_cat%=0 then return
cat_mode% = 3
message "Cette fonction n'est pas encore réalisée."
return
' suppression à implémenter
return

cat_sel:
gosub prod_save
gosub cat_save
gosub raz_album
sel_cat% = item_index(no_cat_list%)
clear no_prod_list%
sel_prod% = 0
clear no_prod_text%
file$ = item_index$(no_cat_list%)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_load no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
return

cat_abandon:
active 0
hide no_ask_cat%
return

cat_valider:
active 0
select cat_mode%
case 1 : ' création d'une nouvelle catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
item_add no_cat_list%,s$
gosub cat_save
file$ = lower$(s$)
gosub file_name
cat_file$ = file$
file_open_write 1,rep$+cat_file$
file_writeln 1,id_cat$+s$
file_close 1
sel_prod% = 0
clear no_prod_list%
sel_cat% = count(no_cat_list%)
case 2 : ' renommer une catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nouveau nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
s1$ = item_index$(no_cat_list%)
item_delete no_cat_list%,sel_cat%
item_insert no_cat_list%,sel_cat%,s$
file$ = lower$(s1$)
gosub file_name
s2$ = album$
s1$ = file$
file$ = lower$(s$)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_rename rep$+s1$,rep$+cat_file$
clear no_work%
file_load no_work%,rep$+cat_file$
item_delete no_work%,1
item_insert no_work%,1,id_cat$+s$
file_save no_work%,rep$+cat_file$
end_select
hide no_ask_cat%
return

cat_save:
if sel_cat%>0
item_insert no_prod_list%,1,id_cat$+item_read$(no_cat_list%, sel_cat%)
file_save no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
end_if
return

file_name:
i% = instr(file$," ")
while i%>0
file$ = left$(file$,i%-1)+"_"+mid$(file$,i%+1,len(file$))
i% = instr(file$," ")
end_while
album$ = file$
file$ = file$ + ".txt"
return

prod_sel:
gosub prod_save
gosub raz_album
sel_prod% = item_index(no_prod_list%)
file$ = item_index$(no_prod_list%)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
gosub aff_album
return

prod_new:
caption no_ask_prod%+1,"Nom du produit"
prod_mode% = 1
inactive 0
show no_ask_prod%
return

prod_ren:
if sel_prod%=0 then return
caption no_ask_prod%+1,"Nouveau nom de produit"
prod_mode% = 2
inactive 0
show no_ask_prod%
return

prod_del:
if sel_prod%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment supprimer ce produit ?")<>1 then return
prod_mode% = 3
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file_delete rep$+file$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+album$+file$+".jpg")=1
file_delete rep$+album$+file$+".jpg"
end_if
if file_exists(rep$+album$+file$+".bmp")=1
file_delete rep$+album$+file$+".bmp"
end_if
next i%
dir_remove rep$+album$
gosub raz_album
sel_prod% = 0
return

prod_abandon:
active 0
hide no_ask_prod%
return

prod_valider:
active 0
select prod_mode%
case 1 : ' création d'un nouveau produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nom du produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
item_add no_prod_list%,s$
gosub prod_save
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+maq$
item_delete no_prod_text%,1
item_insert no_prod_text%,1,id_prod$+s$
file_save no_prod_text%,file_prod$
item_delete no_prod_text%,1
sel_prod% = count(no_prod_list%)
dir_make rep$+album_file$
case 2 : ' renommer un produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nouveau nom de produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
item_insert no_prod_list%,sel_prod%,s$
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
d2$ = album$
album_file$ = album$
file_rename rep$+s1$,rep$+prod_file$
clear no_work%
file_load no_work%,rep$+prod_file$
item_delete no_work%,1
item_insert no_work%,1,id_prod$+s$
file_save no_work%,rep$+prod_file$
dir_make rep$+d2$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+d1$+file$+".jpg")=1
file_copy rep$+d1$+file$+".jpg",rep$+d2$+file$+".jpg"
file_delete rep$+d1$+file$+".jpg"
end_if
if file_exists(rep$+d1$+file$+".bmp")=1
file_copy rep$+d1$+file$+".bmp",rep$+d2$+file$+".bmp"
file_delete rep$+d1$+file$+".bmp"
end_if
next i%
dir_remove rep$+d1$
end_select
hide no_ask_prod%
return

prod_save:
if sel_prod%>0
item_insert no_prod_text%,1,id_prod$+item_read$(no_prod_list%,sel_prod%)
file_save no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
end_if
return

aff_photo:
i% = number_click - no_album%
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".jpg"
else
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
return

aff_album:
if dir_exists(rep$+album_file$)=0
dir_make rep$+album_file$
return
end_if
for i%=1 to 4
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".jpg"
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
next i%
return

add_album:
if sel_prod%>0
i% = ((number_click - no_album% - 4)+1)/2
file$ = file_name$(no_open%)
if file$="_" then return
s2$ = right$(file$,4)
if file_exists(rep$+album_file$+"\album"+str$(i%)+s2$)=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
file_copy file$,rep$+album_file$+"\album"+str$(i%)+s2$
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+s2$
end_if
return

rem_album:
if sel_prod%>0
i% = ((number_click - no_album% - 5)+1)/2
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
delete no_album% + i%
picture no_album% + i% : parent no_album% + i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
end_if
return

raz_album:
if sel_prod%>0
for i%=1 to 4
delete no_album% + i%
picture no_album% + i% : parent no_album%+i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no_album%+i%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
next i%
delete no_photo%
picture no_photo% : parent no_photo%,no_photo%-1
top no_photo%,20 : left no_photo%,10
height no_photo%,height(no_photo%-1)-30 : width no_photo%,width(no_photo%-1)-20
end_if
return

Une nouvelle version, avec une fonction "Imprimer" dans le menu qui copie l'image d'écran à l'aide de WTP.exe. Pour obtenir l'image d'écran, on utilise une nouvelle dll: PrintScreen.dll. Il faut donc la télécharger, ainsi que mon WTP.exe. Tout est sur mon WebDav:
Site: http://www.mydrive.ch/
Identifiant: panoramic@klausgunther
Mot de passe: panoramic123
Dossier DLLs pour la dll et WTP pour WTP.

Voici le code du programme:

Code:: ' MesPlantes.bas
'
' Application personnelle de gestion de plantes et fleurs

label labels : gosub labels
gosub constantes
gosub variables
gosub donnees
gosub form0
gosub menu
gosub GUI
gosub initialisations
end

labels:
label constantes, variables, donnees, form0, menu, GUI, initialisations
label sortie, fini
label cat_new, cat_ren, cat_del, cat_sel, cat_abandon, cat_valider, cat_save
label prod_new, prod_ren, prod_del, prod_sel, prod_abandon
label prod_valider, prod_save, imprimer
label aff_album, aff_photo, add_album, rem_album, raz_album
label file_name

return

constantes:
dim titre$ : titre$ = "Mes Graines, Fleurs et Plantes"
dim root$ : root$ = "C:\"
dim rep$ : rep$ = root$ + "MesPlantes\"
dim base$ : base$ = "MesPlantes.txt"
dim id$ : id$ = "** MesPlantes: Catégories"
dim id_cat$ : id_cat$ = "** Catégorie: "
dim id_prod$ : id_prod$ = "** Produit: "
dim maq$ : maq$ = "maquette.txt"
dim PrintScreen$ : PrintScreen$ = "PrintScreen.dll"
dim hdc$ : hdc$ = "HDC.jpg"
dim hdctxt$ : hdctxt$ = "hdc.ini"
dim hdcprint$ : hdcprint$ = rep$+"wtp.exe /file="+rep$+hdctxt$
return

variables:
dim no%, no1%, no2%, no3%, i%, j%, n%, s$, s1$, s2$, d1$, d2$
dim file$, album$
dim no_work%, no_album%, no_picture%, no_photo%, album_file$
dim no_open%, no_print%
dim no_cat_list%, no_ask_cat%, no_cat_name%
dim sel_cat%, cat_mode%, cat_file$
dim no_prod_list%, no_ask_prod%, no_prod_name%, no_prod_text%
dim sel_prod%, prod_mode%, prod_file$

return

donnees:
return

form0:
full_space 0
caption 0,titre$
on_close 0,fini
return

menu:
no% = no% + 1 : main_menu no% : no1% = no%
' menu "Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Catégories"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,cat_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,cat_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,cat_del
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Produits"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,prod_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,prod_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,prod_del

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Imprimer" : on_click no%,imprimer

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Sortie" : on_click no%,sortie

' menu "Outils"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Outils"

' sortie du programme
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Aide"

return

GUI:
no% = no% + 1 : image no% : no_print% = no%
no% = no% + 1 : dlist no% : no_work% = no%
no% = no% + 1 : open_dialog no% : no_open% = no%
filter no%,"Images|*.jpg;*.bmp" : dir_dialog no%,rep$

no% = no% + 1 : container no% : top no%,10 : left no%,10 : no1% = no%
width no%,200 : height no%,300 : caption no%,"Catégories"
no% = no% + 1 : list no% : parent no%,no1% : no_cat_list% = no%
top no%,20 : left no%,20
height no%,240 : width no%,170 : on_click no%,cat_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,cat_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,cat_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,cat_del

no% = no% + 1 : container no% : top no%,320 : left no%,10 : no1% = no%
width no%,200 : height no%,400 : caption no%,"Végétaux"
no% = no% + 1 : list no% : parent no%,no1% : no_prod_list% = no%
top no%,20 : left no%,20
height no%,340 : width no%,170 : on_click no%,prod_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,prod_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,prod_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,prod_del

no% = no% + 1 : container no% : top no%,10 : left no%,220
width no%,400 : height no%,710 : caption no%,"Produit"
no% = no% + 1 : memo no% : parent no%,no%-1 : no_prod_text% = no%
top no%,20 : left no%,20 : bar_vertical no%
height no%,680 : width no%,370

no% = no% + 1 : container no% : top no%,10 : left no%,630 : no1% = no%
width no%,width(0)-650 : height no%,height(0)-250 : caption no%,"Photo"
no% = no% + 1 : picture no% : parent no%,no1% : no_photo% = no%
top no%,20 : left no%,10 : stretch_on no%
height no%,height(no1%)-30 : width no%,width(no1%)-20

no% = no% + 1 : container no% : top no%,height(0)-230 : left no%,630
width no%,width(0)-650 : height no%,height(0)-top(no%)-80 : no1% = no%
caption no%,"Album" : no_album% = no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,10 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,160 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,310 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,460 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,10 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,120 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,160 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,270 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,310 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,420 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,460 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,570 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15

' saisie du nom d'une catégorie
no% = no% + 1 : form no% : no1% = no% : no_ask_cat% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_cat_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,cat_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,cat_valider

' saisie du nom d'un produit
no% = no% + 1 : form no% : no1% = no% : no_ask_prod% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_prod_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,prod_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,prod_valider

return

initialisations:
dir_change root$
if dir_exists(rep$)=0 then dir_make rep$
if file_exists(rep$+base$)=0
file_open_write 1,rep$+base$
file_writeln 1,id$
file_close 1
end_if
if file_exists(rep$+maq$)=0
file_open_write 1,rep$+maq$
file_writeln 1,"** Maquette produit"
file_writeln 1,"Nom:"
file_writeln 1,"Exposition:"
file_writeln 1,"Terre:"
file_writeln 1,"Arrosage:"
file_writeln 1,"Semis/plantation:"
file_writeln 1,"Floraison:"
file_writeln 1,"Récolte:"
file_writeln 1,"Taille:"
file_writeln 1,""
file_writeln 1,"Prix:"
file_writeln 1,""
file_writeln 1,"Notes:"
file_close 1
end_if
if file_exists(rep$+hdctxt$)=0
file_open_write 1,rep$+hdctxt$
file_writeln 1,"<#image="+rep$+hdc$+",0,0,4900,3062#>"
file_close 1
end_if
file_load no_cat_list%,rep$+base$
item_add no_cat_list%,"****************"
if item_read$(no_cat_list%,1)<>id$
message "Le fichier "+rep$+base$+" n'est pas un fichier valide."
terminate
end_if
item_delete no_cat_list%,count(no_cat_list%)
item_delete no_cat_list%,1
return

sortie:
if message_confirmation_yes_no("Voulez-vous vraiment sortir du programme ?")=1
fini:
gosub cat_save
gosub prod_save
item_insert no_cat_list%,1,id$
file_save no_cat_list%,rep$+base$
terminate
end_if
return

cat_new:
caption no_ask_cat%+1,"Nom de la catégorie"
cat_mode% = 1
inactive 0
show no_ask_cat%
return

cat_ren:
if sel_cat%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment renommer cette catégorie ?")<>1 then return
message "Cette fonction n'est pas encore réalisée."
return
caption no_ask_cat%+1,"Nouveau nom de la catégorie"
cat_mode% = 2
show no_ask_cat%
return

cat_del:
if message_confirmation_yes_no("Voulez-vous vraiment supprimer cette catégorie ?")<>1 then return
if sel_cat%=0 then return
cat_mode% = 3
message "Cette fonction n'est pas encore réalisée."
return
' suppression à implémenter
return

cat_sel:
gosub prod_save
gosub cat_save
gosub raz_album
sel_cat% = item_index(no_cat_list%)
clear no_prod_list%
sel_prod% = 0
clear no_prod_text%
file$ = item_index$(no_cat_list%)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_load no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
return

cat_abandon:
active 0
hide no_ask_cat%
return

cat_valider:
active 0
select cat_mode%
case 1 : ' création d'une nouvelle catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
item_add no_cat_list%,s$
gosub cat_save
file$ = lower$(s$)
gosub file_name
cat_file$ = file$
file_open_write 1,rep$+cat_file$
file_writeln 1,id_cat$+s$
file_close 1
sel_prod% = 0
clear no_prod_list%
sel_cat% = count(no_cat_list%)
case 2 : ' renommer une catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nouveau nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
s1$ = item_index$(no_cat_list%)
item_delete no_cat_list%,sel_cat%
item_insert no_cat_list%,sel_cat%,s$
file$ = lower$(s1$)
gosub file_name
s2$ = album$
s1$ = file$
file$ = lower$(s$)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_rename rep$+s1$,rep$+cat_file$
clear no_work%
file_load no_work%,rep$+cat_file$
item_delete no_work%,1
item_insert no_work%,1,id_cat$+s$
file_save no_work%,rep$+cat_file$
end_select
hide no_ask_cat%
return

cat_save:
if sel_cat%>0
item_insert no_prod_list%,1,id_cat$+item_read$(no_cat_list%, sel_cat%)
file_save no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
end_if
return

file_name:
i% = instr(file$," ")
while i%>0
file$ = left$(file$,i%-1)+"_"+mid$(file$,i%+1,len(file$))
i% = instr(file$," ")
end_while
album$ = file$
file$ = file$ + ".txt"
return

prod_sel:
gosub prod_save
gosub raz_album
sel_prod% = item_index(no_prod_list%)
file$ = item_index$(no_prod_list%)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
gosub aff_album
return

prod_new:
caption no_ask_prod%+1,"Nom du produit"
prod_mode% = 1
inactive 0
show no_ask_prod%
return

prod_ren:
if sel_prod%=0 then return
caption no_ask_prod%+1,"Nouveau nom de produit"
prod_mode% = 2
inactive 0
show no_ask_prod%
return

prod_del:
if sel_prod%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment supprimer ce produit ?")<>1 then return
prod_mode% = 3
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file_delete rep$+file$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+album$+file$+".jpg")=1
file_delete rep$+album$+file$+".jpg"
end_if
if file_exists(rep$+album$+file$+".bmp")=1
file_delete rep$+album$+file$+".bmp"
end_if
next i%
dir_remove rep$+album$
gosub raz_album
sel_prod% = 0
return

prod_abandon:
active 0
hide no_ask_prod%
return

prod_valider:
active 0
select prod_mode%
case 1 : ' création d'un nouveau produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nom du produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
item_add no_prod_list%,s$
gosub prod_save
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+maq$
item_delete no_prod_text%,1
item_insert no_prod_text%,1,id_prod$+s$
file_save no_prod_text%,file_prod$
item_delete no_prod_text%,1
sel_prod% = count(no_prod_list%)
dir_make rep$+album_file$
case 2 : ' renommer un produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nouveau nom de produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
item_insert no_prod_list%,sel_prod%,s$
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
d2$ = album$
album_file$ = album$
file_rename rep$+s1$,rep$+prod_file$
clear no_work%
file_load no_work%,rep$+prod_file$
item_delete no_work%,1
item_insert no_work%,1,id_prod$+s$
file_save no_work%,rep$+prod_file$
dir_make rep$+d2$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+d1$+file$+".jpg")=1
file_copy rep$+d1$+file$+".jpg",rep$+d2$+file$+".jpg"
file_delete rep$+d1$+file$+".jpg"
end_if
if file_exists(rep$+d1$+file$+".bmp")=1
file_copy rep$+d1$+file$+".bmp",rep$+d2$+file$+".bmp"
file_delete rep$+d1$+file$+".bmp"
end_if
next i%
dir_remove rep$+d1$
end_select
hide no_ask_prod%
return

prod_save:
if sel_prod%>0
item_insert no_prod_text%,1,id_prod$+item_read$(no_prod_list%,sel_prod%)
file_save no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
end_if
return

aff_photo:
i% = number_click - no_album%
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".jpg"
else
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
return

aff_album:
if dir_exists(rep$+album_file$)=0
dir_make rep$+album_file$
return
end_if
for i%=1 to 4
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".jpg"
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
next i%
return

add_album:
if sel_prod%>0
i% = ((number_click - no_album% - 4)+1)/2
file$ = file_name$(no_open%)
if file$="_" then return
s2$ = right$(file$,4)
if file_exists(rep$+album_file$+"\album"+str$(i%)+s2$)=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
file_copy file$,rep$+album_file$+"\album"+str$(i%)+s2$
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+s2$
end_if
return

rem_album:
if sel_prod%>0
i% = ((number_click - no_album% - 5)+1)/2
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
delete no_album% + i%
picture no_album% + i% : parent no_album% + i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
end_if
return

raz_album:
if sel_prod%>0
for i%=1 to 4
delete no_album% + i%
picture no_album% + i% : parent no_album%+i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no_album%+i%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
next i%
delete no_photo%
picture no_photo% : parent no_photo%,no_photo%-1
top no_photo%,20 : left no_photo%,10
height no_photo%,height(no_photo%-1)-30 : width no_photo%,width(no_photo%-1)-20
end_if
return

imprimer:
if file_exists(rep$+PrintScreen$)=0
message "Le fichier "+rep$+PrintScreen$+" manque."
return
end_if
pause 300
dll_on rep$+PrintScreen$
i% = dll_call1("ScreenCopy",1)
dll_off
delete no_print%
image no_print%
clipboard_paste no_print%
if file_exists(rep$+hdc$)=1 then file_delete rep$+hdc$
pause 300
file_save no_print%,rep$+hdc$
file_load no_print%,rep$+hdc$
pause 300
execute hdcprint$
return

Merci Klaus Wink

Nouvelle version:
L'imrpession se fait maintenant en mode paysage, via un fichier JPG que je retourne de 90 degrés. Ou plus exactement, après la copie d'écran, je retourne l'image dans le presse-papier de 90 degrés, avant de l'écrire dans in fichier JPG qui est ensuite édité par mon outil WTP.

La nouvelle fonction de la dll PrintScreen.dll est:
i%=DLL_CALL0("Rotate90")
Elle suppose que le presse-papier contient une image et la retourne de 90 degrés, quelque soit son orientation. Donc, 4 appels successifs à cette routine reproduisent la même image, sans perte de qualité.

Il y a aussi deux autres nouvelles fonctions:
i%=DLL_CALL0("RotateM90") : ' rotation de -90 degrés
i%=DLL_CALL0("Rotate90") : rotation de 180 degrés

Voici le code:

Code:: ' MesPlantes.bas
'
' Application personnelle de gestion de plantes et fleurs

label labels : gosub labels
gosub constantes
gosub variables
gosub donnees
gosub form0
gosub menu
gosub GUI
gosub initialisations
end

labels:
label constantes, variables, donnees, form0, menu, GUI, initialisations
label sortie, fini
label cat_new, cat_ren, cat_del, cat_sel, cat_abandon, cat_valider, cat_save
label prod_new, prod_ren, prod_del, prod_sel, prod_abandon
label prod_valider, prod_save, imprimer
label aff_album, aff_photo, add_album, rem_album, raz_album
label file_name

return

constantes:
dim titre$ : titre$ = "Mes Graines, Fleurs et Plantes"
dim root$ : root$ = "C:\"
dim rep$ : rep$ = root$ + "MesPlantes\"
dim base$ : base$ = "MesPlantes.txt"
dim id$ : id$ = "** MesPlantes: Catégories"
dim id_cat$ : id_cat$ = "** Catégorie: "
dim id_prod$ : id_prod$ = "** Produit: "
dim maq$ : maq$ = "maquette.txt"
dim PrintScreen$ : PrintScreen$ = "PrintScreen.dll"
dim hdc$ : hdc$ = "HDC.jpg"
dim hdctxt$ : hdctxt$ = "hdc.ini"
dim hdcprint$ : hdcprint$ = rep$+"wtp.exe /file="+rep$+hdctxt$
return

variables:
dim no%, no1%, no2%, no3%, i%, j%, n%, s$, s1$, s2$, d1$, d2$
dim file$, album$
dim no_work%, no_album%, no_picture%, no_photo%, album_file$
dim no_open%, no_print%
dim no_cat_list%, no_ask_cat%, no_cat_name%
dim sel_cat%, cat_mode%, cat_file$
dim no_prod_list%, no_ask_prod%, no_prod_name%, no_prod_text%
dim sel_prod%, prod_mode%, prod_file$

return

donnees:
return

form0:
full_space 0
caption 0,titre$
on_close 0,fini
return

menu:
no% = no% + 1 : main_menu no% : no1% = no%
' menu "Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Catégories"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,cat_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,cat_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,cat_del
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Produits"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,prod_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,prod_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,prod_del

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Imprimer" : on_click no%,imprimer

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Sortie" : on_click no%,sortie

' menu "Outils"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Outils"

' sortie du programme
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Aide"

return

GUI:
no% = no% + 1 : image no% : no_print% = no%
no% = no% + 1 : dlist no% : no_work% = no%
no% = no% + 1 : open_dialog no% : no_open% = no%
filter no%,"Images|*.jpg;*.bmp" : dir_dialog no%,rep$

no% = no% + 1 : container no% : top no%,10 : left no%,10 : no1% = no%
width no%,200 : height no%,300 : caption no%,"Catégories"
no% = no% + 1 : list no% : parent no%,no1% : no_cat_list% = no%
top no%,20 : left no%,20
height no%,240 : width no%,170 : on_click no%,cat_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,cat_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,cat_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,cat_del

no% = no% + 1 : container no% : top no%,320 : left no%,10 : no1% = no%
width no%,200 : height no%,400 : caption no%,"Végétaux"
no% = no% + 1 : list no% : parent no%,no1% : no_prod_list% = no%
top no%,20 : left no%,20
height no%,340 : width no%,170 : on_click no%,prod_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,prod_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,prod_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,prod_del

no% = no% + 1 : container no% : top no%,10 : left no%,220
width no%,400 : height no%,710 : caption no%,"Produit"
no% = no% + 1 : memo no% : parent no%,no%-1 : no_prod_text% = no%
top no%,20 : left no%,20 : bar_vertical no%
height no%,680 : width no%,370

no% = no% + 1 : container no% : top no%,10 : left no%,630 : no1% = no%
width no%,width(0)-650 : height no%,height(0)-250 : caption no%,"Photo"
no% = no% + 1 : picture no% : parent no%,no1% : no_photo% = no%
top no%,20 : left no%,10 : stretch_on no%
height no%,height(no1%)-30 : width no%,width(no1%)-20

no% = no% + 1 : container no% : top no%,height(0)-230 : left no%,630
width no%,width(0)-650 : height no%,height(0)-top(no%)-80 : no1% = no%
caption no%,"Album" : no_album% = no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,10 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,160 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,310 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,460 : height no%,height(no1%)-40 : width no%,140
stretch_on no%
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,10 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,120 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,160 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,270 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,310 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,420 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,460 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,570 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15

' saisie du nom d'une catégorie
no% = no% + 1 : form no% : no1% = no% : no_ask_cat% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_cat_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,cat_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,cat_valider

' saisie du nom d'un produit
no% = no% + 1 : form no% : no1% = no% : no_ask_prod% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_prod_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,prod_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,prod_valider

return

initialisations:
dir_change root$
if dir_exists(rep$)=0 then dir_make rep$
if file_exists(rep$+base$)=0
file_open_write 1,rep$+base$
file_writeln 1,id$
file_close 1
end_if
if file_exists(rep$+maq$)=0
file_open_write 1,rep$+maq$
file_writeln 1,"** Maquette produit"
file_writeln 1,"Nom:"
file_writeln 1,""
file_writeln 1,"Exposition:"
file_writeln 1,"Terre:"
file_writeln 1,"Arrosage:"
file_writeln 1,"Semis/plantation:"
file_writeln 1,"Floraison:"
file_writeln 1,"Récolte:"
file_writeln 1,"Taille:"
file_writeln 1,""
file_writeln 1,"Prix:"
file_writeln 1,""
file_writeln 1,"Notes:"
file_close 1
end_if
if file_exists(rep$+hdctxt$)=0
file_open_write 1,rep$+hdctxt$
file_writeln 1,"<#image="+rep$+hdc$+",0,0,4300,6880#>"
file_close 1
end_if
file_load no_cat_list%,rep$+base$
item_add no_cat_list%,"****************"
if item_read$(no_cat_list%,1)<>id$
message "Le fichier "+rep$+base$+" n'est pas un fichier valide."
terminate
end_if
item_delete no_cat_list%,count(no_cat_list%)
item_delete no_cat_list%,1
return

sortie:
if message_confirmation_yes_no("Voulez-vous vraiment sortir du programme ?")=1
fini:
gosub cat_save
gosub prod_save
item_insert no_cat_list%,1,id$
file_save no_cat_list%,rep$+base$
terminate
end_if
return

cat_new:
caption no_ask_cat%+1,"Nom de la catégorie"
cat_mode% = 1
inactive 0
show no_ask_cat%
return

cat_ren:
if sel_cat%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment renommer cette catégorie ?")<>1 then return
message "Cette fonction n'est pas encore réalisée."
return
caption no_ask_cat%+1,"Nouveau nom de la catégorie"
cat_mode% = 2
show no_ask_cat%
return

cat_del:
if message_confirmation_yes_no("Voulez-vous vraiment supprimer cette catégorie ?")<>1 then return
if sel_cat%=0 then return
cat_mode% = 3
message "Cette fonction n'est pas encore réalisée."
return
' suppression à implémenter
return

cat_sel:
gosub prod_save
gosub cat_save
gosub raz_album
sel_cat% = item_index(no_cat_list%)
clear no_prod_list%
sel_prod% = 0
clear no_prod_text%
file$ = item_index$(no_cat_list%)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_load no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
return

cat_abandon:
active 0
hide no_ask_cat%
return

cat_valider:
active 0
select cat_mode%
case 1 : ' création d'une nouvelle catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
item_add no_cat_list%,s$
gosub cat_save
file$ = lower$(s$)
gosub file_name
cat_file$ = file$
file_open_write 1,rep$+cat_file$
file_writeln 1,id_cat$+s$
file_close 1
sel_prod% = 0
clear no_prod_list%
sel_cat% = count(no_cat_list%)
case 2 : ' renommer une catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nouveau nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
s1$ = item_index$(no_cat_list%)
item_delete no_cat_list%,sel_cat%
item_insert no_cat_list%,sel_cat%,s$
file$ = lower$(s1$)
gosub file_name
s2$ = album$
s1$ = file$
file$ = lower$(s$)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_rename rep$+s1$,rep$+cat_file$
clear no_work%
file_load no_work%,rep$+cat_file$
item_delete no_work%,1
item_insert no_work%,1,id_cat$+s$
file_save no_work%,rep$+cat_file$
end_select
hide no_ask_cat%
return

cat_save:
if sel_cat%>0
item_insert no_prod_list%,1,id_cat$+item_read$(no_cat_list%, sel_cat%)
file_save no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
end_if
return

file_name:
i% = instr(file$," ")
while i%>0
file$ = left$(file$,i%-1)+"_"+mid$(file$,i%+1,len(file$))
i% = instr(file$," ")
end_while
album$ = file$
file$ = file$ + ".txt"
return

prod_sel:
gosub prod_save
gosub raz_album
sel_prod% = item_index(no_prod_list%)
file$ = item_index$(no_prod_list%)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
gosub aff_album
return

prod_new:
caption no_ask_prod%+1,"Nom du produit"
prod_mode% = 1
inactive 0
show no_ask_prod%
return

prod_ren:
if sel_prod%=0 then return
caption no_ask_prod%+1,"Nouveau nom de produit"
prod_mode% = 2
inactive 0
show no_ask_prod%
return

prod_del:
if sel_prod%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment supprimer ce produit ?")<>1 then return
prod_mode% = 3
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file_delete rep$+file$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+album$+file$+".jpg")=1
file_delete rep$+album$+file$+".jpg"
end_if
if file_exists(rep$+album$+file$+".bmp")=1
file_delete rep$+album$+file$+".bmp"
end_if
next i%
dir_remove rep$+album$
gosub raz_album
sel_prod% = 0
return

prod_abandon:
active 0
hide no_ask_prod%
return

prod_valider:
active 0
select prod_mode%
case 1 : ' création d'un nouveau produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nom du produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
item_add no_prod_list%,s$
gosub prod_save
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+maq$
item_delete no_prod_text%,1
item_insert no_prod_text%,1,id_prod$+s$
file_save no_prod_text%,file_prod$
item_delete no_prod_text%,1
sel_prod% = count(no_prod_list%)
dir_make rep$+album_file$
case 2 : ' renommer un produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nouveau nom de produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
item_insert no_prod_list%,sel_prod%,s$
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
d2$ = album$
album_file$ = album$
file_rename rep$+s1$,rep$+prod_file$
clear no_work%
file_load no_work%,rep$+prod_file$
item_delete no_work%,1
item_insert no_work%,1,id_prod$+s$
file_save no_work%,rep$+prod_file$
dir_make rep$+d2$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+d1$+file$+".jpg")=1
file_copy rep$+d1$+file$+".jpg",rep$+d2$+file$+".jpg"
file_delete rep$+d1$+file$+".jpg"
end_if
if file_exists(rep$+d1$+file$+".bmp")=1
file_copy rep$+d1$+file$+".bmp",rep$+d2$+file$+".bmp"
file_delete rep$+d1$+file$+".bmp"
end_if
next i%
dir_remove rep$+d1$
end_select
hide no_ask_prod%
return

prod_save:
if sel_prod%>0
item_insert no_prod_text%,1,id_prod$+item_read$(no_prod_list%,sel_prod%)
file_save no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
end_if
return

aff_photo:
i% = number_click - no_album%
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".jpg"
else
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
return

aff_album:
if dir_exists(rep$+album_file$)=0
dir_make rep$+album_file$
return
end_if
for i%=1 to 4
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".jpg"
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
next i%
return

add_album:
if sel_prod%>0
i% = ((number_click - no_album% - 4)+1)/2
file$ = file_name$(no_open%)
if file$="_" then return
s2$ = right$(file$,4)
if file_exists(rep$+album_file$+"\album"+str$(i%)+s2$)=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
file_copy file$,rep$+album_file$+"\album"+str$(i%)+s2$
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+s2$
end_if
return

rem_album:
if sel_prod%>0
i% = ((number_click - no_album% - 5)+1)/2
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
delete no_album% + i%
picture no_album% + i% : parent no_album% + i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
end_if
return

raz_album:
if sel_prod%>0
for i%=1 to 4
delete no_album% + i%
picture no_album% + i% : parent no_album%+i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no_album%+i%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
next i%
delete no_photo%
picture no_photo% : parent no_photo%,no_photo%-1
top no_photo%,20 : left no_photo%,10
height no_photo%,height(no_photo%-1)-30 : width no_photo%,width(no_photo%-1)-20
end_if
return

imprimer:
if file_exists(rep$+PrintScreen$)=0
message "Le fichier "+rep$+PrintScreen$+" manque."
return
end_if
pause 300
dll_on rep$+PrintScreen$
i% = dll_call1("ScreenCopy",1)
delete no_print%
image no_print%
i% = dll_call0("Rotate90")
clipboard_paste no_print%
if file_exists(rep$+hdc$)=1 then file_delete rep$+hdc$
pause 300
file_save no_print%,rep$+hdc$
file_load no_print%,rep$+hdc$
pause 300
execute hdcprint$
dll_off
return

Je suis surpris, tu n'as pas de commentaire pour cet excellent programme. Merci Klaus
PS: Pour info, le texte est un peu coupé sur mon portable en W7, pour le titre des containers sont un peu coupés, mais bon rien de grave Wink

Tiens, les titres des containers sont coupés ? Fais stp "Imprimer" par le menu et poste-moi le fichier HDC.jpg qui est généré - il contient la copie d'écran en mode paysage. J'ai essayé de m'adapter à des tailles d'écran variables, mais ce n'est jamais simple quand on n'a qu'une seule machine. Et peux-tu joindre les dimensions Panoramic réelles de l'écran, par screen_x et screen_y ?

Que penses-tu des 4 fonctions de PrintScreen.dll:
dll_call1("ScreenCopy",x%) : ' envoyer la copie d'écran dans le presse-papier
dll_call0("Rotate90") : ' tourner l'image du presse-papier de 90 degrés
dll_call0("RotateM90") : ' tourner l'image du presse-papier de -90 degrés
dll_call0("Rotate180") : ' tourner l'image du presse-papier de 180 degrés

Cool, non ?

Oui Klaus, c'est une DLL bien pratique combinée au presse papier Wink

Je ne te mets pas de capture d'écran, désolé et tant mieux pour toi, car quand j'ai réessayé, le problème ne se pose plus ... Je ne sais pas trop ce qui c'est passé tout-à-l'heure, mais le problème devait venir de quelque chose chez moi car même en relançant plusieurs fois, le problème ne s'est pas reproduit.

OK, tant mieux.

je suis en train de préparer une fonction permettant de super poser des images les unes sur les autres, AVEC une couleur de transparence, et tout ça dans le presse-papier, de sorte à pouvoir récupérer le résultat dans un picture par CLIPBOARD_PASTE et le sauvegarder par FILE_SAVE dans un JPG !

Super, ça pour les jeux, entre autre, c'est super pratique.
Mais aussi pour les montage photos,etc ...
J'espère que tu va réussir. Après par contre, je n'aurais plus d'excuses pour ne pas me remettre à bosser ... du coup il faudra que je me creuse un peu les méninges pour illustrer l'utilisation Wink

Finalement, c'était beaucoup plus rapide que prévu ! Et ça marche très bien !

La dll PrintScreen.dll contient 3 nouvelles fonctions qui forment un ensemble logique:

i% = dll_call0("LoadPicture")
Cette fonction initialise le système de modification d'image, en chargeant une image contenue déjà dans le presse-papier. La routine retourne 1 si erreur, 0 si OK.

i% = dll_call5("ModifyPicture",x%,y%,R%,G%,B%)
prend l'image contenue dans le presse-papier et la superpose à l'image chargée précédemment par LoadPicture. Elle sera insérée à partir de (x%,y%) en pixels, et la couleur R%,G%,B% est la couleur de transparence ! La routine retourne 1 si erreur, 0 si OK.

i% = dll_call0("SavePicture")
copie l'image interne modifie dans le presse-papier, et annule l'image interne.

Les routines doivent être appelées dans l'ordre. Il ne faut pas faire DLL_OFF entre LoadPicture et SavePicture. Plusieurs ModifiyPicture peuvent être appelées en rafale. Les images ajoutées par ModifyPicture doivent physiquement tenir dans l'image spécifiée par LoadPicture. Je corrigerai les dimensions excédentes prochainement.

Et voici une démo qui affiche un rond plein et un carré plein dans une photo à fournir (adapter le nom de l'image dans le source), en gérant des couleurs de transparence différentes. Il suffit de cliquer les boutons du bas, dans l'ordre de gauche à droite. Le clic sur lr bouton "Fin" visualisera le résultat dans l'image du hait, et on le trouve aussi dans le presse-papier.

Code:: ' Test_ModifyPicture.bas

label debut, cercle, rectangle, fin
dim i%

width 0,450 : height 0,750

picture 1 : top 1,10 : left 1,10 : width 1,400 : height 1,400
stretch_on 1 : file_load 1,"album1.jpg"

picture 11 : top 11,430 : left 11,10 : width 11,200 : height 11,200
color 11,127,0,0
picture 12 : top 12,430 : left 12,220 : width 12,200 : height 12,200
color 12,0,0,127

button 31 : top 31,650 : left 31,10 : caption 31,"Début"
on_click 31,debut
button 32 : top 32,650 : left 32,120 : caption 32,"Cercle"
on_click 32,cercle
button 33 : top 33,650 : left 33,230 : caption 33,"Rectangle"
on_click 33,rectangle
button 34 : top 34,650 : left 34,340 : caption 34,"Fin"
on_click 34,fin

2d_target_is 11 : 2d_pen_width 4 : 2d_fill_color 255,0,0
2d_circle 100,100,50
2d_target_is 12 : 2d_pen_width 4 : 2d_fill_color 0,0,255
2d_rectangle 50,50,150,150

end

debut:
dll_on "PrintScreen.dll"
clipboard_copy 1
i% = dll_call0("LoadPicture")
return

cercle:
clipboard_copy 11
i% = dll_call5("ModifyPicture",30,30,127,0,0)
return

rectangle:
clipboard_copy 12
i% = dll_call5("ModifyPicture",60,60,0,0,127)
return

fin:
i% = dll_call0("SavePicture")
clipboard_paste 1
dll_off
return

Voici le même programme avec une info-bulle construite par le programme, qui sera insérée dans l'image, avec une 3ème couleur transparente:

Code:: ' Test_ModifyPicture.bas

label debut, cercle, rectangle, bulle, fin
dim i%

width 0,660 : height 0,750

picture 1 : top 1,10 : left 1,10 : width 1,400 : height 1,400
stretch_on 1 : file_load 1,"album1.jpg"

picture 11 : top 11,430 : left 11,10 : width 11,200 : height 11,200
color 11,127,0,0
picture 12 : top 12,430 : left 12,220 : width 12,200 : height 12,200
color 12,0,0,127
picture 13 : top 13,430 : left 13,430 : width 13,200 : height 13,200
color 13,255,255,255

button 31 : top 31,650 : left 31,10 : caption 31,"Début"
on_click 31,debut
button 32 : top 32,650 : left 32,120 : caption 32,"Cercle"
on_click 32,cercle
button 33 : top 33,650 : left 33,230 : caption 33,"Rectangle"
on_click 33,rectangle
button 34 : top 34,650 : left 34,340 : caption 34,"Bulle"
on_click 34,Bulle
button 35 : top 35,650 : left 35,450 : caption 35,"Fin"
on_click 35,fin

2d_target_is 11 : 2d_pen_width 4 : 2d_fill_color 255,0,0
2d_circle 100,100,50

2d_target_is 12 : 2d_pen_width 4 : 2d_fill_color 0,0,255
2d_rectangle 50,50,150,150

2d_target_is 13 : 2d_pen_width 2
2d_fill_color 83,129,172 : 2d_pen_color 255,0,0
2d_circle 50,100,40 : 2d_circle 150,100,40
2d_pen_color 83,129,172 : 2d_rectangle 50,60,150,140
2d_pen_color 255,0,0 : 2d_poly_from 50,60 : 2d_poly_to 30,10
2d_poly_to 70,60 : 2d_poly_to 150,60 : 2d_flood 55,45,83,129,172
2d_poly_from 50,140 : 2d_poly_to 150,140
print_target_is 13 : print_locate 55,80
font_size 13,20 : print "Coucou"

end

debut:
dll_on "PrintScreen.dll"
clipboard_copy 1
i% = dll_call0("LoadPicture")
return

cercle:
clipboard_copy 11
i% = dll_call5("ModifyPicture",30,30,127,0,0)
return

rectangle:
clipboard_copy 12
i% = dll_call5("ModifyPicture",60,60,0,0,127)
return

bulle:
clipboard_copy 13
i% = dll_call5("ModifyPicture",150,220,255,255,255)
return

fin:
i% = dll_call0("SavePicture")
clipboard_paste 1
dll_off
return

Et voici le résultat, en cliquant sur les 5 boutons dans l'ordre, de gauche à droite:

Gestionnaire perso de plantes (ou d'autres types d'objets) A113

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Pas le temps d'essayer tout de suite, mais ça ça m'intéresse (plus que les plantes), Klaus c'est toi le meilleur... et le plus rapide !

JL35 a écrit:: Klaus c'est toi le meilleur... et le plus rapide !

JE CONFIRME

sunny

Bof, tu sais, les plantes... c'est mon hobby, avec mon épouse. Mais tu peux l'utiliser de la même manière pour gérer les DC/DVD, les bouteilles de vin, les livres dans ta bibliothèque, tes archives de logiciels... Tout ce qui peut se classer par catégories, avec une fiche descriptive individuelle et des photos.

Une petite note concernant l'incrustation des images: la couleur de transparence peut être prise directement dans l'image à incruster, en définissant, par convention, que le pixel du bas à gauche est la couleur de transparence. Cela donne ceci:

Code:: picture 10
... constituer l'image
R% = COLOR_PIXEL_RED(10,0,height(10)-1)
R% = COLOR_PIXEL_GREEN(10,0,height(10)-1)
R% = COLOR_PIXEL_BLUE(10,0,height(10)-1)
i%=DLL_CALL5("PictureModify",x%,y%,R%,G%,B%)

Merci Klaus, je test ce soir Wink

La dll PrintScreen.dll contient une nouvelle fonction:

i%=dll_call2("ResizePicture",w%,h%)

Elle redimensionne l'image dans le presse-papier à la largeur w% et hauteur h%, comme s'il y avait in STRETCH_ON sur le presse-papier

Cette fonction peut être utilisée, par exemple, après un appel à ScreenCopy pour redimensionner l'image, produire une vignette, etc. Et si l'on souhaite garder le même ratio, il suffit d'utiliser d'abord les fonctions GetClipboardPictureWidth et GetClipboardPictureHeight pour avoir les dimensions réelles, puis appliquer un prorata, de la manière suivante:

Code:: dim i%, w%, h%, f
picture 10
...
i% = dll_call1("PrintScreen",1) : ' produit l'image de l'écran actif dans le presse-papier
w% = dll_call0("GetClipboardPictureWidth") : ' prendre la largeur réelle
h% = dll_call0("GetClipboardPictureHeight") : ' prendre la hauteur réelle
' redimensionner en fonction de la largeur à 300 pixels
f = 300/w%
w% = 300
h% = h% * f
' ou en fonction de la hauteur à 250 pixels
f = 250/h%
h% = 250
w% = w%*f
i% = dll_call2("ResizePicture",w%,h%) : redimensionner l'image dans le presse-papier
clipboard_copy 10 : ' récupérer l'image dans un picture (ou image d'ailleurs)
file_save 10,"monimage.bmp"

Cette fonction peut aussi être utilisée pour pallier à un manque dans Panoramic. Actuellement, l'objet PICTURE permet d'afficher i=une image dans un espace dimensionné par les commandes WIDTH et HEIGHT. Mais soit l'image est affichée avec sa taille réelle, et est donc tronquée si elle dépasse, ou avec des zones blanches non utilise autour, soit elle est ajustée verticalement et horizontalement si la commande STRETCH_ON a été donnée pour le picture. Néanmoins, les dimensions d'origine restent mémorisées, et un FILE_SAVE restaurera l'image dans sa taille originale.

Avec la fonction ResizePicture, on peut changer la taille de l'image de façon effective. Et elle gardera la nouvelle taille lors de l'enregistrement sur disque.

Regarder ici pour une liste complète des fonctions de cette dll.

Génial Klaus Wink

Merci, bon je ne testerai pas tout de suite puisque je fais d'autres choses en ce moment mais c'est une fonction super pratique (ça évitera de passer par des programmes externes au profit d'une DLL)

Nouvelle version, adaptée à un écran plus peti( (1024 x 768 pixels). Egalement correction d'un bug en suppression d'une image de l'album.

Code:: ' MesPlantes.bas
'
' Application personnelle de gestion de plantes et fleurs

label labels : gosub labels
gosub constantes
gosub variables
gosub donnees
gosub form0
gosub menu
gosub GUI
gosub initialisations
end

labels:
label constantes, variables, donnees, form0, menu, GUI, initialisations
label sortie, fini
label cat_new, cat_ren, cat_del, cat_sel, cat_abandon, cat_valider, cat_save
label prod_new, prod_ren, prod_del, prod_sel, prod_abandon
label prod_valider, prod_save, imprimer
label aff_album, aff_photo, add_album, rem_album, raz_album
label file_name

return

constantes:
dim titre$ : titre$ = "Mes Graines, Fleurs et Plantes"
dim root$ : root$ = "C:\"
dim rep$ : rep$ = root$ + "MesPlantes\"
dim base$ : base$ = "MesPlantes.txt"
dim id$ : id$ = "** MesPlantes: Catégories"
dim id_cat$ : id_cat$ = "** Catégorie: "
dim id_prod$ : id_prod$ = "** Produit: "
dim maq$ : maq$ = "maquette.txt"
dim PrintScreen$ : PrintScreen$ = "PrintScreen.dll"
dim hdc$ : hdc$ = "HDC.jpg"
dim hdctxt$ : hdctxt$ = "hdc.ini"
dim hdcprint$ : hdcprint$ = rep$+"wtp.exe /file="+rep$+hdctxt$
dim form0_width% : form0_width% = 1024
dim form0_height% : form0_height% = 768
return

variables:
dim no%, no1%, no2%, no3%, i%, j%, n%, s$, s1$, s2$, d1$, d2$
dim file$, album$
dim no_work%, no_album%, no_picture%, no_photo%, album_file$
dim no_open%, no_print%
dim no_cat_list%, no_ask_cat%, no_cat_name%
dim sel_cat%, cat_mode%, cat_file$
dim no_prod_list%, no_ask_prod%, no_prod_name%, no_prod_text%
dim sel_prod%, prod_mode%, prod_file$

return

donnees:
return

form0:
width 0,form0_width%
height 0,form0_height%
caption 0,titre$
on_close 0,fini
return

menu:
no% = no% + 1 : main_menu no% : no1% = no%
' menu "Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Fichier"
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Catégories"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,cat_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,cat_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,cat_del
no% = no% + 1 : sub_menu no% : parent no%,no2% : no3% = no%
caption no%,"Produits"
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Créer" : on_click no%,prod_new
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Renommer" : on_click no%,prod_ren
no% = no% + 1 : sub_menu no% : parent no%,no3%
caption no%,"Supprimer" : on_click 0,prod_del

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Imprimer" : on_click no%,imprimer

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"-------"

no% = no% + 1 : sub_menu no% : parent no%,no2%
caption no%,"Sortie" : on_click no%,sortie

' menu "Outils"
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Outils"

' sortie du programme
no% = no% + 1 : sub_menu no% : parent no%,no1% : no2% = no%
caption no%,"Aide"

return

GUI:
no% = no% + 1 : image no% : no_print% = no%
no% = no% + 1 : dlist no% : no_work% = no%
no% = no% + 1 : open_dialog no% : no_open% = no%
filter no%,"Images|*.jpg;*.bmp" : dir_dialog no%,rep$

no% = no% + 1 : container no% : top no%,10 : left no%,10 : no1% = no%
width no%,200 : height no%,80 : caption no%,"Catégories"
no% = no% + 1 : combo no% : parent no%,no1% : no_cat_list% = no%
top no%,20 : left no%,20
width no%,170 : on_click no%,cat_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,cat_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,cat_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,cat_del

no% = no% + 1 : container no% : top no%,10 : left no%,220 : no1% = no%
width no%,200 : height no%,80 : caption no%,"Végétaux"
no% = no% + 1 : combo no% : parent no%,no1% : no_prod_list% = no%
top no%,20 : left no%,20
width no%,170 : on_click no%,prod_sel
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,10 : caption no%,"Créer"
width no%,50 : height no%,15 : on_click no%,prod_new
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,70 : caption no%,"Renommer"
width no%,60 : height no%,15 : on_click no%,prod_ren
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-25 : left no%,140 : caption no%,"Suppr."
width no%,50 : height no%,15 : on_click no%,prod_del

no% = no% + 1 : container no% : top no%,100 : left no%,10
width no%,410 : height no%,590 : caption no%,"Produit"
no% = no% + 1 : memo no% : parent no%,no%-1 : no_prod_text% = no%
top no%,20 : left no%,20 : bar_vertical no%
height no%,550 : width no%,380

no% = no% + 1 : container no% : top no%,10 : left no%,430 : no1% = no%
width no%,width(0)-450 : height no%,height(0)-250 : caption no%,"Photo"
no% = no% + 1 : picture no% : parent no%,no1% : no_photo% = no%
top no%,20 : left no%,10 : stretch_on no%
height no%,height(no1%)-30 : width no%,width(no1%)-20

no% = no% + 1 : container no% : top no%,height(0)-230 : left no%,430
width no%,width(0)-450 : height no%,height(0)-top(no%)-80 : no1% = no%
caption no%,"Album" : no_album% = no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,10 : height no%,height(no1%)-40 : width no%,130
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,150 : height no%,height(no1%)-40 : width no%,130
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,290 : height no%,height(no1%)-40 : width no%,130
stretch_on no%
no% = no% + 1 : picture no% : parent no%,no1% : on_click no%,aff_photo
top no%,20 : left no%,430 : height no%,height(no1%)-40 : width no%,130
stretch_on no%
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,10 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,110 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,150 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,250 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,290 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,390 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,440 : on_click no%,add_album
caption no%,"+" : width no%,30 : height no%,15
no% = no% + 1 : button no% : parent no%,no1%
top no%,height(no1%)-20 : left no%,530 : on_click no%,rem_album
caption no%,"-" : width no%,30 : height no%,15

' saisie du nom d'une catégorie
no% = no% + 1 : form no% : no1% = no% : no_ask_cat% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_cat_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,cat_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,cat_valider

' saisie du nom d'un produit
no% = no% + 1 : form no% : no1% = no% : no_ask_prod% = no% : hide no%
border_hide no% : top no%,100 : left no%,50 : width no%,250 : height no%,110
' color no%,255,0,0
no% = no% + 1 : container no% : parent no%,no1% : no2% = no%
width no%,width(no1%)
no% = no% + 1 : edit no% : parent no%,no2% : no_prod_name% = no%
top no%,30 : left no%,30 : width no%,200
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,30 : caption no%,"Abandon" : on_click no%,prod_abandon
no% = no% + 1 : button no% : parent no%,no2%
top no%,60 : left no%,150 : caption no%,"Valider" : on_click no%,prod_valider

return

initialisations:
dir_change root$
if dir_exists(rep$)=0 then dir_make rep$
if file_exists(rep$+base$)=0
file_open_write 1,rep$+base$
file_writeln 1,id$
file_close 1
end_if
if file_exists(rep$+maq$)=0
file_open_write 1,rep$+maq$
file_writeln 1,"** Maquette produit"
file_writeln 1,"Nom:"
file_writeln 1,""
file_writeln 1,"Exposition:"
file_writeln 1,"Terre:"
file_writeln 1,"Arrosage:"
file_writeln 1,"Semis/plantation:"
file_writeln 1,"Floraison:"
file_writeln 1,"Récolte:"
file_writeln 1,"Taille:"
file_writeln 1,""
file_writeln 1,"Prix:"
file_writeln 1,""
file_writeln 1,"Notes:"
file_close 1
end_if
if file_exists(rep$+hdctxt$)=0
file_open_write 1,rep$+hdctxt$
file_writeln 1,"<#image="+rep$+hdc$+",0,0,4300,6880#>"
file_close 1
end_if
file_load no_cat_list%,rep$+base$
item_add no_cat_list%,"****************"
if item_read$(no_cat_list%,1)<>id$
message "Le fichier "+rep$+base$+" n'est pas un fichier valide."
terminate
end_if
item_delete no_cat_list%,count(no_cat_list%)
item_delete no_cat_list%,1
return

sortie:
if message_confirmation_yes_no("Voulez-vous vraiment sortir du programme ?")=1
fini:
gosub cat_save
gosub prod_save
item_insert no_cat_list%,1,id$
file_save no_cat_list%,rep$+base$
terminate
end_if
return

cat_new:
caption no_ask_cat%+1,"Nom de la catégorie"
cat_mode% = 1
inactive 0
show no_ask_cat%
return

cat_ren:
if sel_cat%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment renommer cette catégorie ?")<>1 then return
message "Cette fonction n'est pas encore réalisée."
return
caption no_ask_cat%+1,"Nouveau nom de la catégorie"
cat_mode% = 2
show no_ask_cat%
return

cat_del:
if message_confirmation_yes_no("Voulez-vous vraiment supprimer cette catégorie ?")<>1 then return
if sel_cat%=0 then return
cat_mode% = 3
message "Cette fonction n'est pas encore réalisée."
return
' suppression à implémenter
return

cat_sel:
gosub prod_save
gosub cat_save
gosub raz_album
sel_cat% = item_index(no_cat_list%)
clear no_prod_list%
sel_prod% = 0
clear no_prod_text%
file$ = item_index$(no_cat_list%)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_load no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
return

cat_abandon:
active 0
hide no_ask_cat%
return

cat_valider:
active 0
select cat_mode%
case 1 : ' création d'une nouvelle catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
item_add no_cat_list%,s$
gosub cat_save
file$ = lower$(s$)
gosub file_name
cat_file$ = file$
file_open_write 1,rep$+cat_file$
file_writeln 1,id_cat$+s$
file_close 1
sel_prod% = 0
clear no_prod_list%
sel_cat% = count(no_cat_list%)
case 2 : ' renommer une catégorie
s$ = trim$(text$(no_cat_name%))
if s$=""
message "Le nouveau nom de la catégorie manque."
hide no_ask_cat%
return
end_if
if count(no_cat_list%)>0
for i%=1 to count(no_cat_list%)
if lower$(item_read$(no_cat_list%,i%))=lower$(s$)
message "Cette catégorie existe déjà."
hide no_ask_cat%
return
end_if
next i%
end_if
s1$ = item_index$(no_cat_list%)
item_delete no_cat_list%,sel_cat%
item_insert no_cat_list%,sel_cat%,s$
file$ = lower$(s1$)
gosub file_name
s2$ = album$
s1$ = file$
file$ = lower$(s$)
gosub file_name
album_file$ = album$
cat_file$ = file$
file_rename rep$+s1$,rep$+cat_file$
clear no_work%
file_load no_work%,rep$+cat_file$
item_delete no_work%,1
item_insert no_work%,1,id_cat$+s$
file_save no_work%,rep$+cat_file$
end_select
hide no_ask_cat%
return

cat_save:
if sel_cat%>0
item_insert no_prod_list%,1,id_cat$+item_read$(no_cat_list%, sel_cat%)
file_save no_prod_list%,rep$+cat_file$
item_delete no_prod_list%,1
end_if
return

file_name:
i% = instr(file$," ")
while i%>0
file$ = left$(file$,i%-1)+"_"+mid$(file$,i%+1,len(file$))
i% = instr(file$," ")
end_while
album$ = file$
file$ = file$ + ".txt"
return

prod_sel:
gosub prod_save
gosub raz_album
sel_prod% = item_index(no_prod_list%)
file$ = item_index$(no_prod_list%)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
gosub aff_album
return

prod_new:
caption no_ask_prod%+1,"Nom du produit"
prod_mode% = 1
inactive 0
show no_ask_prod%
return

prod_ren:
if sel_prod%=0 then return
caption no_ask_prod%+1,"Nouveau nom de produit"
prod_mode% = 2
inactive 0
show no_ask_prod%
return

prod_del:
if sel_prod%=0 then return
if message_confirmation_yes_no("Voulez-vous vraiment supprimer ce produit ?")<>1 then return
prod_mode% = 3
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file_delete rep$+file$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+album$+file$+".jpg")=1
file_delete rep$+album$+file$+".jpg"
end_if
if file_exists(rep$+album$+file$+".bmp")=1
file_delete rep$+album$+file$+".bmp"
end_if
next i%
dir_remove rep$+album$
gosub raz_album
sel_prod% = 0
return

prod_abandon:
active 0
hide no_ask_prod%
return

prod_valider:
active 0
select prod_mode%
case 1 : ' création d'un nouveau produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nom du produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
item_add no_prod_list%,s$
gosub prod_save
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
album_file$ = album$
file_load no_prod_text%,rep$+maq$
item_delete no_prod_text%,1
item_insert no_prod_text%,1,id_prod$+s$
file_save no_prod_text%,file_prod$
item_delete no_prod_text%,1
sel_prod% = count(no_prod_list%)
dir_make rep$+album_file$
case 2 : ' renommer un produit
s$ = trim$(text$(no_prod_name%))
if s$=""
message "Le nouveau nom de produit manque."
hide no_ask_prod%
return
end_if
if count(no_prod_list%)>0
for i%=1 to count(no_prod_list%)
if lower$(item_read$(no_prod_list%,i%))=lower$(s$)
message "Ce produit existe déjà."
hide no_ask_prod%
return
end_if
next i%
end_if
s1$ = item_index$(no_prod_list%)
item_delete no_prod_list%,sel_prod%
item_insert no_prod_list%,sel_prod%,s$
file$ = lower$(s1$)
gosub file_name
s1$ = file$
d1$ = album$
file$ = lower$(s$)
gosub file_name
prod_file$ = file$
d2$ = album$
album_file$ = album$
file_rename rep$+s1$,rep$+prod_file$
clear no_work%
file_load no_work%,rep$+prod_file$
item_delete no_work%,1
item_insert no_work%,1,id_prod$+s$
file_save no_work%,rep$+prod_file$
dir_make rep$+d2$
for i%=1 to 4
file$ = "\Album"+str$(i%)
if file_exists(rep$+d1$+file$+".jpg")=1
file_copy rep$+d1$+file$+".jpg",rep$+d2$+file$+".jpg"
file_delete rep$+d1$+file$+".jpg"
end_if
if file_exists(rep$+d1$+file$+".bmp")=1
file_copy rep$+d1$+file$+".bmp",rep$+d2$+file$+".bmp"
file_delete rep$+d1$+file$+".bmp"
end_if
next i%
dir_remove rep$+d1$
end_select
hide no_ask_prod%
return

prod_save:
if sel_prod%>0
item_insert no_prod_text%,1,id_prod$+item_read$(no_prod_list%,sel_prod%)
file_save no_prod_text%,rep$+prod_file$
item_delete no_prod_text%,1
end_if
return

aff_photo:
i% = number_click - no_album%
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".jpg"
else
file_load no_photo%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
return

aff_album:
if dir_exists(rep$+album_file$)=0
dir_make rep$+album_file$
return
end_if
for i%=1 to 4
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".jpg"
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+".bmp"
end_if
next i%
return

add_album:
if sel_prod%>0
i% = ((number_click - no_album% - 4)+1)/2
file$ = file_name$(no_open%)
if file$="_" then return
s2$ = right$(file$,4)
if file_exists(rep$+album_file$+"\album"+str$(i%)+s2$)=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
file_copy file$,rep$+album_file$+"\album"+str$(i%)+s2$
file_load no_album%+i%,rep$+album_file$+"\album"+str$(i%)+s2$
end_if
return

rem_album:
if sel_prod%>0
i% = ((number_click - no_album% - 5)+1)/2
if file_exists(rep$+album_file$+"\album"+str$(i%)+".jpg")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
if file_exists(rep$+album_file$+"\album"+str$(i%)+".bmp")=1
file_delete rep$+album_file$+"\album"+str$(i%)+s2$
end_if
delete no_album% + i%
picture no_album% + i% : parent no_album% + i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no_album% + i%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
end_if
return

raz_album:
if sel_prod%>0
for i%=1 to 4
delete no_album% + i%
picture no_album% + i% : parent no_album%+i%,no_album%
on_click no_album% + i%,aff_album : stretch_on no_album%+i%
top no_album% + i%,20 : left no_album% + i%,10+(i%-1)*150
height no_album% + i%,height(no_album%)-40 : width no_album% + i%,140
next i%
delete no_photo%
picture no_photo% : parent no_photo%,no_photo%-1
top no_photo%,20 : left no_photo%,10
height no_photo%,height(no_photo%-1)-30 : width no_photo%,width(no_photo%-1)-20
end_if
return

imprimer:
if file_exists(rep$+PrintScreen$)=0
message "Le fichier "+rep$+PrintScreen$+" manque."
return
end_if
pause 300
dll_on rep$+PrintScreen$
i% = dll_call1("ScreenCopy",1)
delete no_print%
image no_print%
i% = dll_call0("Rotate90")
clipboard_paste no_print%
if file_exists(rep$+hdc$)=1 then file_delete rep$+hdc$
pause 300
file_save no_print%,rep$+hdc$
file_load no_print%,rep$+hdc$
pause 300
execute hdcprint$
dll_off
return

Pour faire suite au post de Nardo, je dirais qu'il y a un petit test qui serait bien avant de chercher à créer un répertoire qui consisterait à vérifier que le répertoire de base existe et de proposer de le créer s'il n'existe pas et mettre à jour les variables en conséquence bien entendu

Quel post de Nardo ? Pas dans ce fil de discussion, en tout cas.

Ce programme de gestionnaire correspond à un besoin personnel, et je l'ai juste mis à disposition à titre d'exemple de programmation. Pour moi, la localisation dans c:\MesPlantes\ me convient parfaitement, et j'ai placé l'exécutable dans ce dossier, ainsi que tous les fichiers techniques annexes, tels que PrintScreen.dll, WTP.exe, maquette.txt et essai.xxx. Tous les fichiers se créent dans ce répertoire, ainsi que les sous-répertoires pour les albums des produits.

Maintenant, si cela ne convient pas, il suffit de changer la variable rep$ dans le sous-programme constantes. C'est simple. Mais je n'ai pas prévu ici un fichier de configuration (où le placer ?) qui contiendrait le nom du répertoire cible. Libre à tous d'intégrer cela, comme adaptation personnelle.

Bonjour à tous !
Je pense que Jicehel c'est trompé de post cf.-> https://panoramic.1fr1.net/t2315p30-quelques-lignes-de-code-plus-tard#22134

Il est très bien comme il est ton prog Klaus ! Je pense d'ailleurs l'utiliser pour mes poissons !
De toute manière cette histoire de répertoire est un problème récurrent sous Panoramic et DIR_CURRENT$ ne fonctionne pas correctement lorsque l'on lance l'applic à partir de l'éditeur...

Gestionnaire perso de plantes (ou d'autres types d'objets) 07

Oui Klaus, ton programme est très bien, mais c'est juste pour le blinder par rapport à l'utilisateur mais bien sûr on peut l'adapter directement dans le source. En fait c'est vraiment un choix à faire soit de blinder le programme de protections divers soit on fait un programme pour nous avec les fonctionnalités et moins de protections Wink

» Guide des plantes
» 2.02 du 5/3/2013: types de données "entiers" 8 et 16 bits
» FRANCAIS : Apprendre les différents types d'adjectifs
» Lancement de ma page perso
» un gestionnaire banquaire