One of the few issues withg Powerbasic is, that the actual implementation of GUI Tasks is not easily modular.
There is no easy way to create a subprogram with a form and just copy and paste it into another program.
And call it ten times (and get ten forms). We know there are such things implemented for example in Delphi or VB.
Thats not primarily the fault of PB, but due to the fact that there are often Message-Loops etc. involved which is just windows architecture.
To make completely modular GUI Subprograms therefore is mostly a more complex task.
Example: a timed Message-Box
Thats a Message-Box which will dissapear after a few seconds.
I've looked up some forum-code on "timed Messageboxes" and there seems to be no chance to "just copy and paste a code-module".
In other words, there is no cheap sollution.
Its like you bought a TV. Its not enough to have a TV, you need to connect it to power-supply and antenna etc.
But thats not what I want, I need an accu-driven set with builtin antenna.
Back to the Message-Box.
I am using here an invisible Dialog which is later closed from outside the thread.
I had this idea (yes, it works ...) which is just a prototype and its at least a bit modular.
But maybe someone has a cheaper idea - which works under all OS (W2k and Up) and is completely modular
(for example can be called multiple times)?
Here's my example.
' we have one global Variable here, thats the only non-modular point
GLOBAL U_Dia AS LONG
'-----------------------------------------------------------------------------------------------------
FUNCTION U_Timed_Mbx(BYVAL T01 AS DWORD) AS DWORD
LOCAL S01, S02 AS STRING
S01 = "Message"
S02 = "Title"
DIALOG NEW %HWND_DESKTOP, "", 0, 0, 0, 0 TO U_Dia
MessageBox U_Dia,(S01),(S02), %MB_ICONINFORMATION + %MB_TOPMOST
DIALOG END U_Dia
END FUNCTION
'-----------------------------------------------------------------------------------------------------
' T01 - Item-Nummer, T02 - Listen-Nummer
SUB Timed_Call(BYVAL T01 AS LONG,BYVAL T02 AS LONG)
REGISTER R01 AS LONG
THREAD CREATE U_Timed_Mbx(0) TO R01
SLEEP 4000 ' This is the default time the Msgbox will be alive.
DIALOG SEND U_Dia, %WM_SYSCOMMAND, %SC_CLOSE, 0
END SUB
'-----------------------------------------------------------------------------------------------------
The problem with the Windows messagebox is that it is Modal and the operating system controls its message loop.
Likely there may be someway to modify this so you could add timing (ie. window hook), but it isn't simple.
You posed this question about EZGUI as well and it overcomes this problem by offering two different messagebox commands.
One is EZ_MsgBox which is the system messagebox.
The other is EZ_MsgBoxEx which is not a system messagebox, but is actually an internal EZGUI form (dialog) which acts like a messagebox and offers other features.
This allows the EZ_MsgBoxEx commands messagebox to be acted upon like any other Form.
You could for example, impliment a timer (EZ_StartTimer) in the forms %EZ_Started event. The form has the name "{MSGBOX}" and can have its events processed via code.
I am not sure why Windows does not offer some kind of dialog procedure hook for the messagebox. The common dialog functions allow you to define an external dialog procedure hook, but the messagebox does not.
A cheap timed message box.
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
GLOBAL szMsgBoxTitle AS ASCIIZ * 256
SUB TimedMsgBoxProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL idEvent AS DWORD, BYVAL dwTime AS DWORD)
SendMessage FindWindow("", szMsgBoxTitle), %WM_CLOSE, 0, 0
END SUB
FUNCTION PBMAIN () AS LONG
LOCAL dwTimerID AS DWORD
LOCAL lRes AS LONG
szMsgBoxTitle = "Timed Message Box"
dwTimerID = SetTimer(0, 0, 5000, CODEPTR(TimedMsgBoxProc))
lRes = MSGBOX("Timed message box test", %MB_OK, szMsgBoxTitle)
KillTimer 0, dwTimerId
END FUNCTION
@Chris, thanks for the answer, in fact a Timer in the EZ_Starting Event may be a sollution . In this case its not modular how i want it and its not cheaper then what I have here. This is something I'd wish and suggest for a future version of EZGUI:
Some predefined Forms for 99% of the most used cases (Font-,Colour-, and Printerselect-, Loadfile-,Choosedir-,Savefile- and a Timed Messagebox with the option to check "do not show this message again"). Just all those nasty standard-things needed in RAD developement, where I do normally not want to use my time to reinvent the wheel, but just want to write one command.
@Jose, your idea is maybe the cheapest implementation, combined with a THREAD like in my example, and a random window title, it may be even a little bit modular :-). I'll take a closer look.
An EZGUI version of Jose code:
SUB EZ_TMBProc(BYVAL hWnd&, BYVAL uMsg&, BYVAL idEvent&, BYVAL dwTime&)
IF EZ_IsForm("{MSGBOX}", "V") THEN EZ_UnloadForm "{MSGBOX}"
END SUB
'
FUNCTION EZ_MsgBoxExT (BYVAL Seconds!, BYVAL FormName$, BYVAL MText$, BYVAL MTitle$, BYVAL B1$, BYVAL B2$, BYVAL B3$, BYVAL Pict$, BYVAL Prop$, BYVAL Font1&, BYVAL Font2&) AS LONG
LOCAL MS&, TMID&
MS&=INT(Seconds!*1000)
TMID&= SetTimer(0, 0, MS&, CODEPTR(EZ_TMBProc))
FUNCTION=EZ_MsgBoxEx(FormName$, MText$, MTitle$, B1$, B2$, B3$, Pict$, Prop$, Font1&, Font2&)
KillTimer 0, TMID&
END FUNCTION
Simply use the above EZ_MsgBoxExT function instead of EZ_MsgBoxEx function.
Thanks Chris, also a quick alternative. As said in my post above, for professional usage there are still some components missing.
1. A timer on the Buton which shows the number of seconds that remain until close.
2. The chance of a checkmark to check "Do not display this again".
Maybe with the chance of setting an automatic registry key somewhere to not dispaly this again?
Messageboxes like this are these days in many professional Apps. Thats why I recommend, to have something "readymade" available, EZGUI would be a good place as its made for RAD developement. Maybe you can think of it for V.6.
Hi all,
my little contribution on the cause ;)
This message box show an optional count down in the message box title.
I put together quicly (time, time, always short in time !!!) so excuse for any error.
Some code is "stolen" from PB forum many years ago. I forgot original author, sorry.
Ciao
Eros
Here is the code from Eros, which is attached in the zip-file.
@Eros, thanks for this big contribution, which is not perfectly modular as well, because of a lot of globals.
Also this will prevent to use it several times at the same time, from the same program.
Having said this, it can be used in a library as ".INC" file as a module, because the globals are unique as well as the procedure names.
#INCLUDE "WIN32API.INC"
GLOBAL gTimerBase AS LONG
GLOBAL gTimerLoop AS LONG
GLOBAL gTimerMSec AS LONG
GLOBAL gTimerElap AS LONG
GLOBAL gTimerHwnd AS LONG
GLOBAL gTimerTitle AS STRING
GLOBAL gTimerFmt AS STRING
GLOBAL gTimerLoopWindow AS LONG
'=========================================================
FUNCTION MessageBoxTimer( _
BYVAL hWnd AS DWORD , _
BYVAL uiMsg AS DWORD , _
BYVAL idEvent AS DWORD , _
BYVAL dwTime AS DWORD _
) AS LONG
DIM szTitle AS ASCIIZ * 256
DIM sTitle AS STRING
DIM lTitleLen AS LONG
DIM lPos AS LONG
DIM TimeRemain AS DOUBLE
IF gTimerHwnd = 0& THEN
gTimerHwnd = GetForegroundWindow()
END IF
SELECT CASE LONG idEvent
CASE gTimerBase
PostQuitMessage 0
FUNCTION = 0
gTimerHwnd = 0&
CASE gTimerLoop
IF gTimerHwnd <> 0& THEN
lTitleLen = GetWindowText ( _
gTimerHwnd, _
szTitle, _
SIZEOF(szTitle) _
)
gTimerElap = gTimerElap + gTimerLoopWindow
TimeRemain = gTimerMSec - gTimerElap
lPos = INSTR(gTimerTitle, "%t")
IF lPos THEN
sTitle = gTimerTitle
REPLACE "%t" WITH FORMAT$((TimeRemain / 1000), gTimerFmt) IN sTitle
ELSE
sTitle = gTimerTitle + FORMAT$((TimeRemain / 1000), gTimerFmt)
END IF
SetWindowText gTimerHwnd, BYCOPY sTitle
END IF
END SELECT
END FUNCTION
'=========================================================
FUNCTION TimedMessageBox( BYVAL hWnd AS DWORD , _
ptszMessage AS ASCIIZ , _
ptszTitle AS ASCIIZ , _
BYVAL flags AS DWORD , _
BYVAL lmSec AS LONG , _
BYVAL lmSecRefresh AS LONG , _
BYVAL sRefreshFmt AS STRING _
) AS LONG
'
DIM iResult AS LONG
DIM Msg AS tagMsg
DIM TimerProcPtr AS DWORD
DIM PrevActiveWin AS LONG
DIM TimerBase AS LONG
DIM TimerLoop AS LONG
DIM lPos AS LONG
'
PrevActiveWin = GetForegroundWindow()
IF lmSec > 0 THEN
TimerProcPtr = CODEPTR(MessageBoxTimer)
TimerBase = SetTimer(0, 0, lmSec, TimerProcPtr)
IF lmSecRefresh > 0 THEN
gTimerLoopWindow = lmSecRefresh
TimerLoop = SetTimer(0, 0, gTimerLoopWindow, TimerProcPtr)
END IF
gTimerElap = 0&
gTimerMSec = lmSec
gTimerBase = TimerBase
gTimerLoop = TimerLoop
ELSE
gTimerMSec = 0
gTimerBase = 0
gTimerLoop = 0
END IF
gTimerHwnd = 0&
gTimerTitle = ptszTitle
gTimerFmt = sRefreshFmt
IF lmSec THEN
lPos = INSTR(ptszTitle, "%t")
IF lPos THEN
REPLACE "%t" WITH FORMAT$((lmSec / 1000), gTimerFmt) IN ptszTitle
ELSE
ptszTitle = ptszTitle + FORMAT$((lmSec / 1000), sRefreshFmt)
END IF
END IF
FUNCTION = MessageBox(hWnd, ptszMessage, ptszTitle, flags)
IF lmSec > 0 THEN
KillTimer 0, TimerBase
KillTimer 0, TimerLoop
iResult= PeekMessage(Msg, %Null, %WM_QUIT, %WM_QUIT, %PM_REMOVE)
IF iResult THEN FUNCTION = %IDTIMEOUT
END IF
gTimerElap = 0
gTimerHwnd = 0
gTimerMSec = 0
gTimerBase = 0
gTimerLoop = 0
gTimerLoopWindow = 0
gTimerTitle = ""
gTimerFmt = ""
SetForegroundWindow PrevActiveWin
END FUNCTION
'=========================================================
FUNCTION PBMAIN() AS LONG
LOCAL lReturn AS LONG
lReturn = TimedMessageBox ( _
0 , _ 'No Parent
"Any message, bla, bla, bla, bla, bla ...." , _ 'Message to display
"Message will be out in %t secs" , _ 'Title
0 , _ 'How to display it
5000 , _ 'Milliseconds to wait
1000 , _
"#0" _
)
END FUNCTION
Here is another one that is derived from the PB Forum. It includes a silent Msgbox, that is one that does not make this Sound when the Message pops up.
FUNCTION Silent_MBX(BYVAL hOwner AS LONG, BYVAL sMsg AS STRING, OPT BYVAL sTitle AS STRING, OPT BYVAL dwFlags AS DWORD) AS LONG
REGISTER Res AS LONG
LOCAL MbParams AS MSGBOXPARAMS
IF LEN(sTitle) = 0 THEN sTitle = "Message" ' $AppName ?
SELECT CASE dwFlags AND &H000000f0 ' Choose appropriate icon
CASE &H00000010 ' %MB_ICONHAND, %MB_ICONERROR, %MB_ICONSTOP
MbParams.lpszIcon = %IDI_HAND
CASE &H00000020 ' %MB_ICONQUESTION
MbParams.lpszIcon = %IDI_QUESTION
CASE &H00000030 ' %MB_ICONEXCLAMATION, %MB_ICONWARNING
MbParams.lpszIcon = %IDI_EXCLAMATION
CASE &H00000040 ' %MB_ICONASTERISK, %MB_ICONINFORMATION
MbParams.lpszIcon = %IDI_ASTERISK
CASE ELSE ' %MB_USERICON
MbParams.lpszIcon = %IDI_APPLICATION ' Or Icon from resource file..?
END SELECT
dwFlags = (dwFlags AND &Hffffff0f) OR &H00000080 ' Force %MB_USERICON Style
IF zero(hOwner) THEN hOwner = GetForegroundWindow() ' 0 for desktop or function could
' take 'hOwner' as a parameter
MbParams.cbSize = SIZEOF(MbParams)
MbParams.hwndOwner = hOwner
MbParams.hInstance = 0
MbParams.lpszCaption = STRPTR(sTitle)
MbParams.lpszText = STRPTR(sMsg)
MbParams.dwStyle = dwFlags ' if .dwStyle includes %MB_USERICON, .lpszIcon is valid
' MbParams.lpszIcon = ' and Windows doesn't automatically asign a sound !
MbParams.dwContextHelpId = 0
MbParams.lpfnMsgBoxCallback = 0
MbParams.dwLanguageId = 0 ' 3081 ?
Res = MESSAGEBOXINDIRECT(MbParams)
FUNCTION = Res
END FUNCTION
'------------------------------------------------------------------------------------------------------
' info - timed messagebox.
'
' usage: TMBX_MBX msg$ [[,delay&] [,iconstyle&] [,caption$]]
'
' defaults: 5sec delay, %mb_iconinformation, [apptitle] info msg.
' TMBX_MBX "timed message goes here.. ", _ 'message for display
' 8, _ 'length of time visible
' %mb_iconexclamation, _ '%mb_iconinformation etc
' "notification message" 'title bar caption
' TMBX_MBX "five seconds to go!" 'e.g. using defaults
' TMBX_MBX "ten seconds to go!", 10 'e.g. 10sec message
'------------------------------------------------------------------------------------------------------
$apptitle = "aptitle" 'optional
TYPE Tmbx_Params
btntext AS ASCIIZ * 14
msgdelay AS LONG
hwnd AS DWORD
hctrl AS DWORD
hhook AS DWORD
END TYPE
GLOBAL Tmbx_pinf AS Tmbx_Params PTR
'------------------------------------------------------------------------------------------------------
DECLARE FUNCTION TMBX_MBX (BYVAL STRING, OPT BYVAL LONG, OPT BYVAL DWORD, OPT BYVAL STRING) AS LONG
DECLARE FUNCTION Tmbx_cbtproc(BYVAL LONG, BYVAL LONG, BYVAL LONG) AS LONG
DECLARE FUNCTION Tmbx_countdownthread(BYVAL DWORD) AS LONG
' Bei Delay=32768 = endlose zeit (für Auswahlmöglichkeit)
FUNCTION TMBX_MBX(BYVAL smsg AS STRING, OPT BYVAL delay AS LONG,OPT BYVAL dwflags AS DWORD, OPT BYVAL stitle AS STRING) AS LONG
#REGISTER NONE '# for windows bug work around, see below..
LOCAL hparent AS LONG, ctrlwrd AS LONG, res AS LONG
LOCAL inf AS Tmbx_Params
LOCAL T01 AS LONG
Tmbx_pinf = VARPTR(inf) 'Tmbx_pinf - global pointer to infoparms
delay = 1000*(IIF(delay = 0, 15, delay)) 'default 5 sec display time
inf.msgdelay = delay
inf.btntext = "&ok"
IF stitle="" THEN
#IF %DEF($apptitle) 'uses $apptitle if defined
stitle = $apptitle
#ENDIF
stitle = " "+stitle 'i.e. "myapp info msg"
ELSE
stitle = " "+stitle 'user's optional title
END IF
IF dwflags=%false THEN
dwflags = %mb_iconinformation 'default "information" icon
END IF
hparent = getforegroundwindow() 'or = 0 for desktop..?
'install hook (remove hook within Tmbx_cbtproc)
inf.hhook = setwindowshookex(%wh_cbt, CODEPTR(Tmbx_cbtproc),getmodulehandle(""), getcurrentthreadid)
T01=Silent_MBX(hparent, (smsg), BYVAL (stitle), dwflags)
ctrlwrd = &b0001001100111111 '# this guarantees extended precision
ASM fldcw ctrlwrd ; '# as per pb gazette #25
FUNCTION=T01 '# in some windows 2000 systems + ??
END FUNCTION
'------------------------------------------------------------------------------------------------------
FUNCTION Tmbx_cbtproc(BYVAL lmsg AS LONG, BYVAL wparam AS LONG, _
BYVAL lparam AS LONG) AS LONG
LOCAL hTmbx_countdownthread AS LONG, hctrl AS LONG, res AS LONG
SELECT CASE lmsg
CASE %hcbt_activate
unhookwindowshookex @Tmbx_pinf.hhook 'finished with hook
IF @Tmbx_pinf.hwnd = 0 THEN
@Tmbx_pinf.hwnd = wparam 'msgbox handle
CONTROL HANDLE wparam, 1 TO hctrl 'id = 1 for ok btn
@Tmbx_pinf.hctrl = hctrl 'button handle
THREAD CREATE Tmbx_countdownthread(wparam) TO hTmbx_countdownthread 'pass handle
THREAD CLOSE hTmbx_countdownthread TO res
FUNCTION = 0
END IF
END SELECT
END FUNCTION
'------------------------------------------------------------------------------------------------------
FUNCTION Tmbx_countdownthread(BYVAL hwnd AS DWORD) AS LONG
LOCAL n AS LONG, x AS LONG
LOCAL btntext AS STRING
IF @Tmbx_pinf.msgdelay<>32768000 THEN
FOR n = @Tmbx_pinf.msgdelay/1000 TO 1 STEP -1
DIALOG GET SIZE hwnd TO x, x 'get size of msgbox
IF x < 1 THEN EXIT FOR 'msgbox gone?
btntext = @Tmbx_pinf.btntext+" ["+FORMAT$(n)+" sec.]"
sendmessage @Tmbx_pinf.hctrl, %wm_settext, 0, STRPTR(btntext)
SLEEP 1000
NEXT
DO WHILE x > 0
postmessage hwnd, %wm_syscommand, %sc_close, 0 'close msgbox
DIALOG DOEVENTS
DIALOG GET SIZE hwnd TO x, x
LOOP
END IF
END FUNCTION
'------------------------------------------------------------------------------------------------------
This is my actual Version. I am not happy with the limited modularity, because i need to use Global variables here.
Actually I have no better idea, as Macros do not expand outside Sub's or functions and Objects can not easily incorporate Thread Functions.
I leave this to discussion, if anyone has a more modular idea, not needing any GLOBALS.
Possibly still using a Thread function. Can be using Objects :-).
#IF NOT %DEF(%X_LR_INC)
%X_LR_INC=1
' we have these global Variables here, thats the only non-modular point, which prevents this to be called multiple times.
GLOBAL X_LR_Dia AS LONG
GLOBAL X_LR_Msg,X_LR_Title AS STRING
'------------------------------------------------------------------------------------------
' Msg-Text, Title, Zeitdauer in Sec., default=4000
SUB X_LR(BYVAL S01 AS STRING,BYVAL S02 AS STRING,OPT BYVAL T01 AS LONG)
REGISTER R01 AS LONG,R02 AS LONG
IF (T01=0) THEN T01=4000
X_LR_Msg=TRIM$(S01):X_LR_Title=TRIM$(S02)
THREAD CREATE X_LR_Mbx(0) TO R01
SLEEP T01 ' This is the default time the Msgbox will be alive.
DIALOG SEND X_LR_Dia, %WM_SYSCOMMAND, %SC_CLOSE, 0
END SUB
'-----------------------------------------------------------------------------------------------------
' Thread Funktion
FUNCTION X_LR_Mbx(BYVAL T01 AS DWORD) AS DWORD
DIALOG NEW %HWND_DESKTOP, "", 0, 0, 0, 0 TO X_LR_Dia
MessageBox X_LR_Dia,(X_LR_Msg),(X_LR_Title), %MB_ICONINFORMATION + %MB_TOPMOST
DIALOG END X_LR_Dia
END FUNCTION
'------------------------------------------------------------------------------------------
#ENDIF
'-----------------------------------------------------------------------------------------------------
Quote from: Theo Gottwald on September 24, 2008, 01:19:06 PMif anyone has a more modular idea
I usually have a more modular idea, since I took the "modular programming" course so seriously (1973). This one has no GLOBALS, but a new TYPE and a STATIC instead. I'm not experienced with threads, so be careful....
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
#IF NOT %DEF(%X_LR_INC)
%X_LR_INC=1
TYPE tX_LR
dia AS LONG
msg AS ASCIZ * 64
title AS ASCIZ * 64
hparent AS DWORD
END TYPE
'------------------------------------------------------------------------------------------
' Msg-Text, Title, Zeitdauer in Sec., default=4000
SUB X_LR(BYVAL S01 AS STRING,BYVAL S02 AS STRING,OPT BYVAL T01 AS LONG)
REGISTER R01 AS LONG,R02 AS LONG
STATIC xlr AS tX_LR
IF (T01=0) THEN T01=4000
xlr.dia = t01: xlr.msg = TRIM$(S01): xlr.title = TRIM$(S02)
'X_LR_Msg=TRIM$(S01):X_LR_Title=TRIM$(S02)
THREAD CREATE X_LR_Mbx(VARPTR(xlr)) TO R01
SLEEP T01 ' This is the default time the Msgbox will be alive.
DIALOG SEND xlr.hparent, %WM_SYSCOMMAND, %SC_CLOSE, 0
END SUB
'-----------------------------------------------------------------------------------------------------
' Thread Funktion
FUNCTION X_LR_Mbx(BYVAL p AS DWORD) AS DWORD
LOCAL pXLR AS tX_LR PTR
LOCAL X_LR_DIA AS DWORD
pXLR = p
DIALOG NEW %HWND_DESKTOP, "", 0, 0, 0, 0 TO @pXLR.hparent
MessageBox @pXLR.dia, @pXLR.msg, @pXLR.title, %MB_ICONINFORMATION + %MB_TOPMOST
DIALOG END @pXLR.hparent
END FUNCTION
'------------------------------------------------------------------------------------------
#ENDIF
'-----------------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
X_LR ( "hello", "text", 1000)
END FUNCTION