Author Topic: EBAC Calculator  (Read 9492 times)

0 Members and 1 Guest are viewing this topic.

Offline George McGinn

  • Global Moderator
  • Forum Regular
  • Posts: 210
    • View Profile
    • Resume
EBAC Calculator
« on: October 14, 2021, 04:36:45 pm »
This is a rework of a post I made a few months ago.

I converted my EBAC Calculator from Zenity to now use InForm, and uses many of it's features.

I've included all the files needed to compile it, and have tested it on Linux and MAC OSX. It should also run on Windows (I don't have a Windows OS installed).

Below is the main program for those who want to look at it, but you will need the files/directories in the .ZIP file if you want to compile it. You do not need InForm to compile and use the program. Just the files provided.

Here's the main source:
Code: QB64: [Select]
  1. REM $TITLE: ebacCalculator.bas Version 1.0  04/01/2021 - Last Update: 10/14/2021
  2. _TITLE "ebacCalculator.bas"
  3. ' ebacCalculator.bas    Version 2.0  10/14/2021
  4. '-----------------------------------------------------------------------------------
  5. '       PROGRAM: ebacCalculator.bas
  6. '        AUTHOR: George McGinn
  7. '
  8. '  DATE WRITTEN: 04/01/2021
  9. '       VERSION: 2.0
  10. '       PROJECT: Estimated Blood-Alcohol Content Calculator
  11. '
  12. '   DESCRIPTION: Program shows many of the functions of using InForm while using
  13. '                most of the original code from the Zenity project. This can now
  14. '                run on all systems (Linux, MAC and Windows).
  15. '
  16. ' Written by George McGinn
  17. ' Copyright (C)2021 by George McGinn - All Rights Reserved
  18. ' Version 1.0 - Created 04/01/2021
  19. ' Version 2.0 - Created 10/14/2021
  20. '
  21. ' CHANGE LOG
  22. '-----------------------------------------------------------------------------------
  23. ' 04/01/2021 v1.0  GJM - New Program (TechBASIC and C++ Versions).
  24. ' 06/19/2021 v1.5  GJM - Updated to use Zenity and SHELL commands to run on Linux with
  25. '                        a simple GUI.
  26. ' 10/14/2021 v2.0  GJM - Updated to use InForm GUI in place of Zenity an SHELL commands.
  27. '                        Can now run on any OS
  28. '-----------------------------------------------------------------------------------
  29. '  Copyright (C)2021 by George McGinn.  All Rights Reserved.
  30. '
  31. ' untitled.bas by George McGinn is licensed under a Creative Commons
  32. ' Attribution-NonCommercial 4.0 International. (CC BY-NC 4.0)
  33. '
  34. ' Full License Link: https://creativecommons.org/licenses/by-nc/4.0/legalcode
  35. '
  36. '-----------------------------------------------------------------------------------
  37. ' PROGRAM NOTES
  38. '
  39. ': This program uses
  40. ': InForm - GUI library for QB64 - v1.3
  41. ': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - [member=2]FellippeHeitor[/member]
  42. ': https://github.com/FellippeHeitor/InForm
  43. '-----------------------------------------------------------------------------------
  44.  
  45. ': Controls' IDs: ------------------------------------------------------------------
  46. DIM SHARED maleRB AS LONG
  47. DIM SHARED femaleRB AS LONG
  48. DIM SHARED AgreeCB AS LONG
  49. DIM SHARED AGREEBT AS LONG
  50. DIM SHARED ebacFRM AS LONG
  51. DIM SHARED weightLB AS LONG
  52. DIM SHARED nbrdrinksLB AS LONG
  53. DIM SHARED timeLB AS LONG
  54. DIM SHARED EnterInformationLB AS LONG
  55. DIM SHARED WeightTB AS LONG
  56. DIM SHARED nbrDrinksTB AS LONG
  57. DIM SHARED TimeTB AS LONG
  58. DIM SHARED CancelBT AS LONG
  59. DIM SHARED HELPBT AS LONG
  60. DIM SHARED QUITBT AS LONG
  61. DIM SHARED displayResults AS LONG
  62. DIM SHARED informationLB AS LONG
  63.  
  64. ': User-defined Variables: ---------------------------------------------------------
  65. DIM SHARED AS STRING HELPFile
  66. DIM SHARED AS INTEGER l, SOBER, legalToDrive
  67. DIM SHARED AS SINGLE B, OZ, Wt, EBAC
  68. DIM SHARED numeric(255)
  69.  
  70. DIM SHARED AS STRING helpcontents, prt_text
  71.  
  72.  
  73.  
  74. ': External modules: ---------------------------------------------------------------
  75. '$INCLUDE:'InForm/InForm.bi'
  76. '$INCLUDE:'InForm/xp.uitheme'
  77. '$INCLUDE:'ebacCalculator.frm'
  78.  
  79.  
  80.  
  81. ': Event procedures: ---------------------------------------------------------------
  82. SUB __UI_BeforeInit
  83.  
  84.  
  85. SUB __UI_OnLoad
  86.  
  87. ' *** Initialize Variables
  88.     A = 0
  89.     Wt = 0
  90.     B = .0
  91.     T = 0: St = 0
  92.     I = 0
  93.     Bdl = 1.055
  94.     OZ = .5
  95.     SOBER = False: legalToDrive = False
  96.     HELPFile = "EBACHelp.txt"
  97.     displayDisclaimer
  98.  
  99.  
  100. SUB __UI_BeforeUpdateDisplay
  101.     'This event occurs at approximately 60 frames per second.
  102.     'You can change the update frequency by calling SetFrameRate DesiredRate%
  103.  
  104.  
  105. SUB __UI_BeforeUnload
  106.     'If you set __UI_UnloadSignal = False here you can
  107.     'cancel the user's request to close.
  108.  
  109.  
  110. SUB __UI_Click (id AS LONG)
  111.     SELECT CASE id
  112.         CASE maleRB
  113.             Sex = "M"
  114.  
  115.         CASE femaleRB
  116.             Sex = "F"
  117.  
  118.         CASE AGREEBT
  119.             Answer = MessageBox("Do you want to perform another calculation?             ", "", MsgBox_YesNo + MsgBox_Question)
  120.             IF Answer = MsgBox_Yes THEN
  121.                 Control(AgreeCB).Value = False
  122.                 Control(AGREEBT).Disabled = True
  123.             ELSE
  124.                 Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
  125.                SYSTEM
  126.             END IF
  127.  
  128.         CASE CancelBT
  129.             ResetForm
  130.  
  131.         CASE OKBT
  132.             IF Control(maleRB).Value = False AND Control(femaleRB).Value = False THEN
  133.                 Answer = MessageBox("Invalid: You must select either M (male) or F (female). Please Correct.", "", MsgBox_Ok + MsgBox_Information)
  134.                 EXIT SUB
  135.             END IF
  136.             A = Control(nbrDrinksTB).Value
  137.             Wt = Control(WeightTB).Value
  138.             T = Control(TimeTB).Value
  139.             calcEBAC
  140.             Control(QUITBT).Disabled = True
  141.             ResetList displayResults
  142.             Text(displayResults) = prt_text
  143.  
  144.         CASE HELPBT
  145.             ResetList displayResults
  146.             IF _FILEEXISTS(HELPFile) THEN
  147.                 DIM fh AS LONG
  148.                 fh = FREEFILE
  149.                 OPEN HELPFile FOR INPUT AS #fh
  150.                 DO UNTIL EOF(fh)
  151.                     LINE INPUT #fh, helpcontents
  152.                     AddItem displayResults, helpcontents
  153.                 LOOP
  154.                 CLOSE #fh
  155.                 Control(displayResults).LastVisibleItem = 0
  156.             ELSE
  157.                 Answer = MessageBox("HELP File " + HELPFile$ + " Not Found                             ", "", MsgBox_Ok + MsgBox_Question)
  158.                 SYSTEM 1
  159.             END IF
  160.  
  161.         CASE QUITBT
  162.             Answer = MessageBox("Are you sure you want to QUIT?                     ", "", MsgBox_YesNo + MsgBox_Question)
  163.             IF Answer = MsgBox_Yes THEN
  164.                 Answer = MessageBox("Thank You for using EBAC Calculator. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
  165.                 SYSTEM
  166.             END IF
  167.  
  168.     END SELECT
  169.  
  170. SUB __UI_MouseEnter (id AS LONG)
  171.  
  172. SUB __UI_MouseLeave (id AS LONG)
  173.  
  174. SUB __UI_FocusIn (id AS LONG)
  175.  
  176. SUB __UI_FocusOut (id AS LONG)
  177.     'This event occurs right before a control loses focus.
  178.     'To prevent a control from losing focus, set __UI_KeepFocus = True below.
  179.  
  180. SUB __UI_MouseDown (id AS LONG)
  181.  
  182. SUB __UI_MouseUp (id AS LONG)
  183.  
  184. SUB __UI_KeyPress (id AS LONG)
  185.     'When this event is fired, __UI_KeyHit will contain the code of the key hit.
  186.     'You can change it and even cancel it by making it = 0
  187.  
  188. SUB __UI_TextChanged (id AS LONG)
  189.     SELECT CASE id
  190.  
  191.         CASE WeightTB
  192.             Control(AgreeCB).Value = False
  193.             Control(AGREEBT).Disabled = True
  194.  
  195.         CASE nbrDrinksTB
  196.             Control(AgreeCB).Value = False
  197.             Control(AGREEBT).Disabled = True
  198.  
  199.         CASE TimeTB
  200.             Control(AgreeCB).Value = False
  201.             Control(AGREEBT).Disabled = True
  202.  
  203.     END SELECT
  204.  
  205. SUB __UI_ValueChanged (id AS LONG)
  206.     SELECT CASE id
  207.  
  208.         CASE maleRB
  209.             Control(AgreeCB).Value = False
  210.             Control(AGREEBT).Disabled = True
  211.  
  212.         CASE femaleRB
  213.             Control(AgreeCB).Value = False
  214.             Control(AGREEBT).Disabled = True
  215.  
  216.         CASE AgreeCB
  217.             IF Control(AgreeCB).Value = True THEN
  218.                 Control(AGREEBT).Disabled = False
  219.                 Control(QUITBT).Disabled = False
  220.             ELSE
  221.                 Control(AGREEBT).Disabled = True
  222.                 Control(QUITBT).Disabled = True
  223.             END IF
  224.  
  225.     END SELECT
  226.  
  227. SUB __UI_FormResized
  228.  
  229. '$INCLUDE:'InForm/InForm.ui'
  230.  
  231.  
  232. ': User FUNCTIONS/SUBROUTINES: ---------------------------------------------------------------
  233.  
  234. SUB displayDisclaimer
  235.  
  236. '    prt_text = "*** DISCLAIMER ***" + CHR$(10)
  237.     prt_text = "Unless otherwise separately undertaken by the Licensor, to the extent" + CHR$(10)
  238.     prt_text = prt_text + "possible, the Licensor offers the Licensed Material as-is and" + CHR$(10)
  239.     prt_text = prt_text + "as-available, and makes no representations or warranties of any kind" + CHR$(10)
  240.     prt_text = prt_text + "concerning the Licensed Material, whether express, implied, statutory," + CHR$(10)
  241.     prt_text = prt_text + "or other. This includes, without limitation, warranties of title," + CHR$(10)
  242.     prt_text = prt_text + "merchantability, fitness for a particular purpose, non-infringement," + CHR$(10)
  243.     prt_text = prt_text + "absence of latent or other defects, accuracy, or the presence or absence" + CHR$(10)
  244.     prt_text = prt_text + "of errors, whether or not known or discoverable. Where disclaimers of" + CHR$(10)
  245.     prt_text = prt_text + "warranties are not allowed in full or in part, this disclaimer may not" + CHR$(10)
  246.     prt_text = prt_text + "apply to You." + CHR$(10) + CHR$(10)
  247.  
  248.     prt_text = prt_text + "To the extent possible, in no event will the Licensor be liable to You" + CHR$(10)
  249.     prt_text = prt_text + "on any legal theory (including, without limitation, negligence) or" + CHR$(10)
  250.     prt_text = prt_text + "otherwise for any direct, special, indirect, incidental, consequential," + CHR$(10)
  251.     prt_text = prt_text + "punitive, exemplary, or other losses, costs, expenses, or damages" + CHR$(10)
  252.     prt_text = prt_text + "arising out of this Public License or use of the Licensed Material, even" + CHR$(10)
  253.     prt_text = prt_text + "if the Licensor has been advised of the possibility of such losses," + CHR$(10)
  254.     prt_text = prt_text + "costs, expenses, or damages. Where a limitation of liability is not" + CHR$(10)
  255.     prt_text = prt_text + "allowed in full or in part, this limitation may not apply to You." + CHR$(10) + CHR$(10)
  256.  
  257.     prt_text = prt_text + "The disclaimer of warranties and limitation of liability provided above" + CHR$(10)
  258.     prt_text = prt_text + "shall be interpreted in a manner that, to the extent possible, most" + CHR$(10)
  259.     prt_text = prt_text + "closely approximates an absolute disclaimer and waiver of all liability." + CHR$(10)
  260.  
  261.     Answer = MessageBox(prt_text, "*** DISCLAIMER ***", MsgBox_YesNo + MsgBox_Question)
  262.     IF Answer = MsgBox_No THEN
  263.         Answer = MessageBox("Sorry you don't agree. Please Don't Drink and Drive.", "", MsgBox_Ok + MsgBox_Information)
  264.         SYSTEM
  265.     END IF
  266.  
  267.  
  268.  
  269. SUB ResetForm
  270.     Control(nbrDrinksTB).Value = 0
  271.     Control(WeightTB).Value = 0
  272.     Control(TimeTB).Value = 0
  273.     Control(AgreeCB).Value = False
  274.     Control(AGREEBT).Disabled = True
  275.     Control(maleRB).Value = False
  276.     Control(femaleRB).Value = False
  277.     ResetList displayResults
  278.     Sex = ""
  279.  
  280.  
  281. SUB calcEBAC
  282. '-------------------------------------------------------------
  283. ' *** Convert Drinks into Fluid Ounces of EtOH (Pure Alcohol).
  284. ' *** A is number of drinks. 1 drink is about .6 FLoz of alcohol
  285.     FLoz = A * OZ
  286.     legalToDrive = False
  287.  
  288. '-----------------------------------------------------
  289. ' *** Set/calculate EBAC values based on Sex
  290.     SELECT CASE Sex
  291.         CASE "M"
  292.             B = .017
  293.             EBAC = 7.97 * FLoz / Wt - B * T
  294.         CASE "F"
  295.             B = .019
  296.             EBAC = 9.86 * FLoz / Wt - B * T
  297.     END SELECT
  298.  
  299.     IF EBAC < 0 THEN EBAC = 0
  300.  
  301. '----------------------------------------------------------------------------------------------
  302. ' *** Populate the EBAC string with the EBAC value formatted to 3 decimal places for FORM output
  303.     prt_text = "ESTIMATED BLOOD ALCOHOL CONTENT (EBAC) in g/dL = " + strFormat$(STR$(EBAC), "###.###") + CHR$(10) + CHR$(10)
  304.  
  305.  
  306. '-----------------------------------------------------------------------------------------
  307. ' *** Based on EBAC range values, populate the FORM output string with the approriate text
  308.     SELECT CASE EBAC
  309.         CASE .500 TO 100.9999
  310.             prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, DEATH LIKELY" + CHR$(10)
  311.             prt_text = prt_text + "Unconsious/coma, unresponsive, high likelihood of death. It is illegal" + CHR$(10) + _
  312.                                   "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
  313.         CASE .400 TO .4999
  314.             prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, DEATH POSSIBLE" + CHR$(10)
  315.             prt_text = prt_text + "Onset of coma, and possible death due to respiratory arrest. It is illegal" + CHR$(10) + _
  316.                                   "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
  317.         CASE .350 TO .3999
  318.             prt_text = prt_text + "*** ALERT: CALL AN AMBULANCE, SEVERE ALCOHOL POISONING" + CHR$(10)
  319.             prt_text = prt_text + " Coma is possible. This is the level of surgical anesthesia. It is illegal" + CHR$(10) + _
  320.                                   "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
  321.         CASE .300 TO .3499
  322.             prt_text = prt_text + "*** ALERT: YOU ARE IN A DRUNKEN STUP0R, AT RISK TO PASSING OUT" + CHR$(10)
  323.             prt_text = prt_text + "STUPOR. You have little comprehension of where you are. You may pass out" + CHR$(10) + _
  324.                                   "suddenly and be difficult to awaken. It is illegal to operate a motor" + CHR$(10) + _
  325.                                   "vehicle at this level of intoxication in all states." + CHR$(10)
  326.         CASE .250 TO .2999
  327.             prt_text = prt_text + "*** ALERT: SEVERLY IMPAIRED - DRUNK ENOUGH TO CAUSE SEVERE INJURY/DEATH TO SELF" + CHR$(10)
  328.             prt_text = prt_text + "All mental, physical and sensory functions are severely impaired." + CHR$(10) + _
  329.                                   "Increased risk of asphyxiation from choking on vomit and of seriously injuring" + CHR$(10) + _
  330.                                   "yourself by falls or other accidents. It is illegal to operate a motor" + CHR$(10) + _
  331.                                   "vehicle at this level of intoxication in all states." + CHR$(10)
  332.         CASE .200 TO .2499
  333.             prt_text = prt_text + "YOU ARE EXTREMELY DRUNK" + CHR$(10)
  334.             prt_text = prt_text + "Feeling dazed/confused or otherwise disoriented. May need help to" + CHR$(10) + _
  335.                                   "stand/walk. If you injure yourself you may not feel the pain. Some" + CHR$(10) + _
  336.                                   "people have nausea and vomiting at this level. The gag reflex" + CHR$(10) + _
  337.                                   "is impaired and you can choke if you do vomit. Blackouts are likely" + CHR$(10) + _
  338.                                   "at this level so you may not remember what has happened. It is illegal" + CHR$(10) + _
  339.                                   "to operate a motor vehicle at this level of intoxication in all states." + CHR$(10)
  340.         CASE .160 TO .1999
  341.             prt_text = prt_text + "YOUR ARE SEVERLY DRUNK - ENOUGH TO BECOME VERY SICK" + CHR$(10)
  342.             prt_text = prt_text + "Dysphoria* predominates, nausea may appear. The drinker has the appearance" + CHR$(10) + _
  343.                                   "of a 'sloppy drunk.' It is illegal to operate a motor vehicle at this level" + CHR$(10) + _
  344.                                   "of intoxication in all states." + CHR$(10) + CHR$(10) + _
  345.                                   "* Dysphoria: An emotional state of anxiety, depression, or unease." + CHR$(10)
  346.         CASE .130 TO .1599
  347.             prt_text = prt_text + "YOU ARE VERY DRUNK - ENOUGH TO LOSE PHYSICAL & MENTAL CONTROL" + CHR$(10)
  348.             prt_text = prt_text + "Gross motor impairment and lack of physical control. Blurred vision and major" + CHR$(10) + _
  349.                                   "loss of balance. Euphoria is reduced and dysphoria* is beginning to appear." + CHR$(10) + _
  350.                                   "Judgment and perception are severely impaired. It is illegal to operate a " + CHR$(10) + _
  351.                                   "motor vehicle at this level of intoxication in all states." + CHR$(10) + CHR$(10)
  352.             prt_text = prt_text + "* Dysphoria: An emotional state of anxiety, depression, or unease." + CHR$(10)
  353.         CASE .100 TO .1299
  354.             prt_text = prt_text + "YOU ARE LEGALLY DRUNK" + CHR$(10)
  355.             prt_text = prt_text + "Significant impairment of motor coordination and loss of good judgment." + CHR$(10) + _
  356.                                   "Speech may be slurred; balance, vision, reaction time and hearing will be" + CHR$(10) + _
  357.                                   "impaired. Euphoria. It is illegal to operate a motor vehicle at this level" + CHR$(10) + _
  358.                                   "of intoxication in all states." + CHR$(10)
  359.         CASE .070 TO .0999
  360.             prt_text = prt_text + "YOU MAY BE LEGALLY DRUNK" + CHR$(10)
  361.             prt_text = prt_text + "Slight impairment of balance, speech, vision, reaction time, and hearing." + CHR$(10) + _
  362.                                   "Euphoria. Judgment and self-control are reduced, and caution, reason and" + CHR$(10) + _
  363.                                   "memory are impaired (in some* states .08 is legally impaired and it is illegal" + CHR$(10) + _
  364.                                   "to drive at this level). You will probably believe that you are functioning" + CHR$(10) + _
  365.                                   "better than you really are." + CHR$(10) + CHR$(10)
  366.             prt_text = prt_text + "(*** As of July, 2004 ALL states had passed .08 BAC Per Se Laws. The final" + CHR$(10) + _
  367.                                   "one took effect in August of 2005.)" + CHR$(10)
  368.         CASE .040 TO .0699
  369.             prt_text = prt_text + "YOU MAY BE LEGALLY BUZZED" + CHR$(10)
  370.             prt_text = prt_text + "Feeling of well-being, relaxation, lower inhibitions, sensation of warmth." + CHR$(10) + _
  371.                                   "Euphoria. Some minor impairment of reasoning and memory, lowering of caution." + CHR$(10) + _
  372.                                   "Your behavior may become exaggerated and emotions intensified (Good emotions" + CHR$(10) + _
  373.                                   "are better, bad emotions are worse)" + CHR$(10)
  374.         CASE .020 TO .0399
  375.             prt_text = prt_text + "YOU MAY BE OK TO DRIVE, BUT IMPAIRMENT BEGINS" + CHR$(10)
  376.             prt_text = prt_text + "No loss of coordination, slight euphoria and loss of shyness. Depressant effects" + CHR$(10) + _
  377.                                   "are not apparent. Mildly relaxed and maybe a little lightheaded." + CHR$(10)
  378.         CASE .000 TO .0199
  379.             prt_text = prt_text + "YOU ARE OK TO DRIVE" + CHR$(10)
  380.     END SELECT
  381.  
  382. '-----------------------------------------------------------
  383. '*** Determine if Drunk (>.08 EBAC) and calculate:
  384. '***    - When user will be less than .08
  385. '***    - How long it will take to become completely sober
  386.     IF EBAC > .08 THEN
  387.         SOBER = False
  388.         CEBAC = EBAC
  389.         st = T
  390.         DO UNTIL SOBER = True
  391.             T = T + 1
  392.             IF CEBAC > .0799 THEN I = I + 1
  393.  
  394.             SELECT CASE Sex
  395.                 CASE "M"
  396.                     B = .017
  397.                     CEBAC = 7.97 * FLoz / Wt - B * T
  398.                 CASE "F"
  399.                     B = .019
  400.                     CEBAC = 9.86 * FLoz / Wt - B * T
  401.             END SELECT
  402.  
  403.             IF legalToDrive = False THEN
  404.                 IF CEBAC < .08 THEN
  405.                     prt_text = prt_text + CHR$(10) + CHR$(10) + "It will take about " + strFormat$(STR$(I), "##") + " hours from your last drink to be able to drive." + CHR$(10)
  406.                     legalToDrive = True
  407.                 END IF
  408.             END IF
  409.  
  410.             IF CEBAC <= 0 THEN
  411.                 prt_text = prt_text + "It will take about " + strFormat$(STR$(T - st), "##") + " hours from your last drink to be completely sober."
  412.                 SOBER = True
  413.             END IF
  414.         LOOP
  415.     END IF
  416.  
  417.  
  418.  
  419. FUNCTION strFormat$ (text AS STRING, template AS STRING)
  420. '-----------------------------------------------------------------------------
  421. ' *** Return a formatted string to a variable
  422. '
  423.     d = _DEST: s = _SOURCE
  424.     n = _NEWIMAGE(80, 80, 0)
  425.     _DEST n: _SOURCE n
  426.     PRINT USING template; VAL(text)
  427.     FOR i = 1 TO 79
  428.         t$ = t$ + CHR$(SCREEN(1, i))
  429.     NEXT
  430.     IF LEFT$(t$, 1) = "%" THEN t$ = MID$(t$, 2)
  431.     strFormat$ = _TRIM$(t$)
  432.     _DEST d: _SOURCE s
  433.     _FREEIMAGE n
  434.  
  435.  

And the Form file:
Code: QB64: [Select]
  1. ': This form was generated by
  2. ': InForm - GUI library for QB64 - v1.3
  3. ': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - [member=2]FellippeHeitor[/member]
  4. ': https://github.com/FellippeHeitor/InForm
  5. '-----------------------------------------------------------
  6. SUB __UI_LoadForm
  7.  
  8.     DIM __UI_NewID AS LONG, __UI_RegisterResult AS LONG
  9.  
  10.     __UI_NewID = __UI_NewControl(__UI_Type_Form, "ebacFRM", 618, 630, 0, 0, 0)
  11.     __UI_RegisterResult = 0
  12.     SetCaption __UI_NewID, "EBAC - ESTIMATED BLOOD ALCOHOL CONTENT CALCULATOR"
  13.     Control(__UI_NewID).Font = SetFont("Fonts/arial.ttf", 16)
  14.     Control(__UI_NewID).HasBorder = False
  15.  
  16.     __UI_NewID = __UI_NewControl(__UI_Type_Label, "SexLB", 40, 26, 232, 64, 0)
  17.     __UI_RegisterResult = 0
  18.     SetCaption __UI_NewID, "Sex:"
  19.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  20.     Control(__UI_NewID).HasBorder = False
  21.     Control(__UI_NewID).VAlign = __UI_Middle
  22.  
  23.     __UI_NewID = __UI_NewControl(__UI_Type_Label, "weightLB", 99, 25, 173, 91, 0)
  24.     __UI_RegisterResult = 0
  25.     SetCaption __UI_NewID, "Weight (lbs):"
  26.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  27.     Control(__UI_NewID).HasBorder = False
  28.     Control(__UI_NewID).VAlign = __UI_Middle
  29.  
  30.     __UI_NewID = __UI_NewControl(__UI_Type_Label, "nbrdrinksLB", 138, 25, 134, 121, 0)
  31.     __UI_RegisterResult = 0
  32.     SetCaption __UI_NewID, "Number of drinks:"
  33.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  34.     Control(__UI_NewID).HasBorder = False
  35.     Control(__UI_NewID).VAlign = __UI_Middle
  36.  
  37.     __UI_NewID = __UI_NewControl(__UI_Type_Label, "timeLB", 202, 25, 70, 151, 0)
  38.     __UI_RegisterResult = 0
  39.     SetCaption __UI_NewID, "Time (hrs) from first drink:"
  40.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  41.     Control(__UI_NewID).HasBorder = False
  42.     Control(__UI_NewID).VAlign = __UI_Middle
  43.  
  44.     __UI_NewID = __UI_NewControl(__UI_Type_Label, "EnterInformationLB", 440, 31, 16, 17, 0)
  45.     __UI_RegisterResult = 0
  46.     SetCaption __UI_NewID, "Enter information about your or your friend:"
  47.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 18)
  48.     Control(__UI_NewID).HasBorder = False
  49.     Control(__UI_NewID).VAlign = __UI_Middle
  50.  
  51.     __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "WeightTB", 50, 23, 278, 92, 0)
  52.     __UI_RegisterResult = 0
  53.     Control(__UI_NewID).Font = SetFont("", 16)
  54.     Control(__UI_NewID).HasBorder = True
  55.     Control(__UI_NewID).Min = -32768
  56.     Control(__UI_NewID).Max = 32767
  57.     Control(__UI_NewID).CanHaveFocus = True
  58.     Control(__UI_NewID).BorderSize = 1
  59.     Control(__UI_NewID).NumericOnly = __UI_NumericWithBounds
  60.  
  61.     __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "nbrDrinksTB", 50, 23, 278, 121, 0)
  62.     __UI_RegisterResult = 0
  63.     Control(__UI_NewID).Font = SetFont("", 16)
  64.     Control(__UI_NewID).HasBorder = True
  65.     Control(__UI_NewID).Min = -32768
  66.     Control(__UI_NewID).Max = 32767
  67.     Control(__UI_NewID).CanHaveFocus = True
  68.     Control(__UI_NewID).BorderSize = 1
  69.     Control(__UI_NewID).NumericOnly = __UI_NumericWithBounds
  70.  
  71.     __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "TimeTB", 50, 25, 277, 151, 0)
  72.     __UI_RegisterResult = 0
  73.     Control(__UI_NewID).Font = SetFont("", 16)
  74.     Control(__UI_NewID).HasBorder = True
  75.     Control(__UI_NewID).Min = -32768
  76.     Control(__UI_NewID).Max = 32767
  77.     Control(__UI_NewID).CanHaveFocus = True
  78.     Control(__UI_NewID).BorderSize = 1
  79.     Control(__UI_NewID).NumericOnly = __UI_NumericWithBounds
  80.  
  81.     __UI_NewID = __UI_NewControl(__UI_Type_Button, "CancelBT", 99, 30, 435, 99, 0)
  82.     __UI_RegisterResult = 0
  83.     SetCaption __UI_NewID, "&Cancel"
  84.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  85.     Control(__UI_NewID).HasBorder = False
  86.     Control(__UI_NewID).CanHaveFocus = True
  87.  
  88.     __UI_NewID = __UI_NewControl(__UI_Type_Button, "OKBT", 99, 30, 435, 63, 0)
  89.     __UI_RegisterResult = 0
  90.     SetCaption __UI_NewID, "&OK"
  91.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  92.     Control(__UI_NewID).HasBorder = False
  93.     Control(__UI_NewID).CanHaveFocus = True
  94.  
  95.     __UI_NewID = __UI_NewControl(__UI_Type_Button, "HELPBT", 99, 30, 435, 134, 0)
  96.     __UI_RegisterResult = 0
  97.     SetCaption __UI_NewID, "&HELP"
  98.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  99.     Control(__UI_NewID).HasBorder = False
  100.     Control(__UI_NewID).CanHaveFocus = True
  101.  
  102.     __UI_NewID = __UI_NewControl(__UI_Type_Button, "QUITBT", 99, 30, 435, 170, 0)
  103.     __UI_RegisterResult = 0
  104.     SetCaption __UI_NewID, "&QUIT"
  105.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  106.     Control(__UI_NewID).HasBorder = False
  107.     Control(__UI_NewID).CanHaveFocus = True
  108.  
  109.     __UI_NewID = __UI_NewControl(__UI_Type_Label, "informationLB", 210, 17, 22, 194, 0)
  110.     __UI_RegisterResult = 0
  111.     SetCaption __UI_NewID, "Information Display"
  112.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  113.     Control(__UI_NewID).HasBorder = False
  114.     Control(__UI_NewID).VAlign = __UI_Middle
  115.     Control(__UI_NewID).BorderSize = 1
  116.  
  117.     __UI_NewID = __UI_NewControl(__UI_Type_ListBox, "displayResults", 576, 320, 20, 213, 0)
  118.     __UI_RegisterResult = 0
  119.     Control(__UI_NewID).Font = SetFont("Fonts/Courier New.ttf", 12)
  120.     Control(__UI_NewID).HasBorder = True
  121.     Control(__UI_NewID).CanHaveFocus = True
  122.     Control(__UI_NewID).BorderSize = 2
  123.  
  124.     __UI_NewID = __UI_NewControl(__UI_Type_Button, "AGREEBT", 99, 31, 495, 574, 0)
  125.     __UI_RegisterResult = 0
  126.     SetCaption __UI_NewID, "&AGREE"
  127.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  128.     Control(__UI_NewID).HasBorder = False
  129.     Control(__UI_NewID).CanHaveFocus = True
  130.     Control(__UI_NewID).Disabled = True
  131.  
  132.     __UI_NewID = __UI_NewControl(__UI_Type_CheckBox, "AgreeCB", 564, 23, 26, 544, 0)
  133.     __UI_RegisterResult = 0
  134.     SetCaption __UI_NewID, "I agree that this programand its results are not legally binding."
  135.     Control(__UI_NewID).HasBorder = False
  136.     Control(__UI_NewID).CanHaveFocus = True
  137.  
  138.     __UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "maleRB", 40, 23, 277, 64, 0)
  139.     __UI_RegisterResult = 0
  140.     SetCaption __UI_NewID, "M"
  141.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  142.     Control(__UI_NewID).HasBorder = False
  143.     Control(__UI_NewID).CanHaveFocus = True
  144.  
  145.     __UI_NewID = __UI_NewControl(__UI_Type_RadioButton, "femaleRB", 40, 23, 322, 64, 0)
  146.     __UI_RegisterResult = 0
  147.     SetCaption __UI_NewID, "F"
  148.     Control(__UI_NewID).Font = SetFont("Fonts/Arial Black.ttf", 14)
  149.     Control(__UI_NewID).HasBorder = False
  150.     Control(__UI_NewID).CanHaveFocus = True
  151.  
  152.  
  153. SUB __UI_AssignIDs
  154.     ebacFRM = __UI_GetID("ebacFRM")
  155.     SexLB = __UI_GetID("SexLB")
  156.     weightLB = __UI_GetID("weightLB")
  157.     nbrdrinksLB = __UI_GetID("nbrdrinksLB")
  158.     timeLB = __UI_GetID("timeLB")
  159.     EnterInformationLB = __UI_GetID("EnterInformationLB")
  160.     WeightTB = __UI_GetID("WeightTB")
  161.     nbrDrinksTB = __UI_GetID("nbrDrinksTB")
  162.     TimeTB = __UI_GetID("TimeTB")
  163.     CancelBT = __UI_GetID("CancelBT")
  164.     OKBT = __UI_GetID("OKBT")
  165.     HELPBT = __UI_GetID("HELPBT")
  166.     QUITBT = __UI_GetID("QUITBT")
  167.     informationLB = __UI_GetID("informationLB")
  168.     displayResults = __UI_GetID("displayResults")
  169.     AGREEBT = __UI_GetID("AGREEBT")
  170.     AgreeCB = __UI_GetID("AgreeCB")
  171.     maleRB = __UI_GetID("maleRB")
  172.     femaleRB = __UI_GetID("femaleRB")
  173.  

