Des dlls compilées a la demande en FreeBasic, avec l'appel

Nombre de messages : 42 Date d'inscription : 18/05/2011

Bonjour à tous
javascript:emoticonp(' Very Happy

')

[ edit le 19/05 ] ATTENTION code en cours d'adaptation à la largeur du site . Telech' ,mais...

[ edit le 19/05 BIS ] code modifié à 18h10 je vais faire l'essai de copié-coller

[ edit le 19/05 TER ] telech' copié-coller OK , normalement tout est modifié .

Je viens de m'inscrire mais j'ai essayé la prog sous Windows depuis quelque temps grace à Panoramic.
Depuis que Jean Debord à communiqué sur les dlls et FreeBasic , j'ai boosté mon neurone pour en faire
quelque chose...
Essayez ce petit wizzard pour fabriquer une dll selon les souhaits du moment ,vous me direz si c'est correct.
Il faut installer FreeBasic , si possible FBedit .
Copier les chemins nécessaires à la compilation automatique : tout est situé en début de prog.
Pour débuter , quelques tests aussi ; le passage de strings est plus coton que les integers et les flottants.
ADAPTER les paths , bien sur.

Code:: ' "Speed of light" speedo-FB V 3d - 05/2011" by enform
' Aide à la compilation d'une Dll FreeBasic et code Panoramic d'appel.
' Freeware .
' La DLL est inexistente au départ et créée à la demande par FB .
' 2 fichiers créés plus la dll.
' Pour installer Freebasic voir site http://freebasic.net/ et
' http://fbedit.freebasic.net/
' Code Basic Panoramic-language
' ----------------------------- Help ----------------------------
'
' Basé sur les explications de Jean Debord 'Utilisation de DLLs
' en PANORAMIC' + Dll Eval .
' Merci à lui, qui lui meme remercie... Pour moi,c'est un
' apprentissage ...avec la lecture du forum .
' La simplicité d'écriture de Panoramic est toute indiquée pour
' les débutants sous Windows.
' Principe : Choix des paramètres (de 0 à 6) ; nommage manuel ou auto
' (préréglé avec 1er param' + 'params auto')
' Donner (changer)un nom de fichier dans l' Edit 'File' ; ex:
' abc tout court!
' 'abc' donnera 3 fichiers automatiquement : abc_p.bas ,
' abc_fb.bas , abc_fb.dll
' Donner un nom de fonction dans le petit Edit Func. (préréglé ->
' Fun1' )
' -Appui sur 'New Func' -> 2 listings : 1 partie FB ,1 partie Pano
' (préréglé avec 1er param 'integer')
' Compléter le code dans le mémo , ou autres éditeurs .
' -'Save Files' ->2 fichiers :1) code Pano seul. ex : abc_p.bas.
' 2) code FB seul. ex : abc_fb.bas.
' -'Compiler' : le fichier 'code FB' ex : abc_fb.bas doit etre
' déjà sauveg' . Son path doit etre dans le grand Edit
' (préréglé C:\...\ ). Le compiler est
' appelé avec.(execute ligne 316 ?).
' (option : Ajouter '-x' 'xyz.dll' donne un autre nom à la
' dll) . Chercher le résultat sur le DD.
' Sinon : bugs! ou Seven ?. Corriger ou passer par l'éditeur
' Fbedit.( Régler fbedit sur 'Windows dll'.
' (Dans 'Options' , 'Build Options' : ajouter à la ligne de
' Command' : -x test.dll (ou autre nom);)
' Dans 'Options' , 'Path Options' : régler vos paths .
' Pour Seven ,recopie dossier complet FreeBasic dans
' C:\Users \..... --> acces libre ! Adapter les paths!
' - 'Load Files' : charge un/deux fichier ,ex : abc_fb.bas ->
' détecte le nb de fonctions existentes
' pour pouvoir enchainer les numeros des fonctions avec
' 'New Func'.( calculé avec les lignes Func 1,2..)
' Bug ? A l'appui sur 'Load Files' c'est 'Save Files' qui
' apparait. Il faut 'quit load' et recommencer.
' - 'New Func' (si l'Edit 'Func' est vide -> RAZ des mémos).
' 'Quit' : Quit .
' 'Nom des params contient un i -> integer, d -> double (float),
' s -> string ;p ->Pano ,fb -> FreeBasic
' 1er test: Entrer un nom de fichier 'racine' dans l'edit 'File' -> test
' Appui sur 'New Func' puis 'Save Files' , 'Save 2 Files';
' 2 codes valides sont produits , mais peu actifs :
' seulement un '0'serait retourné par la dll compilée.
'
' 'Un débugger 'Basic code' pour FB : fdebug_2011_04_21 ; pour les
' binaires 'exe' : Ollydbg .

' -------------- Fun in Fun'ction ---------------------------------------
label objets , panocode , raz , goback , saveall , savepano , savefb
label loadpano , loadfb , loadall, goback2

dim bas_save$ , bas_save_fb$ , p , np ,par ,TypePar ,NumberPar , fcnt%
dim l ,ln$ , ligne , file$, dll$
dim fonc$ ,affunc$ , fun$(6), bas$ , affvirg$ ,affend$ , a$ , path_dll$
dim path_file$ , path_fbc$, dims$(6), pri$(6) , prd$(6) , prs$(6) , r
dim text_7$

