File "MyMsgBox.inc"
Path: /linkedit/inc/MyMsgBox.inc
File size: 10.87 KB
MIME-type:
Charset: utf-8
'---------------------------------------------------------------------------------------------------------------------------
' 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
'---------------------------------------------------------------------------------------------------------------------------