ImgColorPalette

'                              ImgColorPalette
'                                   Vs 0.1
'                                 Y GERONIMI
'                                 19/08/2019
' ==============================================================================
' VARIABLES
' ==============================================================================
' Gestion des objets
  dim no%
' Gestion des messages
  dim Mess%
' Dimensions de l'image
  dim WImg%
  dim LImg%
' ==============================================================================
' CONSTANTES - ENVIRONNEMENT
' ==============================================================================
  dim Src$
  dim App$
  dim PathSrc$
  dim PathApp$
  dim PathAppImg$
  dim Logo$
  dim IconOut$(10)
  dim IconIn$(10)
  dim IconClic$(10)
' ==============================================================================
' CONSTANTES - OBJETS
' ==============================================================================
  dim fbor%
  dim Frame%(10)
  dim PictLogo%
  dim BtnPict%(10)
  dim PictImport%
  dim PictColor%
  dim Pb%
  dim PictSrc%
  dim Alph%(2)
  dim ColorList%
  dim Odial%
' ==============================================================================
' LABELS
' ==============================================================================
  label CLIC
  label DCLIC
  label MMFRAME1,MMFRAME3,MMFRAME5
  label MMBTN1,MMBTN2,MMBTN3,MMBTN4,MMBTN5
  label MUP1,MUP2,MUP3,MUP4,MUP5
  label MDOWN1,MDOWN2,MDOWN3,MDOWN4,MDOWN5
  label MMPCOL
' ==============================================================================
' DATAS
' ==============================================================================
' ------------------------------- NO DATAS -------------------------------------
' ==============================================================================
' PROGRAMME
' ==============================================================================
  InitConstEnvironnement()
  InitConstObjets()
  GUI()
  pause 500
  if Src$<>""
     CreateImgColorPalette()
  end_if
  end
' ==============================================================================
' SS PROGRAMMES
' ==============================================================================
  CLIC:
     if number_click = BtnPict%(1)
        OPEN()
     end_if
    
     if number_click = BtnPict%(2)
        ABOUT()
     end_if
    
     if number_click = BtnPict%(3)
        HELP()
     end_if
    
     if number_click = BtnPict%(4)
        Terminate
     end_if
    
     if number_click = BtnPict%(5)
        clipboard_string_copy caption$(Alph%(1))  
     end_if
    
     if number_click = PictColor%
        off_mouse_move PictColor%
        cursor_default PictColor%
     end_if  
  return
' ------------------------------------------------------------------------------
  DCLIC:
     if number_double_click = PictColor%
        on_mouse_move PictColor%,MMPCOL
        cursor_cross PictColor%
     end_if
  return
' ------------------------------------------------------------------------------  
' Suvol souris frame 1
  MMFRAME1:
     off_mouse_move Frame%(1)
     ActiveMouseMoveBtnPict(1)
  return
' ------------------------------------------------------------------------------
' Suvol souris frame 3
  MMFRAME3:
     off_mouse_move Frame%(3)
     ActiveMouseMoveBtnPict(1)
  return
' ------------------------------------------------------------------------------
' Suvol souris frame 5
  MMFRAME5:
     off_mouse_move Frame%(5)
     ActiveMouseMoveBtnPict(1)
  return
' ------------------------------------------------------------------------------  
' Survol souris bouton 1
  MMBTN1:
     off_mouse_move BtnPict%(1)
     ActiveMouseMoveFrame(1)
  return
' ------------------------------------------------------------------------------
' Survol souris bouton 2
  MMBTN2:
     off_mouse_move BtnPict%(2)
     ActiveMouseMoveFrame(2)
  return
' ------------------------------------------------------------------------------
' Survol souris bouton 3
  MMBTN3:
     off_mouse_move BtnPict%(3)
     ActiveMouseMoveFrame(3)
  return
' ------------------------------------------------------------------------------
' Survol souris bouton 4
  MMBTN4:
     off_mouse_move BtnPict%(4)
     ActiveMouseMoveFrame(4)
  return
