petit souci de list

Dim Vs$ : Vs$="1.0"
' Constantes -------------------------------------------------------------------
Dim D$,DO$,Kgf$
' Variables Globales -----------------------------------------------------------
Dim Cle$,Valeur$,Donnee$,Pay$,User$,def$(100)
Dim x%,M%,M1%
Dim Pict$,Larg%,Haut%
' Labels -----------------------------------------------------------------------
Label Clic,Clic2,D_Clic
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Init_Constantes()
Init_User()
Init_Dossiers()
Init_F0(500,350,0,0)
Init_Menu()
Init_Objets()
Init_Caption()
end
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Procédure d' initialisation des constantes
' ------------------------------------------------------------------------------
Sub Init_Constantes()
  D$=Dir_Current$
  Kgf$=D$+"\KGF.dll"
  DO$=D$+"\Output"
End_Sub
' ------------------------------------------------------------------------------
' Procédure d'initialisation de l'utilisateur
' ------------------------------------------------------------------------------
Sub Init_User()
  Dim_Local res%,sep%,T$
  Dll_On Kgf$
  Cle$="Control Panel\International"
  Valeur$="sCountry"
  res%=Dll_Call4("ReadRegistryKey",3,Adr(Cle$),Adr(Valeur$),Adr(Donnee$))
  If res%>0 Then Message "Erreur  -  Clé de Registre Invalide"
  Pay$=trim$(Donnee$)
  Dll_Off
  T$=Dir_Current$
  sep%=instr(T$,"\")
  T$=Right$(T$,Len(T$)-sep%)
  sep%=instr(T$,"\")
  T$=Right$(T$,Len(T$)-sep%)
  sep%=instr(T$,"\")
  User$=Left$(T$,sep%-1)
  Init_Langue(Pay$)
End_Sub
' ------------------------------------------------------------------------------
' Procédure d' initialisation de la langue
' ------------------------------------------------------------------------------
Sub Init_Langue(Pay$)
  Dim_Local x%
  If Pay$<>"France" and Pay$<>"England" and Pay$<>"Deutschland"
      Pay$="France"
  End_If
  Restore
  Read def$(1)
  While def$(1)<>Pay$
      Read def$(1)
  End_While
  For x%=2 To 20 :Read def$(x%) :Next x%
End_Sub
' ------------------------------------------------------------------------------
' Procédure de création des sous dossiers
' ------------------------------------------------------------------------------
Sub Init_Dossiers()
  If Dir_Exists(D$+"\Output")=0 Then Dir_Make D$+"\Output"
End_Sub
' ------------------------------------------------------------------------------
' Procédure d' initialisation du form 0
' ------------------------------------------------------------------------------
Sub Init_F0(W%,H%,T%,L%)
  Width 0,W% :Height 0,H%
  If T%=0 and L%=0
      Top 0,(Screen_y-H%)/2:Left 0,(Screen_x-W%)/2
  Else
      If T%>0 and L%>0
        Top 0,T% :Left 0,L%
      Else
        If L%>0
            Top 0,(Screen_y-H%)/2:Left 0,L%
        Else
            Top 0,T% :Left 0,(Screen_x-W%)/2
        End_If
      End_If
  End_If
  Font_Name 0,"Times new roman" :Font_Size 0,10
  Caption 0,"Picture Tools  Vs: "+Vs$
End_Sub
' ------------------------------------------------------------------------------
' Procédure de création du Main_Menu
' ------------------------------------------------------------------------------
Sub Init_Menu()
  Dim_Local x%
  Main_Menu 1
  For x%=2 To 8:Sub_Menu x% :On_Click x%,Clic :Next x%
  For x%=2 To 5:Parent x%,1 :Next x%
  For x%=6 To 8:Parent x%,2 :Next x%
  For x%=9 To 11:Sub_Menu x% :Parent x%,3:on_click x%,Clic :Next x%
End_Sub
' ------------------------------------------------------------------------------
' Procédure d' initialisation des objets du form 0
' ------------------------------------------------------------------------------
Sub Init_Objets()
  Dim_Local x%
  Container 100:Hide 100:top 100,10:left 100,5:Width 100,474 :height 100,275
  Font_Name 100,"Times new roman" : Font_Size 100,10 :Font_Color 100,120,20,10
  For x%=101 To 103:Alpha x% :Parent x%,100:Next x%
  Top 101,25 : Left 101,13
  Top 102,245: Left 102,33:Font_Color 102,0,0,255
  Top 103,25 : Left 103,200
  List 104 :Parent 104,100:Top 104,43  :Left 104,13 :width 104,180:Height 104,200
  Font_Color 104,160,0,255
  Edit 105 :Parent 105,100:Top 105,43  :Left 105,200:Width 105,260
  Picture 106:Parent 106,100:Top 106,70:Left 106,200:Width 106,260:Height 106,170:color 106,220,220,220
  Stretch_On 106
  Button 107:Parent 107,100:Top 107,25:Left 107,120:Width 107,15  :Height 107,15
  Caption 107,"+":Font_Bold 107 :Cursor_Point 107
  Button 108:Parent 108,100:Top 108,245:Left 108,200:Cursor_Point 108
  Button 109:parent 109,100:Top 109,245:Left 109,280:Cursor_Point 109:Width 109,85
  Button 110:Parent 110,100:Top 110,245:Left 110,370:Cursor_Point 110:Width 110,85
  On_click 104,Clic2
  On_Double_Click 104,D_Clic
  For x%=107 To 110:On_click x%,Clic :Next x%
  dlist 120 : dlist 121
'                          ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
  Container 200:Hide 200:top 200,10:left 200,5:Width 200,474 :height 200,275
 
End_Sub
' ------------------------------------------------------------------------------
' Procédure d'intialisation des caption
' ------------------------------------------------------------------------------
Sub Init_Caption()
  Dim_Local x%
  For x%=2 to 11 :caption x%,def$(x%) :Next x%
  caption 100,chr$(32)+chr$(32)+def$(6)+chr$(32)+chr$(32)
  caption 101,def$(12)
  caption 102,def$(13)
  caption 103,def$(14)
  For x%=108 To 110 : Caption x%, def$(x%-93):Next x%
  For x%=108 To 110 : Hint x%,def$(x%-90):Next x%
End_Sub
' ------------------------------------------------------------------------------
' Routage des procédures par Clic & Double Clic
' ------------------------------------------------------------------------------
Clic:
  For x%=2 to 11
      If Clicked(x%)=1 Then M%=x%
  Next x%
  For x%=107 To 110
      If Clicked(x%)=1 Then M1%=x%
  Next x%
 
  Select M%
  Case 2
  Case 3
  Case 4 : About()
  Case 5 : Help()
  Case 6 : Show 100 :Hide 200
  Case 7 : Show 200 :Hide 100:Coloramic()
  Case 8 : Close0()
  Case 9 : Pay$="France"    :Init_Langue(Pay$):Init_Caption()
  Case 10: Pay$="England"    :Init_Langue(Pay$):Init_Caption()
  Case 11: Pay$="Deutschland":Init_Langue(Pay$):Init_Caption()
  End_Select
  ' Menu des boutons du container 100 -----------------------------------------
  Select M1%
  case 107: Ajout_Img()
  case 108: CopyToPP()
  case 109: DIC()
  case 110: DIC()
  End_Select
Return
' ------------------------------------------------------------------------------
Clic2:
  Dim I%,I$
  I%=Item_index(104)
  I$=item_read$(120,I%)
  Preview(I%,I$)
  Free I% :Free I$
return
' ------------------------------------------------------------------------------
D_Clic:
  Dim I%
  I%=item_index(104)
  Item_delete 104,I%
  Item_delete 120,I%
  Width 106,260:height 106,170:color 106,220,220,220
  Free I%
Return
' ------------------------------------------------------------------------------
' Procédure d'ajout d'image à la liste de DIC
' ------------------------------------------------------------------------------
Sub Ajout_Img()
  Dim_Local Img$
  Open_Dialog 122
  Filter 122,"*.jpg & *.bmp|*.jpg;*.bmp"
  Img$=File_Name$(122)
  Delete 122
  ' message Img$
  Item_add 120,Img$
  Item_add 104,file_extract_name$(Img$)
End_Sub
' ------------------------------------------------------------------------------
' Procédure de copie des data dans le presse papier
' ------------------------------------------------------------------------------
Sub CopyToPP()
  If count(121)>0
  Else
      Message "Il n' y a rien à copier"
  End_If
End_Sub
' ------------------------------------------------------------------------------
' Procédure de prévisualisation
' ------------------------------------------------------------------------------
Sub Preview(I%,I$)
  Dim_Local res%
  Pict$=I$
  Dll_On Kgf$
  res% = dll_call3("AnalyzeImageFile",adr(Pict$),adr(Larg%),adr(Haut%))
  If res%>0 Then Message "Format Invalide"
  Dll_Off
  Miniature(260,170,Larg%,Haut%,106)
End_Sub
'-------------------------------------------------------------------------------
' MINIATURE
' ------------------------------------------------------------------------------
Sub Miniature(L_Max%,H_Max%,L%,H%,No% )
  Dim_Local x%,y%,z
  x%=L% :y%=H% :z=1
  While x%>L_Max% or y%>H_Max%
      z=z-0.01
      x%=x%*z
      y%=y%*z
  End_While
  Width No%,x%
  Height No%,y%
  file_load No%,Pict$
End_Sub
' ------------------------------------------------------------------------------
' Procédure de l' A PROPOS...
' ------------------------------------------------------------------------------
Sub About()
  Message "A Propos en cours de réalisation"
End_Sub
' ------------------------------------------------------------------------------
' Procédure de l'AIDE
' ------------------------------------------------------------------------------
Sub Help()
  Message "Aide en cours de réalisation"
End_Sub
' ------------------------------------------------------------------------------
' Procédure de la fonction DATA IMAGE CREATOR
' ------------------------------------------------------------------------------
Sub DIC()
  Dim f$,L%,H%
  Dim_Local n$,ii%
  if count(104)>0
  ' convertion image ----------------------------------------------------------
  If Number_Click=109 and item_index(104)>0
      clear 121
      n$=item_index$(104)
      ii%=item_index(104)
      File_Open_Write 1001,DO$+"\"+Left$(n$,len(n$)-4)+".bas"
        Text 105,Left$(n$,len(n$)-4)+".bas"
        F1002(ii%)
        Get_Size(item_read$(120,ii%))
        Preview(1,Item_read$(120,ii%))
        Ecriture(L%,H%)
      file_close 1001
      command_target_is 0
  End_If
  ' convertion liste d'image --------------------------------------------------
  If Number_Click=110
      clear 121
      ii%=1
      File_Open_Write 1001,DO$+"\Include_Image.bas"
        Text 105,"Include_Image.bas"
        While Count(104)>0
            F1002(ii%)
            Get_Size(Item_Read$(120,ii%))
            Preview(1,Item_Read$(120,ii%))
            Ecriture(L%,H%)
        End_While
      File_Close 1001
      Command_Target_is 0
  End_If
  Width 106,260:height 106,170:color 106,220,220,220
  Text 105,""
  If Object_Exists(1002)=1 Then Delete 1002
  Free f$:Free H% :Free L%
  Else
      if Number_Click=109 or Number_click=110 Then Message "La liste est vide"
  End_If
End_Sub
' ------------------------------------------------------------------------------
' Procedure de la fenêtre d'affichage invisible
' ------------------------------------------------------------------------------
Sub F1002(ii%)
  Dim_Local ii%
  ii%=ii%
  ' création du form invisible 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$(120,ii%)
End_Sub
' ------------------------------------------------------------------------------
' Procédure de récupération de la taille de l'image à traîter
' ------------------------------------------------------------------------------
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
' ------------------------------------------------------------------------------
' Procédure d'écriture dans le fichier *.bas
' ------------------------------------------------------------------------------
Sub Ecriture(L%,H%)
  Dim_Local nom$,x%,y%,R%,G%,B%
  ' Ecriture des données
  nom$=file_extract_name$(item_read$(120,1))
  nom$=LEFT$(nom$,len(nom$)-3)+"bmp"
  file_writeln 1001,"Data "+chr$(34)+nom$+chr$(34)+","+str$(H%)+","+str$(L%)
  item_add 121,"Data "+chr$(34)+nom$+chr$(34)+","+str$(H%)+","+str$(L%)
      for x%=1 to L%
        for y%= 1 to H%
            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 121,"data "+str$(R%)+","+str$(G%)+","+str$(B%)
            display
        Next y%
      Next x%
  Item_Delete 104,item_index(104)
  Item_Delete 120,item_index(104)
End_Sub
' ------------------------------------------------------------------------------
' Procédure de la fonction Coloramic
' ------------------------------------------------------------------------------
Sub Coloramic()
End_Sub
' ------------------------------------------------------------------------------
' Procédure de Fermeture
' ------------------------------------------------------------------------------
Sub Close0()
  Terminate
End_Sub
' ------------------------------------------------------------------------------
' DATAS LANGUES
' ------------------------------------------------------------------------------
Data "France"
Data "Outils"
Data "Langue"
Data "A Propos..."
Data "Aide"
Data "Data Image Créator"
Data "Coloramic"
Data "Quitter"
Data "Français"
Data "Anglais"
Data "Allemand"
Data "Liste des Images"
Data "Double clic pour effacer"
Data "Nom du nouveau fichier"
Data "Copier"
Data "Convert/Image"
Data "Convert/Liste"
Data "Copie le code dans le presse papier"
Data "Convertion de l'image sélectionnée"
Data "Convertion de la liste d'image"

Data "England"
Data "Tools"
Data "Language"
Data "About"
Data "Help"
Data "Data Image Créator"
Data "Coloramic"
Data "Exit"
Data "French"
Data "English"
Data "German"

Data "Liste des Images"
Data "Double clic pour effacer"
Data "Nom du nouveau fichier"
Data "Copier"
Data "Convert/Image"
Data "Convert/Liste"
Data "Copie le code dans le presse papier"
Data "Convertion de l'image sélectionnée"
Data "Convertion de la liste d'image"

Data "Deutschland"
Data "Tools"
Data "Sprache"
Data "Über"
Data "Die Beihilfen"
Data "Data Image Créator"
Data "Coloramic"
Data "Verlassen"
Data "Französisch"
Data "Englisch"
Data "Deutsch"

Data "Liste des Images"
Data "Double clic pour effacer"
Data "Nom du nouveau fichier"
Data "Copier"
Data "Convert/Image"
Data "Convert/Liste"
Data "Copie le code dans le presse papier"
Data "Convertion de l'image sélectionnée"
Data "Convertion de la liste d'image"

sep%=instr(T$,"\")
  T$=Right$(T$,Len(T$)-sep%)
  sep%=instr(T$,"\")    : ‘  < ------ à mettre en REM
  T$=Right$(T$,Len(T$)-sep%) : ‘  < ------ à mettre en REM
  sep%=instr(T$,"\")                  : ‘ < ---------à mettre en REM

Ecriture( L%,H%,ii%)

Sub Ecriture (L%,H%,ii%)

Item_delete 104,ii%

Item_delete 120,ii%

Dim Vs$ : Vs$="1.0"
' Constantes -------------------------------------------------------------------
Dim D$,DO$,Kgf$
' Variables Globales -----------------------------------------------------------
Dim Cle$,Valeur$,Donnee$,Pay$,User$,def$(100)
Dim x%,M%,M1%
Dim Pict$,Larg%,Haut%
' Labels -----------------------------------------------------------------------
Label Clic,Clic2,Clic3,D_Clic
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Init_Constantes()
Init_User()
Init_Dossiers()
Init_F0(500,350,0,0)
Init_Menu()
Init_Objets()
Init_Caption()
end
' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Procédure d' initialisation des constantes
' ------------------------------------------------------------------------------
Sub Init_Constantes()
  D$=Dir_Current$
  Kgf$=D$+"\KGF.dll"
  DO$=D$+"\Output"
End_Sub
' ------------------------------------------------------------------------------
' Procédure d'initialisation de l'utilisateur
' ------------------------------------------------------------------------------
Sub Init_User()
  Dim_Local res%,sep%,T$
  Dll_On Kgf$
  Cle$="Control Panel\International"
  Valeur$="sCountry"
  res%=Dll_Call4("ReadRegistryKey",3,Adr(Cle$),Adr(Valeur$),Adr(Donnee$))
  If res%>0 Then Message "Erreur  -  Clé de Registre Invalide"
  Pay$=trim$(Donnee$)
  Dll_Off
  T$=Dir_Current$
  sep%=instr(T$,"\")
  T$=Right$(T$,Len(T$)-sep%)
  sep%=instr(T$,"\")
  T$=Right$(T$,Len(T$)-sep%)
  sep%=instr(T$,"\")
  User$=Left$(T$,sep%-1)
  Init_Langue(Pay$)
End_Sub
' ------------------------------------------------------------------------------
' Procédure d' initialisation de la langue
' ------------------------------------------------------------------------------
Sub Init_Langue(Pay$)
  Dim_Local x%
  If Pay$<>"France" and Pay$<>"England" and Pay$<>"Deutschland"
      Pay$="France"
  End_If
  Restore
  Read def$(1)
  While def$(1)<>Pay$
      Read def$(1)
  End_While
  For x%=2 To 20 :Read def$(x%) :Next x%
End_Sub
' ------------------------------------------------------------------------------
' Procédure de création des sous dossiers
' ------------------------------------------------------------------------------
Sub Init_Dossiers()
  If Dir_Exists(D$+"\Output")=0 Then Dir_Make D$+"\Output"
End_Sub
' ------------------------------------------------------------------------------
' Procédure d' initialisation du form 0
' ------------------------------------------------------------------------------
Sub Init_F0(W%,H%,T%,L%)
  Width 0,W% :Height 0,H%
  If T%=0 and L%=0
      Top 0,(Screen_y-H%)/2:Left 0,(Screen_x-W%)/2
  Else
      If T%>0 and L%>0
        Top 0,T% :Left 0,L%
      Else
        If L%>0
            Top 0,(Screen_y-H%)/2:Left 0,L%
        Else
            Top 0,T% :Left 0,(Screen_x-W%)/2
        End_If
      End_If
  End_If
  Font_Name 0,"Times new roman" :Font_Size 0,10
  Caption 0,"Picture Tools  Vs: "+Vs$
End_Sub
' ------------------------------------------------------------------------------
' Procédure de création du Main_Menu
' ------------------------------------------------------------------------------
Sub Init_Menu()
  Dim_Local x%
  Main_Menu 1
  For x%=2 To 8:Sub_Menu x% :On_Click x%,Clic :Next x%
  For x%=2 To 5:Parent x%,1 :Next x%
  For x%=6 To 8:Parent x%,2 :Next x%
  For x%=9 To 11:Sub_Menu x% :Parent x%,3:on_click x%,Clic :Next x%
End_Sub
' ------------------------------------------------------------------------------
' Procédure d' initialisation des objets du form 0
' ------------------------------------------------------------------------------
Sub Init_Objets()
  Dim_Local x%
  Container 100:Hide 100:top 100,10:left 100,5:Width 100,474 :height 100,275
  Font_Name 100,"Times new roman" : Font_Size 100,10 :Font_Color 100,120,20,10
  For x%=101 To 103:Alpha x% :Parent x%,100:Next x%
  Top 101,25 : Left 101,13
  Top 102,245: Left 102,33:Font_Color 102,0,0,255
  Top 103,25 : Left 103,200
  List 104 :Parent 104,100:Top 104,43  :Left 104,13 :width 104,180:Height 104,200
  Font_Color 104,160,0,255
  Edit 105 :Parent 105,100:Top 105,43  :Left 105,200:Width 105,260
  Picture 106:Parent 106,100:Top 106,70:Left 106,200:Width 106,260:Height 106,170:color 106,220,220,220
  Stretch_On 106
  Button 107:Parent 107,100:Top 107,25:Left 107,120:Width 107,15  :Height 107,15
  Caption 107,"+":Font_Bold 107 :Cursor_Point 107
  Button 108:Parent 108,100:Top 108,245:Left 108,200:Cursor_Point 108
  Button 109:parent 109,100:Top 109,245:Left 109,280:Cursor_Point 109:Width 109,85
  Button 110:Parent 110,100:Top 110,245:Left 110,370:Cursor_Point 110:Width 110,85
  On_click 104,Clic2
  On_Double_Click 104,D_Clic
  For x%=107 To 110:On_click x%,Clic3 :Next x%
  dlist 120 : dlist 121
'                          ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
  Container 200:Hide 200:top 200,10:left 200,5:Width 200,474 :height 200,275
 
End_Sub
' ------------------------------------------------------------------------------
' Procédure d'intialisation des caption
' ------------------------------------------------------------------------------
Sub Init_Caption()
  Dim_Local x%
  For x%=2 to 11 :caption x%,def$(x%) :Next x%
  caption 100,chr$(32)+chr$(32)+def$(6)+chr$(32)+chr$(32)
  caption 101,def$(12)
  caption 102,def$(13)
  caption 103,def$(14)
  For x%=108 To 110 : Caption x%, def$(x%-93):Next x%
  For x%=108 To 110 : Hint x%,def$(x%-90):Next x%
End_Sub
' ------------------------------------------------------------------------------
' Routage des procédures par Clic & Double Clic
' ------------------------------------------------------------------------------
Clic:
  For x%=2 to 11
      If Clicked(x%)=1 Then M%=x%
  Next x%
 
  Select M%
  Case 2
  Case 3
  Case 4 : About()
  Case 5 : Help()
  Case 6 : Show 100 :Hide 200
  Case 7 : Show 200 :Hide 100:Coloramic()
  Case 8 : Close0()
  Case 9 : Pay$="France"    :Init_Langue(Pay$):Init_Caption()
  Case 10: Pay$="England"    :Init_Langue(Pay$):Init_Caption()
  Case 11: Pay$="Deutschland":Init_Langue(Pay$):Init_Caption()
  End_Select
Return
' ------------------------------------------------------------------------------
Clic2:
  Dim I%,I$
  I%=Item_index(104)
  I$=item_read$(120,I%)
  Preview(I%,I$)
  Free I% :Free I$
return
' ------------------------------------------------------------------------------
Clic3:
  For x%=107 To 110
      If Clicked(x%)=1 Then M1%=x%
  Next x%

  Select M1%
  case 107: Ajout_Img()
  case 108: CopyToPP()
  case 109: DIC()
  case 110: DIC()
  End_Select
return
' ------------------------------------------------------------------------------
D_Clic:
  Dim I%
  I%=item_index(104)
  Item_delete 104,I%
  Item_delete 120,I%
  Width 106,260:height 106,170:color 106,220,220,220
  Free I%
Return
' ------------------------------------------------------------------------------
' Procédure d'ajout d'image à la liste de DIC
' ------------------------------------------------------------------------------
Sub Ajout_Img()
  Dim_Local Img$
  Open_Dialog 122
  Filter 122,"*.jpg & *.bmp|*.jpg;*.bmp"
  Img$=File_Name$(122)
  Delete 122
  If img$<>"_"
      Item_add 120,Img$
      Item_add 104,file_extract_name$(Img$)
  End_if
End_Sub
' ------------------------------------------------------------------------------
' Procédure de copie des data dans le presse papier
' ------------------------------------------------------------------------------
Sub CopyToPP()
  If count(121)>0
  Else
      Message "Il n' y a rien à copier"
  End_If
End_Sub
' ------------------------------------------------------------------------------
' Procédure de prévisualisation
' ------------------------------------------------------------------------------
Sub Preview(I%,I$)
  Dim_Local res%
  Pict$=I$
  Dll_On Kgf$
  res% = dll_call3("AnalyzeImageFile",adr(Pict$),adr(Larg%),adr(Haut%))
  If res%>0 Then Message "Format Invalide"
  Dll_Off
  Miniature(260,170,Larg%,Haut%,106)
End_Sub
'-------------------------------------------------------------------------------
' MINIATURE
' ------------------------------------------------------------------------------
Sub Miniature(L_Max%,H_Max%,L%,H%,No% )
  Dim_Local x%,y%,z
  x%=L% :y%=H% :z=1
  While x%>L_Max% or y%>H_Max%
      z=z-0.01
      x%=x%*z
      y%=y%*z
  End_While
  Width No%,x%
  Height No%,y%
  file_load No%,Pict$
End_Sub
' ------------------------------------------------------------------------------
' Procédure de l' A PROPOS...
' ------------------------------------------------------------------------------
Sub About()
  Message "A Propos en cours de réalisation"
End_Sub
' ------------------------------------------------------------------------------
' Procédure de l'AIDE
' ------------------------------------------------------------------------------
Sub Help()
  Message "Aide en cours de réalisation"
End_Sub
' ------------------------------------------------------------------------------
' Procédure de la fonction DATA IMAGE CREATOR
' ------------------------------------------------------------------------------
Sub DIC()
  Dim f$,L%,H%
  Dim_Local n$,ii%
  if count(104)>0
  ' convertion image ----------------------------------------------------------
  If Number_Click=109 and item_index(104)>0
      clear 121
      n$=item_index$(104)
      ii%=item_index(104)
      File_Open_Write 1001,DO$+"\"+Left$(n$,len(n$)-4)+".bas"
        Text 105,Left$(n$,len(n$)-4)+".bas"
        F1002(ii%)
        Get_Size(item_read$(120,ii%))
        Preview(1,Item_read$(120,ii%))
        Ecriture(L%,H%,ii%)
      file_close 1001
      command_target_is 0
  End_If
  ' convertion liste d'image --------------------------------------------------
  If Number_Click=110
      clear 121
      ii%=1
      File_Open_Write 1001,DO$+"\Include_Image.bas"
        Text 105,"Include_Image.bas"
        While Count(104)>0
            F1002(ii%)
            Get_Size(Item_Read$(120,ii%))
            Preview(1,Item_Read$(120,ii%))
            Ecriture(L%,H%,ii%)
        End_While
      File_Close 1001
      Command_Target_is 0
  End_If
  Width 106,260:height 106,170:color 106,220,220,220
  Text 105,""
  If Object_Exists(1002)=1 Then Delete 1002
  Free f$:Free H% :Free L%
  Else
      if Number_Click=109 or Number_click=110 Then Message "La liste est vide"
  End_If
End_Sub
' ------------------------------------------------------------------------------
' Procedure de la fenêtre d'affichage invisible
' ------------------------------------------------------------------------------
Sub F1002(ii%)
  ' création du form invisible 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$(120,ii%)
End_Sub
' ------------------------------------------------------------------------------
' Procédure de récupération de la taille de l'image à traîter
' ------------------------------------------------------------------------------
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
' ------------------------------------------------------------------------------
' Procédure d'écriture dans le fichier *.bas
' ------------------------------------------------------------------------------
Sub Ecriture(L%,H%,ii%)
  Dim_Local nom$,x%,y%,R%,G%,B%
  ' Ecriture des données
  nom$=file_extract_name$(item_read$(120,1))
  nom$=LEFT$(nom$,len(nom$)-3)+"bmp"
  file_writeln 1001,"Data "+chr$(34)+nom$+chr$(34)+","+str$(H%)+","+str$(L%)
  item_add 121,"Data "+chr$(34)+nom$+chr$(34)+","+str$(H%)+","+str$(L%)
      for x%=1 to L%
        for y%= 1 to H%
            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 121,"data "+str$(R%)+","+str$(G%)+","+str$(B%)
            display
        Next y%
      Next x%
  Item_Delete 104,ii%
  Item_Delete 120,ii%
End_Sub
' ------------------------------------------------------------------------------
' Procédure de la fonction Coloramic
' ------------------------------------------------------------------------------
Sub Coloramic()
End_Sub
' ------------------------------------------------------------------------------
' Procédure de Fermeture
' ------------------------------------------------------------------------------
Sub Close0()
  Terminate
End_Sub
' ------------------------------------------------------------------------------
' DATAS LANGUES
' ------------------------------------------------------------------------------
Data "France"
Data "Outils"
Data "Langue"
Data "A Propos..."
Data "Aide"
Data "Data Image Créator"
Data "Coloramic"
Data "Quitter"
Data "Français"
Data "Anglais"
Data "Allemand"
Data "Liste des Images"
Data "Double clic pour effacer"
Data "Nom du nouveau fichier"
Data "Copier"
Data "Convert/Image"
Data "Convert/Liste"
Data "Copie le code dans le presse papier"
Data "Convertion de l'image sélectionnée"
Data "Convertion de la liste d'image"

Data "England"
Data "Tools"
Data "Language"
Data "About"
Data "Help"
Data "Data Image Créator"
Data "Coloramic"
Data "Exit"
Data "French"
Data "English"
Data "German"
Data "Photo List"
Data "Double-click to delete"
Data "Name the new file"
Data "Copy"
Data "Convert / Image"
Data "Convert / List"
Data "copy code to clipboard"
Data "Converting the selected image"
Data "Conversion of the image list"

Data "Deutschland"
Data "Tools"
Data "Sprache"
Data "Über"
Data "Die Beihilfen"
Data "Data Image Créator"
Data "Coloramic"
Data "Verlassen"
Data "Französisch"
Data "Englisch"
Data "Deutsch"
Data "Photo List"
Data "Doppel-Klick zu löschen"
Data "Benennen Sie die neue Datei"
Data "Copy"
Data "Konvertieren / Image"
Data "Konvertieren / List"
Data "copy-Code in die Zwischenablage kopieren"
Data "Konvertieren Sie das ausgewählte Bild"
Data "Conversion des Bildes Liste"

Label boucle
Dim T$,T2$,i%, sep%
T$= "C:\Users\Yannick\Desktop" : T2$=T$ :i%=1
boucle:
While instr(T2$,"\") > 0
  sep%=instr(T2$,"\") :  T2$=Right$(T2$,Len(T2$)-sep%)
End_While
if i%=1 then T2$=LEFT$(T$,LEN(T$)-(LEN(T2$)+1)) : i%=i%+1 : goto boucle
print T2$

DIM EMail$ :  EMail$ = "nardo.26@truc.fr"

F_RINSTR%(Email$,".")
print RINSTR_return%
END
' ------------------------------------------------------------------------------
' Renvoie la position d'une occurrence de texte dans une autre en partant de la droite
' print INSTR(EMail$ , ".")  renvoie 6
' F_RINSTR(EMail$ , ".") : print  RINSTR_return% affiche 14
' ------------------------------------------------------------------------------
SUB F_RINSTR%(A$,B$)
  IF VARIABLE("Rinstr_return%")=0 THEN DIM Rinstr_return%
  DIM_LOCAL i%:i%=0
  IF INSTR(A$,B$)<>0
    FOR i%=LEN(A$) TO 1 STEP -1
      IF INSTR(RIGHT$(A$,LEN(A$)-i%+1),B$)<> 0 THEN EXIT_FOR
    NEXT i%
  END_IF
  Rinstr_return% = i%
END_SUB

F_RINSTR%(DIR_CURRENT$,"\") : t$=LEFT$(DIR_CURRENT$,RINSTR_return%-1)
F_RINSTR%(t$,"\") :User$=RIGHT$(t$,LEN(t$)-RINSTR_return%)