D.I.C version Sub

Sujet: D.I.C version Sub Mar 18 Sep 2012 - 5:26

Voilà, j'ai remis mon petit outils au goût du jour ! Laughing

Il transforme un *.bmp ou *.jpg en fichier Data *.bas
Dans cette version on peut faire un fichier de plusieurs images
ou un fichier par image.
Les *.jpg sont transformés en *.bmp
On peut copier le code dans le memo pour le coller directement
dans un source.

Il fonctionne avec KGF.dll

Testez le ! mais ne choisissez pas un 1200x800 car même
si il est rapide, il vous faudra prévoir soit une bonne cafetière
soit d'aller tondre la pelouse Laughing

Edit : Spéciale Nardo26, N'oublies pas de forcer l'éditeur pour le dossier source ! Wink

Code:: Dim x%,M%,Lang$,def$(200),D$,DO$
Dim f$,L%,H%
Label Clic,Supprimer

F0()
Menu()
Objets()
Init()
end
' ------------------------------------------------------------------------------
Sub F0()
' taille et placement du Form 0
width 0,680:height 0,460 :top 0,(screen_y-460)/2:left 0,(screen_x-680)/2
' Ecriture dans le form 0
Font_name 0,"Times new roman":Font_Size 0,10:Font_Color 0,100,20,10
Caption 0,"Data Image *.bas Creator vs 1.0"
End_Sub
' ------------------------------------------------------------------------------
Sub Menu()
Main_Menu 1
For x%=2 To 15:Sub_Menu x% :On_Click x%,Clic :Next x%
For x%=2 To 6 :Parent x%,1:Next x%
For x%=7 To 8 :Parent x%,2:Next x%
For x%=9 To 10 :Parent x%,3:Next x%
For x%=11 To 12:Parent x%,9:Next x%
For x%=13 to 15:Parent x%,4:Next x%
End_Sub
' ------------------------------------------------------------------------------
Sub Objets()
Dim_Local x%
For x%=101 To 105:Alpha x% :Next x%
Top 101,15 :Left 101,10
Top 102,200:Left 102,30:Font_Color 102,0,0,255
Top 103,230:Left 103,10
Top 104,15 :Left 104,200
Top 105,65 :Left 105,200
List 106
Top 106,30 :Left 106,10 :Width 106,180 :Height 106,170 :Cursor_Point 106
Font_Color 106,0,0,0:On_Double_Click 106,Supprimer
Picture 107:Stretch_On 107
Top 107,245:Left 107,10 :Width 107,180 :height 107,150 :Color 107,240,240,240
Edit 108
Top 108,30 :Left 108,200:Width 108,450
Font_Color 108,0,0,0
Memo 109
Top 109,80 :Left 109,200:Width 109,450 :Height 109,315 :Bar_Both 109
Font_Color 109,0,0,0
Dlist 110
Dlist 111
Image 112
End_Sub
' ------------------------------------------------------------------------------
Sub Init()
Init_Dossier()
If Lang$="" Then Lang$="Français"
Init_Langue(Lang$)
End_Sub
' ------------------------------------------------------------------------------
Sub Init_Dossier()
D$=Dir_Current$
If Dir_Exists(D$+"\Output")=0 Then Dir_Make D$+"\Output"
DO$=D$+"\Output"
End_Sub
' ------------------------------------------------------------------------------
Sub Init_Langue(Lang$)
Dim_Local x%,s$,Lang$
Lang$=Lang$
Restore
Read s$
While s$<>Lang$
Read s$
End_While
def$(1)=s$
For x%=2 to 20 :Read def$(x%):Next x%
Init_Caption()
End_Sub
' ------------------------------------------------------------------------------
Sub Init_Caption()
Dim_Local x%
For x%=2 To 15 :Caption x%,def$(x%):Next x%
For x%=101 To 105:Caption x%,def$(x%-85):Next x%
End_Sub
' ------------------------------------------------------------------------------
Clic:
For x%=2 To 15
If Clicked(x%)=1 Then M%=x%
Next x%
Select M%
Case 2 :' Fichier
Case 3 :' Edit
Case 4 :' Langue

