XProfan

fbPROC fbIteration(ByRef xr As Integer,ByRef yi As Integer) As Integer Export
  dim as double a,b,r,i,x,xalt,y
  dim as integer v,ergebnis
  r=_rmin!+_xr&*_ar!
  i=_imin!+_yi&*_ai!
  v=0
  x=0.0
  y=0.0
  do
    xalt=x
    a=x*x
    b=y*y
    x=a-b+r
    y=2*xalt*y+i
    v=v+1
  loop until (((a+b)>_tiefe%) or (v=_tiefe%))
  si v=_tiefe% then
    ergebnis=0
  d'autre
    ergebnis=(v mod _maxf&)+1
  end si
  return ergebnis
ENDPROC

{$FBSYNTAX on}

declare _hE1%,_hE2%,_Mutex% SharedInFbProcs
declare _hE3%,_Ende%,_Zaehler%,_hDLL%

fbPROC fbThreadProc(ByVal p As Integer) As Integer Export
  dim as integer zaehler,i,t,ende
  dim as zstring pointer s
  ende=0
  zaehler=0
  t=timer
  s=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,1000)
  tandis que ende=0
    zaehler=zaehler+1
    si p=1
      poke zstring,s,"Fil "+str(p)+" fonctionne... "+str(zaehler)
      WaitForSingleObject(_Mutex%,0)
      sendmessage(_hE1%,WM_SETTEXT,0,s)
      ReleaseMutex(_Mutex%)
    d'autre
      poke zstring,s,"Fil "+str(p)+" fonctionne... "+str(zaehler)
      WaitForSingleObject(_Mutex%,0)
      sendmessage(_hE2%,WM_SETTEXT,0,s)
      ReleaseMutex(_Mutex%)
    endif
    sleep 1000-(timer-t)
    t=timer
  endwhile
  HeapFree(GetProcessHeap(),0,s)
  return 0
ENDPROC

cls
_hE1%:=@create("EDIT",%HWnd,"",10,10,@width(%HWnd)-20,20)
_hE2%:=@create("EDIT",%HWnd,"",10,40,@width(%HWnd)-20,20)
_hE3%:=@create("EDIT",%HWnd,"",10,70,@width(%HWnd)-20,20)
_Mutex%=~CreateMutex(0,0,0)
_hDLL%=@usedll("test_fbprocs.dll")
~CreateThread(0,0,~getprocaddress(_hDLL%,"FBTHREADPROC@4"),1,0,0)
~CreateThread(0,0,~getprocaddress(_hDLL%,"FBTHREADPROC@4"),2,0,0)
_Zaehler%:=0
_Ende%:=0
whilenot _Ende%
  inc _Zaehler%
  settext _hE3%,"cela Hauptprogramm fonctionne... "+@str$(_Zaehler%)
  waitinput 1
  si %scankey=27
    _Ende%:=1
  endif
endwhile
freedll _hDLL%
end

{$FBSYNTAX on}

declare Bereich#

fbPROC fbStringTest(ByVal pString As ZString Pointer) As Integer Export
  MessageBox(0,*pString,"Testausgabe String",0) 'qui Stern avant qui Pointer-Variablen besagt, dass qui le contenu pris volonté soll, pas qui Wert des Pointers (es ginge mais dans diesem le cas aussi sans Stern, qui API-Funktion MessageBox nimmt aussi den Pointer sur den String)
  *pString="ca est un neuer Teststring."
  return 0
ENDPROC

cls
dim Bereich#,10000 '10000 ist sur jeden le cas grand genug
string Bereich#,0="ca est un Teststring."
fbStringTest(Bereich#)
imprimer @string$(Bereich#,0)
waitinput
end

 {$FBSYNTAX on}
declare Bereich#
fbPROC fbStringTest(ByVal pString As ZString Pointer) As Integer Export
Screenres(256,100)
imprimer *pString
MessageBox(0,*pString,"Testausgabe String",0)
return 0

ENDPROC

cls
dim Bereich#,10000
string Bereich#,0="Dies est un Teststring."
fbStringTest(Bereich#)
imprimer @string$(Bereich#,0)
waitinput
end