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
  bucle until (((a+b)>_tiefe%) or (v=_tiefe%))
  if v=_tiefe% then
    ergebnis=0
  más
    ergebnis=(v mod _maxf&)+1
  end if
  volver ergebnis
ENDPROC

{$FBSYNTAX on}

declarar _hE1%,_hE2%,_Mutex% SharedInFbProcs
declarar _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)
  mientras que ende=0
    zaehler=zaehler+1
    if p=1
      poke zstring,s,"Hilo "+str(p)+" se ejecuta... "+str(zaehler)
      WaitForSingleObject(_Mutex%,0)
      sendmessage(_hE1%,WM_SETTEXT,0,s)
      ReleaseMutex(_Mutex%)
    más
      poke zstring,s,"Hilo "+str(p)+" se ejecuta... "+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)
  volver 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%,"Das Hauptprogramm se ejecuta... "+@str$(_Zaehler%)
  waitinput 1
  if %scankey=27
    _Ende%:=1
  endif
endwhile
freedll _hDLL%
end

{$FBSYNTAX on}

declarar Zona#

fbPROC fbStringTest(ByVal pString As ZString Pointer) As Integer Export
  MessageBox(0,*pString,"Testausgabe String",0) 'el Stern antes Pointer-Variables besagt, dass el Inhalt genommen voluntad se, no Valor des Pointers (lo ginge aber en diesem Fall auch sin Stern, el API-Función MessageBox nimmt auch el Pointer en el String)
  *pString="Dies es una neuer Teststring."
  volver 0
ENDPROC

cls
dim Zona#,10000 '10000 es en cada Fall groß genug
cadena Zona#,0="Dies es una Teststring."
fbStringTest(Zona#)
imprimir @cadena$(Zona#,0)
waitinput
end

 {$FBSYNTAX on}
declarar Zona#
fbPROC fbStringTest(ByVal pString As ZString Pointer) As Integer Export
Screenres(256,100)
imprimir *pString
MessageBox(0,*pString,"Testausgabe String",0)
volver 0

ENDPROC

cls
dim Zona#,10000
cadena Zona#,0="Dies es una Teststring."
fbStringTest(Zona#)
imprimir @cadena$(Zona#,0)
waitinput
end