Case 5 :' A Propos...
APp()
Case 6 :' Aide
Aide()
Case 7 :' Ajouter (2)
Ajouter()
Case 8 :' Quitter (2)
Quitter()
Case 9 :' Convertir (3)
Case 10:' Copier (3)
Copie()
Case 11:' Fichier/Fichier (9)
inactive 10:inactive 7
Convert_Fichier()
Case 12:' Liste (9)
inactive 10:inactive 7
Convert_Liste()
Case 13:' Francais
Lang$="Français"
Init_Langue(Lang$)
Case 14:' Anglais
Lang$="Anglais"
Init_Langue(Lang$)
Case 15:' Allemand
Lang$="Allemand"
Init_Langue(Lang$)
End_Select
Return
' ------------------------------------------------------------------------------
Sub Ajouter()
Dim_Local File$
Open_dialog 1000
Filter 1000,"*.bmp;*.jpg|*.bmp;*.jpg"
File$=File_name$(1000)
Delete 1000
if count(106)=0
Clear 109
Text 108,""
2d_target_is 107
cls
color 107,240,240,240
end_if
Item_Add 110,File$
Item_Add 106,File_Extract_Name$(File$)
End_Sub
' ------------------------------------------------------------------------------
Supprimer:
dim Item%
Item%=Item_Index(106)
If count(106)>0
Item_Delete 106,Item%
Item_Delete 110,Item%
End_If
Free Item%
Return
' ------------------------------------------------------------------------------
Sub Copie()
Dim_Local res%,hnd%
hnd%=Handle(109)
If Count(109)>0
Dll_On D$+"\KGF.dll"
res% =dll_call1("ClipboardCopy",hnd%)
Dll_Off
End_if
End_Sub
' ------------------------------------------------------------------------------
Sub Convert_Liste()
File_Open_Write 1001,DO$+"\Include_Image.bas"
Text 108,"Include_Image.bas"
While Count(106)>0
F1002()
Get_Size(Item_Read$(110,1))
stretch_on 107
Appercu(Item_read$(110,1),L%,H%)
Ecriture()
End_While
File_Close 1001
Clear 106
Command_Target_is 0
active 10:active 7
If Object_Exists(1002)=1 Then Delete 1002
End_Sub
' ------------------------------------------------------------------------------
Sub Convert_Fichier()
Dim_Local n$
while count(106)>0
n$=Item_read$(106,1)
File_Open_Write 1001,DO$+"\"+Left$(n$,len(n$)-4)+".bas"
Text 108,Left$(n$,len(n$)-4)+".bas"
F1002()
Get_Size(item_read$(110,1))
stretch_on 107
Appercu(Item_read$(110,1),L%,H%)
Ecriture()
file_close 1001
end_while
command_target_is 0
active 10:active 7
if object_exists(1002)=1 then delete 1002
End_Sub
' ------------------------------------------------------------------------------
Sub Appercu(I$,L%,H%)
Dim_Local x%,y%,z
x%=L% :y%=H% :z=1
if x%>y%
while x%>180 or y%>150
z=z-0.01
x%=x%*z
y%=y%*z
end_while
else
while y%>150 or x%>180
z=z-0.01
x%=x%*z
y%=y%*z
end_while
end_if
width 107,x% : height 107,y%
File_load 107,I$
End_Sub
' ------------------------------------------------------------------------------
Sub F1002()
' création du form invible de travail
If Object_Exists(1002)=0
Form 1002:Hide 1002:Command_Target_Is 1002
Picture 1003
end_if
' placement de l'image chargé dans le picture 101
file_load 1003,item_read$(110,1)
End_Sub
' ------------------------------------------------------------------------------
Sub Get_Size(a$)
Dim_Local res%
f$=a$
dll_on D$+"\KGF.dll"
res%=dll_call3("AnalyzeImageFile",adr(f$),adr(L%),adr(H%))
if res%=1
message "Extension de fichier invalide !"
end_if
dll_off
End_Sub
' ------------------------------------------------------------------------------
Sub Ecriture()
Dim_Local nom$,x%,y%,R%,G%,B%
' Ecriture des données
nom$=file_extract_name$(item_read$(110,1))
nom$=LEFT$(nom$,len(nom$)-3)+"bmp"
file_writeln 1001,"Data "+chr$(34)+nom$+chr$(34)+","+str$(H%)+","+str$(L%)
item_add 109,"Data "+chr$(34)+nom$+chr$(34)+","+str$(H%)+","+str$(L%)
for x%=0 to L% -1
for y%= 0 to H% -1
R% =color_pixel_red(1003,x%,y%)
G% =color_pixel_green(1003,x%,y%)
B% =color_pixel_blue(1003,x%,y%)
file_writeln 1001,"data "+str$(R%)+","+str$(G%)+","+str$(B%)
item_add 109,"data "+str$(R%)+","+str$(G%)+","+str$(B%)
Display
next y%
next x%
item_delete 106,1
item_delete 110,1
End_Sub
' ------------------------------------------------------------------------------
Sub APp()
Message "Data Image *.bas Creator vs 1.0"+chr$(13)+"Créé par YGERONIMI"+chr$(13)+"Avec PANORAMIC EDITOR 0.9.24 i2"
End_Sub
' ------------------------------------------------------------------------------
Sub Aide()
Message "En Cours"
End_Sub
' ------------------------------------------------------------------------------
Sub Quitter()
Terminate
End_Sub
' ------------------------------------------------------------------------------
' DATA LANGUE : FRANCAIS
' ------------------------------------------------------------------------------
Data "Français"
Data "Fichier"
Data "Edit"
Data "Langue"
Data "A Propos..."
Data "Aide"
Data "Ajouter"
Data "Quitter"
Data "Convertir"
Data "Copier"
Data "Fichier/Fichier"
Data "Liste"
Data "- Français"
Data "- Anglais"
Data "- Allemand"
Data "Liste des images :"
Data "Double Clic pour effacer"
Data "Apperçu :"
Data "Fichier en cours de convertion :"
Data "Fichier Data :"
' ------------------------------------------------------------------------------
' DATA LANGUE : ANGLAIS
' ------------------------------------------------------------------------------
Data "Anglais"
Data "File"
Data "Edit"
Data "Language"
Data "About ..."
Data "Help"
Data "Add"
Data "Exit"
Data "Convert"
Data "Copy"
Data "File / File"
Data "List"
Data "- French"
Data "- English"
Data "- German"
Data "Image List"
Data "Double-click to delete"
Data "preview"
Data "file during convertion"
Data "Data File"
' ------------------------------------------------------------------------------
' DATA LANGUE : ALLEMAND
' ------------------------------------------------------------------------------
Data "Allemand"
Data "Dateï"
Data "Ausgabe"
Data "Sprache"
Data "Über ..."
Data "Die Beihilfen"
Data "Hinzufügen"
Data "Verlassen"
Data "konvertieren"
Data "kopieren"
Data "Dateï / Datei"
Data "Liste"
Data "- Französisch"
Data "- Englisch"
Data "- Deutsch"
Data "Liste der Bilder"
Data "Doppel-Klick zu löschen"
Data "Vorschau"
Data "Datei während der Konvertierung"
Data "Datendatei"