' ------------------------------------------------------------------------------
' Survol souris bouton 5
  MMBTN5:
     off_mouse_move BtnPict%(5)
     ActiveMouseMoveFrame(5)
  return
' ------------------------------------------------------------------------------
  MMPCOL:
     off_mouse_move PictSrc%
     caption Alph%(1),ColorPanel$(PictColor%)
     on_mouse_move PictSrc%,MMPCOL
  return
' ------------------------------------------------------------------------------  
' Souris relachée bouton 1
  MUP1:
     font_color BtnPict%(1),170,0,255
     file_load BtnPict%(1),IconIn$(1)
  return
' ------------------------------------------------------------------------------
' Souris relachée bouton 2
  MUP2:
     font_color BtnPict%(2),170,0,255
     file_load BtnPict%(2),IconIn$(2)
  return
' ------------------------------------------------------------------------------
' Souris relachée bouton 3
  MUP3:
     font_color BtnPict%(3),170,0,255
     file_load BtnPict%(3),IconIn$(3)
  return
' ------------------------------------------------------------------------------
' Souris relachée bouton 4
  MUP4:
     font_color BtnPict%(4),170,0,255
     file_load BtnPict%(4),IconIn$(4)
  return
' ------------------------------------------------------------------------------
' Souris relachée bouton 5
  MUP5:
     font_color BtnPict%(5),170,0,255
     file_load BtnPict%(5),IconIn$(5)
  return
' ------------------------------------------------------------------------------  
' Souris appuyée bouton 1
  MDOWN1:
     font_color BtnPict%(1),255,0,0
     file_load BtnPict%(1),IconClic$(1)
  return
' ------------------------------------------------------------------------------  
' Souris appuyée bouton 2
  MDOWN2:
     font_color BtnPict%(2),255,0,0
     file_load BtnPict%(2),IconClic$(2)
  return
' ------------------------------------------------------------------------------  
' Souris appuyée bouton 3
  MDOWN3:
     font_color BtnPict%(3),255,0,0
     file_load BtnPict%(3),IconClic$(3)
  return
' ------------------------------------------------------------------------------  
' Souris appuyée bouton 4
  MDOWN4:
     font_color BtnPict%(4),255,0,0
     file_load BtnPict%(4),IconClic$(4)
  return
' ------------------------------------------------------------------------------  
' Souris appuyée bouton 5
  MDOWN5:
     font_color BtnPict%(5),255,0,0
     file_load BtnPict%(5),IconClic$(5)
  return
' ==============================================================================
' PROCEDURE - INITIALISATIONS
' ==============================================================================
  Sub InitConstEnvironnement()
     dim_local i%
    
     App$ = Param_value$(0)
     PathApp$ = file_extract_path$(App$)
     PathAppImg$ = PathApp$+"Img"
     Src$ = Param_value$(1)
     PathSrc$ = file_extract_path$(Src$)
     Logo$ = PathAppImg$+"Logo.bmp"
     for i%=1 to 5 : IconOut$(i%) = PathAppImg$+"BtnOut_"+str$(i%)+".bmp" : next i%
     for i%=1 to 5 : IconIn$(i%) = PathAppImg$+"BtnIn_"+str$(i%)+".bmp" : next i%
     for i%=1 to 5 : IconClic$(i%) = PathAppImg$+"BtnClic_"+str$(i%)+".bmp" : next i%
  End_sub
' ------------------------------------------------------------------------------
  Sub InitConstObjets()
     dim_local i%
    
     for i%=1 to 10 : no%=no%+1 : Frame%(i%)=no%   : next i%
     for i%=1 to 10 : no%=no%+1 : BtnPict%(i%)=no% : next i%
     for i%=1 to 2  : no%=no%+1 : Alph%(i%)=no%    : next i%
     no%=no%+1 : PictLogo%=no%
     no%=no%+1 : PictImport%=no%
     no%=no%+1 : PictColor%=no%
     no%=no%+1 : Pb%=no%
     no%=no%+1 : PictSrc%=no%
     no%=no%+1 : ColorList%=no%
     no%=no%+1 : fbor%=no%
     no%=no%+1 : Odial%=no%
  End_sub
