Novembre 2024 | Lun | Mar | Mer | Jeu | Ven | Sam | Dim |
---|
| | | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | | Calendrier |
|
|
| Pano Sub Icon Creator | |
| | Auteur | Message |
---|
Yannick
Nombre de messages : 8635 Age : 53 Localisation : Bretagne Date d'inscription : 15/02/2010
| Sujet: Pano Sub Icon Creator Lun 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 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) | |
| | | Yannick
Nombre de messages : 8635 Age : 53 Localisation : Bretagne Date d'inscription : 15/02/2010
| Sujet: re Lun 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... | |
| | | Yannick
Nombre de messages : 8635 Age : 53 Localisation : Bretagne Date d'inscription : 15/02/2010
| Sujet: re Mer 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.exeCe fichier peut être placé n'importe où sur votre ordi. - 1 dossier : PanoSubIconTmpCe dossier doit être placé dans le dossier "C:\Temp" - 1 fichier : PanoSubIcon.basCe 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
| |
| | | Contenu sponsorisé
| Sujet: Re: Pano Sub Icon Creator | |
| |
| | | | Pano Sub Icon Creator | |
|
Sujets similaires | |
|
| Permission de ce forum: | Vous ne pouvez pas répondre aux sujets dans ce forum
| |
| |
| |