Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SpriggsySpriggs on February 26, 2021, 03:41:39 pm

Title: More verbose message boxes
Post by: SpriggsySpriggs on February 26, 2021, 03:41:39 pm
The below code is for Windows 32 and 64 bit. It's similar to what I did for my WPFMessageBox library but this uses the native message boxes in Windows. Take those first few commented lines from the bas code and paste them at the top of your program (and uncomment them). That turns over the error handling to the functions I'm giving you. These functions can be used to give more verbose error messages in your applications, especially for ones that utilize the WinAPI. See below for a screenshot of an example:

 


Code: QB64: [Select]
  1. 'ON ERROR GOTO ERRHANDLE
  2. 'ERRHANDLE:
  3. 'IF ERR THEN
  4. '    IF _INCLERRORLINE THEN
  5. '        CriticalError ERR, _INCLERRORLINE, _INCLERRORFILE$
  6. '        RESUME NEXT
  7. '    ELSE
  8. '        CriticalError ERR, _ERRORLINE, ""
  9. '        RESUME NEXT
  10. '    END IF
  11. 'END IF
  12. $If MESSAGEBOX = UNDEFINED Then
  14.         Function MessageBox& (ByVal Zer0 As Long, message As String, title As String, Byval MBType As _Unsigned Long)
  15.     End Declare
  16.     $Let MESSAGEBOX = TRUE
  18.  
  19. Declare Library ".\preproc"
  20.     Function __FUNCTION_NAME$ ()
  21.     Function __FUNCTION_NAME_FULL$ ()
  23.  
  24. Sub SoftError (title As String, message As String)
  25.     Const MB_OK = 0 'OK button only
  26.     Const MB_YESNO = 4 'Yes & No
  27.     Const MB_ICONSTOP = 16 'Error stop sign icon
  28.     Const MB_ICONEXCLAMATION = 48 'Exclamation-point icon
  29.     Const MB_SETFOCUS = 65536 'Set message box as focus
  30.     Const IDOK = 1 'OK button pressed
  31.     Const IDYES = 6 'Yes button pressed
  32.     Const IDNO = 7 'No button pressed
  33.  
  34.     Dim As Long Answer
  35.     Answer = MessageBox(0, message + Chr$(0), title + Chr$(0), MB_OK + MB_SETFOCUS + MB_ICONEXCLAMATION)
  37.  
  38. Sub CriticalError (ERRR, ERRLINE, INCL As String)
  39.     Const MB_OK = 0 'OK button only
  40.     Const MB_YESNO = 4 'Yes & No
  41.     Const MB_ICONSTOP = 16 'Error stop sign icon
  42.     Const MB_ICONEXCLAMATION = 48 'Exclamation-point icon
  43.     Const MB_SETFOCUS = 65536 'Set message box as focus
  44.     Const IDOK = 1 'OK button pressed
  45.     Const IDYES = 6 'Yes button pressed
  46.     Const IDNO = 7 'No button pressed
  47.  
  48.     Dim As String message
  49.     message = "The program ran into a problem that it couldn't handle." + Chr$(10) + "Error Code: " + LTrim$(Str$(ERRR)) + Chr$(10) + Chr$(10) + _ErrorMessage$ + " on line " + LTrim$(Str$(ERRLINE))
  50.     If INCL <> "" Then
  51.         message = message + " in " + INCL
  52.     Else
  53.         message = message + " in main module"
  54.     End If
  55.     message = message + Chr$(10) + "For more information about this issue and possible fixes, visit https://www.qb64.org/forum" + Chr$(10) + "Continue?"
  56.     Dim Answer As Long
  57.     Answer = MessageBox(0, message + Chr$(0), "Error: " + LTrim$(Str$(ERRR)) + Chr$(0), MB_YESNO + MB_SETFOCUS + MB_ICONSTOP)
  58.     Select Case Answer
  59.         Case IDYES
  60.             Exit Sub
  61.         Case IDNO
  62.             System
  63.     End Select
  65.  
  66. Sub CriticalErrorWinAPI (additionalInfo As String)
  67.     Const MB_OK = 0 'OK button only
  68.     Const MB_YESNO = 4 'Yes & No
  69.     Const MB_ICONSTOP = 16 'Error stop sign icon
  70.     Const MB_ICONEXCLAMATION = 48 'Exclamation-point icon
  71.     Const MB_SETFOCUS = 65536 'Set message box as focus
  72.     Const IDOK = 1 'OK button pressed
  73.     Const IDYES = 6 'Yes button pressed
  74.     Const IDNO = 7 'No button pressed
  75.  
  76.     Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H00000100
  77.     Const FORMAT_MESSAGE_FROM_SYSTEM = &H00001000
  78.     Const FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
  79.     Const LANG_NEUTRAL = &H00
  80.     Const SUBLANG_DEFAULT = &H01
  81.     $If GETLASTERROR = UNDEFINED Then
  82.         Declare Library
  83.             Function GetLastError& ()
  84.         End Declare
  85.         $Let GETLASTERROR = TRUE
  86.     $End If
  88.         Function FormatMessage& Alias FormatMessageA (ByVal dwFlags As Long, Byval lpSource As Long, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As _Offset, Byval nSize As Long, Byval Arguments As _Offset)
  89.     End Declare
  91.         Function MAKELANGID& (ByVal p As Long, Byval s As Long)
  92.     End Declare
  93.     $If OFFSETTOSTRING = UNDEFINED Then
  94.         Declare CustomType Library ".\offsettostring"
  95.             Function offset_to_string$ Alias offset_to_offset (ByVal offset As _Offset)
  96.         End Declare
  97.         $Let OFFSETTOSTRING = TRUE
  98.     $End If
  99.     Dim As String message, ERRMSG
  100.     Dim As _Offset lpMsgBuf
  101.     Dim As Long msg, Answer, ERRR
  102.     ERRR = GetLastError
  103.     msg = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, ERRR, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _Offset(lpMsgBuf), 0, 0)
  104.     ERRMSG = offset_to_string(lpMsgBuf)
  105.     If additionalInfo <> "" Then
  106.         message = "The program ran into a problem in function " + additionalInfo + Chr$(10)
  107.     Else
  108.         message = "The program ran into a problem that it couldn't handle." + Chr$(10)
  109.     End If
  110.     message = message + "Error Code: " + LTrim$(Str$(ERRR)) + Chr$(10) + Chr$(10) + ERRMSG + Chr$(10) + "For more information about this issue and possible fixes, visit https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes"
  111.     Select Case ERRR
  112.         Case 0
  113.             Exit Sub
  114.         Case 1 TO 499
  115.             message = message + "--0-499-"
  116.         Case 500 TO 999
  117.             message = message + "--500-999-"
  118.         Case 1000 TO 1299
  119.             message = message + "--1000-1299-"
  120.         Case 1300 TO 1699
  121.             message = message + "--1300-1699-"
  122.         Case 1700 TO 3999
  123.             message = message + "--1700-3999-"
  124.         Case 4000 TO 5999
  125.             message = message + "--4000-5999-"
  126.         Case 6000 TO 8199
  127.             message = message + "--6000-8199-"
  128.         Case 8200 TO 8999
  129.             message = message + "--8200-8999-"
  130.         Case 9000 TO 11999
  131.             message = message + "--9000-11999-"
  132.         Case 12000 TO 15999
  133.             message = message + "--12000-15999-"
  134.     End Select
  135.     message = message + Chr$(10) + Chr$(10) + "Continue?"
  136.     Answer = MessageBox(0, message + Chr$(0), "Error: " + LTrim$(Str$(ERRR)) + Chr$(0), MB_YESNO + MB_SETFOCUS + MB_ICONSTOP)
  137.     Select Case Answer
  138.         Case IDYES
  139.             Exit Sub
  140.         Case IDNO
  141.             System
  142.     End Select

Code: C++: [Select]
  1. //preproc.h
  2. #define __VARIABLE_NAME(Variable) (#Variable)
  3. #define __FUNCTION_NAME() (__func__)
  4. #define __FUNCTION_NAME_FULL() (__PRETTY_FUNCTION__)
  5. #define __SRC_LINE() (__LINE__)
  6. #define __SRC_FILE() (__FILE__)
  7. #define __STATIC_COUNT() (__COUNTER__)
  8. #define __COMPILE_DATE() (__DATE__)
  9. #define __COMPILE_TIME() (__TIME__)
  10. #define __SRC_LAST_EDIT() (__TIMESTAMP__)
  11. #ifdef QB64_WINDOWS
  12. #define __WIN32() (_WIN32)
  13. #define __WIN64() (_WIN64)
  14. #endif
  15. #define __INC_DEPTH() (__INCLUDE_LEVEL__)
  16. #define __BASE_FILE() (__BASE_FILE__)

Code: C++: [Select]
  1. //offsettostring.h
  2.   void *offset_to_offset(void* offset){
  3.    return offset;
  4.    }
Title: Re: More verbose message boxes
Post by: bplus on February 26, 2021, 10:15:06 pm
And that is impressive too!
Text Only | Text with Attachments