' ==============================================================================
' PROCEDURES - INTERFACE
' ==============================================================================
  Sub GUI()
     dim_local i%,t%,etiq$,capt$
    
     dlist ColorList%
    
     border_hide 0
     height 0,310
     width 0,650
     top 0,(screen_y-height(0))/2
     left 0,(screen_x-width(0))/2
     color 0,120,120,130
     font_name 0,"Courier new" : font_size 0,10 : font_bold 0 : font_color 0,120,120,130
    
     panel Frame%(1)
     height Frame%(1),(28*1)+(5*2)
     width Frame%(1),145
     top Frame%(1),10
     left Frame%(1),10
     on_mouse_move Frame%(1),MMFRAME1
    
        button_picture BtnPict%(1)
        parent BtnPict%(1),Frame%(1)
        height BtnPict%(1),28
        width BtnPict%(1),135
        top BtnPict%(1),5
        left BtnPict%(1),5
        picture_left BtnPict%(1)
        file_load BtnPict%(1),IconOut$(1)
        caption BtnPict%(1),chr$(32)+"&OPEN"+string$(6,chr$(32))
        cursor_point BtnPict%(1)
        on_click BtnPict%(1),CLIC
        
     panel Frame%(2)
     height Frame%(2),height_client(0)-(28*4)-(5*6)-20
     width Frame%(2),145
     top Frame%(2),top(Frame%(1))+height(Frame%(1))
     left Frame%(2),10
    
        picture PictLogo%
        parent PictLogo%,Frame%(2)
        height PictLogo%,140
        width PictLogo%,140
        top PictLogo%,(height_client(Frame%(2))-height(PictLogo%))/2
        left PictLogo%,(width_client(Frame%(2))-width(PictLogo%))/2
        file_load PictLogo%,Logo$
        
     panel Frame%(3)
     height Frame%(3),(28*3)+(5*4)
     width Frame%(3),145
     top Frame%(3),height_client(0)-height(Frame%(3))-10
     left Frame%(3),10
    
        etiq$ = "&ABOUT,&HELP,&QUIT,"
        t%=5
        for i%=2 to 4
           button_picture BtnPict%(i%)
           parent BtnPict%(i%),Frame%(3)
           height BtnPict%(i%),28
           width BtnPict%(i%),135
           top BtnPict%(i%),t%
           left BtnPict%(i%),5
           picture_left BtnPict%(i%)
           file_load BtnPict%(i%),IconOut$(i%)
           capt$ = left$(etiq$,instr(etiq$,chr$(44))-1)
           etiq$ = right$(etiq$,len(etiq$)-instr(etiq$,chr$(44)))
           caption BtnPict%(i%),chr$(32)+capt$+string$(10-len(capt$),chr$(32))
           cursor_point BtnPict%(i%)
           on_click BtnPict%(i%),CLIC
          
           t%=t%+height(BtnPict%(i%))+5          
        next i%
                  
     panel Frame%(4)
     height Frame%(4),height_client(0)-20-38
     width Frame%(4),width_client(0)-width(Frame%(1))-161
     top Frame%(4),10
     left Frame%(4),left(Frame%(1))+width(Frame%(1))+10
    
        picture PictSrc%
        parent PictSrc%,Frame%(4)
        height PictSrc%,height_client(Frame%(4))-20
        width PictSrc%,width_client(Frame%(4))-20
        top PictSrc%,(height_client(Frame%(4))-height(PictSrc%))/2
        left PictSrc%,(width_client(Frame%(4))-width(PictSrc%))/2
        color PictSrc%,0,0,0
    
     panel Frame%(5)
     height Frame%(5),height_client(0)-20-38
     width Frame%(5),130
     top Frame%(5),10
     left Frame%(5),width_client(0)-width(Frame%(5))-10
    
        picture PictColor%
        parent PictColor%,Frame%(5)
        height PictColor%,height_client(Frame%(5))-60
        width PictColor%,width_client(Frame%(5))-10
        top PictColor%,5
        left PictColor%,5
        color PictColor%,240,240,240
        cursor_cross PictColor%
        on_mouse_move PictColor%,MMPCOL
        on_click PictColor%,CLIC
        on_double_click PictColor%,DCLIC
        
        alpha Alph%(1)
        parent Alph%(1),frame%(5)
        caption Alph%(1),string$(9,"-")
        top Alph%(1),top(PictColor%)+height(PictColor%)+5
        left Alph%(1),(width_client(frame%(5))-width(Alph%(1)))/2
                
        button_picture BtnPict%(5)
        parent BtnPict%(5),Frame%(5)
        height BtnPict%(5),28
        width BtnPict%(5),width_client(Frame%(5))-10
        top BtnPict%(5),height_client(Frame%(5))-32
        left BtnPict%(5),5
        picture_left BtnPict%(5)
        file_load BtnPict%(5),IconOut$(5)
        caption BtnPict%(5),chr$(32)+"&COPY"+string$(4,chr$(32))
        cursor_point BtnPict%(5)
        on_click BtnPict%(5),CLIC
                
     panel Frame%(6)
     height Frame%(6),38
     width Frame%(6),width_client(0)-width(Frame%(1))-30
     top Frame%(6),height_client(0)-height(Frame%(6))-10
     left Frame%(6),left(Frame%(1))+width(Frame%(1))+10
    
        progress_bar Pb%
        parent Pb%,Frame%(6)
        width Pb%,width_client(Frame%(6))-80
        top Pb%,10
        left Pb%,10
        COLOR_PROGRESS_BAR(Pb%,120,120,130)
        
        alpha Alph%(2)
        parent Alph%(2),frame%(6)
        top Alph%(2),top(Pb%)
        left Alph%(2),left(Pb%)+width(Pb%)+10
        caption Alph%(2),"0 %"
    
     ActiveMouseMoveFrame(0)
     ActiveMouseMoveBtnPict(0)
     ActiveMouseUp()
     ActiveMouseDown()                
  End_sub