' les paths sont rassemblés dans ces 10 lignes . Adapter à son PC...
dir_change "C:\Users\compaq\PanoramicDivers\"
gosub objets : mark_on 6 : mark_on 122
open_dialog 80
save_dialog 81
' -x = rename ex: 'aa_fb.bas' -> 'testaa.dll' -R = fichier Asm conservé
' reglages par défaut
path_dll$ = "C:\Users\compaq\PanoramicDivers\"
text 9 ,"fun1"
text_7$ = "C:\Users\compaq\PanoramicDivers\" : text 7 , text_7$
' path_shell$ = "C:\Users\compaq\FreeBasic\start_shell.exe"
path_fbc$ = "C:\Users\compaq\FreeBasic\fbc.exe -dll "
' il faut un espace apres -dll
' path_fbc$ = "C:\Users\compaq\FreeBasic\start_shell.exe" : ' fbc.exe -
' dll "
' start_shell.exe c'est du secours si la compil auto rate (+ d'autres modifs)
' ============= Adapter les paths à son PC ======================
'
end

' -----------------------------------------------------------------------
On_Click_Button_3:
' Quit
terminate
return

On_Click_Button_5:
' Func
' ------------ instructions FB ' obligatoires ' ----------------
fonc$ = text$(9) : fonc$ = trim$(fonc$)
' petit Edit = nom de la prochaine fonction

if fonc$ = ""
fcnt% = 0 : ' si petit Edit vide RAZ
clear 71 : clear 91
goto raz : ' sort de la proc' , attend appui New Func
end_if
fcnt% = fcnt% +1 : ' N° de fonction

for r = 1 to 6
pri$(r) = "i" + str$(10*fcnt%+r)
' N° de param auto i11,i12,...i21,i22,i23 ...
next r
for r = 1 to 6
prd$(r) = "d" + str$(10*fcnt%+r)
' N° de param auto d11,d12,...d21,d22,d23 ...
next r
for r = 1 to 6
prs$(r) = "s" + str$(10*fcnt%+r)
' N° de param auto s11,s12,...s21,s22,s23 ...
next r
' en stock dans un tableau
if fcnt% = 1
file$ = text$(121) : dll$ = file$ + "_fb.dll"
item_add 91 ," dir_change " +chr$(34) + path_dll$ + chr$(34)
item_add 91 ," label Quit "
item_add 91 ," dll_on "+ chr$(34) + dll$ + chr$(34)
if checked(122) =1
item_add 91 ," button 999 : left 999,15 : top 999 ,height(0)-60 "
item_add 91 ," width 999,width(0)-55 "
item_add 91 , " height 999,18:caption 999,"+chr$(34)+"Quit"+ chr$(34)
item_add 91 ," on_click 999 , Quit "
end_if
item_add 91 ," ' ------------------------------------------ "
' file$ = text$(121)
' text 7 , text_7$ + file$ + "_fb.bas"
end_if
item_add 71 ,""
item_add 71 ," ' Func " + str$(fcnt%)
item_add 71 ," ' "
item_add 71 ," extern "+chr$(34)+"Windows-MS"+chr$(34)
np = 0 : TypePar = 0 : NumberPar = 0

for par = 1 to 6
np = np + 10
' les n° d'option ( les dizaines)
for p = 1 to 4
' les n° d'option ( les unités)
if checked(np + p)= 1
' n° donne le type int ,double ,string
TypePar = p

select p
case 1
fun$(par) = ""
' les 6 params préparés dans un tableau
case 2
if checked(6) = 0
fun$(par) = " as integer "
' avec leur type directement pré-écrit ,manuel
else
' avec leur type directement pré-écrit , auto
fun$(par) = "fb_" + pri$(par) + " as integer "
' + param auto
end_if
dims$(par) = " as integer "
' mémorisé à chaque nouveau param
case 3
if checked(6) = 0
fun$(par) = " byref as double "
else
fun$(par) = " byref fb_" + prd$(par) + " as double "
' + param auto
end_if
dims$(par) = " byref as double "
case 4
if checked(6) = 0
fun$(par) = " byref as string ptr "
else
fun$(par) = " byref fb_"+ prs$(par) + " as zstring ptr "
' + param auto
end_if
dims$(par) = " byref as zstring ptr "
end_select
exit_for
end_if
next p
if TypePar > 1 then NumberPar = NumberPar +1
' type 1 (check 0) ne compte pas
next par

affunc$ = " function "+ fonc$ + "("
affvirg$ = ","
' préparé
affend$ = ") as integer export"

a$ = affunc$
for par = 1 to NumberPar
' nombre de params
if par =1
a$ = a$ + fun$(par)
' 1er param sans virgule avant
else
a$ = a$ + affvirg$ + fun$(par)
end_if
next par
item_add 71 , a$ + affend$
item_add 71 , " ' dim as integer"
item_add 71 , " ' dim as double "
item_add 71 , " ' dim as string "
item_add 71 , " ' your code..."
item_add 71 , ""

' ------ instructions " obligatoires " --------------------

item_add 71 ," function = 0"
item_add 71 ," ' "
item_add 71 ," end function "
item_add 71 ," end extern "
item_add 71 ," ' ----------- End function FB ------------"
gosub panocode
raz:
return
' -------------------------------------------------------------
panocode:
item_add 91 ,""
item_add 91 ,""
item_insert 91 ,fcnt% + 2, " label "+ fonc$

if checked(6) = 1
a$ = " dim " + " R_" + fonc$ + "% "
' dim auto
for par = 1 to NumberPar
if instr(fun$(par),"string")>0
a$ = a$ + ", p_"+ prs$(par)+ "$"
end_if
if instr(fun$(par),"double")>0
a$ = a$ + ", p_"+ prd$(par)
end_if
if instr(fun$(par),"integer")>0
a$ = a$ + ", p_"+ pri$(par)+ "%"
end_if
next par

item_insert 91 ,fcnt% + 2, a$
else
item_insert 91 ,fcnt% + 2, " dim "
end_if
if fcnt% = 1
item_add 91 ," ' your code..."
item_add 91 ," gosub " + fonc$
item_add 91 ," "
item_add 91 ," end "
item_add 91 ," ' "
item_add 91 ," REM --------- procedures ------------------- "
item_add 91 ,"Quit:"
item_add 91 ," dll_off"
item_add 91 ," terminate"
item_add 91 ,"return "
item_add 91 ," ' ------------------------------------------ "
item_add 91 , fonc$ + ":"
' label auto !! French design
item_add 91 ," ' your code..."
item_add 91 ," ' "
end_if
if fcnt% > 1
for l = 1 to count(91)
ln$ =item_read$(91,l)
if instr(ln$,"end")>0 then exit_for
next l
item_insert 91,l ," gosub " + fonc$
item_insert 91,l+1 ," "
item_add 91 ," ' ------------------------------------- "
item_add 91 , fonc$ + ":"
' label auto !! French design
item_add 91 ," ' your code..."
item_add 91 ," ' "
end_if
a$ = " R_"+fonc$+"% = dll_call"+str$(NumberPar)+"( "
a$ = a$ +chr$(34)+ fonc$ +chr$(34)+"," : ' dll_call auto

if checked(6) = 1
' si 'params auto'
for par = 1 to NumberPar
if instr(fun$(par),"string")>0
a$ = a$ + "adr(" + "p_" + prs$(par)+ "$)" + " ,"
end_if
if instr(fun$(par),"double")>0
a$ = a$ + "adr(" +"p_" + prd$(par)+ ")" + " ,"
end_if
if instr(fun$(par),"integer")>0
a$ = a$ + "p_" + pri$(par)+ "% ,"
end_if
next par
if fun$(par -1) <> ""
a$ = left$(a$,len(a$)-1)
' - la derniere ,
end_if
item_add 91 , a$ + ")"
else
item_add 91 , a$ + ")"
end_if
item_add 91 ,"return "
item_add 91 ," ' ----------------------------------------- "
return
' ----------------------------------------------------------
On_Click_Button_2:
' Compiler
file$ = text$(121)
' item_add 91 , path_fbc$ + text$(7)+ file$ + "_fb.bas"
' clipboard_string_copy path_fbc$ + text$(7)+ file$ + "_fb.bas"
' item_add 91 , text$(7) + file$ + "_fb.bas"
' execute path_shell$ : ' text$(7) + file$ + "_fb.bas"
execute_wait path_fbc$ + text$(7) + file$ + "_fb.bas"
if file_exists("lib" + dll$ + ".a") = 1
file_delete "lib" + dll$ + ".a"
end_if
return
' --------------------------------------------------------------
On_Click_Button_1:
' Load
hide 1 : hide 2 : hide 3 : hide 4 : hide 5
show 112 :show 113 :show 114 :show 115
color 0 , 100,200,100
return
On_Click_Button_4:
' Save
' trace_on trace.txt
hide 1 : hide 2 : hide 3 : hide 4 : hide 5
show 102 :show 103 :show 104 :show 105
color 0 , 100,200,100
return
On_Click_Button_102:
gosub savepano
return
On_Click_Button_103:
gosub savefb
return
On_Click_Button_104:
gosub saveall
return
On_Click_Button_105:
gosub goback
return

goback:
hide 102 : hide 103 : hide 104 : hide 105
show 1 : show 2 :show 3 :show 4 :show 5
color 0 , 100,200,255
return

saveall:
' sauveg les fichiers 'X_p' pour Pano et 'X_fb' pour le compil
gosub savepano
gosub savefb
return
savepano:
file$ = text$(121)
file_save 91 , file$ + "_p.bas"
return
savefb:
file$ = text$(121)
file_save 71 , file$ + "_fb.bas"
return
' ---- Load File -----------------------------------------
loadpano:
filter 80 ,"code Pano _p.bas|*_p.bas"
bas$=file_name$(80)
file_load 91 , bas$
p = instr(bas$,".bas")
for np = p to 1 step -1
if mid$(bas$,np,1)= "\" then exit_for
next np
file$ = mid$(bas$,np +1,(p-np))
' item_add 91,file$ + " " + str$(np) + " " + str$(p)
p = instr(file$,"_")
text 121 , left$(file$,p-1)
return
loadfb:
filter 80 ,"code FB _fb.bas|*_fb.bas"
bas$=file_name$(80)
file_load 71 , bas$
for l = 1 to count(71)
ln$ =item_read$(71,l)
if instr(ln$,"Func")> 0
' des fonctions déjà chargées ?
fcnt% = val(right$(trim$(ln$),3))
' le N° de base pour N°s de fonctions
end_if
' est le dernier trouvé
next l
p = instr(bas$,".bas")
for np = p to 1 step -1
' if mid$(bas$,np,1)= "\" then exit_for
if mid$(bas$,np,1)= "\"
text 7 , left$(bas$,np)
exit_for
end_if
next np
file$ = mid$(bas$,np +1,(p-np))
' lire le nom du fichier 'racine'
' item_add 71 , file$ + " " + str$(np) + " " + str$(p)
p = instr(file$,"_")
text 121 , left$(file$,p-1)
file$ = text$(121) : dll$ = file$ + "_fb.dll"
return
loadall:
gosub loadpano
gosub loadfb
return
On_Click_Button_112:
gosub loadpano
return
On_Click_Button_113:
gosub loadfb
return
On_Click_Button_114:
gosub loadall
return
On_Click_Button_115:
gosub goback2
return
goback2:
hide 112 : hide 113 : hide 114 : hide 115
show 1 : show 2 :show 3 :show 4 :show 5
color 0 , 100,200,255
return

' ---------------------------------------------------------------
objets:
label On_Click_Button_1
label On_Click_Button_2
label On_Click_Button_3
label On_Click_Button_4
label On_Click_Button_5
label On_Click_Button_102
label On_Click_Button_103
label On_Click_Button_104
label On_Click_Button_105
label On_Click_Button_112
label On_Click_Button_113
label On_Click_Button_114
label On_Click_Button_115

left 0,screen_x - 575
top 0,screen_y - 220
width 0,575
height 0,210
caption 0," Speedo-FB V3 d by enform "
color 0 , 100,200,255

button 112
left 112,100
top 112,10
caption 112,"Load Pano" : hint 112 , "fichier '_p'"
on_click 112,On_Click_Button_112

button 113
left 113,190
top 113,10
caption 113,"Load FB" : hint 113 , "fichier '_fb'"
on_click 113,On_Click_Button_113

button 114
left 114,280
top 114,10
caption 114,"Load 2 Files" : hint 114 , " 1 Pano + 1 FB "
on_click 114,On_Click_Button_114

button 115
left 115,370
top 115,10
caption 115,"Quit 'load'"
on_click 115,On_Click_Button_115

button 102
left 102,100
top 102,10
caption 102,"Save Pano" : hint 102 , "fichier '_p'"
on_click 102,On_Click_Button_102

button 103
left 103,190
top 103,10
caption 103,"Save FB" : hint 103 , "fichier '_fb'"
on_click 103,On_Click_Button_103

button 104
left 104,280
top 104,10
caption 104,"Save 2 Files" : hint 104 , " 1 Pano + 1 FB "
on_click 104,On_Click_Button_104

button 105
left 105,370
top 105,10
caption 105,"Quit 'save'"
on_click 105,On_Click_Button_105

button 1
left 1,100
top 1,10
caption 1,"Load Files" : hint 1 , " 1 Pano , 1 FB "
on_click 1,On_Click_Button_1

button 2
left 2,10
top 2,10
caption 2,"Compiler fb" : hint 2 , "fichier sur DD"
on_click 2,On_Click_Button_2

button 3
left 3,370
top 3,10
caption 3,"Quit"
on_click 3,On_Click_Button_3

button 4
left 4,280
top 4,10
caption 4,"Save Files" : hint 4 , " 1 Pano , 1 FB "
on_click 4,On_Click_Button_4

button 5
left 5,190
top 5,10
caption 5,"New Func" : hint 5 , " RAZ si Edit 'Func' est vide "
on_click 5,On_Click_Button_5

container_option 15 :left 15,10 :top 15 ,35
width 15,75 : height 15 ,105
hint 15 , "1er param "

option 14
left 14,5

' N°s des options bien ordonnés!
top 14,10
width 14,50
caption 14,"string"
parent 14 , 15

option 13
left 13,5
top 13,35
width 13,50
height 13,20
caption 13,"double"
parent 13 , 15

option 12
left 12,5
top 12,60
width 12,50
caption 12,"integer"
parent 12 , 15 : mark_on 12 : ' mark_on 11

option 11 : left 11,5 : top 11,85 :width 11,50
caption 11,"0" : parent 11 , 15
container_option 25 :left 25,100 :top 25 ,35
width 25,75 : height 25 ,105
hint 25 , "2e param "
option 24
left 24,5
top 24,10
width 24,50
caption 24,"string"
parent 24 , 25

option 23
left 23,5
top 23,35
width 23,50
caption 23,"double"
parent 23 , 25

option 22
left 22,5
top 22,60
width 22,50
caption 22,"integer"
parent 22 , 25

option 21 : left 21,5 : top 21,85 :width 21,50
caption 21,"0" : parent 21 ,25
container_option 35 :left 35,190 :top 35 ,35
width 35,75 : height 35 ,105
hint 35 , "3e param "
option 34
left 34,5
top 34,10
width 34,50
caption 34,"string"
parent 34 , 35

option 33
left 33,5
top 33,35
width 33,50
caption 33,"double"
parent 33 , 35

option 32
left 32,5
top 32,60
width 32,50
caption 32,"integer"
parent 32 , 35

option 31 : left 31,5 : top 31,85 :width 31,50
caption 31,"0" : parent 31 , 35
container_option 45 :left 45,280 :top 45 ,35
width 45,75 : height 45 ,105
hint 45 , "4e param "
option 44
left 44,5
top 44,10
width 44,50
caption 44,"string"
parent 44 , 45

option 43
left 43,5
top 43,35
width 43,50
caption 43,"double"
parent 43 , 45

option 42
left 42,5
top 42,60
width 42,50
caption 42,"integer"
parent 42 , 45

option 41 : left 41,5 : top 41,85 :width 41,50
caption 41,"0" : parent 41 , 45
container_option 55 :left 55,370 :top 55 ,35
width 55,75 : height 55 ,105
hint 55 , "5e param "
option 54
left 54,5
top 54,10
width 54,50
caption 54,"string"
parent 54 , 55

option 53
left 53,5
top 53,35
width 53,50
caption 53,"double"
parent 53 , 55

option 52
left 52,5
top 52,60
width 52,50
caption 52,"integer"
parent 52 , 55

option 51 : left 51,5 : top 51,85 :width 51,50
caption 51,"0" : parent 51 , 55
container_option 65 :left 65,460 :top 65 ,35
width 65,75 : height 65 ,105
hint 65 , "6e param "
option 64
left 64,5
top 64,10
width 64,50
caption 64,"string"
parent 64 , 65

option 63
left 63,5
top 63,35
width 63,50
caption 63,"doub"
parent 63 , 65

option 62
left 62,5
top 62,60
width 62,50
caption 62,"integer"
parent 62 , 65

option 61 : left 61,5 : top 61,85 :width 61,50
caption 61,"0" : parent 61 , 65
mark_on 21 : mark_on 31 : mark_on 41 : mark_on 51 : mark_on 61
' check 6 : left 6 , 460 : top 6,15 : caption 6,"params auto"
check 6 : left 6 , 460 : top 6,3 : caption 6,"params auto"
check 122 :left 122 ,460 :top 122,21 :caption 122,"button Quit"

edit 7
left 7,3
top 7,145
width 7,280 : hint 7 , " nom du fichier à compiler "

alpha 8 : left 8,438 : top 8,148 : caption 8, " Func"

edit 9
left 9,468
top 9,145
width 9,90 : hint 9 , " vide -> RAZ"

alpha 120 : left 120,295 : top 120,148 : caption 120, "File"
edit 121 : left 121 ,315 : top 121 , 145 : width 121, 115

form 70
' aff memo fichier lu Editable
left 70 , screen_x - 575
top 70 , 1
width 70,575
height 70,screen_y -220
caption 70 ," Listing d'entrée éditable FB"
color 70 , 100,200,255

memo 71
' aff memo fichier lu Editable
left 71,3
top 71,0
width 71,width(70) - 25
height 71,height(70) -43
parent 71 , 70
font_size 71 , 9 : font_name 71,"Courier New"
bar_both 71

form 90
' aff memo fichier lu Editable
left 90 , screen_x - 575 -575
top 90 , 1
width 90,575
height 90,screen_y -220
caption 90 ," Listing d'entrée éditable Panoramic"
color 90 , 100,200,255

memo 91
' aff memo fichier lu Editable
left 91,3
top 91,0
width 91,width(70) - 25
height 91,height(70) -43
parent 91 , 90
font_size 91 , 9 : font_name 91,"Courier New"
bar_both 91

return

Au départ il faut écrire un nom"racine' de fichier dans l"edit File .
par exemple aaa . A la sauveg' on aura 2 fichiers autom' : aaa_p.bas pour Panoramic et
aaa_fb.bas pour le compil' qui écrira
une dll aaa_fb.dll
Lire le Help en debut de prog et demandez moi si c'est insuffisant .

Des fichiers test: les noms sont en debut de code.
Quand on fait 'Load' , le nom du fichier est ' choppé ' et inscrit dans l'edit 'File';( si vous changez les noms ...
ce n'est pas grave...pour ma fierté...).Mais dans les codes test la dll à déja un nom !

- minimum ( c'est le nom à écrire dans l'édit 'File' quand on ne 'Load' pas)

Avant de charger des exemples , simplement écrire un nom quelconque dans l'édit 'File' et
cliquer sur 'New Func' pour voir le code 'de base' écrit tout seul .
Dans le Help je signale un bug? a l'appui sur 'load' . cliquer sur 'quit load' et re-clic sur 'load'.

1er fichier -> 'Load fb'
2e fichier -> ' Load Pano'

Code:: ' minimum_fb.bas

' Func 1
'
extern "Windows-MS"
function fun1(fb_i11 as integer ) as integer export
' dim as integer
' dim as double
' dim as string
' your code...

function = fb_i11 + 10
'
end function
end extern
' --------------------- End function FB ----------------

Code:: ' minimum_p.bas

dir_change "C:\Users\compaq\PanoramicDivers\"
label Quit
dim R_fun1% , p_i11%
label fun1
dll_on "minimum_fb.dll"
button 999 :left 999,15 : top 999 ,height(0)-60 : width 999,width(0)-55
height 999,18 : caption 999,"Quit"
on_click 999 , Quit
' -------------------------------------------------------

p_i11% = 10
' your code...
gosub fun1
print R_fun1%
end
'
REM --------------- procedures --------------------------
Quit:
dll_off
terminate
return
' -------------------------------------------------------
fun1:
' your code...
'
R_fun1% = dll_call1( "fun1",p_i11% )
return
' -------------------------------------------------------

J'espère qu'il n'y a pas d'erreurs.
A suivre

enform

Nombre de messages : 42 Date d'inscription : 18/05/2011

Bonjour,

Je vais essayer d'ajouter d'auters tests.

javascript:emoticonp(' Shocked

')

[ edit le 19/5 ] ATTENTION : Si on entre du code par copié-collé :
- c'est le code Pano à gauche , le code FB à droite
- il faut écrire le nom racine dans l'édit File : pour le code ci-dessous -> mult c'est tout
- si on 'load' des fichiers , c'est auto .
- donc si on copie_colle les codes ci-dessous directement -> mult dans l'édit File
- si on préfère d'abord enreg' des fichiers via un éditeur donner les noms :
- mult_fb.bas et mult_p.bas aux fichiers .
- la dll sera nommée mult_fb.dll autom' .

mult

-code pour 'load fb' ( panneau de droite )

Code:: ' mult_fb.bas

' Func 1
'
extern "Windows-MS"
function fun1(fb_i11 as integer ) as integer export
' dim as integer
' dim as double
' dim as string
' your code...
fb_i11 = fb_i11 * 2
function = fb_i11
'
end function
end extern
' --------------------- End function FB ----------------

-code pour 'load Pano' ( panneau de gauche )

Code:: ' mult_p.bas

dir_change "C:\Users\compaq\PanoramicDivers\"
label Quit
dim R_fun1% , p_i11%
label fun1
dll_on "mult_fb.dll"
button 999 :left 999,15 : top 999 ,height(0)-60 : width 999,width(0)-55
height 999,18 : caption 999,"Quit"
on_click 999 , Quit
' -------------------------------------------------------

p_i11% = 10
' your code...
gosub fun1
print R_fun1%
end
'
REM --------------- procedures --------------------------
Quit:
dll_off
terminate
return
' -------------------------------------------------------
fun1:
' your code...
'
R_fun1% = dll_call1( "fun1",p_i11% )
return
' -------------------------------------------------------

file-2 ( nom 'racine' dans l'edit File )

-code pour 'load fb'

Code:: ' file-2_fb.bas

' Func 1
'
extern "Windows-MS"
function fun1( byref fb_s11 as zstring ptr , byref fb_s12 as zstring ptr ,fb_i13 as _
integer ) as integer export
' dim as integer
' dim as double
' dim as string
' your code...
'' examples/manual/fileio/open.bas -> modifié
'' --------
' compile with -lang qb

' Create a string .
Dim buffer As String, f As Integer
' buffer = ""

' Find the first free file number.
f = FreeFile

' Open the file "file.ext" for input usage, using the file number "f". first line in 'buffer'
Open *fb_s11 For Input As #f
If Err>0 Then Print "Error opening the file" ' :End

' Place in our string a line of the file, using number "f".
' pour lire plusieurs lignes -> do loop voir 'examples\file\filetext.bas'
Line Input #f, buffer
' Line Input #f, buffer
*fb_s12 = buffer ' string à l'adr pointée par le ptr
' Close all open files.
Close #f

' End the program. (Check the file "file.ext" upon running to see the output.)
' End pas de End dans les Dll

function = Err
'
end function
end extern
' --------------------- End function FB ----------------

-code pour 'load Pano'

Code:: ' file-2_p.bas

dir_change "C:\Users\compaq\PanoramicDivers\"
label Quit
dim R_fun1% , p_s11$, p_s12$, p_i13%
label fun1
dll_on "file-2_fb.dll"
button 999 :left 999,15 : top 999 ,height(0)-60 : width 999,width(0)-55
height 999,18 : caption 999,"Quit"
on_click 999 , Quit
' -------------------------------------------------------
p_s12$ = " "
p_s11$= "C:\Users\compaq\PanoramicDivers\x.bas" : ' un fichier à lire par la Dll
gosub fun1
' la chaine en retour ... la 1ere ligne ; ça marche ! ( p_i13% n'a pas servi )
print p_s12$
' pour lire d'autres lignes surement reinit p_s12$ avec des espaces... à voir .
' coté FB , à voir aussi ,mais sans doute non.
end
'
REM --------------- procedures --------------------------
Quit:
dll_off
terminate
return
' -------------------------------------------------------
fun1:
' your code...
'
R_fun1% = dll_call3( "fun1",adr(p_s11$) ,adr(p_s12$) ,p_i13% )
return
' -------------------------------------------------------

Nombre de messages : 42 Date d'inscription : 18/05/2011

Bonjour,
suite des petits tests .

- string-a

-code pour 'load fb'

Code:: ' string-a_fb.bas

' Func 1
'
extern "Windows-MS"
function string1( byref fb_s11 as zstring ptr ,ByRef fb_i12 as integer , byref _
fb_s13 as zstring ptr ) as integer export

dim as integer R_string1
dim as integer len_coucou
' dim as double
dim as string coucou , recoucou , rerecoucou

coucou = "C'est FB qui a travaillé"
len_coucou = Len(coucou)
fb_i12 = len_coucou

recoucou = "123456" & *fb_s13
' rerecoucou = coucou + recoucou
coucou = recoucou
' *fb_s11 = Left(coucou,15) ' *fb_s13 ou *fb_s11
*fb_s11 = coucou ' *fb_s13 ou *fb_s11
function = len_coucou
'
end function
end extern
' --------------------- End function FB -----------

-code pour 'load Pano'

Code:: ' string-a_p.bas

dir_change "C:\Users\compaq\PanoramicDivers\"
label Quit
dim R_string1% , p_s11$, p_i12%, p_s13$
label string1
dll_on "string-a_fb.dll"
button 999 :left 999,15 : top 999 ,height(0)-60 : width 999,width(0)-55
height 999,18 : caption 999,"Quit"
on_click 999 , Quit
' -------------------------------------------------------
' p_i12% non utilisé
' chaine longue de départ ,va etre modif' par la Dll
print "p_s11$ = chaine d'espaces pour que la Dll ait la place d'écrire"
p_s11$ = string$(100," ")
print " 0) chaine de départ écrite par Pano dans p_s13$"
p_s13$ = string$(100,"a")

print ""
print "chaine = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
' print time$
' gosub string1
' print time$ + " "
R_string1% = dll_call3( "string1",adr(p_s11$) ,adr(p_i12%) ,adr(p_s13$) )
' retour de la longueur de la chaine modifiée par la Dll
print " ' longueur (renvoyée par la Dll) d' une chaine FB 'coucou' ,pour left()"
print str$(R_string1%) + " retour len string FB ,par R_string1% "
print str$(p_i12%) + " retour len string FB ,par p_i12% "
print " adr de la chaine p_s11$ écrite par Pano'"
print str$(adr(p_s11$))
print ""
print " 1) chaine de départ modifiée par la Dll repérée par un pointeur (retour brut)"
print " la Dll n'a pas changé la longueur de la chaine,seulement certaines lettres"

' avant d'afficher le retour,on modifie la chaine dans Pano'
p_s13$ = string$(40,"b") : ' + " p_s13$"
print p_s13$ +" dans Pano'"
print p_s11$ + " ->retour par p_s11$"
print " 2) meme retour mais nettoyage avec left par Pano'"
print left$(p_s11$,R_string1%) : ' nettoyage du surplus
print ""
' nouvelle chaine longue finissant par des espaces (pour trim'mer après)
print " nouvelle chaine de départ terminée par des espaces (on ne les voit pas ici!)"
print "AzertyuiopaZertyuiopazertyuiopazer chaine avec espaces"
p_s13$ = "Azerty " : ' uiopaZertyuiopazertyuiopazer
print " 3) nouvel appel à la Dll"

' gosub string1 : ' non, en direct
R_string1% = dll_call3( "string1",adr(p_s11$) ,adr(p_i12%) ,adr(p_s13$) )
' retour chaine modifiée
print " 4) chaine de départ modifiée par la Dll, repérée par un pointeur (retour brut)"
print " il y a des espaces à la fin, mais on ne les voit pas "
print p_s11$ + " ->retour par p_s11$ (ou sont les espaces?)"
print " 5) retour (ou pas) puis nettoyage avec trim par Pano'"
print trim$(p_s11$) : ' nettoyage du surplus d'espaces
' print "pourquoi les Az ,pas évident ! ; effet zstring Ptr ? "
print "' ATTENTION aux commentaires peut-etre pas a jour"

'
end
'
REM --------------- procedures --------------------------
Quit:
dll_off
terminate
return
' -------------------------------------------------------
string1:
' your code...
'
R_string1% = dll_call3( "string1",adr(p_s11$) ,p_i12% ,adr(p_s13$) )
return
' -------------------------------------------------------

for-next_1a_ok

-code pour 'load fb'

Code:: ' for-next_1a_fb_ok.bas

' Func 1
'
extern "Windows-MS"
function fornext1(fb_i11 as integer ,fb_i12 as integer ) as integer

export

dim as integer R_fornext1
dim as integer x , z ,y2
' dim as double
' dim as string

' mult' de nb entiers
for x = 1 to fb_i11
for z = 1 to 1000000
y2 = fb_i12 * fb_i12
next z
next x

R_fornext1 = y2 ' for return , change this value...
function = R_fornext1
'
end function
' end extern
' --------------------- End function FB -----------
' Func 2
'
function fornext2(fb_i21 as integer , byref fb_d22 as double , byref _
fb_d23 As Double ) as integer export

dim as integer R_fornext2
dim as integer x , z
dim as double y2 , y3
' dim as string

' mult' de nb flottants
y2 = fb_d22
for x = 1 to fb_i21
for z = 1 to 1000000
y3 = y2 * y2
next z
next x
fb_d23 = y3
R_fornext2 = CInt(y3) ' for return , change this value...
function = R_fornext2
'
end function
end extern
' --------------------- End function FB -----------

-code pour 'load p'

Code:: ' for-next_1a_p_ok.bas Ancienne version sans code 'quit' auto

dir_change "C:\Users\compaq\Panoramic\"
dim R_fornext1% , p_i11% , p_i12%
dim R_fornext2% , p_i21% , p_d22 , p_d23
label fornext1
label fornext2
dll_on "speed.dll"
width 0 , 500 : height 0 , 600 : color 0 , 100,255,255

p_i11% = 1000 : ' x 1 000 000 de mult integer
p_i12% = 11 : ' valeur à multiplier par la Dll

print ""
print " p_i12% = 11 à multiplier par la Dll ( au carré )"
print time$
gosub fornext1
print time$ + " test vitesse de mult integer : p_i11% x 1 000 000"
print str$(R_fornext1%)
print ""

p_i21% = 1000 : ' x 1 000 000 de mult flottant
p_d22 = 20.5 : ' valeur à multiplier par la Dll
print " p_i22% = 20.5 à multiplier par la Dll ( au carré )"
print time$
gosub fornext2
print time$ + " test vitesse de mult flottant : p_i21% x 1 000 000"
print str$(R_fornext2%) + " retour en integer par R_fornext2%"
print ""
print str$(p_d23) + " retour en integer par p_d23 "
end : ' only 1 'end'

fornext1:
R_fornext1% = dll_call2( "fornext1",p_i11% ,p_i12% )
return

fornext2:
R_fornext2% = dll_call3( "fornext2",p_i21% ,adr(p_d22) ,adr(p_d23) )
return

ouf, c'est tout pour le moment. Bug free ?

Tchao
enform

Merci, génial, je vais essayer ça et regarder si je ne peux pas me débrouiller avec pour faire ma DLL pour le SAPI 4 Smile

Beau boulot à priori, je dis à priori puisque je n'ai pas encore essayé

Nombre de messages : 42 Date d'inscription : 18/05/2011

Bonjour,

Un autre passage de string aller-retour avec modification .
Jean Debord avait posé la question en Fevrier ... Est-ce que l'exemple fonctionnera correctement ?

string-b

code pour 'load fb'

Code:: ' string-b_fb.bas
' Func 1
'
extern "Windows-MS"
function string1( byref fb_s11 as zstring ptr ,ByRef fb_i12 as Integer , _
byref fb_s13 as zstring ptr ) as integer Export

dim as integer R_string1
dim as integer len_coucou
' dim as double
dim as string coucou , recoucou , rerecoucou

coucou = "C'est FB qui a travaillé"
len_coucou = Len(coucou)
fb_i12 = len_coucou

recoucou = "123456" & *fb_s13
' rerecoucou = coucou & recoucou
coucou = recoucou
' *fb_s11 = Left(coucou,15) ' *fb_s13 ou *fb_s11
*fb_s11 = coucou ' *fb_s13 ou *fb_s11
function = len_coucou
'
end function
end extern
' --------------------- End function FB -----------

code pour 'load pano'

Code:: ' string-b_p.bas

dir_change "C:\Users\compaq\PanoramicDivers\"
label Quit
dim R_string1% , p_s11$, p_i12%, p_s13$
label string1
dll_on "string-a_fb.dll"
button 999 :left 999,15 : top 999 ,height(0)-60 : width 999,width(0)-55
height 999,18 : caption 999,"Quit"
on_click 999 , Quit
' -------------------------------------------------------
width 0 , 800
' p_i12% non utilisé
' chaine longue de départ ,va etre modif' par la Dll
print "p_s11$ = chaine d'espaces pour que la Dll ait la place d'écrire"
p_s11$ = string$(100," ")
print " 0) chaine de départ écrite par Pano dans p_s13$"
p_s13$ = string$(100,"a")

print ""
print "chaine = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"

' print time$
' gosub string1
' print time$ + " "
R_string1% = dll_call3( "string1",adr(p_s11$) ,adr(p_i12%) ,adr(p_s13$) )
' retour de la longueur de la chaine modifiée par la Dll
print " ' longueur (renvoyée par la Dll) d' une chaine FB 'coucou' ,pour left()"

print str$(R_string1%) + " retour len string FB ,par R_string1% "
print str$(p_i12%) + " retour len string FB ,par p_i12% "
print " adr de la chaine p_s11$ écrite par Pano'"
print str$(adr(p_s11$))
print ""
print " 1) chaine de départ modifiée par la Dll repérée par un pointeur (retour brut)"

print " la Dll n'a pas changé la longueur de la chaine,seulement certaines lettres"

' avant d'afficher le retour,on modifie la chaine dans Pano' , elle n'est pas envoyée

p_s13$ = string$(40,"b") : ' + " p_s13$"
print p_s13$ +" dans Pano , elle n'est pas envoyée"
print "retour par p_s11$ -> " + p_s11$
print " 2) meme retour mais limitation avec left par Pano' bon..."
print left$(p_s11$,R_string1%) : ' nettoyage du surplus
print ""
' nouvelle chaine longue finissant par des espaces (pour trim'mer après)
print " nouvelle chaine de départ terminée par des espaces (on ne les voit pas ici!)"