Here is the complete ZIP file, that contains all the source, fonts, and text files needed to run the program: 
____________________________________________________________________
George McGinn
Theoretical/Applied Computer Scientist
Member: IEEE, IEEE Computer Society
Technical Council on Software Engineering
IEEE Standards Association
American Association for the Advancement of Science (AAAS)

FellippeHeitor

  • Guest
Re: EBAC Calculator
« Reply #1 on: October 14, 2021, 05:11:32 pm »
Great adaptation, George - precisely the kind of app that benefits from InForm, due to the type of input. Thanks for sharing!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: EBAC Calculator
« Reply #2 on: October 14, 2021, 05:14:45 pm »
Interesting. A program that merits both cheers and booze.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline George McGinn

  • Global Moderator
  • Forum Regular
  • Posts: 210
    • View Profile
    • Resume
Re: EBAC Calculator
« Reply #3 on: October 14, 2021, 05:40:22 pm »
I'll drink to that!  Cheers!

Interesting. A program that merits both cheers and booze.

Pete
____________________________________________________________________
George McGinn
Theoretical/Applied Computer Scientist
Member: IEEE, IEEE Computer Society
Technical Council on Software Engineering
IEEE Standards Association
American Association for the Advancement of Science (AAAS)

Offline Qwerkey

  • Forum Resident
  • Posts: 755
    • View Profile
Re: EBAC Calculator
« Reply #4 on: October 16, 2021, 04:59:13 am »
Great to have a member writing InForm programs.

Very small point: your form has a typo: "I agree that this programand its results are not legally binding." Space missing after 'program'.

Richard

Offline George McGinn

  • Global Moderator
  • Forum Regular
  • Posts: 210
    • View Profile
    • Resume
Re: EBAC Calculator
« Reply #5 on: October 16, 2021, 09:52:21 am »
Caught that after I posted.

Great to have a member writing InForm programs.

Very small point: your form has a typo: "I agree that this programand its results are not legally binding." Space missing after 'program'.

Richard
____________________________________________________________________
George McGinn
Theoretical/Applied Computer Scientist
Member: IEEE, IEEE Computer Society
Technical Council on Software Engineering
IEEE Standards Association
American Association for the Advancement of Science (AAAS)