' ------------------------------------------------------------------------------
  Sub ActiveMouseMoveFrame(n%)
     on_mouse_move Frame%(1),MMFRAME1
     on_mouse_move Frame%(3),MMFRAME3
     on_mouse_move Frame%(5),MMFRAME5
    
     if n%<>0
        font_color BtnPict%(n%),170,0,255
        file_load BtnPict%(n%),IconIn$(n%)
     end_if
  End_sub
' ------------------------------------------------------------------------------
  Sub ActiveMouseMoveBtnPict(n%)
     dim_local i%
    
     on_mouse_move BtnPict%(1),MMBTN1
     on_mouse_move BtnPict%(2),MMBTN2
     on_mouse_move BtnPict%(3),MMBTN3
     on_mouse_move BtnPict%(4),MMBTN4
     on_mouse_move BtnPict%(5),MMBTN5
    
     if n%<>0
        for i%=1 to 5
            font_color BtnPict%(i%),120,120,130
            file_load BtnPict%(i%),IconOut$(i%)
        next i%
     end_if
  End_sub
' ------------------------------------------------------------------------------
  Sub ActiveMouseUp()
     on_mouse_up BtnPict%(1),MUP1
     on_mouse_up BtnPict%(2),MUP2
     on_mouse_up BtnPict%(3),MUP3
     on_mouse_up BtnPict%(4),MUP4
     on_mouse_up BtnPict%(5),MUP5
  End_sub
' ------------------------------------------------------------------------------
  Sub ActiveMouseDown()
     on_mouse_down BtnPict%(1),MDOWN1
     on_mouse_down BtnPict%(2),MDOWN2
     on_mouse_down BtnPict%(3),MDOWN3
     on_mouse_down BtnPict%(4),MDOWN4
     on_mouse_down BtnPict%(5),MDOWN5
  End_sub
