Dlls compilees nouvelle version avec gestion clipboard texte

'      "Speed of light"  speedo-FB-V4 a_7 - 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' )
'  -Si on écrit 'clipxxxx' ( au moins 'clip' les 4 lettres) dans l'Edit 'Func'
'          on aura du code pour le clipboard 'get' et 'set' .
'  -Appui sur 'New Func' -> 2 listings : 1 partie FB ,1 partie Pano
'        (préréglé avec 1er param 'integer')
'      Compléter le code dans les mémos , ou autres éditeurs .
' -'Save Files' ->2 fichiers :1) code Pano seul. ex : abc_p.bas.
'                            2) code FB  seul.  ex : abc_fb.bas.
' -'Compiler fb' : 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 319 ?).
'      (option : Ajouter '-x' 'xyz.dll'    donne un autre nom à la
'      dll).Chercher le résultat sur le DD.(l'invite de commande apparait
'      au moins 1 à 2 sec . Si c'est un 'flash' , c'est raté) .
'            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 save' 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.
'            Appui sur 'quit save' puis 'compiler fb'
'            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 , clip

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$ ,clipflag%

' 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 : clipflag% = 0
    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  "
  item_add 91 ," ' ------------------------------------------ "
 end_if
end_if
for l = 1 to count(71)
  if instr(item_read$(71,l),"OpenClipboard") = 0 then clipflag% = 1
  if clipflag% = 0 and left$(text$(9),4) = "clip"
  ' si on écrit 'clipxxxx' dans Edit Func
      gosub clip          : ' code pour clipboard FB 1 fois
      exit_for
  end_if
 
next l
  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
    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$ + ":"
        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
  hide 102 : hide 103 :  hide 104 : hide 105
  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
' ---------------------------------------------------------------
clip:
 item_add 71 ," ' code pour ClipBoard text ,sur forum FB "
 item_insert 71 ,1,"#include Once " + chr$(34) + "windows.bi" +chr$(34)
 item_add 71 ," Function get_clipboard () As String "
 item_add 71 ," Dim As Zstring Ptr s_ptr "
 item_add 71 ,"  Dim As HANDLE hglb "
 item_add 71 ,"  Dim As String s = chr$(34)+ chr$(34)"

 item_add 71 ," If (IsClipboardFormatAvailable(CF_TEXT) = 0) Then Return _ "
 item_add 71 ,"  chr$(34)+ chr$(34) "

 item_add 71 ,"  If OpenClipboard( NULL ) <> 0 Then "
 item_add 71 ,"    hglb = GetClipboardData(cf_text) "
 item_add 71 ,"    s_ptr = GlobalLock(hglb) "
 item_add 71 ,"    If (s_ptr <> NULL) Then  "
 item_add 71 ,"      s = *s_ptr  "
 item_add 71 ,"      GlobalUnlock(hglb) "
 item_add 71 ,"    End If  "
 item_add 71 ,"    CloseClipboard()  "
 item_add 71 ,"  End If  "

 item_add 71 ,"  Return s  "
 item_add 71 ," End Function "

 item_add 71 ," Sub set_clipboard (Byref x As String) "
 item_add 71 ,"  Dim As HANDLE hText = NULL "
 item_add 71 ,"  Dim As Ubyte Ptr clipmem = NULL "
 item_add 71 ,"  Dim As Integer n = Len(x)  "

 item_add 71 ,"  If n > 0 Then "
 item_add 71 ,"  hText = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, n + 1)"
 item_add 71 ,"    Sleep 15"
 item_add 71 ,"    If (hText) Then "
 item_add 71 ,"      clipmem = GlobalLock(hText)"
 item_add 71 ,"      If clipmem Then "
 item_add 71 ,"        CopyMemory(clipmem, Strptr(x), n) "
 item_add 71 ,"      Else "
 item_add 71 ,"        hText = NULL "
 item_add 71 ,"      End If  "
 item_add 71 ,"      If GlobalUnlock(hText) Then "
 item_add 71 ,"        hText = NULL  "
 item_add 71 ,"      End If  "
 item_add 71 ,"    End If  "
 item_add 71 ,"    If (hText) Then "
 item_add 71 ,"      If OpenClipboard(NULL) Then "
 item_add 71 ,"        Sleep 15 "
 item_add 71 ,"        If EmptyClipboard() Then "
 item_add 71 ,"          Sleep 15 "
 item_add 71 ,"          If SetClipboardData(CF_TEXT, hText) Then"
 item_add 71 ,"            Sleep 15 "
 item_add 71 ,"          End If "
 item_add 71 ,"        End If "
 item_add 71 ,"        CloseClipboard()"
 item_add 71 ,"      End If  "
 item_add 71 ,"    End If "
 item_add 71 ,"  End If "
 item_add 71 ," End Sub "
 item_add 71 ," ' -----------  utilisation ---------- "
 item_add 71 ," ' dim as string s "
 item_add 71 ," ' s = get_clipboard () "
 item_add 71 ," ' set_clipboard (s) "
 item_add 71 ," ' ----------------------------------- "
  clipflag% = 1          : ' code pour clipboard FB non
  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 V4 a  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

#include Once "windows.bi"
' code sur forum FB
Function get_clipboard () As String
  Dim As Zstring Ptr s_ptr
  Dim As HANDLE hglb
  Dim As String s = ""

  If (IsClipboardFormatAvailable(CF_TEXT) = 0) Then Return ""

  If OpenClipboard( NULL ) <> 0 Then
    hglb = GetClipboardData(cf_text)
    s_ptr = GlobalLock(hglb)
    If (s_ptr <> NULL) Then
      s = *s_ptr
      GlobalUnlock(hglb)
    End If
    CloseClipboard()
  End If

  Return s
