FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  RechercherRechercher  Dernières imagesDernières images  S'enregistrerS'enregistrer  MembresMembres  Connexion  
Derniers sujets
» Logiciel de planétarium.
Pano Sub Icon Creator Emptypar Pedro Sam 23 Nov 2024 - 15:50

» Un autre pense-bête...
Pano Sub Icon Creator Emptypar Froggy One Jeu 21 Nov 2024 - 15:54

» Récupération du contenu d'une page html.
Pano Sub Icon Creator Emptypar Pedro Sam 16 Nov 2024 - 14:04

» Décompilation
Pano Sub Icon Creator Emptypar JL35 Mar 12 Nov 2024 - 19:57

» Un album photos comme du temps des grands-mères
Pano Sub Icon Creator Emptypar jjn4 Mar 12 Nov 2024 - 17:23

» traitement d'une feuille excel
Pano Sub Icon Creator Emptypar jjn4 Jeu 7 Nov 2024 - 3:52

» Aide-mémoire mensuel
Pano Sub Icon Creator Emptypar jjn4 Lun 4 Nov 2024 - 18:56

» Des incomprèhension avec Timer
Pano Sub Icon Creator Emptypar Klaus Mer 30 Oct 2024 - 18:26

» KGF_dll - nouvelles versions
Pano Sub Icon Creator Emptypar Klaus Mar 29 Oct 2024 - 17:58

» instructions panoramic
Pano Sub Icon Creator Emptypar maelilou Lun 28 Oct 2024 - 19:51

» Figures fractales
Pano Sub Icon Creator Emptypar Marc Ven 25 Oct 2024 - 12:18

» Panoramic et Scanette
Pano Sub Icon Creator Emptypar Yannick Mer 25 Sep 2024 - 22:16

» Editeur d étiquette avec QR évolutif
Pano Sub Icon Creator Emptypar JL35 Lun 23 Sep 2024 - 22:40

» BUG QR Code DelphiZXingQRCode
Pano Sub Icon Creator Emptypar Yannick Dim 22 Sep 2024 - 11:40

» fichier.exe
Pano Sub Icon Creator Emptypar leclode Ven 20 Sep 2024 - 19:02

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Novembre 2024
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
252627282930 
CalendrierCalendrier
Le Deal du moment : -25%
PC Portable Gamer 16,1” HP Victus 16 – 16 ...
Voir le deal
749.99 €

 

 Pano Sub Icon Creator

Aller en bas 
AuteurMessage
Yannick




Nombre de messages : 8635
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

Pano Sub Icon Creator Empty
MessageSujet: Pano Sub Icon Creator   Pano Sub Icon Creator EmptyLun 12 Aoû 2019 - 19:48

Le titre n' est pas terrible mais bon.
Jack nous a offert la possibilité de dessiner dans les pictures des button_picture
Il m' est allors venu l'idée d' embarquer un mask du dessin de l'icone d'un bouton dans une sub.

Je vous laisse découvrir un premier jet...à interpréter, le compilateur a encore quelques soucis avec certaines commandes.

Bon voilà l' appli qui créé le code de la sub :
Code:
' ==============================================================================
' VARIABLES
' ==============================================================================
' Gestion des objets
' ------------------------------------------------------------------------------
  dim no%
' ------------------------------------------------------------------------------
' Gestion du traitement
' ------------------------------------------------------------------------------
  dim format%
  dim Icone$
' ==============================================================================
' CONSTANTES FICHIERS
' ==============================================================================
  dim ImgBtnPictOn$(10)
  dim ImgBtnPictOff$(10)
  dim ImgBtnPictClic$(10)
  dim Logo$
' ==============================================================================
' CONSTANTES OBJETS
' ==============================================================================
  dim Odial%
  dim Sdial%
  dim Frame%(10)
  dim BtnPict%(10)
  dim ContOpt%
  dim FormatOpt%(4)
  dim BackGrd%
  dim MaskPict%
  dim MaskText%
  dim LogoPict%
' ==============================================================================
' LABELS
' ==============================================================================
  label CLIC
  label FIN
  label MoveFrame1,MoveFrame2,MoveFrame3,MoveFrame4,MoveFrame5
  label MoveBtn1,MoveBtn2,MoveBtn3,MoveBtn4,MoveBtn5,MoveBtn6,MoveBtn7,MoveBtn8
' ==============================================================================
' PROGRAMME
' ==============================================================================
  InitConstFichiers()
  InitConstObjet()
  GUI()
  end
' ==============================================================================
' SOUS PROGRAAMMES
' ==============================================================================
' Gestion des CLIC
' ------------------------------------------------------------------------------
  CLIC:
   ' Ouverture d'un fichier Mask
     if number_click = BtnPict%(1)
        Icone$=LoadingFile$(str$(format%))
        OpenFile(Icone$)
     end_if
   ' Suvegarde d'un traitement de fichier
     if number_click = BtnPict%(2)
        SaveFile()
     end_if
   ' Effacement du memo
     if number_click = BtnPict%(3)
        Clear MaskText%
     end_if
   ' Copie du memo
     if number_click = BtnPict%(4)
        Select_text MaskText%,1,NbreCaractere%(MaskText%)
        clipboard_string_copy select_read$(MaskText%)        
     end_if
   ' Creation de la procedure
     if number_click = BtnPict%(5)
        MakeProcedure(Icone$,MaskPict%,MaskText%)
     end_if
   ' Fermeture de l'application
     if number_click = BtnPict%(8)
        font_color BtnPict%(8),255,0,0
        file_load  BtnPict%(8),ImgBtnPictClic$(8)
        wait 500
        Terminate
     end_if
   ' Options de format  
     if number_click = FormatOpt%(1)
        ResizeMaskPict(16)
        format%=16        
        font_color FormatOpt%(2),120,120,130
        font_color FormatOpt%(3),120,120,130
        font_color FormatOpt%(4),120,120,130
        font_color FormatOpt%(1),170,0,255
     end_if
     if number_click = FormatOpt%(2)
        ResizeMaskPict(24)
        format%=24
        font_color FormatOpt%(1),120,120,130
        font_color FormatOpt%(3),120,120,130
        font_color FormatOpt%(4),120,120,130
        font_color FormatOpt%(2),170,0,255
     end_if
     if number_click = FormatOpt%(3)
        ResizeMaskPict(32)
        format%=32
        font_color FormatOpt%(1),120,120,130
        font_color FormatOpt%(2),120,120,130
        font_color FormatOpt%(4),120,120,130
        font_color FormatOpt%(3),170,0,255
     end_if
     if number_click = FormatOpt%(4)
        ResizeMaskPict(48)
        format%=48
        font_color FormatOpt%(1),120,120,130
        font_color FormatOpt%(2),120,120,130
        font_color FormatOpt%(3),120,120,130
        font_color FormatOpt%(4),170,0,255
     end_if  
  return