' ------------------------------------------------------------------------------
  Sub ResizePictSrc(h%,l%)
     height PictSrc%,h%
     width PictSrc%,l%
     top PictSrc%,(height_client(Frame%(4))-height(PictSrc%))/2
     left PictSrc%,(width_client(Frame%(4))-width(PictSrc%))/2  
  End_sub
' ------------------------------------------------------------------------------
  Sub COLOR_PROGRESS_BAR(nb%,r%,g%,b%)
     dim_local i%
     dll_on "user32.dll"
        i%=dll_call4("SendMessageA",handle(nb%),1033,0,(b%*65536)+(g%*256)+r%)
     dll_off
  End_sub
' ------------------------------------------------------------------------------
  Sub BlocInterface()
     dim_local i%
    
     for i%=1 to 5 : inactive Frame%(i%) : next i%
  End_sub
' ------------------------------------------------------------------------------
  Sub DeblocInterface()
     dim_local i%
      
     for i%=1 to 5 : active Frame%(i%) : next i%  
  End_sub
' ==============================================================================
' PROCEDURES - AUTRES
' ==============================================================================
  Sub OPEN()
     dim_local f$
    
     open_dialog Odial%
     dir_dialog Odial%,":"
     filter Odial%,"*.bmp|*.bmp"
     f$=file_name$(Odial%)
     delete Odial%
    
     if f$<>"_"        
        Src$ = f$
        CreateImgColorPalette()
     end_if
  End_sub
' ------------------------------------------------------------------------------
  Sub ABOUT()
     dim_local t$,tt$
    
     t$ = "Image Color Palette"
     tt$ = string$(int((30-len(t$))/2),chr$(32))+t$+string$(int((30-len(t$))/2),chr$(32))
     t$ = "Vs 0.1"
     tt$ = tt$+chr$(13)+string$(int((30-len(t$))/2),chr$(32))+t$+string$(int((30-len(t$))/2),chr$(32))
     t$ = "Y.GERONIMI"
     tt$ = tt$+chr$(13)+string$(int((30-len(t$))/2),chr$(32))+t$+string$(int((30-len(t$))/2),chr$(32))
     t$ = "20/08/2019"
     tt$ = tt$+chr$(13)+string$(int((32-len(t$))/2),chr$(32))+t$+string$(int((30-len(t$))/2),chr$(32))
     Mess% = message_information_ok(tt$)
  End_sub
' ------------------------------------------------------------------------------
  Sub HELP()
     Mess% = message_warning_ok("En construction !")
  End_sub
' ------------------------------------------------------------------------------
  Sub ANALYZEPICTURE(obj%,HPict%,WPict%)
     dim_local i%,x%,y%,r$,g$,b$,col$,p%,tx%,ty%,fx%,fy%,bx%,by%,ttpx%
    
     ttpx% = (HPict%*WPict%)
     min Pb%,0 : max Pb%,ttpx% : position Pb%,0
    
     for y% = 0 to HPict%-1
        for x% = 0 to WPict%-1
           r$ = str$(color_pixel_red(obj%,x%,y%))    : r$=string$(5-len(r$),"0")+r$ : r$=right$(r$,3)
           g$ = str$(color_pixel_green(obj%,x%,y%))  : g$=string$(5-len(g$),"0")+g$ : g$=right$(g$,3)
           b$ = str$(color_pixel_blue(obj%,x%,y%))   : b$=string$(5-len(b$),"0")+b$ : b$=right$(b$,3)    
           col$ = r$+g$+b$
           if count(ColorList%)>0
              p%=0
              i%=0
              repeat
                 i%=i%+1
                 if col$ = item_read$(ColorList%,i%)
                    p%=1
                    exit_repeat
                 end_if
              until i%=count(ColorList%)
              if p%=0
                 item_add ColorList%,col$
                 if count(ColorList%)<361
                    if tx% > 120
                       tx% =0 : ty% = ty%+8
                       bx% =7 : by% = by%+8                    
                    end_if
                    2d_target_is PictColor%
                    2d_pen_color val(r$),val(g$),val(b$)
                    2d_rectangle tx%,ty%,bx%,by%
                    fx%=tx%+1 : fy%=ty%+1
                    2d_flood fx%,fy%,val(r$),val(g$),val(b$)
                    tx% = tx%+8
                    bx% = bx%+8                                    
                 end_if                
              end_if
           else
               item_add ColorList%,col$
               color PictColor%,120,120,130
               2d_target_is PictColor%
               2d_pen_color val(r$),val(g$),val(b$)
               tx%=0 : ty%=0 : bx%=7 : by%=7
               2d_rectangle tx%,ty%,bx%,by%
               fx%=tx%+1 : fy%=ty%+1
               2d_flood fx%,fy%,val(r$),val(g$),val(b$)
               tx% = tx%+8
               bx% = bx%+8
           end_if
           position Pb%,position(Pb%)+1
           display          
           caption Alph%(2),str$(int((position(Pb%)*100)/ttpx%))+" %"
           display
        next x%
     next y%
  End_sub