Bon maintenant Sleep

Sujet: Re: D.I.C version Sub Mar 18 Sep 2012 - 22:30

Dans un autre endroit, Ygeronimi m'a posé une question:

Citation :: As tu essayé ma dernière version nocturne de D.I.C avec des "sub" ?

La réponse est OUI.
J’ai chargé une image et le DIC (je souris déjà parce que « dic » en arabe veut dire «coq») commence à faire son travail : Dans la zone appropriée les lignes DATA commencent à défiler.
Je me suis dis c’est bon signe !
Mais les DATA défilaient, ... défilaient ... défilaient ....
Je me suis dis : on est entré dans une boucle infinie ou quoi ?
La tentation de mettre fin à ces DATA qui défilaient, ... défilaient,... défilaient, se fait pressante et je me suis dis : tiens, va faire comme Ygeronimi : préparer une cafetière.
Au retour, sur l’écran les DATA continuent à défiler,....défiler, ... défiler.
Ben, ces DATA attendent que je vide la cafetière ou quoi ?
Après avoir ingurgité le contenu de la cafetière, les DATA se sont arrêtées.
Heureusement que je ne fume plus, sinon j’aurais consommé la moitié du paquet !

J’ai vérifié : mon fichier s’est créé avec ... 34060 lignes DATA! ( qui dit mieux?)
Je m’en suis réjoui et, tout seul j’ai éclaté de rire en imaginant la tête d’ygeronimi s’il devrait taper toutes ces lignes au clavier pour en faire un programme !

