Un extracteur de procédures

J'ai fait un utilitaire permettant d'extraire des macros choisis d'un fichier source contenant une multitude de macros. Je l'utilise par défaut avec KGF_SUB.bas, mais un bouton permet d'utiliser n'importe quel fichier source à la place.

Le programme affiche dans une première liste, la liste des procédures contenues dans le fichier source choisi. Un clic sur une de ces procédures "choisit" cette procédure. Elle apparaîtra dans la liste de droite et sera marquée d'une étoile "*" dans la liste de gauche. Un ne peut pas choisir une nouvelle fois une procédure qui est déjà choisie. Un clic dans la liste des procédures choisies l'enlève de cette liste (et enlève l'étoile correspondante dans la liste de gauche).

Un bouton permet d'extraire les procédures choisies. Elles seront placées dans un fichier dont le nom est l'emplacement est choisi par l'utilisateur. Les procédures y apparaîtront dans l'ordre initial d'apparition dans le fichier source d'origine, pas dans l'ordre de leur sélection.

Voici le source de KGF_MacroExtractor.bas:

Code:: ' KGF_MacroExtractor.bas
'
' Ce programme affiche la liste des macros contenus dans KGF_SUB.bas.
' Le programme peut aussi être utilisé avec un autre fichier source
' contenant des macros.
' Certains macros peuvent être sélectionnés et extraits dans un fichier
' source dédié.
'

labels()
constantes()
variables()

invisibles()
form0()
initialisations()
GUI()
charger_macros()

end

sub labels()
label changer_KGF, select_macro, remove_macro, extraire
end_sub

sub constantes()
dim KGF$ : KGF$ = "KGF_SUB.bas"
dim titre$ : titre$ = "KGF_MacroExtractor"
end_sub

sub variables()
dim temp$, n%, i%, s$, t$
end_sub

sub invisibles()
open_dialog 1 : filter 1,"Source Panoramic|*.bas"
dlist 2 : ' indice des macros choisis dans la liste 21
save_dialog 3 : filter 1,"Source Panoramic|*.bas"
dlist 4 : ' liste des macros choisis, triés selon l'indexe
end_sub

sub form0()
full_space 0
caption 0,titre$
alpha 10 : top 10,50 : left 10,100 : hide 10
caption 10,"Choisir l'emplacement de KGF_SUB.bas"
font_size 10,24 : font_bold 10 : font_color 10,255,0,0
end_sub

sub GUI()
alpha 20 : top 20,10 : left 20,10 : caption 20,"0 Macros disponibles:"
list 21 : top 21,25 : left 21,10 : height 21,height(0)-80 : width 21,400
font_name 21,"Courier" : on_click 21,select_macro
alpha 30 : top 30,10 : left 30,430 : caption 30,"0 Macros choisis:"
list 31 : top 31,25 : left 31,430 : height 31,height(0)-80 : width 31,400
font_name 31,"Courier" : on_click 31,remove_macro
button 100 : top 100,25 : left 100,860 : width 100,150
caption 100,"Autre provenance" : on_click 100,changer_KGF
button 101 : top 101,90 : left 101,860 : width 101,150
caption 101,"Extraire les macros" : on_click 101,extraire

end_sub

sub initialisations()
dim_local s$
show 10
while file_exists(KGF$)=0
s$ = file_name$(1)
if s$<>"_" then KGF$ = s$
end_while
hide 10
caption 0,titre$ + " - " + KGF$
end_sub

sub charger_macros()
clear 21 : clear 31
caption 20,"0 Macros disponibles:"
caption 30,"0 Macros choisis:"
file_open_read 1,KGF$
while file_eof(1)=0
file_readln 1,temp$
temp$ = trim$(temp$)
if lower$(left$(temp$,4))="sub "
item_add 21," "+temp$
caption 20,str$(count(21))+" Macros disponibles:"
while instr(lower$(temp$),"end_sub")=0
file_readln 1,temp$
end_while
end_if
end_while
file_close 1
end_sub

changer_KGF:
temp$ = KGF$
KGF$ = KGF$ + "_actuel"
KGF$ = file_name$(1)
if KGF$="_"
KGF$ = temp$
else
if file_exists(KGF$)=0
message "Ce fichier est introuvable"
KGF$ = temp$
end_if
end_if
caption 0,titre$ + " - " + KGF$
charger_macros()
return

select_macro:
n% = item_index(21)
temp$ = item_read$(21,n%)
if left$(temp$,1)=" "
item_add 31,mid$(temp$,3,len(temp$))
item_add 2,str$(n%)
caption 30,str$(count(31))+" Macros choisis:"
temp$ = "* "+mid$(temp$,3,len(temp$))
item_delete 21,n%
item_insert 21,n%,temp$
end_if
return

remove_macro:
n% = item_index(31)
if (n%<1) or (n%>count(31)) then return
item_delete 31,n%
caption 30,str$(count(31))+" Macros choisis:"
i% = val(item_read$(2,n%))
item_delete 2,n%
temp$ = item_read$(21,i%)
item_delete 21,i%
item_insert 21,i%," "+mid$(temp$,3,len(temp$))
return

extraire:
if count(31)=0
message "Il n'y a rien à extraire"
return
end_if
temp$ = file_name$(3)
if temp$="_" then return
if file_exists(temp$)=1
if message_confirmation_yes_no("Remplacer le fichier "+temp$+" ?")<>1 then return
end_if
' construire la liste des macros, triés d'après l'ordre d'apaprition dans le fichier
for i%=1 to count(31)
n% = item_read$(2,i%)
s$ = right$("000"+str$(n%),4)
item_add 4,s$+item_read$(31,i%)
next i%
sort 4
' extraire les macros
file_open_read 2,KGF$
file_open_write 1,temp$
for i%=1 to count(4)
s$ = lower$(mid$(item_read$(4,i%),5,200))
while instr(lower$(temp$),s$)<>1
file_readln 2,temp$
temp$ = trim$(temp$)
end_while
while instr(lower$(temp$),"end_sub")=0
file_writeln 1,temp$
file_readln 2,temp$
end_while
file_writeln 1,temp$
file_writeln 1," "
next i%
file_close 1
file_close 2
return

Merci Klaus

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

J'utilise quelque chose d'un peu similaire, toutes mes procédures étant regroupées dans un seul fichier, classées par catégorie. Je clique une icône 'Subs' sur le bureau qui me présente toute la liste (déroulante) des procédures. Le clic sur un item affiche la procédure correspondante et la copie simultanément dans le clipboard.
Depuis l'éditeur je n'ai plus qu'à la coller à l'emplacement voulu.
PS je radote un peu, c'était là: https://panoramic.1fr1.net/t2897-bibliotheque-de-subs-suite?highlight=biblioth%E8que+de+subs

J'ai honteusement copié ton idée, Jl35: possibilité de copier dans le presse-papier ! En même temps, j'ai corrigé un petit bug...

Code:: ' KGF_MacroExtractor.bas
'
' Ce programme affiche la liste des macros contenus dans KGF_SUB.bas.
' Le programme peut aussi être utilisé avec un autre fichier source
' contenant des macros.
' Certains macros peuvent être sélectionnés et extraits dans un fichier
' source dédié.
'

labels()
constantes()
variables()

invisibles()
form0()
initialisations()
GUI()
charger_macros()

end

sub labels()
label changer_KGF, select_macro, remove_macro
label extraire_fichier, extraire_presse_papier
end_sub

sub constantes()
dim KGF$ : KGF$ = "KGF_SUB.bas"
dim titre$ : titre$ = "KGF_MacroExtractor"
dim crlf$ : crlf$ = chr$(13) + chr$(10)
end_sub

sub variables()
dim temp$, n%, i%, s$, t$
end_sub

sub invisibles()
open_dialog 1 : filter 1,"Source Panoramic|*.bas"
dlist 2 : ' indice des macros choisis dans la liste 21
save_dialog 3 : filter 1,"Source Panoramic|*.bas"
dlist 4 : ' liste des macros choisis, triés selon l'indexe
end_sub

sub form0()
full_space 0
caption 0,titre$
alpha 10 : top 10,50 : left 10,100 : hide 10
caption 10,"Choisir l'emplacement de KGF_SUB.bas"
font_size 10,24 : font_bold 10 : font_color 10,255,0,0
end_sub

sub GUI()
alpha 20 : top 20,10 : left 20,10 : caption 20,"0 Macros disponibles:"
list 21 : top 21,25 : left 21,10 : height 21,height(0)-80 : width 21,400
font_name 21,"Courier" : on_click 21,select_macro
alpha 30 : top 30,10 : left 30,430 : caption 30,"0 Macros choisis:"
list 31 : top 31,25 : left 31,430 : height 31,height(0)-80 : width 31,400
font_name 31,"Courier" : on_click 31,remove_macro
button 100 : top 100,25 : left 100,860 : width 100,150
caption 100,"Autre provenance" : on_click 100,changer_KGF
button 101 : top 101,90 : left 101,860 : width 101,150
caption 101,"Extraire => fichier" : on_click 101,extraire_fichier
button 102 : top 102,120 : left 102,860 : width 102,150
caption 102,"Extraire => presse-papier" : on_click 102,extraire_presse_papier

end_sub

sub initialisations()
dim_local s$
show 10
while file_exists(KGF$)=0
s$ = file_name$(1)
if s$<>"_" then KGF$ = s$
end_while
hide 10
caption 0,titre$ + " - " + KGF$
end_sub

sub charger_macros()
clear 21 : clear 31
caption 20,"0 Macros disponibles:"
caption 30,"0 Macros choisis:"
file_open_read 1,KGF$
while file_eof(1)=0
file_readln 1,temp$
temp$ = trim$(temp$)
if lower$(left$(temp$,4))="sub "
item_add 21," "+temp$
caption 20,str$(count(21))+" Macros disponibles:"
while instr(lower$(temp$),"end_sub")=0
file_readln 1,temp$
end_while
end_if
end_while
file_close 1
end_sub

sub extraire_macros(flag%,out$)
dim_local mac$
clear 4
for i%=1 to count(31)
n% = item_read$(2,i%)
s$ = right$("000"+str$(n%),4)
item_add 4,s$+item_read$(31,i%)
next i%
sort 4
' extraire les macros
file_open_read 2,KGF$
if flag%=1
file_open_write 1,out$
else
mac$ = ""
end_if
for i%=1 to count(4)
s$ = lower$(mid$(item_read$(4,i%),5,200))
while instr(lower$(temp$),s$)<>1
file_readln 2,temp$
temp$ = trim$(temp$)
end_while
while instr(lower$(temp$),"end_sub")=0
if flag%=1
file_writeln 1,temp$
else
mac$ = mac$ + temp$ + crlf$
end_if
file_readln 2,temp$
end_while
if flag%=1
file_writeln 1,temp$
file_writeln 1," "
else
mac$ = mac$ + temp$ + crlf$ + crlf$
end_if
next i%
file_close 2
if flag%=1
file_close 1
message "Les macros extraits sont placés dans le fichier "+out$
else
clipboard_string_copy mac$
message "Les macros extraits sont placés dans le presse-papier"
end_if
end_sub

changer_KGF:
temp$ = KGF$
KGF$ = KGF$ + "_actuel"
KGF$ = file_name$(1)
if KGF$="_"
KGF$ = temp$
else
if file_exists(KGF$)=0
message "Ce fichier est introuvable"
KGF$ = temp$
end_if
end_if
caption 0,titre$ + " - " + KGF$
charger_macros()
return

select_macro:
n% = item_index(21)
temp$ = item_read$(21,n%)
if left$(temp$,1)=" "
item_add 31,mid$(temp$,3,len(temp$))
item_add 2,str$(n%)
caption 30,str$(count(31))+" Macros choisis:"
temp$ = "* "+mid$(temp$,3,len(temp$))
item_delete 21,n%
item_insert 21,n%,temp$
end_if
return

remove_macro:
n% = item_index(31)
if (n%<1) or (n%>count(31)) then return
item_delete 31,n%
caption 30,str$(count(31))+" Macros choisis:"
i% = val(item_read$(2,n%))
item_delete 2,n%
temp$ = item_read$(21,i%)
item_delete 21,i%
item_insert 21,i%," "+mid$(temp$,3,len(temp$))
return

extraire_fichier:
if count(31)=0
message "Il n'y a rien à extraire"
return
end_if
temp$ = file_name$(3)
if temp$="_" then return
if file_exists(temp$)=1
if message_confirmation_yes_no("Remplacer le fichier "+temp$+" ?")<>1 then return
end_if
' construire la liste des macros, triés d'après l'ordre d'apaprition dans le fichier
extraire_macros(1,temp$)
return

extraire_presse_papier:
if count(31)=0
message "Il n'y a rien à extraire"
return
end_if
' construire la liste des macros, triés d'après l'ordre d'apaprition dans le fichier
extraire_macros(2,"")
return

Idée que j' avais honteusement pompé moi même il y a quelque temps....pour bibbliolib

Pas de honte à avoir, puisque c'est l'un des buts de Klaus quand il partage ses sources: que l'on en profite et que l'on les adapte selon nos besoins et usages...

Voici une nouvelle version de l'extracteur de macros. Il y a un nouveau bouton qui place les macros extraits directement dans un fichier source quelconque (ajout à la fin du fichier).

Code:: ' KGF_MacroExtractor.bas
'
' Ce programme affiche la liste des macros contenus dans KGF_SUB.bas.
' Le programme peut aussi être utilisé avec un autre fichier source
' contenant des macros.
' Certains macros peuvent être sélectionnés et extraits dans un fichier
' source dédié.
'

labels()
constantes()
variables()

invisibles()
form0()
initialisations()
GUI()
charger_macros()

end

sub labels()
label changer_KGF, select_macro, remove_macro
label extraire_fichier, extraire_presse_papier, extraire_programme
end_sub

sub constantes()
dim KGF$ : KGF$ = "KGF_SUB.bas"
dim titre$ : titre$ = "KGF_MacroExtractor"
dim crlf$ : crlf$ = chr$(13) + chr$(10)
end_sub

sub variables()
dim temp$, n%, i%, s$, t$
end_sub

sub invisibles()
open_dialog 1 : filter 1,"Source Panoramic|*.bas"
dlist 2 : ' indice des macros choisis dans la liste 21
save_dialog 3 : filter 1,"Source Panoramic|*.bas"
dlist 4 : ' liste des macros choisis, triés selon l'indexe
end_sub

sub form0()
full_space 0
caption 0,titre$
alpha 10 : top 10,50 : left 10,100 : hide 10
caption 10,"Choisir l'emplacement de KGF_SUB.bas"
font_size 10,24 : font_bold 10 : font_color 10,255,0,0
end_sub

sub GUI()
alpha 20 : top 20,10 : left 20,10 : caption 20,"0 Macros disponibles:"
list 21 : top 21,25 : left 21,10 : height 21,height(0)-80 : width 21,400
font_name 21,"Courier" : on_click 21,select_macro
alpha 30 : top 30,10 : left 30,430 : caption 30,"0 Macros choisis:"
list 31 : top 31,25 : left 31,430 : height 31,height(0)-80 : width 31,400
font_name 31,"Courier" : on_click 31,remove_macro
button 100 : top 100,25 : left 100,860 : width 100,150
caption 100,"Autre provenance" : on_click 100,changer_KGF
button 101 : top 101,90 : left 101,860 : width 101,150
caption 101,"Extraire => fichier" : on_click 101,extraire_fichier
button 102 : top 102,120 : left 102,860 : width 102,150
caption 102,"Extraire => presse-papier" : on_click 102,extraire_presse_papier
button 103 : top 103,150 : left 103,860 : width 103,150
caption 103,"Extraire => programme" : on_click 103,extraire_programme

end_sub

sub initialisations()
dim_local s$
show 10
while file_exists(KGF$)=0
s$ = file_name$(1)
if s$<>"_" then KGF$ = s$
end_while
hide 10
caption 0,titre$ + " - " + KGF$
end_sub

sub charger_macros()
clear 21 : clear 31
caption 20,"0 Macros disponibles:"
caption 30,"0 Macros choisis:"
file_open_read 1,KGF$
while file_eof(1)=0
file_readln 1,temp$
temp$ = trim$(temp$)
if lower$(left$(temp$,4))="sub "
item_add 21," "+temp$
caption 20,str$(count(21))+" Macros disponibles:"
while instr(lower$(temp$),"end_sub")=0
file_readln 1,temp$
end_while
end_if
end_while
file_close 1
end_sub

sub extraire_macros(flag%,out$)
dim_local mac$
clear 4
for i%=1 to count(31)
n% = item_read$(2,i%)
s$ = right$("000"+str$(n%),4)
item_add 4,s$+item_read$(31,i%)
next i%
sort 4
' extraire les macros
file_open_read 2,KGF$
if flag%=1
file_open_write 1,out$
else
if flag%=2
mac$ = ""
else
file_open_append 1,out$
file_writeln 1,"' Macros extraits de "+KGF$
end_if
end_if
for i%=1 to count(4)
s$ = lower$(mid$(item_read$(4,i%),5,200))
while instr(lower$(temp$),s$)<>1
file_readln 2,temp$
temp$ = trim$(temp$)
end_while
while instr(lower$(temp$),"end_sub")=0
if (flag%=1) or (flag%=3)
file_writeln 1,temp$
else
mac$ = mac$ + temp$ + crlf$
end_if
file_readln 2,temp$
end_while
if (flag%=1) or (flag%=3)
file_writeln 1,temp$
file_writeln 1," "
else
mac$ = mac$ + temp$ + crlf$ + crlf$
end_if
next i%
file_close 2
if (flag%=1) or (flag%=3)
file_close 1
message "Les macros extraits sont placés dans le fichier "+out$
else
clipboard_string_copy mac$
message "Les macros extraits sont placés dans le presse-papier"
end_if
end_sub

changer_KGF:
temp$ = KGF$
KGF$ = KGF$ + "_actuel"
KGF$ = file_name$(1)
if KGF$="_"
KGF$ = temp$
else
if file_exists(KGF$)=0
message "Ce fichier est introuvable"
KGF$ = temp$
end_if
end_if
caption 0,titre$ + " - " + KGF$
charger_macros()
return

select_macro:
n% = item_index(21)
temp$ = item_read$(21,n%)
if left$(temp$,1)=" "
item_add 31,mid$(temp$,3,len(temp$))
item_add 2,str$(n%)
caption 30,str$(count(31))+" Macros choisis:"
temp$ = "* "+mid$(temp$,3,len(temp$))
item_delete 21,n%
item_insert 21,n%,temp$
end_if
return

remove_macro:
n% = item_index(31)
if (n%<1) or (n%>count(31)) then return
item_delete 31,n%
caption 30,str$(count(31))+" Macros choisis:"
i% = val(item_read$(2,n%))
item_delete 2,n%
temp$ = item_read$(21,i%)
item_delete 21,i%
item_insert 21,i%," "+mid$(temp$,3,len(temp$))
return

extraire_fichier:
if count(31)=0
message "Il n'y a rien à extraire"
return
end_if
temp$ = file_name$(3)
if temp$="_" then return
if file_exists(temp$)=1
if message_confirmation_yes_no("Remplacer le fichier "+temp$+" ?")<>1 then return
end_if
' construire la liste des macros, triés d'après l'ordre d'apaprition dans le fichier
extraire_macros(1,temp$)
return

extraire_presse_papier:
if count(31)=0
message "Il n'y a rien à extraire"
return
end_if
' construire la liste des macros, triés d'après l'ordre d'apaprition dans le fichier
extraire_macros(2,"")
return

extraire_programme:
if count(31)=0
message "Il n'y a rien à extraire"
return
end_if
temp$ = file_name$(3)
if temp$="_" then return
if file_exists(temp$)=0
message "Le fichier "+temp$+" est introuvable")
return
end_if
' construire la liste des macros, triés d'après l'ordre d'apaprition dans le fichier
extraire_macros(3,temp$)
return

Beau boulot !
Tu pars directement de KGF_Sub, mon bibbliolib part de son fichier de stockage.

Certes. Mais le programme a un bouton qui permet de changer de fichier de départ, qui peut être en fait n'importe quel fichier source Panoramic.

Oui, oui, j' ai vu...

» Extracteur de sprites
» extracteur de sprites amélioré
» Mes Procédures
» Les procédures LINOR et ARCOR
» Pseudo-objets GLIST et TAB avec des procédures