Tweet
Code:
'myMsgbox by Charles Dietz 02-14-05
'http://www.cgdsoftware.com
'substitute for MS Windows Msgbox
'allow optional sound and desktop window location
'this code is entered into the public domain and is free to use or change as desired
'-------------------------------------------------------------------------------------
DECLARE FUNCTION MMB_MakeFont(LONG, STRING, BYVAL LONG) AS LONG
FUNCTION myMsgBox(msg AS STRING, OPT BYVAL nStyle AS LONG, BYVAL ti AS STRING, _
BYVAL sound AS LONG, BYVAL x0 AS LONG, BYVAL y0 AS LONG) AS LONG
'nStyle = %MB_OK for 1 button: Ok
' = %MB_YESNO for 2 buttons: Ok, Cancel
' = %MB_OKCANCEL for 2 buttons: Yes, No
' = %MB_YESNOCANCEL for 3 buttons: Yes, No, Cancel
' = %MB_ICONERROR for error icon (stop sign)
' = %MB_ICONINFORMATION for information icon
' = %MB_ICONQUESTION for question icon
' = %MB_ICONWARNING for warning icon
'ti = title and sound = 1 for beep, x0, y0 = desktop location
'Returns %IDOK, %IDYES, %IDNO, or %IDCANCEL
'Requires "WIN32API.INC"
'Load this include file before myMsgbox is used
'----------------------------------------------------------------------------
LOCAL hMsgBox, hParent, hdc, ret, wi, ht, x, y AS LONG
LOCAL hFont, hOrigFont, hIcon, i, m, n, k, w, h AS LONG
LOCAL t AS SIZEL, rc AS RECT, s AS STRING , ss AS STRING
hParent = GetActiveWindow
DIALOG NEW PIXELS, 0, ti, , , 200, 100 TO hMsgBox
DIALOG SET COLOR hMsgBox, -1, %WHITE '%LTGRAY
'size the message box and add controls -------------------------------------
hdc=GetDc(hMsgbox)
hFont = MMB_makeFont(hDC, "MS Sans Serif", 8)
hOrigFont = SelectObject(hdc, hFont)
ss = msg: n = 1 'm = max text length, n = lines of text
DO: i = INSTR(ss, $CRLF): s = ss
IF i THEN s = LEFT$(ss, i - 1): INCR n
GetTextExtentPoint32 hdc, BYVAL STRPTR(s), LEN(s), t
ss = MID$(ss, i + 2): m = MAX(m, t.cx)
LOOP UNTIL i = 0
DeleteObject SelectObject(hdc, hOrigFont)
ReleaseDC hMsgBox, hdc
IF nStyle > 6 THEN k = 50 ELSE k = 10
CONTROL ADD LABEL, hMsgBox, 9990, msg, k, 5, m, 15*n
CONTROL SET COLOR hMsgBox, 9990, RGB(0, 0, 0), %WHITE '%LTGRAY
wi = MAX(220, m + k + 10): ht = MAX(120, 20*n + 55)
m = nStyle MOD 16: n = ht - 70
IF m = %MB_YESNOCANCEL THEN
CONTROL ADD BUTTON, hMsgBox, 9991, "&Yes", 10, n, 60, 30, %BS_DEFAULT
CONTROL ADD BUTTON, hMsgBox, 9992, "&No", 75, n, 60, 30
CONTROL ADD BUTTON, hMsgBox, 9993, "Cancel", 140, n, 60, 30
CONTROL SET FOCUS hMsgbox, 9991
ELSEIF m = %MB_YESNO THEN
CONTROL ADD BUTTON, hMsgBox, 9991, "&Yes", 10, n, 60, 30 ', %BS_DEFAULT
CONTROL ADD BUTTON, hMsgBox, 9992, "&No", 75, n, 60, 30
ELSEIF m = %MB_OKCANCEL THEN
CONTROL ADD BUTTON, hMsgBox, 9991, "&Ok", 10, n, 60, 30, %BS_DEFAULT
CONTROL ADD BUTTON, hMsgBox, 9992, "&Cancel", 75, n, 60, 30
ELSE
CONTROL ADD BUTTON, hMsgBox, 9994, "&Ok", 30, n, 80, 30, %BS_DEFAULT
END IF
'default location of msgbox -------------------------------------------------
'center myMsgbox in active window if x0, y0 not specified
IF hParent THEN
GetWindowRect hParent, rc: x = rc.nLeft: y = rc.nTop
w = rc.nRight - rc.nLeft: h = rc.nBottom - rc.nTop
ELSE
DESKTOP GET CLIENT TO w, h
END IF
IF x0 OR y0 THEN
x = MAX(x0, 0): y = MAX(y0, 0)
ELSE
x = x + (w - wi)/2: y = y + (h - ht)/2
END IF
MoveWindow hMsgbox, x, y, wi, ht, %TRUE
'add icon to msgbox ---------------------------------------------------------
CONTROL ADD LABEL, hMsgBox, 9995, "", 10, 5, 0, 0, %SS_ICON
CONTROL SET COLOR hMsgBox, 9995, RGB(0, 0, 0), %WHITE '%LTGRAY
k = %MB_OK: m = nStyle - m
IF m = %MB_ICONERROR THEN
n = 103: k = %MB_ICONHAND
ELSEIF m = %MB_ICONQUESTION THEN
n = 102: k = %MB_ICONQUESTION
ELSEIF m = %MB_ICONWARNING THEN
n = 101: k = %MB_ICONEXCLAMATION
ELSEIF m = %MB_ICONINFORMATION THEN
n = 104: k = %MB_ICONASTERISK
END IF
hIcon = LoadImage(BYVAL 0, BYVAL n, %IMAGE_ICON, 32, 32, 0)
SendDlgItemMessage hMsgBox, 9995, %STM_SETIMAGE, %IMAGE_ICON, hIcon
'----------------------------------------------------------------------------
ret = 0: IF sound THEN MessageBeep k
DIALOG SHOW MODAL hMsgbox, CALL myMsgBoxProc TO ret
FUNCTION = ret
END FUNCTION
CALLBACK FUNCTION myMsgBoxProc()
LOCAL myMsgboxReturn AS LONG
SELECT CASE CBMSG
CASE %WM_INITDIALOG
CONTROL SEND CBHNDL, 9991, %BM_SETSTYLE, %BS_DEFPUSHBUTTON, %TRUE
SetWindowPos CBHNDL, %HWND_TOPMOST, 0,0,0,0, %SWP_NOMOVE OR %SWP_NOSIZE
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE 9991, %IDOK
myMsgboxReturn = %IDYES
CASE 9992, %IDCANCEL
myMsgboxReturn = %IDNO
CASE 9993
myMsgboxReturn = %IDCANCEL
CASE 9994
myMsgboxReturn = %IDOK
END SELECT
DIALOG END CBHNDL, myMsgboxReturn
END SELECT
END FUNCTION
FUNCTION MMB_MakeFont(hDC AS LONG, sFont AS STRING, BYVAL ptSize AS LONG) AS LONG
LOCAL CyPixels AS LONG, charHt AS LONG
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
charHt = (PtSize * CyPixels) \ 72
FUNCTION = CreateFont(-charHt, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
%ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
%DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY sFont)
END FUNCTION
Comment