Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

MSGBOX Replacement

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Charles Dietz
    replied
    Test myMsgbox

    Code:
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
    #INCLUDE "myMsgbox.inc"
    
    FUNCTION PBMAIN
       LOCAL hDlg AS LONG 
       DIALOG NEW 0, "Test myMsgbox", , , 250, 180, %WS_SYSMENU TO hDlg
       CONTROL ADD BUTTON, hDlg, 100, "Show myMsgbox", 20, 20, 80, 30
       DIALOG SHOW MODAL hDlg, CALL dlgProc
    END FUNCTION
    
    CALLBACK FUNCTION dlgProc()
       LOCAL n AS LONG, sound AS LONG, msg AS STRING, s AS STRING, ti AS STRING
       SELECT CASE CBMSG
       CASE %WM_COMMAND
          IF CBCTL = 100 THEN
             ti = "Test myMsgbox"
             s = "Do you want to hear a beep for error and warning messages?"
             n = myMsgbox(s, %MB_YESNO OR %MB_ICONQUESTION, ti, 0, 0, 0)
             IF n = %IDYES THEN sound = 1
             msg = "This is a test" + $CRLF + "for "
             myMsgbox msg+"error message", %MB_OK OR %MB_ICONERROR, ti, sound, 170, 0
             myMsgbox msg+"information message", %MB_OK OR %MB_ICONINFORMATION, ti, sound, 50, 100
             myMsgbox msg+"question message", %MB_OK OR %MB_ICONQUESTION, ti, sound, 100, 50
             myMsgbox msg+"warning message", %MB_OK OR %MB_ICONWARNING, ti, sound, 20, 20
             myMsgbox "Done testing", %MB_OK, ti, sound 
          END IF
       END SELECT
    END FUNCTION

    Leave a comment:


  • Charles Dietz
    started a topic MSGBOX Replacement

    MSGBOX Replacement

    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
Working...
X