' ------------------------------------------------------------------------------
' Fermeture de l'application
' ------------------------------------------------------------------------------
  FIN:
     Terminate
  return
' ------------------------------------------------------------------------------
' Initialisation des Boutons menu
' ------------------------------------------------------------------------------
  MoveFrame1:
     off_mouse_move Frame%(1)
     InitBtnMenu()
     ActiveBtnMouseMove()
  return
  MoveFrame2:
     off_mouse_move Frame%(2)
     InitBtnMenu()
     ActiveBtnMouseMove()
  return
  MoveFrame3:
     off_mouse_move Frame%(3)
     InitBtnMenu()
     ActiveBtnMouseMove()
  return
  MoveFrame4:
     off_mouse_move Frame%(4)
     InitBtnMenu()
     ActiveBtnMouseMove()
  return
  MoveFrame5:
     off_mouse_move Frame%(5)
     InitBtnMenu()
     ActiveBtnMouseMove()
  return
' ------------------------------------------------------------------------------
' Activation des MOUSE_MOVE sur les boutons
' ------------------------------------------------------------------------------
  MoveBtn1:
     off_mouse_move BtnPict%(1)
     font_color BtnPict%(1),170,0,255
     file_load BtnPict%(1),ImgBtnPictOn$(1)
     ActiveFrameMouseMove()
  return
  MoveBtn2:
     off_mouse_move BtnPict%(2)
     font_color BtnPict%(2),170,0,255
     file_load BtnPict%(2),ImgBtnPictOn$(2)
     ActiveFrameMouseMove()
  return
  MoveBtn3:
     off_mouse_move BtnPict%(3)
     font_color BtnPict%(3),170,0,255
     file_load BtnPict%(3),ImgBtnPictOn$(3)
     ActiveFrameMouseMove()
  return
  MoveBtn4:
     off_mouse_move BtnPict%(4)
     font_color BtnPict%(4),170,0,255
     file_load BtnPict%(4),ImgBtnPictOn$(4)
     ActiveFrameMouseMove()
  return
  MoveBtn5:
     off_mouse_move BtnPict%(5)
     font_color BtnPict%(5),170,0,255
     file_load BtnPict%(5),ImgBtnPictOn$(5)
     ActiveFrameMouseMove()
  return
  MoveBtn6:
     off_mouse_move BtnPict%(6)
     font_color BtnPict%(6),170,0,255
     file_load BtnPict%(6),ImgBtnPictOn$(6)
     ActiveFrameMouseMove()
  return
  MoveBtn7:
     off_mouse_move BtnPict%(7)
     font_color BtnPict%(7),170,0,255
     file_load BtnPict%(7),ImgBtnPictOn$(7)
     ActiveFrameMouseMove()
  return
  MoveBtn8:
     off_mouse_move BtnPict%(8)
     font_color BtnPict%(8),170,0,255
     file_load BtnPict%(8),ImgBtnPictOn$(8)
     ActiveFrameMouseMove()
  return
' ==============================================================================
' PROCEDURES D'INITIALISATION
' ==============================================================================
' FICHIERS
' ------------------------------------------------------------------------------
  Sub InitConstFichiers()
     dim_local i%
        
     for i%=1 to 8
        ImgBtnPictOff$(i%) = dir_current$+"\Img\Ico_Off\Btn_"+str$(i%)+".bmp"
     next i%
     for i%=1 to 8
        ImgBtnPictOn$(i%)  = dir_current$+"\Img\Ico_On\Btn_"+str$(i%)+".bmp"
     next i%
     for i%=1 to 8
        ImgBtnPictClic$(i%)= dir_current$+"\Img\Ico_Clic\Btn_"+str$(i%)+".bmp"
     next i%
     Logo$ = dir_current$+"\Img\Masque1.bmp"  
  End_sub
' ------------------------------------------------------------------------------
' OBJETS
' ------------------------------------------------------------------------------
  Sub InitConstObjet()
     dim_local i%
    
     no%=no%+1 : Odial%=no%
     no%=no%+1 : Sdial%=no%
     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%
     no%=no%+1 : ContOpt%=no%
     for i%=1 to 4 : no%=no%+1 : FormatOpt%(i%)=no% : next i%
     no%=no%+1 : BackGrd%=no%
     no%=no%+1 : MaskPict%=no%
     no%=no%+1 : MaskText%=no%
     no%=no%+1 : LogoPict%=no%
  End_sub
