FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Simuler l’appui de n’importe quelle touche.
par papydall Hier à 23:54

» Le Forum est en vacances.
par JL35 Hier à 21:20

» Une autre façon de terminer une application.
par JL35 Mar 22 Aoû 2017 - 14:27

» Compilateur FBPano
par Mike Lun 21 Aoû 2017 - 23:17

» Pb 20 (en analyse): plantage à l'appel d'un SUB
par Jack Lun 21 Aoû 2017 - 21:58

» Pb 19 (en analyse): libellé d'erreur dans des IF imbriqués
par Jack Lun 21 Aoû 2017 - 21:55

» Copier / coller du texte à partir de la fenêtre de commandes
par jean_debord Lun 21 Aoû 2017 - 9:46

» COMPILATEUR V 0.9 beta 8 du 18 aout 2017
par papydall Lun 21 Aoû 2017 - 5:01

» Mettre en windows en veille
par papydall Lun 21 Aoû 2017 - 4:15

» Stretch_on ne stretch plus...
par papydall Dim 20 Aoû 2017 - 15:22

» Pb 18 (en analyse): RESTORE_LABEL avec DATA à la fin
par Jack Dim 20 Aoû 2017 - 13:21

» Problème de traitement des opérateurs avec le compilateur.
par Pedro Alvarez Sam 19 Aoû 2017 - 20:01

» Pb 17 (résolu): ITEM_SELECT ne fonctionne pas
par Jack Jeu 17 Aoû 2017 - 19:26

» un nouveau editeur panobasic
par Jean Claude Jeu 17 Aoû 2017 - 10:18

» Le compilateur.
par Pedro Alvarez Jeu 17 Aoû 2017 - 8:36

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Août 2017
LunMarMerJeuVenSamDim
 123456
78910111213
14151617181920
21222324252627
28293031   
CalendrierCalendrier

Partagez | 
 

 D.I.C version Sub

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Yannick

avatar

Nombre de messages : 7975
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: D.I.C version Sub   Mar 18 Sep 2012 - 6: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 Laughing 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 Sleep Sleep
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5523
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: D.I.C version Sub   Mar 18 Sep 2012 - 23: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 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 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! lol! lol! lol! lol! lol! lol! lol! lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Yannick

avatar

Nombre de messages : 7975
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: Re   Mer 19 Sep 2012 - 14: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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

Nombre de messages : 7975
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Mer 19 Sep 2012 - 14:27

(...Le Miam est passé Laughing )

Pour la paresse à faire une aide, je suis encore en réflexion
sur le comment. scratch
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: D.I.C version Sub   

Revenir en haut Aller en bas
 
D.I.C version Sub
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Offre promotionnelle : SnagIT 7.25 en version gratuite !
» Comment envoyer une détection chez avira avec Antivir 9 français - Version Classic
» Offre exceptionnelle : True Image 10 en version gratuite et complète
» [Résolu] Pb pour la désinstallation d'Antivir version Anglaise
» [Résolu] Dernière version d'Avast

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC 32 bits :: Vos sources, vos utilitaires à partager-
Sauter vers: