Mon "ImageList Creator"

hide 0
constantes()
variables()
labels()
init()
gui()
show 0
end

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES CONSTANTES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub constantes()
' -> dossier courant
   dim path$
' -> dossiers et fichiers externes
   dim source$
   dim dest$
   dim param$
   dim kgf$
' -> objets panoramic
   dim no%
   dim opendial%
   dim mm%
   dim sm%(20)
   dim pan%
   dim cont%
   dim tvreceiver%
   dim InfimgL%
   dim alph_files%,alph_files2%,alph_fic%,alph_h%,alph_w%,alph_nbimg%
   dim alph_fic2%,alph_h2%,alph_w2%,alph_nbimg2%
   dim pict%
   dim but%
' -> objets kgf
   dim TV%
   dim IMGlist%
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub variables()
   dim ActiveLib$
   dim txt$
   dim saved%
   dim Nbnode%
   dim imgl_w%
   dim imgl_h%
   dim FileSave1$
   dim FileSave2$
   dim IMGimport$
   dim par$
   dim bmp$
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATION DES LABELS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub labels()
   label clic,dclic,change,close0,L,format
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INITIALISATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub init()
   dim_local i%,f$
  
' -> dossier courant
   path$ = dir_current$
   if right$(path$,1)="\" : path$ = left$(path$,len(path$)-1) : end_if
' -> fichiers externes
   source$ = path$+"\src\"
      if dir_exists(source$)=0 : dir_make source$ : end_if
   dest$   = path$+"\lib\"
      if dir_exists(source$)=0 : dir_make source$ : end_if
   param$  = path$+"\param.inf"
' -> objets panoramic
   no%=no%+1 : mm%=no%
   for i%=1 to 20 : no%=no%+1 : sm%(i%)=no% : next i%
   no%=no%+1 : pan%=no%
   no%=no%+1 : tvreceiver%=no%
   no%=no%+1 : InfimgL%=no%
   no%=no%+1 : cont%=no%
   no%=no%+1 : alph_files%=no%
   no%=no%+1 : alph_fic%=no%
   no%=no%+1 : alph_h%=no%
   no%=no%+1 : alph_w%=no%
   no%=no%+1 : alph_nbimg%=no%
   no%=no%+1 : alph_files2%=no%
   no%=no%+1 : alph_fic2%=no%
   no%=no%+1 : alph_h2%=no%
   no%=no%+1 : alph_w2%=no%
   no%=no%+1 : alph_nbimg2%=no%
   no%=no%+1 : pict%=no%
   no%=no%+1 : but%=no%
   no%=no%+1 : opendial%=no%
' -> paramètres
   if file_exists(param$)=1
      file_open_read 1,param$
      file_readln 1,kgf$
      file_close 1
   else
      open_dialog opendial%
      dir_dialog opendial%,"C:\"
      filter opendial%,"*.dll|*.dll"
      f$=file_name$(opendial%)
      delete opendial%
      if f$<>"_"
         kgf$=f$
         file_open_write 1000,param$
         file_writeln 1000,kgf$
         file_close 1000
      end_if
   end_if
   dll_on kgf$
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INTERFACE UTILISATEUR
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub gui()
   dim_local res%,w%,h%

   height 0,350
   width 0,700
   top 0,(screen_y-height(0))/2
   left 0,(screen_x-width(0))/2
   font_name 0,"arial"
   font_size 0,8
   caption 0,"ImageList Creator"
   on_close 0,close0
  
   main_menu mm%
   sub_menu sm%(1) : parent sm%(1),mm% : caption sm%(1),"Fichiers"
      sub_menu sm%(2) : parent sm%(2),sm%(1) : caption sm%(2),"Nouveau"     : on_click sm%(2),clic
      sub_menu sm%(3) : parent sm%(3),sm%(1) : caption sm%(3),"Ouvrir"      : on_click sm%(3),clic
      sub_menu sm%(4) : parent sm%(4),sm%(1) : caption sm%(4),"Enregistrer" : on_click sm%(4),clic
      sub_menu sm%(5) : parent sm%(5),sm%(1) : caption sm%(5),"-"
      sub_menu sm%(6) : parent sm%(6),sm%(1) : caption sm%(6),"Quitter"     : on_click sm%(6),clic
   sub_menu sm%(7) : parent sm%(7),mm% : caption sm%(7),"Edition"
      sub_menu sm%(8) : parent sm%(8),sm%(7) : caption sm%(8),"Ajouter"     : inactive sm%(8) : on_click sm%(8),clic
      sub_menu sm%(9) : parent sm%(9),sm%(7) : caption sm%(9),"Supprimer"   : inactive sm%(9) : on_click sm%(9),clic


   panel pan%
   full_space pan%
   w%=width(pan%)
   h%=height(pan%)
   hide pan%

   edit tvreceiver%
   on_change tvreceiver%,change
   hide tvreceiver%
      
   TV% = dll_call3("CreateTreeViewEx",handle(0),1,0)
   res% = dll_call5("ResizeTreeView",TV%,6,1,250-2,h%-7)
   res% = dll_call3("SetTreeViewEventReceiver",TV%,1,handle(tvreceiver%))
  
   container cont%
   height cont%,h%
   width cont%,w%-250
   top cont%,0
   left cont%,250
   font_bold cont%
   caption cont%," Info Fichiers "
   font_bold_off cont%
  
   alpha alph_files%
   parent alph_files%,cont%
   top alph_files%,30
   left alph_files%,10
   font_bold alph_files%
   font_size alph_files%,10
   font_color alph_files%,0,0,200
   caption alph_files%," - ImageList -"

   alpha alph_fic%
   parent alph_fic%,cont%
   top alph_fic%,60
   left alph_fic%,10
   font_bold alph_fic%
   font_color alph_fic%,120,10,0
   caption alph_fic%,"Fichier : "

   alpha alph_fic2%
   parent alph_fic2%,cont%
   top alph_fic2%,60
   left alph_fic2%,120
   font_bold alph_fic2%
   caption alph_fic2%,""

   alpha alph_h%
   parent alph_h%,cont%
   top alph_h%,80
   left alph_h%,10
   font_bold alph_h%
   font_color alph_h%,120,10,0
   caption alph_h%,"Hauteur (px) : "

   alpha alph_h2%
   parent alph_h2%,cont%
   top alph_h2%,80
   left alph_h2%,120
   font_bold alph_h2%
   caption alph_h2%,""

   alpha alph_w%
   parent alph_w%,cont%
   top alph_w%,100
   left alph_w%,10
   font_bold alph_w%
   font_color alph_w%,120,10,0
   caption alph_w%,"Largeur (px) : "
  
   alpha alph_w2%
   parent alph_w2%,cont%
   top alph_w2%,100
   left alph_w2%,120
   font_bold alph_w2%
   caption alph_w2%,""

   alpha alph_nbimg%
   parent alph_nbimg%,cont%
   top alph_nbimg%,130
   left alph_nbimg%,10
   font_bold alph_nbimg%
   font_color alph_nbimg%,120,10,0
   caption alph_nbimg%,"Nombre d' images : "

   alpha alph_nbimg2%
   parent alph_nbimg2%,cont%
   top alph_nbimg2%,130
   left alph_nbimg2%,120
   font_bold alph_nbimg2%
   caption alph_nbimg2%,""
  
   alpha alph_files2%
   parent alph_files2%,cont%
   top alph_files2%,160
   left alph_files2%,10
   font_bold alph_files2%
   font_size alph_files2%,10
   font_color alph_files2%,0,0,200
   caption alph_files2%," - Image -"
  
   picture pict%
   parent pict%,cont%
   top pict%,180
   left pict%,10
   hide pict%
  
   button but%
   parent but%,cont%
   top but%,180
   left but%,10
   caption but%," Ouvrir "
   cursor_point but%
   on_click but%,clic
   hide but%

   dlist InfimgL%

end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MENUS : CLICK - DOUBLE_CLICK - CHANGE - CLOSE0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

clic:
   if number_click = sm%(2)
      Nbnode% = dll_call3("GetTreeViewInformation",TV%,0,0)
      if Nbnode%<>0
         if saved%=0
            if message_warning_yes_no("L' imagelist en cours n' a pas été enregistrée !"+chr$(13)+"Voulez vous enregistrer vos modifications ?...")=1
               SaveLib()
            end_if
         end_if
      end_if
      NettoyageTV()
      CreateLib()
      resize_picture()
      active sm%(8)
      active sm%(9)
      return
   end_if
  
   if number_click = sm%(3)
      ouvrir()
      resize_picture()
      active sm%(8)
      active sm%(9)
      return
   end_if
  
   if number_click = sm%(4)
      SaveLib()
      return
   end_if
  
   if number_click = sm%(6)
      quitter()
      return
   end_if
  
   if number_click = sm%(8)
      ajouter()
      return
   end_if
  
   if number_click = sm%(9)
      supprimer()
      return
   end_if
  
   if number_click = but%
      execute bmp$
      return
   end_if