' ==============================================================================
' PROCEDURES DE GESTION DE L'INTERFACE
' ==============================================================================
  Sub GUI()
     dim_local i%,t%,l%,obj%,etiq$,capt$
    
     border_small 0
     height 0,450  : width 0,700
     top 0,(screen_y-height(0))/2 : left 0,(screen_x-width(0))/2
     color 0,120,120,130
     caption 0,"PanoSubIcon Editor"
     ' create_hide
    
     panel Frame%(1)
     height Frame%(1),71
     width Frame%(1),145
     top Frame%(1),10
     left Frame%(1),10
     color Frame%(1),240,240,240
     on_mouse_move Frame%(1),MoveFrame1
    
     panel Frame%(2)
     height Frame%(2),71
     width Frame%(2),145
     top Frame%(2),top(Frame%(1))+height(Frame%(1))
     left Frame%(2),10
     color Frame%(2),240,240,240
    
     panel Frame%(3)
     height Frame%(3),height_client(0)-71-71-104-20
     width Frame%(3),145
     top Frame%(3),top(frame%(2))+height(Frame%(2))
     left Frame%(3),10
     color Frame%(3),240,240,240
    
     panel Frame%(4)
     height Frame%(4),104
     width Frame%(4),145
     top Frame%(4),top(frame%(3))+height(Frame%(3))
     left Frame%(4),10
     color Frame%(4),240,240,240    
    
     panel Frame%(5)
     height Frame%(5),230 : width Frame%(5),width_client(0)-width(Frame%(1))-30
     top Frame%(5),10 : left Frame%(5),left(Frame%(1))+width(Frame%(1))+10
     color Frame%(5),240,240,240
    
     panel Frame%(6)
     height Frame%(6),150 : width Frame%(6),width_client(0)-width(Frame%(1))-30
     top Frame%(6),top(Frame%(5))+height(Frame%(5))+10: left Frame%(6),left(Frame%(1))+width(Frame%(1))+10
     color Frame%(6),240,240,240
    
     etiq$ = "&OPEN,&SAVE,&CUT,CO&PY,&MAKE,&ABOUT,&HELP,&QUIT,"
     t%=5
     l%=5
     for i%=1 to 8
        obj%=BtnPict%(i%)
        button_picture obj%
        if i%<3
           parent obj%,Frame%(1)
        else
           if i%>2 and i%<5
              parent obj%,Frame%(2)
           else
              if i%=5
                 parent obj%,Frame%(3)
              else
                 parent obj%,Frame%(4)
              end_if
           end_if
        end_if
        height obj%,28 : width obj%,135
        if i%=3 or i%=5 or i%=6 : t%=5 : end_if
        top obj%,t% : left obj%,l%
        picture_left obj%
        file_load obj%,ImgBtnPictOff$(i%)
        capt$ = left$(etiq$,instr(etiq$,chr$(44))-1)
        etiq$ = right$(etiq$,len(etiq$)-instr(etiq$,chr$(44)))
        caption obj%,chr$(32)+capt$+string$(10-len(capt$),chr$(32))
        font_name obj%,"Courier new" : font_size obj%,10 : font_bold obj% : font_color obj%,120,120,130
        cursor_point obj%
        on_click obj%,CLIC
        t%=t%+height(obj%)+5
     next i%
     ActiveBtnMouseMove()
    
     picture LogoPict%
     parent LogoPict%,Frame%(3)
     height LogoPict%,113  : width LogoPict%,150
     top LogoPict%,top(BtnPict%(5))+height(BtnPict%(5))+5  : left LogoPict%,(width_client(3)-width(LogoPict%))/2
     file_load LogoPict%,Logo$
    
     container_option ContOpt%
     parent ContOpt%,Frame%(5)
     height ContOpt%,50 : width ContOpt%,width_client(Frame%(5))-10
     top ContOpt%,5 : left ContOpt%,5
     font_name ContOpt%,"Courier new" : font_size ContOpt%,10 : font_bold ContOpt% : font_color ContOpt%,120,120,130
     caption ContOpt%," Format "
    
     etiq$="16x16 px,24x24 px,32x32 px,48x48 px,"
     t%=20
     l%=30
     for i%=1 to 4
        obj% = FormatOpt%(i%)
        option obj%
        parent obj%,ContOpt%
        top obj%,t% : left obj%,l%
        capt$ = left$(etiq$,instr(etiq$,chr$(44))-1)
        etiq$ = right$(etiq$,len(etiq$)-instr(etiq$,chr$(44)))
        caption obj%,capt$
        cursor_point obj%
        on_click obj%,CLIC
        l%=l%+width(obj%)+5
     next i%        

     picture BackGrd%
     parent BackGrd%,frame%(5)
     height BackGrd%,20 : width BackGrd%,20
     top BackGrd%,(height_client(Frame%(5))+60-height(BackGrd%))/2 : left BackGrd%,(width_client(Frame%(5))-width(BackGrd%))/2
     color BackGrd%,120,120,130
    
     picture MaskPict%
     parent MaskPict%,frame%(5)
     height MaskPict%,16 : width MaskPict%,16
     top MaskPict%,top(BackGrd%)+2 : left MaskPict%,left(BackGrd%)+2
     color MaskPict%,255,255,255
    
     Memo MaskText%
     parent MaskText%,Frame%(6)
     height MaskText%,height_client(Frame%(6))-10 : width MaskText%,width_client(Frame%(6))-10
     top MaskText%,5 : left MaskText%,5
     bar_both MaskText%
     color MaskText%,255,255,200
     font_name MaskText%,"Courier new" : font_size MaskText%,10 : font_bold MaskText% : font_color MaskText%,120,120,130
    
     ' show_all
     mark_on FormatOpt%(1)  
  End_sub
