'--------------------------------------------------------------------------------------------------------------------------- ' This is MyMsgBox.inc v1.2 for PBWin9 '--------------------------------------------------------------------------------------------------------------------------- ' Examples of use: ' SetMyMsgBoxFont "Ms Sans Serif", 8, -1, -1 ' -1 = default color ' SetMyMsgBoxFont "Lucida Console", 10, %BLACK, %WHITE ' SetMyMsgBoxFont "comic sans ms", 12, %RGB_YELLOW, %RGB_FIREBRICK ' SetMyMsgBoxFont "Arial", 10, -1, -1 ' -1 = default color ' MyMsgBox CB.HNDL, "Simple MyMsgBox without any button defined"+$CR+"(called with only 1 parameter)" ' MyMsgBox CB.HNDL, "Information", "", %MB_ICONINFORMATION ' MyMsgBox CB.HNDL, "Warning"+$CR+"Retry?", "", %MB_ICONWARNING OR %MB_RETRYCANCEL ' MyMsgBox CB.HNDL, "Critical error"+$CR+"What to do?", "", %MB_ICONERROR OR %MB_ABORTRETRYIGNORE ' MyMsgBox CB.HNDL, "%MB_CANCELTRYCONTINUE", "", %MB_CANCELTRYCONTINUE ' MyMsgBox CB.HNDL, "%MB_RETRYCANCEL", "", %MB_RETRYCANCEL ' MyMsgBox CB.HNDL, "%MB_YESNO", "", %MB_YESNO ' MyMsgBox CB.HNDL, "%MB_YESNOCANCEL", "", %MB_YESNOCANCEL ' MyMsgBox CB.HNDL, "%MB_ABORTRETRYIGNORE", "", %MB_ABORTRETRYIGNORE ' MyMsgBox CB.HNDL, "%MB_OKCANCEL", "", %MB_OKCANCEL ' lRes = MyMsgBox(CB.HNDL, "Question?", "", %MB_ICONQUESTION OR %MB_YESNO) ' lRes = MyMsgBox(CB.HNDL, "This just shows the versatility.", "Custom MSGBOX Four", %MB_ICONINFORMATION, "&Yes;&No;&What?") '--------------------------------------------------------------------------------------------------------------------------- #INCLUDE ONCE "windows.inc" '--------------------------------------------------------------------------------------------------------------------------- TYPE MyMsgBoxFont name AS ASCIIZ * %MAX_PATH size AS LONG fore AS LONG back AS LONG END TYPE '--------------------------------------------------------------------------------------------------------------------------- GLOBAL MMB_MSGFONT AS MyMsgBoxFont GLOBAL MMB_BTNFONT AS MyMsgBoxFont GLOBAL MMB_LBL_CANCEL AS STRING GLOBAL MMB_LBL_RETRY AS STRING GLOBAL MMB_LBL_CONTINUE AS STRING GLOBAL MMB_LBL_YES AS STRING GLOBAL MMB_LBL_NO AS STRING GLOBAL MMB_LBL_ABORT AS STRING GLOBAL MMB_LBL_IGNORE AS STRING GLOBAL MMB_LBL_OK AS STRING '--------------------------------------------------------------------------------------------------------------------------- SUB SetMyMsgBoxFont(fntname AS STRING, fntsize AS LONG, fntfore AS LONG, fntback AS LONG) MMB_MSGFONT.name = TRIM$(fntname) + $NUL MMB_MSGFONT.size = fntsize MMB_MSGFONT.fore = fntfore MMB_MSGFONT.back = fntback ' By default, use same font for MyMsgBox buttons: SetMyMsgBoxBtnFont(fntname, fntsize) ' Overwrite this by calling SetMsgBoxBtnFont with another font as parameter END SUB '--------------------------------------------------------------------------------------------------------------------------- SUB SetMyMsgBoxBtnFont(fntname AS STRING, fntsize AS LONG) MMB_BTNFONT.name = TRIM$(fntname) + $NUL MMB_BTNFONT.size = fntsize END SUB '--------------------------------------------------------------------------------------------------------------------------- FUNCTION MyMsgBox(BYVAL hWin AS DWORD, BYVAL msgtxt AS STRING, OPTIONAL BYVAL msgtitle AS STRING, _ OPTIONAL BYVAL style AS LONG, OPTIONAL BYVAL buttons AS STRING) AS LONG LOCAL x, y, tbx, tbw, tbh, btnNb, btn, bx, by, bw AS LONG LOCAL hMsg, hMsgFont, hBtnfont, hIcon AS DWORD LOCAL lRes, ico, bip, spbtn AS LONG LOCAL blist() AS STRING ' Set some default values if absent IF MMB_MSGFONT.name = "" THEN SetMyMsgBoxFont "Ms Sans Serif", 8, -1, -1 IF MMB_LBL_OK = "" THEN MMB_LBL_OK = "&OK" IF MMB_LBL_YES = "" THEN MMB_LBL_YES = "&Yes" IF MMB_LBL_NO = "" THEN MMB_LBL_NO = "&No" IF MMB_LBL_CANCEL = "" THEN MMB_LBL_CANCEL = "&Cancel" IF MMB_LBL_RETRY = "" THEN MMB_LBL_RETRY = "&Retry" IF MMB_LBL_CONTINUE = "" THEN MMB_LBL_CONTINUE = "C&ontinue" IF MMB_LBL_ABORT = "" THEN MMB_LBL_ABORT = "&Abort" IF MMB_LBL_IGNORE = "" THEN MMB_LBL_IGNORE = "&Ignore" ' Prepare dialog title and body IF msgtitle = "" THEN msgtitle = EXE.NAME$ REPLACE $CR WITH $CRLF IN msgtxt REPLACE $CR+$CR WITH $CR IN msgtxt ' Create dialog DIALOG NEW PIXELS , hWin, msgtitle, , , 400, 100 TO hMsg ' Define icon (if any) and sound, from style value bip = %MB_OK IF (STYLE AND %MB_ICONERROR) = %MB_ICONERROR THEN ico = 1 : bip = %MB_ICONHAND IF (STYLE AND %MB_ICONQUESTION) = %MB_ICONQUESTION THEN ico = 2 : bip = %MB_ICONQUESTION IF (STYLE AND %MB_ICONWARNING) = %MB_ICONWARNING THEN ico = 3 : bip = %MB_ICONEXCLAMATION IF (STYLE AND %MB_ICONINFORMATION) = %MB_ICONINFORMATION THEN ico = 4 : bip = %MB_ICONASTERISK tbx = 10 IF ico THEN CONTROL ADD LABEL, hMsg, 12299, "", 5, 5, 0, 0, %SS_ICON ' Control ID 12299 = icon CONTROL SET COLOR hMsg, 12299, MMB_MSGFONT.fore, MMB_MSGFONT.back hIcon = ExtractIcon(BYVAL 0, "user32.dll", ico) SendDlgItemMessage hMsg, 12299, %STM_SETIMAGE, %IMAGE_ICON, hIcon tbx = 5 + 32 + 5 END IF ' Add elements CONTROL ADD TEXTBOX, hMsg, 12300, msgtxt, tbx, 15, 10, 10, %ES_MULTILINE OR %ES_READONLY ' Control ID 12300 = textbox CONTROL ADD GRAPHIC, hMsg, 12301, "", -900, -900, 10, 10 ' Control ID 12301 = test graphic box ' Calculate graphic size of text with desired font GRAPHIC ATTACH hMsg, 12301 FONT NEW MMB_MSGFONT.name, MMB_MSGFONT.size TO hMsgFont CONTROL SET FONT hMsg, 12300, hMsgFont GRAPHIC SET FONT hMsgFont GRAPHIC TEXT SIZE msgtxt TO x, y tbw = MAX(160, MIN(380, x)) ' tbh = (x * y) * tbw / 100000 + (2 * MMB_MSGFONT.size) tbh = y * x/tbw + (2 + PARSECOUNT(msgtxt, $CRLF)) * MMB_MSGFONT.size CONTROL SET SIZE hMsg, 12300, tbw, tbh ' set size of textbox CONTROL SET COLOR hMsg, 12300, MMB_MSGFONT.fore, MMB_MSGFONT.back DIALOG SET COLOR hMsg, MMB_MSGFONT.fore, MMB_MSGFONT.back ' Create buttons from style value (if any) IF (STYLE AND %MB_YESNO) = %MB_YESNO THEN spbtn = 1 : buttons = MMB_LBL_YES+";"+MMB_LBL_NO IF (STYLE AND %MB_ABORTRETRYIGNORE) = %MB_ABORTRETRYIGNORE THEN spbtn = 1 : buttons = MMB_LBL_ABORT+";"+MMB_LBL_RETRY+";"+MMB_LBL_IGNORE IF (STYLE AND %MB_OKCANCEL) = %MB_OKCANCEL THEN spbtn = 1 : buttons = MMB_LBL_OK+";"+MMB_LBL_CANCEL IF (STYLE AND %MB_YESNOCANCEL) = %MB_YESNOCANCEL THEN spbtn = 1 : buttons = MMB_LBL_YES+";"+MMB_LBL_NO+";"+MMB_LBL_CANCEL IF (STYLE AND %MB_RETRYCANCEL) = %MB_RETRYCANCEL THEN spbtn = 1 : buttons = MMB_LBL_RETRY+";"+MMB_LBL_CANCEL IF (STYLE AND %MB_CANCELTRYCONTINUE) = %MB_CANCELTRYCONTINUE THEN spbtn = 1 : buttons = MMB_LBL_CANCEL+";"+MMB_LBL_RETRY+";"+MMB_LBL_CONTINUE IF buttons = "" THEN buttons = MMB_LBL_OK ' Define list of buttons DIM blist(1 TO TALLY(buttons, ";") + 1) FOR y = 1 TO PARSECOUNT(buttons, ";") blist(y) = PARSE$(buttons, ";", y) NEXT btnNb = UBOUND(blist) ' Draw buttons FONT NEW MMB_BTNFONT.name, MMB_BTNFONT.size TO hBtnfont GRAPHIC SET FONT hBtnfont bx = 10 by = 5 + tbh + 25 IF ico THEN by = MAX(5 + tbh + 25, 5 + 32 + 25) ' make it so that buttons don't overlap icon, if any FOR btn = 1 TO btnNb GRAPHIC TEXT SIZE blist(btn) TO x, y x += 20 CONTROL ADD BUTTON, hMsg, 12301 + btn, blist(btn), bx, by, x, 24 CONTROL SET FONT hMsg, 12301 + btn, hBtnfont bx += 10 + x NEXT x = MAX(bx, tbw + IIF(ico, 52, 20)) ' Handle when width of all buttons aligned horizontally > size of window DIALOG SET CLIENT hMsg, x, by + 29 ' set size of dialog ' Center buttons bw = bx - 20 bx = (x - bw) \ 2 FOR btn = 1 TO btnNb CONTROL SET LOC hMsg, 12301 + btn, bx, by CONTROL GET SIZE hMsg, 12301 + btn TO x, y bx += 10 + x NEXT GRAPHIC DETACH ' Beep and display the message box MessageBeep bip DIALOG SET ICON hMsg, "AICO" DIALOG SHOW MODAL hMsg, CALL MyMsgBoxProc() TO lRes IF spbtn = 1 THEN ' Special: buttons created from Style x = lRes ' in this case, return the actual value SELECT CASE blist(x) ' of the button and not the button index CASE MMB_LBL_OK : lRes = %IDOK CASE MMB_LBL_YES : lRes = %IDYES CASE MMB_LBL_NO : lRes = %IDNO CASE MMB_LBL_CANCEL : lRes = %IDCANCEL CASE MMB_LBL_RETRY : lRes = %IDRETRY CASE MMB_LBL_CONTINUE : lRes = %IDCONTINUE CASE MMB_LBL_ABORT : lRes = %IDABORT CASE MMB_LBL_IGNORE : lRes = %IDIGNORE END SELECT END IF FUNCTION = lRes FONT END hMsgFont FONT END hBtnfont IF hIcon THEN DestroyIcon(hIcon) END FUNCTION '--------------------------------------------------------------------------------------------------------------------------- CALLBACK FUNCTION MyMsgBoxProc() AS LONG ' This callback function processes the MyMsgBox dialog events. STATIC activebutton AS LONG SELECT CASE CB.MSG CASE %WM_INITDIALOG CenterWindow CB.HNDL activebutton = 12301 + 1 CONTROL SET FOCUS CB.HNDL, activebutton CASE %WM_COMMAND SELECT CASE CB.CTL CASE %IDOK ' Causes ENTER to post click for button with focus DIALOG POST CB.HNDL, %WM_COMMAND, activebutton, %BN_CLICKED CASE 12302 TO 12320 SELECT CASE CB.CTLMSG CASE %BN_CLICKED DIALOG END CB.HNDL, CB.CTL - 12301 CASE %BN_SETFOCUS activebutton = CB.CTL ' This allows the ENTER key to activate button with focus END SELECT END SELECT END SELECT END FUNCTION '--------------------------------------------------------------------------------------------------------------------------- SUB CenterWindow(BYVAL hWnd AS DWORD) ' This should be fairly straight forward to grasp. ' First see if the parent is the desktop, if not ' it is a child window. Then find the size of the ' client area of the parent and proceed to center ' the child there. LOCAL ncWidth, ncHeight, x, y AS LONG LOCAL hParent AS DWORD WINDOW GET PARENT hWnd TO hParent IF hParent = 0 THEN DESKTOP GET CLIENT TO ncWidth, ncHeight ELSE DIALOG GET CLIENT hParent TO ncWidth, ncHeight END IF DIALOG GET SIZE hWnd TO x, y x = ncWidth - x x \=2 y = ncHeight - y y \=2 DIALOG SET LOC hWnd, x, y END SUB '---------------------------------------------------------------------------------------------------------------------------