Timed Messagebox - a cheaper one?

[Theo Gottwald]

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.

Code Select Expand


' 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 
'-----------------------------------------------------------------------------------------------------



[Chris Boss]

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.

[José Roca]

 
A cheap timed message box.

Code Select Expand


#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


[Theo Gottwald]

@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.

[Chris Boss]

An EZGUI version of Jose code:

Code Select Expand


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.

[Theo Gottwald]

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.

[Eros Olmi]

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

[Theo Gottwald]

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.

Code Select Expand

  #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



[Theo Gottwald]

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.

Code Select Expand



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
'------------------------------------------------------------------------------------------------------   


[Theo Gottwald]

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 :-).

Code Select Expand


#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
'-----------------------------------------------------------------------------------------------------
     

[Chris Holbrook]

if 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....

Code Select Expand


#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