' ------------------------------------------------------------------------------
' Redimension MaskPict
' ------------------------------------------------------------------------------
  Sub ResizeMaskPict(size%)
  
     height BackGrd%,size%+2 : width BackGrd%,size%+2
     top BackGrd%,(height_client(Frame%(5))+60-height(BackGrd%))/2 : left BackGrd%,(width_client(Frame%(5))-width(BackGrd%))/2
     color BackGrd%,120,120,130    
     height MaskPict%,size% : width MaskPict%,size%
     top MaskPict%,top(BackGrd%)+1 : left MaskPict%,left(BackGrd%)+1  
  end_sub
' ------------------------------------------------------------------------------
' Initialisation des Boutons menu
' ------------------------------------------------------------------------------
  Sub InitBtnMenu()
     dim_local i%
    
     for i%=1 to 8
        file_load BtnPict%(i%),ImgBtnPictOff$(i%)
        font_color BtnPict%(i%),120,120,130
     next i%
  End_sub
' ------------------------------------------------------------------------------
' Activation de MOUSE_MOVE sur les frames
' ------------------------------------------------------------------------------
  Sub ActiveFrameMouseMove()
     on_mouse_move Frame%(1),MoveFrame1
     on_mouse_move Frame%(2),MoveFrame2
     on_mouse_move Frame%(3),MoveFrame3
     on_mouse_move Frame%(4),MoveFrame4
     on_mouse_move Frame%(5),MoveFrame5  
  End_sub
' ------------------------------------------------------------------------------
' Activation de MOUSE_MOVE sur les boutons menu
' ------------------------------------------------------------------------------
  Sub ActiveBtnMouseMove()
     on_mouse_move BtnPict%(1),MoveBtn1
     on_mouse_move BtnPict%(2),MoveBtn2
     on_mouse_move BtnPict%(3),MoveBtn3
     on_mouse_move BtnPict%(4),MoveBtn4
     on_mouse_move BtnPict%(5),MoveBtn5
     on_mouse_move BtnPict%(6),MoveBtn6
     on_mouse_move BtnPict%(7),MoveBtn7
     on_mouse_move BtnPict%(8),MoveBtn8
  End_sub
' ==============================================================================
' PROCEDURES DE TRAITEMENT DE FICHIER *.Msk
' ==============================================================================
' Ouverture d'un fichier
' ------------------------------------------------------------------------------
  Sub Openfile(File$)
     if File$<>"_"
        file_load MaskPict%,File$
     end_if
  End_sub
' ------------------------------------------------------------------------------
' Enregistrement du traitemant d'un fichier
' ------------------------------------------------------------------------------
  Sub SaveFile()
     dim_local mess%,f$
  
     if count(MaskText%)>0
        save_dialog Sdial%
        dir_dialog Sdial%,":"
        filter Sdial%,"*.bas|*.bas"
        f$ = file_name$(Sdial%)
        delete Sdial%        
        if f$<>"_"
           if right$(f$,4)<>".bas"
              f$=f$+".bas"
           end_if
           file_save MaskText%,f$
        end_if        
     else
        mess%=message_warning_ok("Aucune donnée à sauvegarder !")        
     end_if
  End_sub
' ------------------------------------------------------------------------------
' Traitement du fichier
' ------------------------------------------------------------------------------
  Sub MakeProcedure(f$,objet%,objet2%)
     dim_local x%,y%,i%,r$,g$,b$,c1$,c2$,line$,file$,mess%
    
     if f$=""
        mess%=message_warning_ok("Vous devez ouvrir une image Mask !")
        exit_sub
     end_if
        
     file$=file_extract_name$(f$)
     file$=left$(file$,len(file$)-4)
     item_add objet2%,"Sub Dessine"+file$+"(obj%,r%,g%,b%)"
     item_add objet2%,"   dim_local x%,y%,Img$,geo$"
     item_add objet2%,""
     2d_target_is objet%
     for y%=0 to format%-1
        for x%=0 to format%-1
          
          
           c1$=str$(x%)
           c1$=right$(string$(4-len(c1$),"0")+c1$,2)
           c2$=str$(y%)
           c2$=right$(string$(4-len(c2$),"0")+c2$,2)
           r$=str$(color_pixel_red(objet%,x%,y%))
           g$=str$(color_pixel_green(objet%,x%,y%))
           b$=str$(color_pixel_blue(objet%,x%,y%))    
          
           if r$+g$+b$="000"
              i%=i%+1
              line$ = line$+c1$+c2$
           end_if
          
           if i%=10
              item_add objet2%,string$(3,chr$(32))+"Img$ = Img$+"+chr$(34)+line$+chr$(34)
              i%=0
              line$=""
           else
              if x%=(format%-1) and y%=(format%-1)
                 item_add objet2%,string$(3,chr$(32))+"Img$ = Img$+"+chr$(34)+line$+chr$(34)
                 i%=0
                 line$=""              
              end_if
           end_if            
        next x%
     next y%
     item_add objet2%,""
     item_add objet2%,string$(3,chr$(32))+"2d_target_is obj%"
     item_add objet2%,""      
     item_add objet2%,string$(3,chr$(32))+"while len(Img$)>0 "
     item_add objet2%,string$(6,chr$(32))+"geo$=left$(Img$,4)"
     item_add objet2%,string$(6,chr$(32))+"Img$=right$(Img$,len(Img$)-4)"
     item_add objet2%,string$(6,chr$(32))+"if len(Img$)=0 : exit_while : end_if"
     item_add objet2%,string$(6,chr$(32))+"x%=val(mid$(Img$,1,2))"
     item_add objet2%,string$(6,chr$(32))+"y%=val(mid$(Img$,3,2))"
     item_add objet2%,string$(6,chr$(32))+"2d_pen_color r%,g%,b%"
     item_add objet2%,string$(6,chr$(32))+"print_locate x%,y%"
     item_add objet2%,string$(6,chr$(32))+"2d_point x%,y%"            
     item_add objet2%,string$(3,chr$(32))+"end_while"
     item_add objet2%,"End_sub"
  End_sub