Mon image d’origine « pèse » 87 KO, son fichier .bas correspondant pèse 5712 KO : c’est vrai que l’image en question représente 5 éléphants : c’est du poids super lourd !

Assez de plaisanterie maintenant :

Like a Star @ heaven

Comme idée c’est bien. On peut se passer de trimballer des fichiers externes avec un programme qui utilise des images.
Mais quand le nombre d’images est élevé, le programme finit d’être de poids super lourd pour entrer dans la catégorie des poids hyper lourds !

Like a Star @ heaven

Comme programme, c'est structuré; c'est bien.

Mais pourquoi ce soupçon de paresse de ne pas terminer de coder ‘L’Aide’ ?

lol!

Sujet: Re Mer 19 Sep 2012 - 13:07

@ papydall,

Je vous avez prévenu pour le temps d'exécution
si les images sont trop grande... Laughing

Dans le premier coq...heu... D.I.C je plaçais une procédure de
restitution de l'image dans un dossier.J'ai abandonné,
lâchement je l'avoue, cette procédure car chacun a sa propre
manière de récupérer des DATA et pas tout le monde veut
recréer le fichier d' origine.

Ensuite, je me suis dit que parfois on ne veut pas d'un fichier
*.bas à placer en #include mais placer directement les DATA
dans le source principal. J' ai donc piqué la fonction de KGF.dll
"ClipboardCopy" pour copier le contenu du fichier rendu visible
par un memo et pouvoir le coller dans le source même si
le fichier *.bas est créé dans un dossier "Output".

Puis, j' ai repris la possibilité de pouvoir créer un fichier de plusieurs
images " include_Image.bas" et celle de plusieurs fichiers séparés
portant chacun le nom de leur image respective avec l'extension *.bas .

Pour le temps de conversion, il est rallongé par l'affichage dans le "mémo"
et le "display" nécessaire pour ne pas avoir un curseur qui tourne en rond (W7)
ou le sablier peut être (XP) avec un affichage figé de l'avancée dans le "mémo".

Pour le nombre de ligne [Nbre de ligne = (LxH)+2 )] .
Il peut être réduit par la méthode de Nardo26.
Personnellement je laisse tel que pour pouvoir me retrouver dans les pixels.

Bon, c'est l'heure du Miam ! Laughing

Sujet: re Mer 19 Sep 2012 - 13:27

(...Le Miam est passé Laughing

)

Pour la paresse à faire une aide, je suis encore en réflexion
sur le comment. scratch

» Que signifient version "régulière" et version "instantanée"
» Version Mac
» Version instantanée V 0.9.29i3 du 30/10/2018
» PANORAMIC V0.9.13b
» version instantanée V 0.9.28i16 du 21/03/2018