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

'      "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

' 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  ----------------

' 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
 ' -------------------------------------------------------

' 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  ----------------

' 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_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  ----------------

' 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
 ' -------------------------------------------------------

'  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  -----------

' 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_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  -----------

'  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

 '  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  -----------

'  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
 ' -------------------------------------------------------

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