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%))
  if v=_tiefe% then
    ergebnis=0
  else
    ergebnis=(v mod _maxf&)+1
  end if
  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)
  while ende=0
    zaehler=zaehler+1
    if p=1
      poke zstring,s,"Thread "+str(p)+" läuft... "+str(zaehler)
      WaitForSingleObject(_Mutex%,0)
      sendmessage(_hE1%,WM_SETTEXT,0,s)
      ReleaseMutex(_Mutex%)
    else
      poke zstring,s,"Thread "+str(p)+" läuft... "+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%,"Das Hauptprogramm läuft... "+@str$(_Zaehler%)
  waitinput 1
  if %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) 'der Stern vor der Pointer-Variablen besagt, dass der Inhalt genommen werden soll, nicht der Wert des Pointers (es ginge aber in diesem Fall auch ohne Stern, die API-Funktion MessageBox nimmt auch den Pointer auf den String)
  *pString="Dies ist ein neuer Teststring."
  return 0
ENDPROC

cls
dim Bereich#,10000 '10000 ist auf jeden Fall groß genug
string Bereich#,0="Dies ist ein Teststring."
fbStringTest(Bereich#)
print @string$(Bereich#,0)
waitinput
end

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

ENDPROC

cls
dim Bereich#,10000
string Bereich#,0="Dies ist ein Teststring."
fbStringTest(Bereich#)
print @string$(Bereich#,0)
waitinput
end