print "AzertyuiopaZertyuiopazertyuiopazer "
' chaine avec espaces"
p_s13$ = "Azerty "

print " 3) nouvel appel à la Dll"

' gosub string1 : ' non, en direct
R_string1% = dll_call3( "string1",adr(p_s11$) ,adr(p_i12%) ,adr(p_s13$) )
' retour chaine modifiée
print " 4) chaine de départ modifiée par la Dll, repérée par un pointeur "

' (retour brut)"
' print " il y a des espaces à la fin, mais on ne les voit pas "
print p_s11$ + " ->retour par p_s11$ (ou sont les espaces?)"
print " 5) retour (ou pas) puis nettoyage avec trim par Pano'"
print trim$(p_s11$) : ' nettoyage du surplus d'espaces
' print "pourquoi les Az ,pas évident ! ; effet zstring Ptr ? "
print "' ATTENTION aux commentaires qui n'ont pas toujours évolué comme les essais"

print "' c'est une recherche de ce qui se passe ou plante "
'
end
'
REM --------------- procedures --------------------------
Quit:
dll_off
terminate
return
' -------------------------------------------------------
string1:
' your code...
'
R_string1% = dll_call3( "string1",adr(p_s11$) ,p_i12% ,adr(p_s13$) )
return
' -------------------------------------------------------