' ==============================================================================
' FONCTIONS
' ==============================================================================
  Fnc LoadingFile$(f$)
     dim_local fn$
    
     open_dialog Odial%
     dir_dialog Odial%,dir_current$+"\Img\Mask\Ico"+f$
     filter Odial%,"*.bmp|*.bmp"
     fn$ = file_name$(Odial%)
     delete Odial%
     result fn$
  End_fnc
' ------------------------------------------------------------------------------
' nombre de caractere du memo
' ------------------------------------------------------------------------------
  Fnc NbreCaractere%(objet%)
     dim_local i%,l$,n%
  
     if count(objet%)>0
        for i%=1 to count(objet%)
           l$=item_read$(objet%,i%)
           n%=n%+len(l$)+2
        next i%
        result n%
     end_if
  End_fnc


Pano Sub Icon Creator Captur49
Utilisation de la procdure créée :
Code:
color 0,255,0,0

button_picture 2
height 2,24 : width 2,24
top 2,20 : left 2,20
button_picture_target_is_picture
height 2,16 : width 2,16
DessineNewFile(2,0,0,150)
end

Sub DessineNewFile(obj%,r%,g%,b%)
  dim_local x%,y%,Img$,geo$

  Img$ = Img$+"0302040205020602070208020902100203030803"
  Img$ = Img$+"1003110303040804110412040305080512050306"
  Img$ = Img$+"0806090610061106120603071207030812080309"
  Img$ = Img$+"1209031012100311121103121212031304130513"
  Img$ = Img$+"0613071308130913101311131213"

  2d_target_is obj%

  while len(Img$)>0
      geo$=left$(Img$,4)
      Img$=right$(Img$,len(Img$)-4)
      if len(Img$)=0 : exit_while : end_if
      x%=val(mid$(Img$,1,2))
      y%=val(mid$(Img$,3,2))
      2d_pen_color r%,g%,b%
      print_locate x%,y%
      2d_point x%,y%
  end_while
End_sub


Je vais mettre le reste sur mon webdav

PanoSubIconCreator.zip


Dernière édition par Yannick le Lun 12 Aoû 2019 - 22:45, édité 1 fois (Raison : reduction de la procedure)
Revenir en haut Aller en bas
Yannick




Nombre de messages : 8635
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

Pano Sub Icon Creator Empty
MessageSujet: re   Pano Sub Icon Creator EmptyLun 12 Aoû 2019 - 22:48

Je viens de modifier un le source au dessus pour réduire la procédure créée.
J' ai fait ceci pour palier au problème des commandes sur les data avec le compilateur.
Le masque de départ doit etre en noir sur blanc.

Je file mettre le webdav à jour...
Laughing
Revenir en haut Aller en bas
Yannick




Nombre de messages : 8635
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010

Pano Sub Icon Creator Empty
MessageSujet: re   Pano Sub Icon Creator EmptyMer 14 Aoû 2019 - 4:13

Bon, j' ai revu ma copie.
Et, j' ai rendu l' application "drag and drop"
Je vous ai mis un zip sur mon webdav.

Attention !
Le zip contient :

- 1 fichier  : PanoSubIcon.exe
Ce fichier peut être placé n'importe où sur votre ordi.
- 1 dossier : PanoSubIconTmp
Ce dossier doit être placé dans le dossier "C:\Temp"
- 1 fichier  : PanoSubIcon.bas
Ce dernier est le source, il n' est pas exécutable sauf si vous désactivez
en mettant en commentaire la ligne 57
Code:
if file$="" : terminate : end_if

Pour qu' il y ait une queconque action vous devez placez un fichier au dessus de l' icone de l' exe.
drag and drop.
Le fichier doit être une image noire sur blanc de 16x16 ou 24x24 ou 32x32 ou 48x48.

Voilà, à vous de voir si vous voulez tester.
L' application crée un procédure qui dessine l' image qui lui a été soumise.

Pour les simples curieux, voilà le source.
Code:
'                            PanoIconSub Editor
'                              version : 0.3
'                                Y GERONIMI
'                                12/08/2019
'
' ==============================================================================
' VARIABLES
' ==============================================================================
  dim no%
  dim File$
  dim Format%
' ==============================================================================
' CONSTANTES - FICHIERS
' ==============================================================================
  dim LogoFile$
  dim IcoFileOff$(5)
  dim IcoFileOn$(5)
  dim IcoFileClic$(5)
' ==============================================================================
' CONSTANTES - OBJETS
' ==============================================================================
  dim MemoSub%
  dim Frame%
  dim Alph%(5)
  dim Pict%
  dim ViewBg%
  dim View%
  dim Pb%
  dim Sdial%
  dim BtnPict%(5)
' ==============================================================================
' LABEL
' ==============================================================================
  label CLIC
  label MOUSEMOVEFRAME
  label MMBUT1
  label MMBUT2
  label MMBUT3
  label MMBUT4
  label MMBUT5
  label MMVIEW
  label MMVIEWBG
  label MUP1
  label MUP2
  label MUP3
  label MUP4
  label MUP5
  label MDOWN1
  label MDOWN2
  label MDOWN3
  label MDOWN4
  label MDOWN5
' ==============================================================================
' PROGRAMME
' ==============================================================================
  File$=param_value$(1)
  if file$="" : Terminate : end_if
  ' InitEnvironnement()
  InitConstantesFichiers()
  InitConstantesObjets()
  GUI()
  Automate()
  end
' ==============================================================================
' SOUS PROGRAMMES
' ==============================================================================
' Gestion des ON_CLICK
  CLIC:
  ' Clipboard Copy
    if number_click = BtnPict%(1)
        ClipBoardCopy()
    end_if
  ' Save *.bas
    if number_click = BtnPict%(2)
        SaveAsBas()
    end_if
  ' About
    if number_click = BtnPict%(3)
        About()
    end_if
  ' Help
    if number_click = BtnPict%(4)
    end_if
  ' Quit
    if number_click = BtnPict%(5)
        Terminate
    end_if
  return
