Download text file
#IF 0
---------------------------- PowerBASIC v7.x
---| DASoft |------------------------------------------
---------------------------- Code DATE: 2003-10-10
| FILE NAME MsgPopper.bas | by
---------------------------- Don Schullian, Jr.
This code is released into the Public Domain
----------------------------------------------------------
No guarantee as to the viability, accuracy, or safety of
use of this code is implied, warranted, or guaranteed
----------------------------------------------------------
Use at your own risk!
----------------------------------------------------------
CONTACT AUTHOR AT d83@DASoftVSS.com
-------------------------------------------------------------------------
This code replaces MSGBOX allowing you a few more bells and whistles like
no caption, time out, no buttons, placement relative to an exiting control,
preformatted text, button text, etc.
THE %MB_xxx equates are used throughout except the few noted below.
If the message times out the return value is ZERO.
If there is no caption then no title bar is drawn.
If there are no buttons then default time out is 3sec
If there are no buttons then the text box is colored
If the message contains $CRLF it is assumed to be pre-formatted
else a maximum width of %MP_MaxWidth is used
C'ya,
Don
#ENDIF
$MP_Words = "Ok,Cancel,Abort,Retry,Ignore,Yes,No,Close,Help,Try Again,Continue"
%MP_BtnXX = 50
%MP_BtnYY = 13
%MP_Gap = 5
%MP_MaxWidth = (%MP_BtnXX * 3) + (%MP_Gap * 4) ' Units wide
%MB_BGRND = %YELLOW
%MB_FGRND = %BLACK
%MP_TIMEOUT1 = &H01000000&
%MP_TIMEOUT2 = &H02000000&
%MP_TIMEOUT3 = &H03000000&
%MP_TIMEOUT4 = &H04000000&
%MP_TIMEOUT5 = &H05000000&
%MP_TIMEOUT10 = &H0A000000&
%MP_TIMEOUTMask = &H0F000000&
%MP_TIMEOUTShift = 14
%MP_NOBUTTONS = &H0000000F&
'
'------------------------------------------------------------------------------
'
#IF 1
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC
DECLARE FUNCTION MsgPop ALIAS "MsgPop" (BYVAL hParent???,BYVAL Msg$,OPT BYVAL Style&,OPT BYVAL Caption$,OPT BYVAL Ctrl&) AS LONG
CALLBACK FUNCTION MsgPopperTest_CB()
DIM Caption AS LOCAL STRING
DIM Ctrl AS LOCAL LONG
DIM Rslt AS LOCAL LONG
DIM Mask AS LOCAL LONG
DIM Msg AS LOCAL STRING
SELECT CASE CBMSG
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE 3001 : IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
Ctrl = 3000
GOTO PopThis
END IF
CASE 3002 : IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
Ctrl = 3002
GOTO PopThis
END IF
CASE 3003 : IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
GOTO PopThis
END IF
END SELECT
END SELECT
EXIT FUNCTION
PopThis:
Msg = "Mary had a little lamb," & $CRLF & _
"it's fleece was white as snow," & $CRLF & _
"and everywhere that mary went," & $CRLF & _
"the lamb was sure to go!"
REPLACE $CRLF WITH $SPC IN Msg
' Msg = Msg & $CRLF & Msg & $CRLF & Msg
Mask = %MB_YESNOCANCEL OR %MP_TIMEOUT5 OR %MB_ICONHAND OR %MB_DEFBUTTON2
' Mask = %MP_NOBUTTONS ' automatic 3sec timeout
Caption = "Message Popper"
' Msg = ""
' Mask = %MB_ICONHAND OR %MP_NOBUTTONS
Rslt = MsgPop(CBHNDL, Msg, Mask, Caption, Ctrl)
' Rslt = MsgPop(%HWND_DESKTOP,Msg,Mask,Caption)
IF Rslt > 0 THEN
Caption = "You clicked """ & PARSE$($MP_WORDS,Rslt) & $DQ
ELSE
Caption = "Timed out"
END IF
CONTROL SET TEXT CBHNDL, 3000, Caption
EXIT FUNCTION
END FUNCTION
'
'------------------------------------------------------------------------------
'
SUB MsgPopperTest (BYVAL hParent AS DWORD)
DIM hDlg AS LOCAL DWORD
DIALOG NEW hParent, "Message Popper",,, 195, 102, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
%WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD TEXTBOX, hDlg, 3000, "" , 5, 5, 180, 15
CONTROL ADD BUTTON , hDlg, 3001, "Pop Text" , 5, 80, 50, 15
CONTROL ADD BUTTON , hDlg, 3002, "Pop Here" , 73, 80, 50, 15
CONTROL ADD BUTTON , hDlg, 3003, "Pop Center", 140, 80, 50, 15
DIALOG SHOW MODAL hDlg, CALL MsgPopperTest_CB
END SUB
'
'------------------------------------------------------------------------------
'
FUNCTION PBMAIN ()
MsgPopperTest %HWND_DESKTOP
END FUNCTION
#ENDIF
'
'------------------------------------------------------------------------------
'
CALLBACK FUNCTION MsgPop_CB () AS LONG
DIM Msec AS LOCAL LONG
SELECT CASE CBMSG
CASE %WM_INITDIALOG : DIALOG GET USER CBHNDL, 8 TO Msec
IF Msec > 0 THEN
SetTimer CBHNDL, 2343, Msec, 0
END IF
CASE %WM_TIMER : KillTimer CBHNDL, 2343
DIALOG END CBHNDL, 0
CASE %WM_COMMAND : SELECT CASE CBCTL
CASE 3001 TO 3003
IF (CBCTLMSG = %BN_CLICKED) OR _
(CBCTLMSG = 1 ) THEN
KillTimer CBHNDL, 2343
DIALOG END CBHNDL, CBCTL - 3000
END IF
END SELECT
END SELECT
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION MsgPop ALIAS "MsgPop" ( BYVAL hParent AS DWORD , _
BYVAL Msg AS STRING, _
OPT BYVAL Style AS LONG , _
OPT BYVAL Caption AS STRING, _
OPT BYVAL Ctrl AS LONG ) EXPORT AS LONG
DIM BrdrXX AS LOCAL LONG
DIM BrdrYY AS LOCAL LONG
DIM BtnCnt AS LOCAL LONG
DIM BtnDef AS LOCAL LONG
DIM Btn (3) AS LOCAL LONG
DIM BtnX (3) AS LOCAL LONG
DIM BtnXX AS LOCAL LONG
DIM BtnYY AS LOCAL LONG
DIM CaptYY AS LOCAL LONG
DIM ClientXX AS LOCAL LONG
DIM ClientYY AS LOCAL LONG
DIM hDc AS LOCAL DWORD
DIM hDlg AS LOCAL DWORD
DIM DlgX AS LOCAL LONG
DIM DlgY AS LOCAL LONG
DIM DlgXX AS LOCAL LONG
DIM DlgYY AS LOCAL LONG
DIM hFont AS LOCAL DWORD
DIM hHold AS LOCAL DWORD
DIM GapX AS LOCAL LONG
DIM GapY AS LOCAL LONG
DIM hIcon AS LOCAL DWORD
DIM IconXX AS LOCAL LONG
DIM IconYY AS LOCAL LONG
DIM hLbl AS LOCAL DWORD
DIM LblX AS LOCAL LONG
DIM LblXX AS LOCAL LONG
DIM LblYY AS LOCAL LONG
DIM Llen AS LOCAL LONG
DIM Mlen AS LOCAL LONG
DIM Msec AS LOCAL LONG
DIM P AS LOCAL LONG
DIM Q AS LOCAL LONG
DIM tSize AS LOCAL SIZEL
DIM Txt AS LOCAL STRING
IF LEN(Caption) = 0 THEN
Dialog New hParent, "", , , 0, 0, %WS_POPUP Or %WS_BORDER Or %WS_CLIPSIBLINGS Or %WS_VISIBLE Or %DS_3DLOOK Or _
%DS_NOFAILCREATE Or %DS_SETFONT, %WS_EX_WINDOWEDGE Or %WS_EX_CONTROLPARENT Or _
%WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR, To hDlg
BrdrXX = GetSystemMetrics(%SM_CXBORDER) * 2
BrdrYY = GetSystemMetrics(%SM_CYBORDER) * 2
ELSE
DIALOG NEW hParent, "",,,0,0, TO hDlg
SetWindowText hDlg, BYCOPY Caption
BrdrXX = GetSystemMetrics(%SM_CXFIXEDFRAME) * 2
BrdrYY = GetSystemMetrics(%SM_CYFIXEDFRAME) * 2
CaptYY = GetSystemMetrics(%SM_CYCAPTION)
END IF
DIALOG UNITS hDlg, %MP_Gap , %MP_Gap TO PIXELS GapX , GapY
DIALOG UNITS hDlg, %MP_MaxWidth, 0 TO PIXELS ClientXX, ClientYY
CONTROL ADD LABEL, hDlg, 1000, Msg, 0, 0, 0, 0
Msec = (Style AND %MP_TIMEOUTMask)
SHIFT RIGHT Msec, %MP_TIMEOUTShift
SELECT CASE LONG (Style AND %MP_NOBUTTONS)
CASE %MB_OK : BtnCnt =1 : Btn(1) = %IDOK
CASE %MB_OKCANCEL : BtnCnt =2 : Btn(1) = %IDOK : Btn(2) = %IDCANCEL
CASE %MB_ABORTRETRYIGNORE : BtnCnt =3 : Btn(1) = %IDABORT : Btn(2) = %IDRETRY : Btn(3) = 5
CASE %MB_YESNOCANCEL : BtnCnt =3 : Btn(1) = %IDYES : Btn(2) = %IDNO : Btn(3) = 2
CASE %MB_YESNO : BtnCnt =2 : Btn(1) = %IDYES : Btn(2) = %IDNO
CASE %MB_RETRYCANCEL : BtnCnt =2 : Btn(1) = %IDRETRY : Btn(2) = %IDCANCEL
CASE %MB_CANCELTRYCONTINUE : BtnCnt =3 : Btn(1) = %IDCANCEL : Btn(2) = %IDTRYAGAIN : Btn(3) = %IDCONTINUE
CASE ELSE : IF Msec = 0 THEN Msec = 3000
END SELECT
IF BtnCnt > 0 THEN
BtnXX = (%MP_BtnXX * BtnCnt) + (%MP_Gap * (BtnCnt + 1))
BtnYY = %MP_BtnYY + %MP_Gap
DIALOG UNITS hDlg, BtnXX, BtnYY TO PIXELS BtnXX, BtnYY
BtnDef = (Style AND %MB_DEFMASK)
SHIFT RIGHT BtnDef, 8
END IF
Mlen = (Style AND %MB_ICONMASK)
IF Mlen <> 0 THEN
SELECT CASE AS LONG Mlen
CASE %MB_ICONEXCLAMATION : hIcon = LoadIcon(BYVAL %NULL, BYVAL %IDI_EXCLAMATION)
CASE %MB_ICONQUESTION : hIcon = LoadIcon(BYVAL %NULL, BYVAL %IDI_QUESTION)
CASE %MB_ICONASTERISK : hIcon = LoadIcon(BYVAL %NULL, BYVAL %IDI_ASTERISK)
CASE ELSE : hIcon = LoadIcon(BYVAL %NULL, BYVAL %IDI_HAND)
END SELECT
IF hIcon <> 0 THEN
CONTROL ADD LABEL, hDlg, 1001, "", %MP_GAP, %MP_GAP, 20, 20, %SS_ICON
CONTROL SEND hDlg, 1001, %STM_SETIMAGE, %IMAGE_ICON, hIcon
IconXX = GetSystemMetrics(%SM_CXICON) + GapX
IconYY = GetSystemMetrics(%SM_CYICON) + GapY
END IF
END IF
Mlen = LEN(Msg)
IF Mlen = 0 THEN
LblXX = IconXX
LblX = 0
ELSE
CONTROL HANDLE hDlg, 1000 TO hLbl
LblX = IconXX + GapX
hDc = GetDc(hLbl)
hFont = SendMessage(hLbl, %WM_GETFONT, 0, 0)
hHold = SelectObject(hDC, hFont)
Q = 1
P = PARSECOUNT(Msg,$CRLF)
IF P > 1 THEN
DO
Txt = PARSE$(Msg,$CRLF,P)
Mlen = LEN(Txt)
GetTextExtentPoint32 hDc, BYCOPY Txt, Mlen, tSize
LblXX = MAX(LblXX,tSize.cx)
LblYY = LblYY + tSize.cy
DECR P
LOOP UNTIL P = 0
ELSE
LblXX = ClientXX - LblX ' Max width
DO
GetTextExtentExPoint hDc, MID$(Msg, Q), Mlen, LblXX, Llen, BYVAL %NULL, tSize
LblYY = LblYY + tSize.cy
Q = Q + Llen
Mlen = Mlen - Llen
LOOP UNTIL Mlen < 1
IF LblYY = tSize.cy THEN LblXX = tSize.cx
END IF
LblYY = LblYY + GapY
SelectObject (hDC , hHold)
ReleaseDC (hLbl, hDC)
END IF
DlgXX = MAX(BtnXX,(LblX + LblXX + GapX)) + BrdrXX
DlgYY = MAX(IconYY,LblYY) + GapY + BrdrYY + CaptYY + BtnYY
DIALOG PIXELS hDlg, DlgXX, DlgYY TO UNITS DlgXX, DlgYY
DIALOG PIXELS hDlg, LblXX, LblYY TO UNITS LblXX, LblYY
DIALOG PIXELS hDlg, LblX , 0 TO UNITS LblX , Q
DIALOG SET SIZE hDlg, DlgXX, DlgYY
IF BtnCnt > 0 THEN
DIALOG GET CLIENT hDlg TO ClientXX, ClientYY
DIALOG PIXELS hDlg, BtnXX, BtnYY TO UNITS BtnXX, BtnYY
P = %MP_BtnXX + %MP_Gap
Q = ClientYY - %MP_BtnYY - %MP_Gap
SELECT CASE BtnCnt
CASE 1 : BtnX(1) = (ClientXX - %MP_BtnXX) \ 2
CASE 2 : BtnX(1) = %MP_Gap
BtnX(2) = ClientXX - P
CASE 3 : BtnX(1) = %MP_Gap
BtnX(2) = (ClientXX - %MP_BtnXX) \ 2
BtnX(3) = ClientXX - P
END SELECT
FOR P = 1 TO BtnCnt
CONTROL ADD BUTTON, hDlg, 3000+P, PARSE$($MP_WORDS,Btn(P)), BtnX(P), Q, %MP_BtnXX, %MP_BtnYY
NEXT
CONTROL SET FOCUS hDlg, BtnDef + 3001
ELSE
DIALOG SET COLOR hDlg, %MB_Fgrnd, %MB_BGRND
CONTROL SET COLOR hDlg, 1000, %MB_Fgrnd, %MB_BGRND
CONTROL SET COLOR hDlg, 1001, %MB_Fgrnd, %MB_BGRND
END IF
IF hParent = %HWND_DESKTOP THEN
ClientXX = GetSystemMetrics(%SM_CXSCREEN)
ClientYY = GetSystemMetrics(%SM_CYSCREEN)
DIALOG PIXELS hDlg, ClientXX, ClientYY TO UNITS ClientXX, ClientYY
DlgX = (ClientXX - DlgXX) / 2
DlgY = (ClientYY - DlgYY) / 2
ELSEif Ctrl > 0 THEN
CONTROL GET LOC hParent, Ctrl TO DlgX, DlgY
CONTROL GET SIZE hParent, Ctrl TO GapX, GapY
DlgY = DlgY + GapY
DlgX = DlgX + 5
ELSE
DIALOG GET CLIENT hParent TO ClientXX, ClientYY
DlgX = (ClientXX - DlgXX) / 2
DlgY = (ClientYY - DlgYY) / 2
END IF
DIALOG SET LOC hDlg, MAX(0,DlgX), MAX(0,DlgY)
CONTROL SET LOC hDlg, 1000 , LblX, 5
CONTROL SET SIZE hDlg, 1000 , LblXX, LblYY
DIALOG SET USER hDlg, 8, Msec
DIALOG SHOW MODAL hDlg, CALL MsgPop_CB TO P
FUNCTION = Btn(P)
END FUNCTION