la chaine est modifiée par la dll.

Tchao
enform

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

Bonjour et bienvenue.
Intéressant a priori, mais comme il y a beaucoup de lignes longues elles sont coupées un peu n'importe comment ici, et ça l'éditeur Panoramic ne va pas aimer... gros boulot de remise en forme... (et de compréhension) avant de pouvoir tester.

Nombre de messages : 42 Date d'inscription : 18/05/2011

Bonjour JL35,

Pour la mise en forme du code test le site est un peu étroit, avec un écran
normal tout se remet en place,je viens d'essayer.

[ edit ] En fait c'etait bien un probleme.

En tout cas je ne suis pas un expert et je cherche...
Le plus délicat est le traitement des chaines puisqu'on transmet leur
adresse en aller-retour.C'est la premiere fois que j'essaie !

Si on définit une chaine dans Panoramic pour etre traitée dans la dll,
elle doit etre assez longue et peut etre constituée ou terminée par
des espaces : la dll ne pourra pas la rallonger .Mais je veux bien qu'on
me dise le contraire , pour augmenter la souplesse .

On peut récupérer le contenu modifié de la chaine ou mieux, dans une autre

chaine dim' dans Pano , remplie d'espaces et assez longue aussi puisque
la dll ne pourra pas la rallonger non plus .

