XProfan

 {$cleq}
const 	asyncMessageBox.Message=1025
declarar	asyncMessageBox.C&
decimals 0

proc asyncMessageBox

    parámetros wnd&,s$,tit$,mode&
    add asyncMessageBox.C&,1
    var h&=globalAlloc(gPTR,24)
    long h&,0=addr(s$),addr(tit$),mode&,wnd&,create("text",hWnd,"",0,0,0,0),asyncMessageBox.C&
    setWindowLong(long(h&,16),gwl_userdata,setWindowLong(long(h&,16),gwl_wndProc,procaddr(asyncMessageBox.wndProc,4)))
    asyncMessageBox.createThread(h&)

    mientras que long(h&,0)

        sleep 10

    wend

    whileloop 100

    wend

    var msg&=long(h&,16)
    mensajes de los usuarios asyncMessageBox.Message
    globalFree(h&)
    var msgboxWnd&=findWindow("."+str$(hWnd)+"."+str$(asyncMessageBox.C&))
    settext msgboxWnd&,tit$
    volver msgboxWnd&

ENDPROC

nProc asyncMessageBox.createThread

    parámetros h&
    createThread(0,0,procAddr(asyncMessageBox.thread,1),h&,0,0)

ENDPROC

nProc asyncMessageBox.wndProc

    Parámetros wnd&,msg&,wp&,lp&

    if msg&=asyncMessageBox.Message

        sendMessage(hWnd,asyncMessageBox.Message,wnd&,lp&)
        destroyWindow(wnd&)
        volver 0

    endif

    volver callWindowProc(getWindowLong(wnd&,gwl_userData),wnd&,msg&,wp&,lp&)

ENDPROC

nproc asyncMessageBox.thread

    parámetros h&
    var s$=cadena$(long(h&,0),0)
    var tit$=cadena$(long(h&,4),0)
    var mode&=long(h&,8)
    var wnd&=long(h&,12)
    var trd&=long(h&,16)
    long h&,0=0
    sendMessage(trd&,asyncMessageBox.Message,0,messageBox(wnd&,s$,"."+str$(hWnd)+"."+str$(long(h&,20)),mode&))
    volver 0

ENDPROC

cls
var myMsgBoxWnd&=asyncMessageBox(desktop,"Huhu","Titel",mb_ok)
settext findWindowEx(myMsgBoxWnd&,0,"BUTTON","OK"),"&Abbrechen"

mientras que 1

    waitinput

wend

end

cls
var myMsgBoxWnd&=asyncMessageBox(desktop,"Huhu","Titel",mb_ok)
var btn&=findWindowEx(myMsgBoxWnd&,0,"BUTTON","OK")
var c&=10

mientras que (c&+2) and isWindow(myMsgBoxWnd&)

    waitinput 1000
    settext btn&,"&Abbrechen ["+str$(c&)+"]"
    sub c&,1

wend

caso isWindow(myMsgBoxWnd&) : sendMessage(myMsgBoxWnd&,wm_close,0,0)
imprimir "fertsch"

mientras que 1

    waitinput

wend

end

'{$ Cleq}
decimals 0
cls
var myTimer&=external("user32","SetTimer",0,0,100,procAddr(myMessageBoxAPCProc,4))
imprimir messageBox("Text","."+str$(%hWnd)+".¡Hola Welt!",0)
waitinput
end

proc myMessageBoxAPCProc

    parámetros wnd&,msg&,id&,tme&
    var s$="."+str$(%hWnd)+"."
    var msgboxWnd&=findWindow(s$)
    casenot msgboxWnd& : volver
    external("user32","KillTimer",0,myTimer&)
    settext msgboxWnd&,del$(getText$(msgboxWnd&),1,len(s$))
    var btn&=external("user32","FindWindowExA",msgboxWnd&,0,"BUTTON","OK")
    casenot btn& : volver
    setText btn&,"&Abbrechen"

endProc