' ------------------------------------------------------------------------------
' Gestion des ON_MOUSE_MOVE sur Frame
  MOUSEMOVEFRAME:
    InitButton()
    ActiveMouseMoveButton()
  return
' ------------------------------------------------------------------------------
' Gestion des ON_MOUSE_MOVE sur button_picture
  MMBUT1:
    MouseMoveButtonPicture(1)
  return 
  MMBUT2:
    MouseMoveButtonPicture(2)
  return 
  MMBUT3:
    MouseMoveButtonPicture(3)
  return 
  MMBUT4:
    MouseMoveButtonPicture(4)
  return 
  MMBUT5:
    MouseMoveButtonPicture(5)
  return
  MMVIEW:
    off_mouse_move View%
    on_mouse_move ViewBg%,MMVIEWBG
    2d_target_is ViewBg%
    2d_flood 1,1,0,0,150
  return
  MMVIEWBG:
    off_mouse_move ViewBg%
    on_mouse_move View%,MMVIEW
    2d_target_is ViewBg%
    2d_flood 1,1,170,195,255
  return
' ------------------------------------------------------------------------------
' Gestion des ON_MOUSE_DOWN sur button_picture
  MDOWN1:
    MouseDownBtn(1)
  return
  MDOWN2:
    MouseDownBtn(2)
  return
  MDOWN3:
    MouseDownBtn(3)
  return
  MDOWN4:
    MouseDownBtn(4)
  return
  MDOWN5:
    MouseDownBtn(5)
  return
' ------------------------------------------------------------------------------
' Gestion des ON_MOUSE_DOWN sur button_picture 
  MUP1:
    MouseUpBtn(1)
  return
  MUP2:
    MouseUpBtn(2)
  return
  MUP3:
    MouseUpBtn(3)
  return
  MUP4:
    MouseUpBtn(4)
  return
  MUP5:
    MouseUpBtn(5)
  return 
' ==============================================================================
' PROCEDURES - INITIALISATIONS
' ==============================================================================
' Environnement
  Sub InitEnvironnement()
    dim_local i%
   
    if dir_exists("C:\Temp")=0                      : dir_make "C:\Temp"                    : end_if
    if dir_exists("C:\Temp\PanoSubIconTmp")=0      : dir_make "C:\Temp\PanoSubIconTmp"    : end_if
    if dir_exists("C:\Temp\PanoSubIconTmp\Img")=0  : dir_make "C:\Temp\PanoSubIconTmp\Img" : end_if
    archiver_on
    archiver_extract "Img.zip","C:\Temp\PanoSubIconTmp\Img"
    archiver_off
  End_sub
' ------------------------------------------------------------------------------
' Fichiers
  Sub InitConstantesFichiers()
    dim_local i%
   
    LogoFile$ = "C:\Temp\PanoSubIconTmp\Img\Logo.bmp"
    for i%=1 to 5 : IcoFileClic$(i%) = "C:\Temp\PanoSubIconTmp\Img\BtnClic_"+str$(i%)+".bmp" : next i%
    for i%=1 to 5 : IcoFileOff$(i%)  = "C:\Temp\PanoSubIconTmp\Img\BtnOff_"+str$(i%)+".bmp"  : next i%
    for i%=1 to 5 : IcoFileOn$(i%)  = "C:\Temp\PanoSubIconTmp\Img\BtnOn_"+str$(i%)+".bmp"  : next i%
  End_sub
' ------------------------------------------------------------------------------
' Objets
  Sub InitConstantesObjets()
    dim_local i%
   
    no%=no%+1 : MemoSub%=no%
    no%=no%+1 : Frame%=no%
    no%=no%+1 : Pict%=no%
    no%=no%+1 : ViewBg%=no%
    no%=no%+1 : View%=no%
    no%=no%+1 : Pb%=no%
    for i%=1 to 5 : no%=no%+1 : Alph%(i%)=no%    : next i%
    for i%=1 to 5 : no%=no%+1 : BtnPict%(i%)=no% : next i%
    no%=no%+1 : Sdial%=no%
  End_sub