Quelqu'un peut-il me confirmer?
Klaus pourrait surement .

Pour les lignes longues comme 'aaaaaaaaaaaaaaa etc au lieu d'espaces
c'est volontaire ,pour voir ce qui se passe .
A nouveau ... je fais des essais ...pas encore du code propre (pour les tests
chaines,j'espère que c'est un peu mieux ailleurs).

Dans l'avant-dernier code : string-b_fb.bas
la dll reçoit la chaine par pointeur sur l'adresse fb_s13 qui vient de
Pano par p_s13$ ( le s pour string , en params auto ).

Le retour se fait par fb_s11 qui devient p_s11$ dans Pano (les params vont
en couple et par ordre : le 1er couple ,2e 3e etc ).

La ligne fb_i12 = len coucou montre un retour de valeur numérique non pas
par la valeur de retour des fonctions : function = .... ( mais à la fin je
le fait aussi , en doublon ) , mais par un des params fb_i12 (qui deviendra
p_i12% dans Pano) et en employant Byref dans la dll ( équivalent adr() ).

On récupère la valeur de p_i12% par str$(p_i12%) dans Pano, à cause de Byref .

La ligne recoucou = "123456" & *fb_s13 montre une concaténation '&' entre
une chaine Dim dans la dll '123456' et la chaine reçue par fb_s13 ( p_s13$
dans Pano ).