' ------------------------------------------------------------------------------
  Sub CreateImgColorPalette()
     if ImageType$(Src$)="bmp"
        WImg% = Largeur%(fbor%,Src$)
        LImg% = Hauteur%(fbor%,Src$)
        if WImg%<(width_client(Frame%(4))-20) or LImg%<(height_client(Frame%(4))-20)        
           ResizePictSrc(LImg%,WImg%)
           file_load PictSrc%,Src$
           pause 500
           BlocInterface()
           ANALYZEPICTURE(PictSrc%,LImg%,WImg%)
           DeblocInterface()
        else
           Mess% = message_warning_ok("Image trop grande !"+chr$(13)+"...poussez les murs.")
        end_if
     else
        mess% = message_warning_ok("Invalid Format !")
     end_if  
  End_sub
' ==============================================================================
' FONCTIONS
' ==============================================================================
  Fnc ImageType$(file$)
     dim_local t$
    
     t$ = file_extract_extension$(file$)
     t$ = right$(t$,3)
    
     result t$
  End_fnc
' ------------------------------------------------------------------------------
  Fnc ColorPanel$(obj%)
     dim_local x%,y%,r$,g$,b$
    
     x% = mouse_x_position(obj%)
     y% = mouse_y_position(obj%)
     r$ = str$(color_pixel_red(obj%,x%,y%))    : r$=string$(5-len(r$),"0")+r$ : r$=right$(r$,3)
     g$ = str$(color_pixel_green(obj%,x%,y%))  : g$=string$(5-len(g$),"0")+g$ : g$=right$(g$,3)
     b$ = str$(color_pixel_blue(obj%,x%,y%))   : b$=string$(5-len(b$),"0")+b$ : b$=right$(b$,3)    

     result r$+g$+b$
  End_fnc
' ------------------------------------------------------------------------------
  Fnc Largeur%(obj%,F$)
     dim_local i%,fr%,w%,p%
    
     filebin_open_read obj%,F$
     p% = 17
     for i%=0 to 3
        p%=p%+1 : filebin_position obj%,p%
        fr% = filebin_read(obj%)
        if i%>0 : w% = w%+(fr%*power(256,i%)) : else : w% = w%+fr% : end_if
     next i%
     filebin_close obj%
     result w%
  End_Fnc
' ------------------------------------------------------------------------------
  Fnc Hauteur%(obj%,F$)
     dim_local i%,fr%,h%,p%
    
     filebin_open_read obj%,F$
     p% = 21
     for i%=0 to 3
        p%=p%+1 : filebin_position obj%,p%
        fr% = filebin_read(obj%)
        if i%>0 : h% = h%+(fr%*power(256,i%)) : else : h% = h%+fr% : end_if
     next i%
     filebin_close obj%
     result h%    
  End_fnc

file_load BtnPict%(1),IconOut$(1)