| asyncMsgBox.inc
Asynchrone MessageBoxen- Rückmeldungen, "MessageBox with eigenem Thread "-example.
<!---->
Download/ into Cart4,99 € inkl. MwSt. no Shipping fee
Pretty Examples: iF (29.06.12)
Hihi,
schauma: Download external Download
{$cleq}
const asyncMessageBox.Message=1025
declare asyncMessageBox.C&
decimals 0
proc asyncMessageBox
parameters 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&)
while long(h&,0)
sleep 10
wend
whileloop 100
wend
var msg&=long(h&,16)
userMessages asyncMessageBox.Message
globalFree(h&)
var msgboxWnd&=findWindow("."+st$(hWnd)+"."+st$(asyncMessageBox.C&))
settext msgboxWnd&,tit$
return msgboxWnd&
endproc
nProc asyncMessageBox.createThread
parameters h&
createThread(0,0,procAddr(asyncMessageBox.thread,1),h&,0,0)
endproc
nProc asyncMessageBox.wndProc
Parameters wnd&,msg&,wp&,lp&
if msg&=asyncMessageBox.Message
sendMessage(hWnd,asyncMessageBox.Message,wnd&,lp&)
destroyWindow(wnd&)
return 0
endif
return callWindowProc(getWindowLong(wnd&,gwl_userData),wnd&,msg&,wp&,lp&)
endproc
nproc asyncMessageBox.thread
parameters h&
var s$=string $(long(h&,0),0)
var tit$=string $(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$,"."+st$(hWnd)+"."+st$(long(h&,20)),mode&))
return 0
endproc
cls
var myMsgBoxWnd&=asyncMessageBox(desktop,"Huhu","Titel",mb_ok)
settext findWindowEx(myMsgBoxWnd&,0,"BUTTON","OK"),"&Abbrechen"
while 1
waitinput
wend
end
or herewith zählts pretty down and closes itself self-employed:
cls
var myMsgBoxWnd&=asyncMessageBox(desktop,"Huhu","Titel",mb_ok)
var btn&=findWindowEx(myMsgBoxWnd&,0,"BUTTON","OK")
var c&=10
while (c&+2) and isWindow(myMsgBoxWnd&)
waitinput 1000
settext btn&,"&Abbrechen ["+st$(c&)+"]"
sub c&,1
wend
case isWindow(myMsgBoxWnd&) : sendMessage(myMsgBoxWnd&,wm_close,0,0)
print "fertsch"
while 1
waitinput
wend
end
iF (29.06.12)
and here time mere by External:
'{$cleq}
decimals 0
cls
var myTimer&=external("user32","SetTimer",0,0,100,procAddr(myMessageBoxAPCProc,4))
print messageBox("Text","."+st$(%hWnd)+".Hello World!",0)
waitinput
end
proc myMessageBoxAPCProc
parameters wnd&,msg&,id&,tme&
var s$="."+st$(%hWnd)+"."
var msgboxWnd&=findWindow(s$)
casenot msgboxWnd& : return
external("user32","KillTimer",0,myTimer&)
settext msgboxWnd&,del$(getText$(msgboxWnd&),1,len(s$))
var btn&=external("user32","FindWindowExA",msgboxWnd&,0,"BUTTON","OK")
casenot btn& : return
setText btn&,"&Abbrechen"
endProc
so the so written but against 100%ig (instead of 99%ig) "absturzsicher" is, should the Roland nativ install because one APC on a interpretierte XProfan- Proc can always crash particularly so komplexer and larger the program is. |
|