Le * signifie 'valeur de' parce qu'on travaille avec des adresses.
*fb_s13 signifie prendre la valeur pointée par la variable pointeur fb_s13.

La ligne coucou = recoucou ne sert pas dans ce test ...

La ligne *fb_s11 = coucou signifie placer la valeur de coucou à l'adresse
pointée par la variable pointeur fb_s11.
Pano recevra la valeur dans p_s11$ , la soeur de fb_s11 .
C'est a peu-pres tout ce que j'ai appris sur FB en dll...

Tchao

enform

Nombre de messages : 42 Date d'inscription : 18/05/2011

Jicehel ,

Qu'est-ce que SAPI4 ? Un lien avec l' Api de Windows ?

salut

oui, c'est la synthèse vocale de microsoft (la reconnaissance aussi, mais c'est surtout la synthès vocale qui serait en principe assez simple à utiliser)

SAPI 4 (et SAPI 5) sont librement utilisable (par contre il n'y a que quelques voix gratuites) et les sources existent en Free basic pour les utiliser.

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

@enform désolé, je n'interviens par sur le fond pour le moment mais sur la forme, si je charge ton premier exemple dans l'éditeur panoramic avec copier/coller (ou même dans notepad d'ailleurs) les lignes trop longues sont coupées avec introduction d'un interligne supplémentaire (ligne vide). Tu n' y es pour rien, c'est le forum qui veut ça, et il faut s'astreindre à faire des lignes plus courtes.
Enfin, ce n'est valable que pour les commentaires en tête, pour le code, les lignes étant de longueur raisonnable, ça marche.
Ce que j'obtiens:

Des dlls compilées a la demande en FreeBasic, avec l'appel Exemple

Tout ce qui est en plus foncé (flèches) est considéré comme instructions par Panoramic...

Nombre de messages : 42 Date d'inscription : 18/05/2011

Bonjour à tous,

Effectivement comme l' a montré JL35 , les lignes longues m'ont piégé . Milles excuses .
J'espère que maintenant à 18h30 ,ça tourne sans problèmes .
L'éditeur FBedit accepte les lignes coupées si on termine avec un caractère '_' (souligné), ex byref _ .
Le plus probable étant dans les lignes function multi-params . J'ai mis des '_' .
Essayez !
Si vous souhaitez un meilleur fichier Help dites le.

Tchao

Enform, je te mets un lien sur le forum freebasic ou il y a les sources pour utiliser sapi4/5, je n'ai pas le temps pour le moment de me mettre dans ce langage: http://www.freebasic.net/forum/viewtopic.php?p=150990

J'ai essayé le dernier exemple sur les chaînes de caractères mais j'obtiens le message "Invalid Pointer Operation" lors du premier appel à la DLL :

Code:: R_string1% = dll_call3( "string1",adr(p_s11$) ,adr(p_i12%) ,adr(p_s13$) )

Je ne comprends pas ce qui se passe puisque toutes les variables chaînes sont déclarées et initialisées.

Nombre de messages : 42 Date d'inscription : 18/05/2011

@ jean-debord

j'ai telech' les codes , pb de lignes longues coupées , mais pour le moment essais en cours.

Est- ce que d'autres exemples ont marché ?
Quand on clique sur 'compiler fb' , l'invite de commande apparait au moins 1 à 2 sec , si c'est
un flash ,il y a bug .
Je viens de faire une autre version avec gestion du clipboard texte .
Mais il faudrait déja qu'avec celle-ci ,ça se passe bien.
Justement ,et les autres exemples ?

salut

Nombre de messages : 42 Date d'inscription : 18/05/2011

@ jean debord
J'ai ré-édité les 2 derniers codes à cause des coupures de lignes.
Maintenant ça passe.
Je vais revérifier les autres dans la soirée.

Nombre de messages : 42 Date d'inscription : 18/05/2011

21h30 j'espere qu'il n'y a plus de lignes coupées.
Le mode edition presente une largeur plus importante que le resultat final , ou c'est mes yeux ? .
Bonne chance.

» Dlls compilees nouvelle version avec gestion clipboard texte
» Problème avec FreeBasic.
» Utilisation de PANORAMIC.DLL avec FreeBASIC
» Demande de fonction spécifique avec KGF.
» Compilateur FBPano