home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PMCBDEMO.ZIP / PMDEMO2.CBL < prev    next >
Text File  |  1990-06-04  |  40KB  |  985 lines
  1.       $set ans85 mf noosvs defaultbyte"00" callfh"extfh"
  2.       *--------------------------------------------------------------*
  3.       * PMDEMO2.CBL
  4.       *
  5.       * Sample program using entry fields defined in a resource file
  6.       * and graphic display of entered values. These values are
  7.       * written to an Indexed file
  8.       * Copyright 1989, Micro Focus Ltd.
  9.       * Author B J Edwards
  10.       *--------------------------------------------------------------*
  11.        environment division.
  12.        special-names.
  13.         call-convention 3 is OS2API.
  14.       *---------------------------------------------------------*
  15.        input-output section.
  16.        file-control.
  17.            select PmFile assign "demofile.ism"
  18.            organization is indexed
  19.            record key is file-record-key
  20.            access is dynamic.
  21.  
  22.        file section.
  23.        fd  PmFile.
  24.        01  PmFileRecord.
  25.             03 file-record-key     pic x(5).
  26.             03 file-field-contents pic x(48).
  27.  
  28.        working-storage section.
  29.  
  30.       *---------------------------------------------------------*
  31.       *  COBOL Copy libraries containing relevant constants
  32.       *---------------------------------------------------------*
  33.            copy "HWND.78".
  34.            copy "SPTR.78".
  35.            copy "FCF.78".
  36.            copy "WM.78".
  37.            copy "WC.78".
  38.            copy "WS.78".
  39.            copy "CS.78".
  40.            copy "MB.78".
  41.            copy "MBID.78".
  42.            copy "DID.78".
  43.            copy "BM.78".
  44.            copy "EM.78".
  45.            copy "EN.78".
  46.            copy "DT.78".
  47.            copy "CLR.78".
  48.            copy "DRO.78".
  49.            copy "SWP.78".
  50.            copy "PATSYM.78".
  51.       *---------------------------------------------------------*
  52.        78  WM-MYMESSAGE            value H"1001".
  53.       *---------------------------------------------------------*
  54.            copy "pmdemo2.cpy".
  55.  
  56.        78 ID-WINDOW                         VALUE 2.
  57.        01  work-data.
  58.            03  hab                 pic 9(9) comp-5.
  59.            03  hmq                 pic 9(9) comp-5.
  60.            03  hwndClient          pic 9(9) comp-5.
  61.            03  hwndGraphClient     pic 9(9) comp-5.
  62.            03  hwndFrame           pic 9(9) comp-5.
  63.            03  hwndGraphFrame      pic 9(9) comp-5.
  64.            03  hwndDialog          pic 9(9) comp-5.
  65.            03  temp-hwnd           pic 9(9) comp-5.
  66.            03  flFrameFlags        pic 9(9) comp-5.
  67.            03  szClientClass       pic x(20)  value 'pmdemo2'.
  68.            03                      pic x      value x"00".
  69.            03  szGraphClass        pic x(20)  value 'graph'.
  70.            03                      pic x      value x"00".
  71.            03  GraphTitle          pic x(20)  value 'Graphs Display'.
  72.            03                      pic x      value x"00".
  73.            03  Header-text.
  74.                05                  pic x(11)  value "Sales for: ".
  75.                05  title-key       pic x(6).
  76.                05                  pic x      value x"00".
  77.            03  nullText            pic x      value x"00".
  78.            03  loop-flag           pic x      value 'C'.
  79.                88  loop-end                   value 'E'.
  80.            03  ModHandle           pic s9(4) comp-5.
  81.            03  ModName             pic x(7) value "PMDEMO2".
  82.            03                      pic x value x"00".
  83.            03  bool                pic 9(4) comp-5.
  84.                88  boolTRUE                   value 1.
  85.                88  boolFALSE                  value 0.
  86.            copy "qmsg.cpy".
  87.  
  88.            03  strlen              pic s9(9) comp-5.
  89.            03  ClientWndProc       procedure-pointer.
  90.            03  AboutDlgProc        procedure-pointer.
  91.            03  KeyDlgProc          procedure-pointer.
  92.            03  DataDlgProc         procedure-pointer.
  93.            03  GraphsWndProc       procedure-pointer.
  94.         01 numeric-message.
  95.            03  pic x(30) value "WARNING: Non numeric value in ".
  96.            03  month-msg pic x(10).
  97.            03                      pic x      value x"00".
  98.         01 save-message.
  99.            03  pic x(30) value "Do you wish to save the data".
  100.            03                      pic x      value x"00".
  101.         01 month-names.
  102.            03       pic x(10) value "January".
  103.            03       pic x(10) value "February".
  104.            03       pic x(10) value "March".
  105.            03       pic x(10) value "April".
  106.            03       pic x(10) value "May".
  107.            03       pic x(10) value "June".
  108.            03       pic x(10) value "July".
  109.            03       pic x(10) value "August".
  110.            03       pic x(10) value "September".
  111.            03       pic x(10) value "October".
  112.            03       pic x(10) value "November".
  113.            03       pic x(10) value "December".
  114.  
  115.         01 redefines month-names.
  116.            03 month-name           pic x(10) occurs 12.
  117.  
  118.         01  MY-MB                  pic 9(4) comp-5.
  119.  
  120.         01  entry-field-contents.
  121.             03 Jan-entry-data        pic x(3).
  122.             03                       pic x value x"00".
  123.             03 Feb-entry-data        pic x(3).
  124.             03                       pic x value x"00".
  125.             03 Mar-entry-data        pic x(3).
  126.             03                       pic x value x"00".
  127.             03 Apr-entry-data        pic x(3).
  128.             03                       pic x value x"00".
  129.             03 May-entry-data        pic x(3).
  130.             03                       pic x value x"00".
  131.             03 Jun-entry-data        pic x(3).
  132.             03                       pic x value x"00".
  133.             03 Jul-entry-data        pic x(3).
  134.             03                       pic x value x"00".
  135.             03 Aug-entry-data        pic x(3).
  136.             03                       pic x value x"00".
  137.             03 Sep-entry-data        pic x(3).
  138.             03                       pic x value x"00".
  139.             03 Oct-entry-data        pic x(3).
  140.             03                       pic x value x"00".
  141.             03 Nov-entry-data        pic x(3).
  142.             03                       pic x value x"00".
  143.             03 Dec-entry-data        pic x(3).
  144.             03                       pic x value x"00".
  145.        01  redefines entry-field-contents.
  146.             03 entry-field-data      pic x(4) occurs 12.
  147.        01  input-key-field.
  148.             03  key-data             pic x(6).
  149.             03                       pic x value x"00".
  150.  
  151.        01  real-numeric-values.
  152.            03  real-num-val          pic 9(4) comp-5 occurs 12.
  153.  
  154.        01  saved-contents            pic x(60).
  155.  
  156.        01  test-char                 pic x.
  157.        01  test-num redefines test-char pic 99 comp.
  158.        01  i                       pic 99 comp-5.
  159.  
  160.        01 entry-field-handles.
  161.            03  hwndEntryField      pic 9(9) comp-5 occurs 12.
  162.        01  hwndKeyField            pic 9(9) comp-5.
  163.        01  hwndKeyDisplay          pic 9(9) comp-5.
  164.  
  165.        01  temp-mp1                pic xxxx comp-5.
  166.        01  redefines temp-mp1.
  167.            03  temp-mp1w1          pic xx   comp-5.
  168.            03  temp-mp1w2          pic xx   comp-5.
  169.  
  170.        01  temp-short              pic 9(4) comp-5.
  171.        01  temp-bytes1             pic x(3).
  172.        01  temp-bytes2             pic x(3).
  173.        01  swp-param               pic 9(4) comp-5.
  174.        01  text-draw               pic 9(4) comp-5.
  175.  
  176.        01  short-vars.
  177.            03  cxChar      pic s9(4) comp-5.
  178.            03  cxCaps      pic s9(4) comp-5.
  179.            03  cyChar      pic s9(4) comp-5.
  180.            03  cyDesc      pic s9(4) comp-5.
  181.            03  cxClient    pic s9(4) comp-5.
  182.            03  cyClient    pic s9(4) comp-5.
  183.  
  184.        01  entry-field-index       pic 9(4) comp-5.
  185.  
  186.        01  n                       pic 99 comp-5.
  187.        01  loop-flag               pic 99 comp-5.
  188.            88  loop-not-terminated value 0.
  189.            88  loop-terminated     value 1.
  190.        01  numeric-flag            pic 99 comp-5.
  191.            88  numerics-fail       value 0.
  192.            88  numerics-pass       value 1.
  193.        01  key-flag                pic 99 comp-5.
  194.            88  key-empty           value 0.
  195.            88  key-not-empty       value 1.
  196.  
  197.        01  fail-index              pic 9(4) comp-5.
  198.  
  199.        01  workarea.
  200.             03  temp-word       pic xx   comp-5.
  201.             03  REDEFINES temp-word.
  202.                 05 temp-ls      pic x   comp-5.
  203.                 05 temp-ms      pic x   comp-5.
  204.             03  temp-snum1          pic s9(4) comp-5.
  205.             03  temp-snum2          pic s9(4) comp-5.
  206.             03  temp-snum3          pic s9(4) comp-5.
  207.             03  temp-snum4          pic s9(4) comp-5.
  208.  
  209.        01  temp-line.
  210.            03  temp-char           pic x occurs 20.
  211.        01  temp-ind                pic 9(4) comp-5.
  212.        01  temp-ind1               pic 9(4) comp-5.
  213.        01  temp-ind2               pic 9(4) comp-5.
  214.  
  215.       *---------------------------------------------------------*
  216.        local-storage section.
  217.        01  ptl.
  218.            03  x        pic s9(9) comp-5.
  219.            03  y        pic s9(9) comp-5.
  220.  
  221.        01  hps                     pic 9(9) comp-5.
  222.  
  223.        01  mresult                 pic s9(9) comp-5.
  224.        01  rcl.
  225.            copy "rectl.cpy".
  226.  
  227.        01 others.
  228.            78 fm-start value NEXT.
  229.            copy "FONTMETR.CPY".
  230.            78 size-of-fm value NEXT - fm-start.
  231.  
  232.       *---------------------------------------------------------*
  233.        linkage section.
  234.  
  235.        01  hwnd                    pic xxxx comp-5.
  236.        01  msg                     pic xx   comp-5.
  237.  
  238.        01  mp1                     pic xxxx comp-5.
  239.        01  redefines mp1.
  240.            03  mp1w1               pic xx   comp-5.
  241.            03  mp1w2               pic xx   comp-5.
  242.  
  243.        01  mp2                     pic xxxx comp-5.
  244.        01  redefines mp2.
  245.            03  mp2w1               pic xx   comp-5.
  246.            03  mp2w2               pic xx   comp-5.
  247.  
  248.       *---------------------------------------------------------*
  249.        procedure division OS2API.
  250.        main section.
  251.            perform start-up
  252.            perform register-classes
  253.            if boolTRUE
  254.                perform create-client-window
  255.                if hwndFrame not = 0
  256.                     perform message-loop until loop-end
  257.                end-if
  258.            end-if
  259.            perform shut-down
  260.            stop run.
  261.       *---------------------------------------------------------*
  262.        start-up section.
  263.            open i-o PmFile
  264.            perform find-resource-handle
  265.            perform set-procedure-entry-point
  266.            call OS2API 'WinInitialize'
  267.                        using   by value 0 size 2
  268.                        returning hab
  269.  
  270.            call OS2API 'WinCreateMsgQueue'
  271.                        using by value hab
  272.                              by value 0 size 2
  273.                        returning hmq.
  274.       *---------------------------------------------------------*
  275.        set-procedure-entry-point section.
  276.            set ClientWndProc  to ENTRY 'ClientWndProc'
  277.            set AboutDlgProc   to ENTRY 'AboutDlgProc'
  278.            set KeyDlgProc     to ENTRY 'KeyDlgProc'.
  279.            set DataDlgProc    to ENTRY 'DataDlgProc'.
  280.            set GraphsWndProc  to ENTRY 'GraphsWndProc'.
  281.       *---------------------------------------------------------*
  282.        register-classes section.
  283.            call OS2API 'WinRegisterClass'
  284.                        using by value     hab
  285.                              by reference szClientClass
  286.                              by value     ClientWndProc
  287.                              by value     CS-SIZEREDRAW size 4
  288.                              by value     0        size 2
  289.                        returning bool.
  290.            call OS2API 'WinRegisterClass'
  291.                        using by value     hab
  292.                              by reference szGraphClass
  293.                              by value     GraphsWndProc
  294.                              by value     CS-SIZEREDRAW size 4
  295.                              by value     0        size 2
  296.                        returning bool.
  297.       *---------------------------------------------------------*
  298.        message-loop section.
  299.            call OS2API 'WinGetMsg'
  300.                          using   by value hab
  301.                                  by reference qmsg
  302.                                  by value 0            size 4
  303.                                  by value 0            size 2
  304.                                  by value 0            size 2
  305.                          returning bool
  306.  
  307.            if boolFALSE
  308.                 set loop-end to true
  309.            else
  310.                 call OS2API 'WinDispatchMsg'
  311.                          using by value hab
  312.                                by reference qmsg
  313.            end-if.
  314.       *---------------------------------------------------------*
  315.        find-resource-handle section.
  316.            call OS2API 'DosGetModHandle'
  317.                            using by reference ModName
  318.                                  by reference ModHandle
  319.                            returning bool
  320.            if not boolFALSE
  321.                move 0 to ModHandle
  322.            end-if.
  323.       *---------------------------------------------------------*
  324.        shut-down section.
  325.            call OS2API 'WinDestroyWindow'   using by value
  326.                                                    hwndGraphClient
  327.            call OS2API 'WinDestroyWindow'   using by value hwndFrame
  328.            call OS2API 'WinDestroyMsgQueue' using by value hmq
  329.            call OS2API 'WinTerminate'       using by value hab
  330.            close PmFile.
  331.       *---------------------------------------------------------*
  332.        create-client-window section.
  333.            compute flFrameFlags = FCF-TITLEBAR      + FCF-SYSMENU
  334.                                 + FCF-SIZEBORDER    + FCF-MINMAX
  335.                                 + FCF-SHELLPOSITION + FCF-TASKLIST
  336.                                 + FCF-MENU          + FCF-ICON
  337.  
  338.            call OS2API 'WinCreateStdWindow'
  339.                             using by value     HWND-DESKTOP size 4
  340.                                   by value     WS-VISIBLE   size 4
  341.                                   by reference flFrameFlags
  342.                                   by reference szClientClass
  343.                                   by reference nulltext
  344.                                   by value     0            size 4
  345.                                   by value     ModHandle
  346.                                   by value     ID-RESOURCE  size 2
  347.                                   by reference hwndClient
  348.                             returning hwndFrame
  349.  
  350.            compute flFrameFlags = FCF-TITLEBAR
  351.                                 + FCF-SHELLPOSITION + FCF-BORDER
  352.  
  353.            call OS2API 'WinCreateStdWindow'
  354.                             using by value     hwndClient
  355.                                   by value     WS-VISIBLE   size 4
  356.                                   by reference flFrameFlags
  357.                                   by reference szGraphClass
  358.                                   by reference GraphTitle
  359.                                   by value     0            size 4
  360.                                   by value     0            size 2
  361.                                   by value     0            size 2
  362.                                   by reference hwndGraphClient
  363.                             returning hwndGraphFrame.
  364.       *---------------------------------------------------------*
  365.        MyClientWndProc section.
  366.  
  367.        entry 'ClientWndProc' using
  368.                               by value hwnd
  369.                   by value msg
  370.                   by value mp1
  371.                   by value mp2.
  372.  
  373.            evaluate msg
  374.                when WM-CREATE
  375.                    perform WM-CREATE-routine
  376.  
  377.                when WM-COMMAND
  378.                    perform WM-COMMAND-routine
  379.  
  380.                when WM-PAINT
  381.                    perform WM-PAINT-routine
  382.  
  383.                when OTHER
  384.                    perform WM-Default-Window-routine
  385.  
  386.            end-evaluate
  387.  
  388.            exit program returning mresult.
  389.  
  390.        WM-COMMAND-routine section.
  391.            evaluate mp1w1
  392.  
  393.                when IDM-ENTRIES
  394.  
  395.                    call OS2API 'WinDlgBox'
  396.                       using by value HWND-DESKTOP size 4
  397.                             by value hwnd
  398.                             by value KeyDlgProc
  399.                             by value modHandle
  400.                             by value IDD-KEY size 2
  401.                             by value 0 size 4
  402.  
  403.                   perform check-for-empty-key
  404.  
  405.                   if key-not-empty
  406.                        call OS2API 'WinDlgBox'
  407.                           using by value HWND-DESKTOP size 4
  408.                                 by value hwnd
  409.                                 by value DataDlgProc
  410.                                 by value modHandle
  411.                                 by value IDD-DATA size 2
  412.                                 by value 0 size 4
  413.                   end-if
  414.  
  415.                when IDM-ABOUT
  416.                    call OS2API 'WinDlgBox'
  417.                       using by value HWND-DESKTOP size 4
  418.                             by value hwnd
  419.                             by value AboutDlgProc
  420.                             by value modHandle
  421.                             by value IDD-ABOUT size 2
  422.                             by value 0 size 4
  423.  
  424.            end-evaluate
  425.  
  426.            move 0 to mresult.
  427.  
  428.        WM-CREATE-routine section.
  429.  
  430.            move low-values to entry-field-contents
  431.            move 0 to mresult.
  432.  
  433.        WM-PAINT-routine section.
  434.            call OS2API 'WinBeginPaint' using
  435.                  by value hwnd
  436.                  by value 0 size 4
  437.                  by value 0 size 4
  438.               returning hps
  439.  
  440.            call OS2API 'GpiErase' using by value hps
  441.  
  442.            call OS2API 'WinEndPaint' using
  443.                  by value hps
  444.  
  445.            move 0 to mresult.
  446.  
  447.        WM-Default-Window-routine section.
  448.            call OS2API 'WinDefWindowProc'
  449.                  using by value hwnd
  450.                        by value msg
  451.                        by value mp1
  452.                        by value mp2
  453.                  returning mresult.
  454.  
  455.       *---------------------------------------------------------*
  456.        MyAboutDialogProc section.
  457.  
  458.        entry 'AboutDlgProc' using
  459.                               by value hwnd
  460.                   by value msg
  461.                   by value mp1
  462.                   by value mp2.
  463.           evaluate msg
  464.               when WM-COMMAND
  465.                   evaluate mp1w1
  466.                       when DID-OK
  467.                       when DID-CANCEL
  468.                           call OS2API 'WinDismissDlg' using
  469.                             by value hwnd
  470.                             by value 1 size 2
  471.                           move 0 to mresult
  472.                   end-evaluate
  473.               when other
  474.                   call OS2API 'WinDefDlgProc'
  475.                    using by value hwnd
  476.                          by value msg
  477.                          by value mp1
  478.                          by value mp2
  479.                    returning mresult
  480.           end-evaluate
  481.           exit program returning mresult.
  482.  
  483.       *---------------------------------------------------------*
  484.        MyDataDialogProc section.
  485.  
  486.        entry 'DataDlgProc' using
  487.                               by value hwnd
  488.                   by value msg
  489.                   by value mp1
  490.                   by value mp2.
  491.           evaluate msg
  492.               when WM-INITDLG
  493.                   move hwnd to hwndDialog
  494.                   call OS2API 'WinPostMsg' using
  495.                         by value hwnd
  496.                         by value WM-MYMESSAGE size 2
  497.                         by value 0 size 4
  498.                         by value 0 size 4
  499.  
  500.                   move 1 to mresult
  501.  
  502.               when WM-MYMESSAGE
  503.                   move saved-contents to entry-field-contents
  504.                   perform find-entry-handles
  505.                   perform find-display-handle
  506.                   perform set-entry-field-sizes
  507.                   perform fill-entry-fields
  508.                   perform fill-display-field
  509.  
  510.                   call OS2API 'WinSetFocus' using
  511.                         by value HWND-DESKTOP size 4
  512.                         by value hwndEntryField(1)
  513.  
  514.                   move 0 to mresult
  515.  
  516.               when WM-COMMAND
  517.                   evaluate mp1w1
  518.                       when DID-OK
  519.                           perform get-entry-field-values
  520.                           perform extract-numerics
  521.                           perform show-graph
  522.                           if numerics-fail
  523.                               move month-name(fail-index) to month-msg
  524.                               compute MY-MB = MB-ICONEXCLAMATION +
  525.                                               MB-ABORTRETRYIGNORE +
  526.                                               MB-DEFBUTTON2 +
  527.                                               MB-MOVEABLE
  528.                               call OS2API 'WinMessageBox'
  529.                                   using by value HWND-DESKTOP size 4
  530.                                         by value HWND-DESKTOP size 4
  531.                                         by reference numeric-message
  532.                                         by reference szClientClass
  533.                                         by value 0 size 2
  534.                                         by value MY-MB
  535.                                   returning temp-short
  536.                               evaluate temp-short
  537.                                when MBID-IGNORE
  538.                                  move entry-field-contents to
  539.                                                        saved-contents
  540.                                  perform save-record-to-disk
  541.                                  call OS2API 'WinDismissDlg' using
  542.                                        by value hwnd
  543.                                        by value 0 size 2
  544.                                when MBID-RETRY
  545.                                  call OS2API 'WinSetFocus' using
  546.                                      by value HWND-DESKTOP size 4
  547.                                      by value hwndEntryField(fail-index)
  548.                                when MBID-ABORT
  549.                                  call OS2API 'WinDismissDlg' using
  550.                                        by value hwnd
  551.                                        by value 0 size 2
  552.                                  move saved-contents to
  553.                                                  entry-field-contents
  554.                                  perform extract-numerics
  555.                                  perform show-graph
  556.                               end-evaluate
  557.                           else
  558.                               compute MY-MB = MB-ICONQUESTION +
  559.                                               MB-YESNO +
  560.                                               MB-MOVEABLE
  561.                               call OS2API 'WinMessageBox'
  562.                                   using by value HWND-DESKTOP size 4
  563.                                         by value HWND-DESKTOP size 4
  564.                                         by reference save-message
  565.                                         by reference szClientClass
  566.                                         by value 0 size 2
  567.                                         by value MY-MB
  568.                                   returning temp-short
  569.                               if temp-short = MBID-YES
  570.                                   move entry-field-contents to
  571.                                                        saved-contents
  572.                                   perform save-record-to-disk
  573.                               else
  574.                                   move saved-contents to
  575.                                                  entry-field-contents
  576.                                   perform extract-numerics
  577.                                   perform show-graph
  578.                               end-if
  579.                               call OS2API 'WinDismissDlg' using
  580.                                        by value hwnd
  581.                                        by value 0 size 2
  582.                           end-if
  583.                   end-evaluate
  584.  
  585.                   move 0 to mresult
  586.  
  587.               when other
  588.  
  589.                   call OS2API 'WinDefDlgProc' using
  590.                          by value hwnd
  591.                          by value msg
  592.                          by value mp1
  593.                          by value mp2
  594.                    returning mresult
  595.           end-evaluate
  596.           exit program returning mresult.
  597.  
  598.        MyKeyDialogProc section.
  599.  
  600.        entry 'KeyDlgProc' using
  601.                               by value hwnd
  602.                   by value msg
  603.                   by value mp1
  604.                   by value mp2.
  605.           evaluate msg
  606.               when WM-INITDLG
  607.                   move hwnd to hwndDialog
  608.                   call OS2API 'WinPostMsg' using
  609.                         by value hwnd
  610.                         by value WM-MYMESSAGE size 2
  611.                         by value 0 size 4
  612.                         by value 0 size 4
  613.  
  614.                   move 1 to mresult
  615.  
  616.               when WM-MYMESSAGE
  617.                   perform find-key-handle
  618.                   perform set-key-field-size
  619.                   perform fill-key-field
  620.  
  621.                   call OS2API 'WinSetFocus' using
  622.                         by value HWND-DESKTOP size 4
  623.                         by value hwndKeyField
  624.  
  625.                   move 0 to mresult
  626.  
  627.               when WM-COMMAND
  628.                   evaluate mp1w1
  629.                       when DID-OK
  630.                           perform get-key-field-value
  631.                           perform load-record-from-disk
  632.                           call OS2API 'WinDismissDlg' using
  633.                                        by value hwnd
  634.                                        by value 0 size 2
  635.                   end-evaluate
  636.  
  637.                   move 0 to mresult
  638.  
  639.               when other
  640.  
  641.                   call OS2API 'WinDefDlgProc' using
  642.                          by value hwnd
  643.                          by value msg
  644.                          by value mp1
  645.                          by value mp2
  646.                    returning mresult
  647.           end-evaluate
  648.           exit program returning mresult.
  649.  
  650.        find-entry-handles section.
  651.            move IDD-ENTRYFLDJAN to temp-short
  652.            move 1 to entry-field-index
  653.            perform 12 times
  654.                call OS2API 'WinWindowFromID' using
  655.                         by value hwnd
  656.                         by value temp-short
  657.                         returning temp-hwnd
  658.                move temp-hwnd to hwndEntryField(entry-field-index)
  659.                add 1 to temp-short
  660.                add 1 to entry-field-index
  661.            end-perform.
  662.  
  663.        find-display-handle section.
  664.            move IDD-KEYDISPLAY to temp-short
  665.                call OS2API 'WinWindowFromID' using
  666.                         by value hwnd
  667.                         by value temp-short
  668.                         returning temp-hwnd
  669.                move temp-hwnd to hwndKeyDisplay.
  670.  
  671.        find-key-handle section.
  672.            move IDD-ENTRYFLDKEY to temp-short
  673.            call OS2API 'WinWindowFromID' using
  674.                         by value hwnd
  675.                         by value temp-short
  676.                         returning temp-hwnd
  677.            move temp-hwnd to hwndKeyField.
  678.  
  679.        set-entry-field-sizes section.
  680.            move 3 to temp-mp1w1
  681.            move 0 to temp-mp1w2
  682.            move 1 to entry-field-index
  683.            perform 12 times
  684.                call OS2API 'WinSendMsg'using
  685.                    by value hwndEntryField(entry-field-index)
  686.                    by value EM-SETTEXTLIMIT   size 2
  687.                    by value temp-mp1
  688.                    by value 0            size 4
  689.                add 1 to entry-field-index
  690.            end-perform.
  691.  
  692.        set-key-field-size section.
  693.            move 6 to temp-mp1w1
  694.            move 0 to temp-mp1w2
  695.            call OS2API 'WinSendMsg'using
  696.                    by value hwndKeyField
  697.                    by value EM-SETTEXTLIMIT   size 2
  698.                    by value temp-mp1
  699.                    by value 0            size 4.
  700.  
  701.        fill-entry-fields section.
  702.            move 1 to entry-field-index
  703.            perform 12 times
  704.                call OS2API 'WinSetWindowText' using
  705.                   by value hwndEntryField(entry-field-index)
  706.                   by reference entry-field-data(entry-field-index)
  707.                add 1 to entry-field-index
  708.            end-perform.
  709.  
  710.        fill-display-field section.
  711.            call OS2API 'WinSetWindowText' using
  712.                   by value hwndKeyDisplay
  713.                   by reference input-key-field
  714.                   returning bool.
  715.  
  716.        fill-key-field section.
  717.            call OS2API 'WinSetWindowText' using
  718.                   by value hwndKeyField
  719.                   by reference input-key-field.
  720.  
  721.        get-entry-field-values section.
  722.            move low-values to entry-field-contents
  723.            move 1 to entry-field-index
  724.            perform 12 times
  725.                call OS2API 'WinQueryWindowText' using
  726.                    by value hwndEntryField(entry-field-index)
  727.                    by value 5 size 2
  728.                    by reference entry-field-data(entry-field-index)
  729.                returning bool
  730.                add 1 to entry-field-index
  731.            end-perform.
  732.  
  733.        get-key-field-value section.
  734.            move low-values to input-key-field
  735.            call OS2API 'WinQueryWindowText' using
  736.                    by value        hwndKeyField
  737.                    by value        7               size 2
  738.                    by reference    input-key-field
  739.                returning bool.
  740.  
  741.        extract-numerics section.
  742.            set numerics-pass to true
  743.            perform varying entry-field-index from 1 by 1 until
  744.                    entry-field-index > 12
  745.                move entry-field-data(entry-field-index) to temp-bytes1
  746.                move spaces to temp-bytes2
  747.                move 3 to n
  748.                if temp-bytes1(3:1) = low-values or spaces
  749.                    if temp-bytes1(2:1) = low-values or spaces
  750.                        if temp-bytes1(1:1) = low-values or spaces
  751.                            move temp-bytes1 to temp-bytes2
  752.                        else
  753.                            move temp-bytes1(1:1) to temp-bytes2(3:1)
  754.                        end-if
  755.                    else
  756.                        move temp-bytes1(1:2) to temp-bytes2(2:2)
  757.                    end-if
  758.                else
  759.                    move temp-bytes1 to temp-bytes2
  760.                end-if
  761.                inspect temp-bytes2 replacing leading low-values by "0"
  762.                inspect temp-bytes2 replacing leading spaces by "0"
  763.                if temp-bytes2 not numeric
  764.                    if numerics-pass
  765.                        set numerics-fail to true
  766.                        move entry-field-index to fail-index
  767.                    end-if
  768.                    move 0 to real-num-val(entry-field-index)
  769.                else
  770.                    move temp-bytes2 to real-num-val(entry-field-index)
  771.                end-if
  772.            end-perform.
  773.       *---------------------------------------------------------*
  774.        MyGraphsWndProc section.
  775.  
  776.        entry 'GraphsWndProc' using
  777.                               by value hwnd
  778.                               by value msg
  779.                               by value mp1
  780.                               by value mp2.
  781.  
  782.           evaluate msg
  783.                when WM-CREATE
  784.                    call OS2API 'WinGetPS'
  785.                                 using by value hwnd
  786.                                 returning hps
  787.  
  788.                    call OS2API 'GpiQueryFontMetrics'
  789.                                 using by value hps
  790.                                       by value size-of-fm size 4
  791.                                       by reference FONTMETRICS
  792.                                 returning bool
  793.  
  794.                    move FONTMETRICS-lEmInc          to cxCaps
  795.                    move FONTMETRICS-lMaxBaselineExt to cyChar
  796.                    move FONTMETRICS-lMaxDescender   to cyDesc
  797.  
  798.                    call OS2API 'WinReleasePS'
  799.                                 using by value hps
  800.  
  801.                    call OS2API 'WinPostMsg' using
  802.                         by value hwnd
  803.                         by value WM-MYMESSAGE size 2
  804.                         by value 0 size 4
  805.                         by value 0 size 4
  806.  
  807.                    move 0 to mresult
  808.  
  809.               when WM-MYMESSAGE
  810.                 call OS2API 'WinQueryWindowRect'
  811.                            using   by value hwndClient
  812.                                    by reference rcl
  813.  
  814.                 compute temp-snum1 = (RECTL-xRight / 4)
  815.                 compute temp-snum2 = 0
  816.                 compute temp-snum3 = (RECTL-xRight / 4 * 3)
  817.                 compute temp-snum4 = RECTL-yTop
  818.                 compute swp-param = SWP-DEACTIVATE + SWP-MOVE
  819.                                   + SWP-SHOW     + SWP-SIZE
  820.                 call OS2API 'WinSetWindowPos' using
  821.                         by value hwndGraphFrame
  822.                         by value HWND-TOP size 4
  823.                         by value temp-snum1
  824.                         by value temp-snum2
  825.                         by value temp-snum3
  826.                         by value temp-snum4
  827.                         by value swp-param
  828.                   move 0 to mresult
  829.  
  830.                when WM-SIZE
  831.                    move mp2w1 to cxClient
  832.                    move mp2w2 to cyClient
  833.                    move 0 to mresult
  834.  
  835.                when WM-PAINT
  836.                    call OS2API 'WinBeginPaint' using
  837.                          by value hwnd
  838.                          by value 0 size 4
  839.                          by value 0 size 4
  840.                       returning hps
  841.  
  842.                    call OS2API 'GpiErase' using by value hps
  843.                    perform draw-graph
  844.                    call OS2API 'WinEndPaint' using
  845.                         by value hps
  846.                    move 0 to mresult
  847.  
  848.                when WM-CLOSE
  849.                    move 0 to mresult
  850.  
  851.                when OTHER
  852.                    perform WM-Default-Window-routine
  853.           end-evaluate
  854.           exit program returning mresult.
  855.  
  856.        find-string-len section.
  857.            if temp-line = spaces
  858.                move 0 to temp-ind
  859.            else
  860.                perform varying temp-ind from 20 by -1 until
  861.                                         temp-char(temp-ind) not = spaces
  862.                end-perform
  863.            end-if
  864.            move temp-ind to strlen.
  865.  
  866.        draw-graph section.
  867.              call OS2API 'GpiSetPattern'
  868.                             using by value hps
  869.                                   by value PATSYM-HALFTONE size 4
  870.  
  871.              call OS2API 'GpiSetColor'
  872.                                 using by value hps
  873.                                       by value CLR-BLACK size 4
  874.              compute x = cxCaps + 50
  875.              compute y = cyClient - 2 * cyChar + cyDesc + 15
  876.              if key-data = spaces or low-values
  877.                  move spaces to temp-line
  878.              else
  879.                  move key-data to title-key
  880.                  move header-text to temp-line
  881.              end-if
  882.              perform find-string-len
  883.              call OS2API 'GpiCharStringAt'
  884.                                 using by value hps
  885.                                       by reference ptl
  886.                                       by value strlen
  887.                                       by reference temp-line
  888.  
  889.              perform varying entry-field-index
  890.               from 1 by 1 until entry-field-index > 12
  891.                move entry-field-index to temp-ind1
  892.                divide 2 into temp-ind1
  893.                multiply 2 by temp-ind1
  894.                if temp-ind1 = entry-field-index
  895.                    call OS2API 'GpiSetColor'
  896.                                 using by value hps
  897.                                       by value CLR-BLUE size 4
  898.                else
  899.                    call OS2API 'GpiSetColor'
  900.                                 using by value hps
  901.                                       by value CLR-RED size 4
  902.                end-if
  903.                move cxCaps to x
  904.                move entry-field-index to temp-ind
  905.                subtract 1 from temp-ind
  906.                divide temp-ind by 12 giving temp-ind1
  907.                                   remainder temp-ind2
  908.                compute y = cyClient - (temp-ind2 * 2.25 + 4)
  909.                                            * cyChar / 2 + cyDesc
  910.                move month-name(entry-field-index) to temp-line
  911.                perform find-string-len
  912.                call OS2API 'GpiCharStringAt'
  913.                                 using by value hps
  914.                                       by reference ptl
  915.                                       by value strlen
  916.                                       by reference temp-line
  917.  
  918.                compute x = cxCaps * 10
  919.                compute y = y - (cyDesc + cyChar / 2) + 5
  920.  
  921.                call OS2API 'GpiMove'
  922.                                 using by value hps
  923.                                       by reference ptl
  924.                compute x = x + real-num-val(entry-field-index) / 5
  925.                compute y = y + cyChar - 1
  926.                if real-num-val(entry-field-index) not = 0
  927.                    call OS2API 'GpiBox'
  928.                                 using by value hps
  929.                                       by value DRO-FILL size 4
  930.                                       by reference ptl
  931.                                       by value 0 size 4
  932.                                       by value 0 size 4
  933.                end-if
  934.            end-perform.
  935.  
  936.        show-graph section.
  937.            call OS2API 'WinUpdateWindow'
  938.                     using by value hwndGraphClient
  939.            call OS2API 'WinInvalidateRect'
  940.                     using by value hwndGraphClient
  941.                           by value 0 size 4
  942.                           by value 0 size 2.
  943.  
  944.        load-record-from-disk section.
  945.            perform capitalize-key
  946.            move input-key-field to file-record-key
  947.            read PmFile
  948.                invalid key
  949.                    move low-values to saved-contents
  950.                not invalid key
  951.                    move file-field-contents to saved-contents
  952.            end-read
  953.            move saved-contents to entry-field-contents
  954.            perform extract-numerics
  955.            perform show-graph.
  956.  
  957.         save-record-to-disk section.
  958.            perform capitalize-key
  959.            move input-key-field to file-record-key
  960.            move saved-contents to file-field-contents
  961.            write PmFileRecord
  962.                invalid key
  963.                    rewrite PmFileRecord
  964.                    end-rewrite
  965.            end-write.
  966.  
  967.        capitalize-key section.
  968.            perform varying i from 1 by 1 until i > 6
  969.                move input-key-field(i:1) to test-char
  970.                if test-num > 96 and < 123
  971.                    subtract 32 from test-num
  972.                    move test-char to input-key-field(i:1)
  973.                end-if
  974.            end-perform.
  975.  
  976.        check-for-empty-key section.
  977.            set key-empty to true
  978.            perform varying i from 1 by 1 until i > 6 or key-not-empty
  979.                if input-key-field(i:1) = spaces or low-values
  980.                    next sentence
  981.                else
  982.                    set key-not-empty to true
  983.                end-if
  984.            end-perform.
  985.