' ==============================================================================
' PROCEDURES - CREATION DE FORMULAIRES
' ==============================================================================
  Sub GUI()
    dim_local i%,t%,l%,etiq$,capt$
   
    border_hide 0
    height 0,230 : width 0,500
    top 0,(screen_y-height(0))/2 : left 0,(screen_x-width(0))/2
    color 0,170,195,255
   
    memo MemoSub% : hide MemoSub%
    height MemoSub%,height_client(0)
    width MemoSub%,width_client(0)

    panel Frame%
    height Frame%,height_client(0)-20
    width frame%,width_client(0)-20
    top Frame%,10
    left Frame%,10
         
    picture Pict%
    parent Pict%,Frame%
    height Pict%,140 : width Pict%,140
    top Pict%,20 : left Pict%,10
    color Pict%,240,240,240   
    file_load Pict%,LogoFile$
         
    picture ViewBg%
    parent ViewBg%,Frame%
    height ViewBg%,52 : width ViewBg%,52
    top ViewBg%,10 : left ViewBg%,width_client(Frame%)-width(ViewBg%)-10
    color ViewBg%,170,195,255

    picture View%
    parent View%,Frame%
    height View%,48 : width View%,48
    top View%,12 : left View%,width_client(Frame%)-width(View%)-12
    color View%,0,0,0
    cursor_point View%
    on_mouse_move View%,MMVIEW
    if File$<>"" : hint View%,file_extract_name$(File$) : end_if
   
    Alpha Alph%(1)
    parent Alph%(1),Frame%
    Top Alph%(1),70 : left Alph%(1),left(Pict%)+width(Pict%)+20
    font_name Alph%(1),"Courier new" : font_size Alph%(1),10 : font_bold Alph%(1)
    font_color Alph%(1),170,195,255   
   
    progress_bar Pb%
    parent Pb%,Frame%
    width Pb%,200
    top Pb%,90 : left Pb%,left(Pict%)+width(Pict%)+20
    COLOR_PROGRESS_BAR(Pb%,170,195,255)
   
    Alpha Alph%(2)
    parent Alph%(2),Frame%
    Top Alph%(2),90 : left Alph%(2),left(Pict%)+width(Pict%)+20
    font_name Alph%(2),"Courier new" : font_size Alph%(2),10 : font_bold Alph%(2)
    font_color Alph%(2),170,195,255
    caption Alph%(2),"...Analyse du fichier."
   
    Alpha Alph%(3)
    parent Alph%(3),Frame%
    Top Alph%(3),top(Pb%)+height(Pb%)+5 : left Alph%(3),left(Pict%)+width(Pict%)+50
    font_name Alph%(3),"Courier new" : font_size Alph%(3),10 : font_bold Alph%(3)
    font_color Alph%(3),170,195,255
    caption Alph%(3),"...Analyse du fichier."
   
    etiq$ = "COPY,SAVE,ABOUT,HELP,QUIT,"
    t% = height_client(Frame%)-33
    l% = 5
    for i%=1 to 5
        button_picture BtnPict%(i%)
        parent BtnPict%(i%),Frame%
       
        button_picture_target_is_object
        height BtnPict%(i%),28 : width BtnPict%(i%),90
        top BtnPict%(i%),t% : left BtnPict%(i%),l%
       
        button_picture_target_is_picture
        height BtnPict%(i%),24 : width BtnPict%(i%),24
        picture_left BtnPict%(i%)
        file_load BtnPict%(i%),IcoFileOff$(i%)
       
        font_name BtnPict%(i%),"Courier new" : font_size BtnPict%(i%),10 : font_bold BtnPict%(i%)
        font_color BtnPict%(i%),150,170,235
        capt$ = left$(etiq$,instr(etiq$,chr$(44))-1)
        etiq$ = right$(etiq$,len(etiq$)-instr(etiq$,chr$(44)))
        caption BtnPict%(i%),chr$(32)+capt$+string$(7-len(capt$),chr$(32))
       
        cursor_point BtnPict%(i%)
        on_click BtnPict%(i%),CLIC
       
        if i%=4 : hide BtnPict%(i%) : end_if
        l%=l%+width(BtnPict%(i%))+5
    next i%
    ActiveMouseMoveButton()
    ActiveMouseUpButton()
    ActiveMouseDownButton()     
    on_mouse_move View%,MMVIEW   
    on_mouse_move ViewBg%,MMVIEWBG
    on_mouse_move Frame%,MOUSEMOVEFRAME
     
  End_sub
' ==============================================================================
' PROCEDURES - AFFICHAGE DE L'INTERFACE
' ==============================================================================
' Détection des mvts sur button
  Sub ActiveMouseMoveButton()
    on_mouse_move BtnPict%(1),MMBUT1
    on_mouse_move BtnPict%(2),MMBUT2
    on_mouse_move BtnPict%(3),MMBUT3
    on_mouse_move BtnPict%(4),MMBUT4
    on_mouse_move BtnPict%(5),MMBUT5
  End_sub
  Sub ActiveMouseUpButton()
    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 ActiveMouseDownButton()
    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
' ------------------------------------------------------------------------------
' mouse_move des boutons
  Sub MouseMoveButtonPicture(n%)   
    off_mouse_move BtnPict%(n%)
    font_color BtnPict%(n%),0,0,150
    file_load BtnPict%(n%),IcoFileOn$(n%)   
    on_mouse_move Frame%,MOUSEMOVEFRAME   
  End_sub
' ------------------------------------------------------------------------------
' initialisation du visuel des boutons
  Sub InitButton()
    dim_local i%
   
    off_mouse_move Frame%
    for i%=1 to 5
        font_color BtnPict%(i%),150,170,235
        file_load BtnPict%(i%),IcoFileOff$(i%)
    next i%
  End_sub
' ------------------------------------------------------------------------------
' Gestion des on_mouse_down
  Sub MouseDownBtn(n%)
    dim_local i%
 
    for i%=1 to 5
        if i%=n%
          file_load BtnPict%(i%),IcoFileClic$(i%)
          font_color BtnPict%(i%),255,0,0
        end_if
    next i%
  End_sub
' ------------------------------------------------------------------------------
' Gestion des on_mouse_up
  Sub MouseUpBtn(n%)
    dim_local i%
 
    for i%=1 to 5
        if i%=n%
          file_load BtnPict%(i%),IcoFileOn$(i%)
          font_color BtnPict%(i%),0,0,150
        end_if
    next i%
  End_sub
' ------------------------------------------------------------------------------
' Redimension des pictures
  Sub ResizePicture(size%)
    dim_local i%
         
    height ViewBg%,size%+4
    width ViewBg%,size%+4
    top ViewBg%,12
    left ViewBg%,width_client(Frame%)-width(ViewBg%)-12
   
    height View%,size%
    width View%,size%
    top View%,top(ViewBg%)+2
    left View%,left(ViewBg%)+2   
  End_sub
' ------------------------------------------------------------------------------
' Colorisation de l'objet PROGRESS_BAR
  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
