On the off chance that anybody hasn't already rolled their own...
Feel free to make improvements, I didn't bother with an icon, for instance.
Code:
Use Windows.pkg
Use cWebModalDialog.pkg
Use cWebEdit.pkg
Use cWebTimer.pkg
//eg: send WebTimedMsg of oWebTimedMsg (self) "Merry Xmas" "Warning" 5000
Object oWebTimedMsg is a cWebModalDialog
Set pbResizable to False
Set piWidth to 600
Set piColumnCount to 8
Object oMsgTxt is a cWebEdit
Set piLabelOffset to 0
Set piColumnCount to 16
Set piColumnSpan to 16
Set pbShowlabel to False
Set pbReadOnly to True
Set piHeight to 100
Set psCaption to ""
End_Object
//allegedly overloading is out of date now using Num_Arguments
Procedure WebTimedMsg Handle hoCaller String sMsg String sTitle Integer iTimeOverride
Integer iArgs iTimeOut
Move num_arguments to iArgs
WebSet psValue of oMsgTxt to sMsg
If (iArgs>2) Set psCaption of oWebTimedMsg to sTitle
Else Set psCaption of oWebTimedMsg to "information"
If (iArgs=4 and iTimeOverride>3000) Set piInterval of oWarningTimer to iTimeOverride
Else Begin
Get refnumN1 "TIMEDMSG" to iTimeOut //we set a system wide timeout
Set piInterval of oWarningTimer to iTimeOut
End
Set pbEnabled of oWarningTimer to True
Send Popup hocaller
End_Procedure
Object oWarningTimer is a cWebTimer //replaces DfTimer with a simpler interface
Set piInterval to 3000
Procedure OnTimer
Send Cancel
End_Procedure
End_Object
End_Object
It sort of matches our Windows timed message (turbo-charged by Raveen's addition) ... again feel free etc
Code:
//TimedMsg displays a message for a given period of milliseconds
//Minimum 2000, unless overridden by the ETIMEOUT setting in Refnum2
//or the second parameter of ShowTimedMessage
//Raveens SUndram's suggestion makes it actually fade, as against just time out
Use cTimer.pkg
Use cMyTextBox.pkg
Use dfBitmap.pkg
//allegedly overloading is out of date now using Num_Arguments
Procedure ShowTimedMsg String sMsg String sType Integer iTimeOverride
Integer iTimeOut iArgs
Move num_arguments to iArgs
Set psMsg of oTimedMsg to sMsg
If (iArgs>1) Set psType of oTimedMsg to (lowercase(sType))
Else Set psType of oTimedMsg to "warning"
If (iArgs=3 and iTimeOverride>2000) Begin
Set piTimeout of oTimedMsg to iTimeOverride
End
Else Begin
Get refnumN1 "TIMEDMSG" to iTimeout
Set piTimeout of oTimedMsg to iTimeOut
End
Send Popup of oTimedMsg
End_Procedure
//eg: Send ShowTimedMsg ("You are already running version" * sVersion )
//eg: Send ShowTimedMsg ("You are already running version" * sVersion ) "error"
//eg: Send ShowTimedMsg ("You are already running version" * sVersion ) "info"
//eg: Send ShowTimedMsg ("You are already running version" * sVersion ) "warning" 5000
//Procedure ShowTimedMsg Overloaded String sMsg //to use default of info and the timeout from Refnum2
// Send WebTimedMsg of oWebTimedMsg Self sMsg "info" 0
//End_Procedure
//
//suggested improvement by RaveenS - see also close_panel
// See: https://msdn.microsoft.com/en-us/library/windows/desktop/ms632669(v=vs.85).aspx
External_Function WINAPI_AnimateWindow "AnimateWindow" user32.dll Integer hWnd DWord dwTime DWord dwFlags ;
Returns Boolean
Enum_List // AnimateWindowFlags : uint
Define AW_HOR_POSITIVE for 1
Define AW_HOR_NEGATIVE for 2
Define AW_VER_POSITIVE for 4
Define AW_VER_NEGATIVE for 8
Define AW_CENTER for 16
Define AW_HIDE for 65536
Define AW_ACTIVATE for 131072
Define AW_SLIDE for 262144
Define AW_BLEND for 524288
End_Enum_List
Object oTimedMsg is a ModalPanel
Property String psMsg ""
Property Integer piTimeout 500
Property String psType
Set Icon to "kirknet.ico"
Set Size to 89 211
Set piMinSize to 89 211
Set Locate_mode to CENTER_ON_PARENT
Set Border_Style to Border_Normal
Set Minimize_Icon to False
Set Maximize_Icon to False
Set Block_Mouse_State to True
Set Sysmenu_Icon to False
Set Caption_Bar to false
Procedure Popup
String sType
//Set Locate_Mode to SMART_LOCATE //CENTER_ON_PANEL //PARENT //SCREEN //To center showTimedMessage
Set piTimeout of oWarningTimer to (piTimeout(Self))
Set Label of oTextBoxMsg to (psMsg(Self))
Get psType to sType
Move (trim(Lowercase(sType))) to sType
If (not("err|warn|info" contains sType)) Begin
Move "info" to sType
End
If (sType="warn") Begin
Set Bitmap of oBitMapContainerTM to "warning.bmp/t/3d"
Set TextColor (oBitMapContainerTM(Self)) to clBlue
Set Label to "Warning..."
End
If (sType="err") Begin
Set Bitmap of oBitMapContainerTM to "error.bmp/t/3d"
Set TextColor (oBitMapContainerTM(Self)) to clRed
Set Label to "Error..."
End
If (sType="info") Begin
Set Bitmap of oBitMapContainerTM to "info.bmp/t/3d"
Set TextColor (oBitMapContainerTM(Self)) to clGreen
Set Label to "Information..."
End
Set Icon to "kirknet.ico"
Set pbEnabled of oWarningTimer to True
Forward Send Popup
End_Procedure
Object oTextBoxMsg is a cMyTextBox
Set Auto_Size_State to False
Set Size to 26 196
Set Location to 34 6
Set Label to "Warning"
Set Justification_Mode to JMode_Center
End_Object
Object oWarningTimer is a cTimer //replaces DfTimer with a simpler interface
Procedure OnTimer //Integer wParam Integer lParam
Send Close_Panel
End_Procedure
End_Object
Object oBitmapContainerTM is a BitmapContainer
Set Size to 24 24
Set Location to 10 96
//Set Bitmap to "Info.bmp/t/3d"
Set Border_Style to border_none
End_Object
Procedure Close_Panel
Handle hWnd
Integer iVoid
Integer iFlags
Get Window_Handle to hWnd
If (hWnd) Begin
Move (AW_BLEND ior AW_HIDE) to iFlags
Move (WINAPI_AnimateWindow(hWnd,500,iFlags)) to iVoid //was 2000
End
Forward Send Close_Panel
End_Procedure
End_Object