return

dclic:
return

change:
   if left$(text$(tvreceiver%),12)="double_click"
      extract()
   end_if
return

close0:
   quitter()
return

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' PROCEDURES ET FONCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub NettoyageTV()
   dim_local res%
   res% = dll_call1("ClearTreeView",TV%)
   caption alph_fic2%,""
   caption alph_h2%,""
   caption alph_w2%,""
   caption alph_nbimg2%,""
   if IMGlist%<>0
      res% = dll_call1("DeleteImageList",IMGlist%)
      clear InfimgL%
   end_if
end_sub

' ------------------------------------------------------------------------------

sub CreateLib()
   dim_local m%,res%
  
   L:
   if message_input("Nouveau","Nom : ","")=1
      if message_text$=""
         goto L
      else
         ActiveLib$ = message_text$+".ilb"
         fileSave1$ = dest$+message_text$+".ilb"
         fileSave2$ = dest$+message_text$+".inf"
      end_if
      if file_exists(dest$+ActiveLib$)=1
         m%=message_warning_ok("Une Librairie porte déjà ce nom !..."+chr$(13)+"Choisir un autre nom ?")
         if m%=1
            goto L
         else
            exit_sub
         end_if
      else
         txt$ = ActiveLib$
         res% = dll_call4("AddTreeViewRootNode",TV%,adr(txt$),0,0)
      end_if
      format:
      if message_input("Dimensions des images","dimensions (ex : 16x16) : ","")=1
         verif_format(message_text$)
         caption alph_fic2%,ActiveLib$
         caption alph_h2%,str$(imgl_h%)
         caption alph_w2%,str$(imgl_w%)
         caption alph_nbimg2%,"0"
         item_add InfimgL%,str$(imgl_h%)
         item_add InfimgL%,str$(imgl_w%)
         IMGlist% = dll_call2("CreateImageList",imgl_w%,imgl_h%)
         saved%=0
      else
         goto format
      end_if
   else
      exit_sub
   end_if
end_sub

' ------------------------------------------------------------------------------

sub ouvrir()
   dim_local res%,f$,t$,i%,m%,ind%
  
   Nbnode% = dll_call3("GetTreeViewInformation",TV%,0,0)
   if Nbnode%<>0
      if saved%=0
         m%=message_warning_yes_no("La librairie en cours n' a pas été enregistré !!!..."+"Voulez vous enregistré vôtre travail ?")
         if m%=1
            SaveLib()
         end_if
      end_if
   end_if
  
   NettoyageTV()
  
   dir_change dest$
   open_dialog opendial%
   dir_dialog opendial%,dest$
   filter opendial%,"*.ilb|*.ilb"
   f$=file_name$(opendial%)
   delete opendial%
  
   if f$<>"_"

      ActiveLib$=file_extract_name$(f$)
      fileSave1$ = f$
      fileSave2$ = left$(f$,len(f$)-3)+"inf"

      file_load InfimgL%,fileSave2$
      imgl_h% = val(item_read$(InfimgL%,1))
      imgl_w% = val(item_read$(InfimgL%,2))
      IMGlist% = dll_call2("CreateImageList",imgl_w%,imgl_h%)
      res% = dll_call2("LoadImageList",IMGlist%,adr(fileSave1$))
      
      caption alph_fic2%,ActiveLib$
      caption alph_h2%,str$(imgl_h%)
      caption alph_w2%,str$(imgl_w%)
      caption alph_nbimg2%,count(InfimgL%)-2

      txt$ = ActiveLib$
      res% = dll_call4("AddTreeViewRootNode",TV%,adr(txt$),0,0)

      if count(InfimgL%)>2
         txt$ = item_read$(InfimgL%,3)
         res% = dll_call4("AddTreeViewChildNode",TV%,adr(txt$),0,0)
         ind% = 1
      end_if

      if count(InfimgL%)>3
         for i%=4 to count(InfimgL%)
            txt$ = item_read$(InfimgL%,i%)
            res% = dll_call3("SelectTreeViewNode",TV%,ind%,0)
            res% = dll_call5("InsertTreeViewNode",TV%,1,adr(txt$),0,0)
            ind% = ind%+1
         next i%
      end_if
      
      Nbnode% = dll_call3("GetTreeViewInformation",TV%,0,0)
      if saved%=0 : saved%=1 : end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub SaveLib()
   dim_local m%,res%
  
   if count(InfimgL%)-2>0
      res% = dll_call2("SaveImageList",IMGlist%,adr(fileSave1$))
      file_save InfimgL%,fileSave2$
      saved%=1
   else
      m%=message_information_ok("La librairie est vide !"+chr$(13)+"Elle ne sera pas enregistré...")
      exit_sub
   end_if