' ==============================================================================
' PROCEDURES - TRAITEMENT DE FICHIER
' ==============================================================================
  Sub Automate()
    dim_local x%,y%,r%,g%,b%,ext$,i%,r$,g$,b$,c1$,c2$,line$,f$,mess%,maxi%
   
    if File$<>""
        ext$ = file_extract_extension$(File$)
        if ext$=".bmp"
          file_load View%,File$
          for x%=0 to 47
              r%=color_pixel_red(View%,x%,0)
              g%=color_pixel_green(View%,x%,0)
              b%=color_pixel_blue(View%,x%,0)
              if r%+g%+b%=0
                exit_for
              end_if 
          next x%
         
          format% = x%
          maxi%= format%*format%
          min Pb%,0 : Max Pb%,maxi% : position Pb%,0
          hint View%,file_extract_name$(File$)+chr$(32)+str$(x%)+"x"+str$(x%)
          ResizePicture(format%)
          caption Alph%(1),file_extract_name$(File$)
         
         
          f$=file_extract_name$(file$)
          f$=left$(f$,len(f$)-4)
          item_add MemoSub%,"Sub Dessine"+f$+"(obj%,r%,g%,b%)"
          item_add MemoSub%,"  dim_local x%,y%,Img$,geo$"
          item_add MemoSub%,""
          2d_target_is view%
          for y%=0 to format%-1
              for x%=0 to format%-1
               
                position Pb%,position(Pb%)+1
                   
                c1$=str$(x%) : c1$=right$(string$(4-len(c1$),"0")+c1$,2)
                c2$=str$(y%) : c2$=right$(string$(4-len(c2$),"0")+c2$,2)
               
                r$=str$(color_pixel_red(View%,x%,y%))
                g$=str$(color_pixel_green(View%,x%,y%))
                b$=str$(color_pixel_blue(View%,x%,y%))   
         
                if r$+g$+b$="000"
                    i%=i%+1
                    line$ = line$+c1$+c2$
                end_if
         
                if i%=10
                    item_add MemoSub%,string$(3,chr$(32))+"Img$ = Img$+"+chr$(34)+line$+chr$(34)
                    i%=0
                    line$=""
                else
                    if x%=(format%-1) and y%=(format%-1)
                      item_add MemoSub%,string$(3,chr$(32))+"Img$ = Img$+"+chr$(34)+line$+chr$(34)
                      i%=0
                      line$=""             
                    end_if
                end_if           
              next x%
          next y%
          item_add MemoSub%,""
          item_add MemoSub%,string$(3,chr$(32))+"2d_target_is obj%"
          item_add MemoSub%,""     
          item_add MemoSub%,string$(3,chr$(32))+"while len(Img$)>0 "
          item_add MemoSub%,string$(6,chr$(32))+"geo$=left$(Img$,4)"
          item_add MemoSub%,string$(6,chr$(32))+"Img$=right$(Img$,len(Img$)-4)"
          item_add MemoSub%,string$(6,chr$(32))+"if len(Img$)=0 : exit_while : end_if"
          item_add MemoSub%,string$(6,chr$(32))+"x%=val(mid$(Img$,1,2))"
          item_add MemoSub%,string$(6,chr$(32))+"y%=val(mid$(Img$,3,2))"
          item_add MemoSub%,string$(6,chr$(32))+"2d_pen_color r%,g%,b%"
          item_add MemoSub%,string$(6,chr$(32))+"print_locate x%,y%"
          item_add MemoSub%,string$(6,chr$(32))+"2d_point x%,y%"           
          item_add MemoSub%,string$(3,chr$(32))+"end_while"
          item_add MemoSub%,"End_sub"
         
          hide Pb%         
          for i%=1 to 3
              left Alph%(i%),left(Pict%)+width(Pict%)+20
              font_color Alph%(i%),0,0,150
          next i%
          caption Alph%(2),"Image "+str$(format%)+"x"+str$(format%)
          caption Alph%(3),"Analyse complète,"+chr$(13)+"prêt à être sauvegardé. "       
        end_if   
    else
        exit_sub
    end_if
  End_sub
' ------------------------------------------------------------------------------
' Copie dans le presse-papier
  Sub ClipBoardCopy()
    dim_local i%,n%
   
    for i%=1 to count(MemoSub%)
        n%=n%+len(item_read$(MemoSub%,i%))+2
    next i%
    select_text MemoSub%,1,n%
    clipboard_copy MemoSub%
  End_sub
' ------------------------------------------------------------------------------
' Sauvegarde dans un fichier
  Sub SaveAsBas()
    dim_local f$,i%
 
    save_dialog Sdial%
    dir_dialog Sdial%,":\"
    filter Sdial%,"*.bas|*.bas"
    f$=file_name$(Sdial%)
    delete Sdial%
    if f$<>"_"
        if right$(f$,4)<>".bas"
          f$=f$+".bas"
          file_save MemoSub%,f$
        end_if
    end_if
  End_sub
' ------------------------------------------------------------------------------
' About
  Sub About()
    dim_local mess%,t$
   
    t$= string$(int((20-len("PanoSubIcon Editor"))/2),chr$(32))+"PanoSubIcon Editor"+chr$(13)
    t$= t$+string$(int((20-len("Version 0.4"))/2),chr$(32))+"Version 0.4"+chr$(13)
    t$= t$+string$(int((20-len("Par Y Geronimi"))/2),chr$(32))+"Par Y Geronimi"+chr$(13)
    t$= t$+string$(int((20-len("12/08/2019"))/2),chr$(32))+"12/08/2019"
    mess%=message_information_ok(t$) 
  End_sub
Revenir en haut Aller en bas
Contenu sponsorisé





Pano Sub Icon Creator Empty
MessageSujet: Re: Pano Sub Icon Creator   Pano Sub Icon Creator Empty

Revenir en haut Aller en bas
 
Pano Sub Icon Creator
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» custom Icon
» Open Icon Library
» Mon "ImageList Creator"
» Data Image Creator D.I.C
» PAnO coloré

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