End Function

Sub set_clipboard (Byref x As String)
  Dim As HANDLE hText = NULL
  Dim As Ubyte Ptr clipmem = NULL
  Dim As Integer n = Len(x)

  If n > 0 Then
    hText = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, n + 1)
    Sleep 15
    If (hText) Then
      clipmem = GlobalLock(hText)
      If clipmem Then
        CopyMemory(clipmem, Strptr(x), n)
      Else
        hText = NULL
      End If
      If GlobalUnlock(hText) Then
        hText = NULL
      End If
    End If
    If (hText) Then
      If OpenClipboard(NULL) Then
        Sleep 15
        If EmptyClipboard() Then
          Sleep 15
          If SetClipboardData(CF_TEXT, hText) Then
            Sleep 15
          End If
        End If
        CloseClipboard()
      End If
    End If
  End If
End Sub

 ' Func  1
 '
 extern "Windows-MS"
 function  fun1(fb_i11  as integer ) as integer export
 '  dim as integer
 '  dim as double
  dim as string s
 '  your code...
 If fb_i11 > 0 then
  s = get_clipboard ()
  s = "  Super    " & Left(s,140)
 ' s =  Left(s,130)
  set_clipboard (s)
 End If 
  function = 0
  '
 end function
 end extern 
 ' ----------- End function FB  ------------

' ClipBoardString-1_p.bas
' Adapter le path  et le fichier d'origine pour memo 1
 dir_change "C:\Users\compaq\PanoramicDivers\"
  label  Quit
  dim  R_fun1%  , p_i11% , a$
  label  fun1
  dll_on "ClipBoardString-1_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 
 ' -------------------------------------------------------
  ' memo 1  données de départ
 memo 1 : top 1 , 20 : height 1 , 400 : width 1 , 270 : bar_vertical 1
  file_load 1 ,"mini_p.bas"              : ' petit fichier quelconque
 ' memo 2  données au retour  par la dll
 memo 2 : top 2 , 20 : left 2, 280 : height 2 , 400 : width 2 , 270
' Et un petit test de la fonction  select_text
  select_text 1,1,250
  a$ = select_read$(1)
 ' ou plus simple
'  a$ = item_read$(1,1)
  clipboard_string_copy a$
 '  wait 500
  p_i11% = 1            : ' flag 'copié'
  gosub fun1
  p_i11% = 0
 ' string en retour de dll ( si ! ) dans memo 2 ... ça marche !
 ' + une concaténation dans la dll  : affiche 'super' au début
  '  wait 500
  a$ = clipboard_string_paste$
  item_add 2,a$
  end
 ' Ouf ! c'est bon
 REM --------------- procedures --------------------------
Quit:
 dll_off
 terminate
return
 ' -------------------------------------------------------
fun1:
 '  your code...
 ' 
  R_fun1% = dll_call1( "fun1",p_i11% )
return
 ' -------------------------------------------------------

' ClipFile-1_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é ,des lignes en ' pour comparer
'' --------
' Create a string .
 Dim buffer As String
 Dim  f As Integer , r As Integer, Retour As String
 buffer = ""
 Retour = "retour"  ' nom du fichier

' Find the first free file number.( -> #f )
f = FreeFile

' Open the file "file.ext" for input, using  "f". first line in '*fb_s11'
Open *fb_s11 For Input As #f
If Err>0 Then Print "Error opening the file" 
' on ouvre un fichier de sortie
r = FreeFile  ' placé juste avant ' open ' (plusieurs freefile)
open Retour + ".txt" for output as #r

do until( eof(f) )
      
  Line Input  #f,  buffer
' Place in our string  a line of the file, using number "f".
' pour lire plusieurs lignes -> do loop voir 'examples\file\filetext.bas'

'  print  buffer
  print #r,  buffer
   
loop

' Close all open files. 
Close #f
Close #r
  *fb_s12 = "retour.txt"        ' nom à l'adr pointée par le ptr fb_s12
' End the prog.
' End    pas de End dans les Dll !!!!!!!!
 
  function = Err
  '
 end function
 end extern 
 ' --------------------- End function FB  ----------------

' ClipBoardString-1_p.bas
' Adapter le path  et le fichier d'origine pour memo 1
 dir_change "C:\Users\compaq\PanoramicDivers\"
  label  Quit
  dim  R_fun1%  , p_i11% , a$
  label  fun1
  dll_on "ClipBoardString-1_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 
 ' -------------------------------------------------------
  ' memo 1  données de départ
 memo 1 : top 1 , 20 : height 1 , 400 : width 1 , 270 : bar_vertical 1
  file_load 1 ,"mini_p.bas"              : ' petit fichier quelconque
 ' memo 2  données au retour  par la dll
 memo 2 : top 2 , 20 : left 2, 280 : height 2 , 400 : width 2 , 270
' Et un petit test de la fonction  select_text
  select_text 2,1,200  : ' avant 2000 , un 1er essai avec 200 ok
  a$ = select_read$(2)    : ' au lieu de 2000 voir 100*count(2) ? 100 ?
  clipboard_string_copy a$
  p_i11% = 1            : ' flag 'copié'
  gosub fun1
  p_i11% = 0
 ' string en retour dans memo 2 ... ça marche !
 ' ok le fichier est bien affiché dans memo 2
  wait 500
  item_add 1,a$
' clear 1 :  wait 1500
' item_add 1,a$
 ' ok ça marche ; si on select ++ que '200' -> bar_vertical 1
 ' pour tout afficher . super simple , Panoramic .
  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
 ' -------------------------------------------------------