end_sub

' ------------------------------------------------------------------------------

sub verif_format(F$)
   dim_local sep%,imgl_h$,imgl_w$
  
   if instr(F$,"x")=0
      message "Format invalide !..."
      free sep%
      free imgl_h$
      free imgl_w$
      goto format
   else
      sep%    = instr(F$,"x")
      imgl_h$ = left$(F$,sep%-1)
      imgl_w$ = right$(F$,len(F$)-sep%)
   end_if
   if numeric(imgl_h$)=0 or numeric(imgl_w$)=0
      message "Format invalide !..."
      free sep%
      free imgl_h$
      free imgl_w$
      goto format
   else
      imgl_h%=val(imgl_h$)
      imgl_w%=val(imgl_w$)
   end_if
end_sub

' ------------------------------------------------------------------------------

sub quitter()
   dim_local res%
  
   Nbnode% = dll_call3("GetTreeViewInformation",TV%,0,0)
   if Nbnode%<>0
      if saved%=0
         if message_warning_yes_no("L' imagelist en cours n' a pas été enregistrée !"+chr$(13)+"Voulez vous enregistrer vos modifications ?...")=1
            SaveLib()
         end_if
      end_if
   end_if
   res% = dll_call1("KillProcessByHandle",handle(0))
end_sub

' ------------------------------------------------------------------------------

sub ajouter()
    dim_local res%,f$,ind%
    
    dir_change source$
    open_dialog opendial%
    dir_dialog opendial%,source$
    filter opendial%,"*.bmp|*.bmp"
    IMGimport$=file_name$(opendial%)
    delete opendial%

    if IMGimport$<>"_"
       res% = dll_call4("AddImageToImageList",IMGlist%,adr(IMGimport$),0,0)
       f$=file_extract_name$(IMGimport$)
       item_add InfimgL%,f$
       if saved%=1 : saved%=0 : end_if
       txt$=f$
       Nbnode% = dll_call3("GetTreeViewInformation",TV%,0,0)
       if Nbnode%=1
          res% = dll_call4("AddTreeViewChildNode",TV%,adr(txt$),0,0)
       else
          if Nbnode%>1
             ind%=Nbnode%-1
             res% = dll_call3("SelectTreeViewNode",TV%,ind%,0)
             res% = dll_call5("InsertTreeViewNode",TV%,1,adr(txt$),0,0)
          end_if
       end_if
    else
       exit_sub
    end_if
    caption alph_nbimg2%,str$(ind%+1)
end_sub

' ------------------------------------------------------------------------------

sub supprimer()
   dim_local res%,ind%,m%,i%,f$,t$
  
   par$=string$(200," ")
   ind% = dll_call3("GetTreeViewInformation",TV%,1,0)
   res% = dll_call3("GetTreeViewInformation",TV%,2,adr(par$))
   f$   = trim$(par$)
   if ind% >0
      m%=message_warning_yes_no("Êtes vous sûr de vouloir supprimer :"+chr$(13)+f$)
      if m%=1
         res% = dll_call1("DeleteTreeViewNode",TV%)
         for i%=1 to count(InfimgL%)
            t$=item_read$(InfimgL%,i%)
            if t$=f$
               item_delete InfimgL%,i%
               exit_for
            end_if
         next i%
         caption alph_nbimg2%,count(InfimgL%)-2
         if saved%=1 : saved%=0 : end_if
      else
         exit_sub
      end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub resize_picture()
   if imgl_h%>100
      hide pict%
      show but%
   else
      height pict%,imgl_h%
      width pict%,imgl_w%
      hide but%
      show pict%
   end_if
end_sub

' ------------------------------------------------------------------------------

sub extract()
   dim_local res%,ind%
   ind% = dll_call3("GetTreeViewInformation",TV%,1,0)
   ind% = ind%-1
   bmp$ = Path$+"\temp.bmp"
   if imgl_h%>100
      res% = dll_call5("ExtractImageFromImageList",IMGlist%,ind%,0,0,adr(bmp$))
   else
      res% = dll_call5("ExtractImageFromImageList",IMGlist%,ind%,0,1,0)
      clipboard_paste pict%
   end_if
end_sub