C     Totally FORTRAN implementation of forms
C     by Barry W. McCleave, PhD, P.E. 601-634-2599
      include 'form32.fi'      
      Logical*1 Function FORM (hInstance,
     1 hwndmain,formtext1,itemselected,valueitem)      
C      FORM TEMPLATE
c      itemtype()=B means row of action buttons Button
c      itemtype()=I means integer*2             Int
c      itemtype()=L (or l) means integer*4      Longint
c      itemtype()=R (or r) means real*4         Real
c      itemtype()=D (or d )means real*8         Double Precision
c      itemtype()=C (or c) means string         Characters (termination \)
c      itemtype()=S (or s) choice only          Selection
c      itemtype()=T (or t) comment field        Text
c      itemtype()=H (or h) form title           Heading
c      itemchosen()= the list item selected (0 if edit entry)
c      delimeter=^ after each selection list item; before first list item 
c      delimeter=| at end of every form item
c      delimeter=\ at end of every text line (\\ produces \ if c string)
c      last item followed by 0 (\0 poduces 0 if c string)
c
      include 'form32.fd'
      character*1 term
      parameter (term=0)
      Integer*4 msgloop
      integer*1 itemselected(1)
      real*8 valueitem(1)
      integer*1 item(20)
      logical*1 confirm
      real*8 value(20)
      Integer*4 hinstance,init
      Character*80 TextBuffer 
      character*2000 formtext
      character*(*) formtext1
      integer*1 formt(2000),base_small_letters
      Integer*4 hinst,ierr 
      Integer*4 hWndEdit,hwnd,hwndmain
      Integer*4 hwndbutton1,hwndbutton2,hwndItem(20)
      common/glob/ TextBuffer,hinst,hWndEdit,hWndItem,
     1 hwndbutton1,hwndbutton2,formtext,item,value,
     2 numitems,numcommentlines,isize,confirm
      equivalence (formt,formtext)
      data base_small_letters/96/
      formtext=formtext1
      isize=1
      numitems=0
      if(formt(1).gt.base_small_letters) formt(1)=formt(1)-32
      numcommentlines=0
      do while(isize.lt.2000.and.formtext(isize:isize).ne.term)
c        convert lower to upper case if necessary
         if(formtext(isize:isize).eq.'|'.and.formt(isize+1).gt.
     1    base_small_letters) formt(isize+1)=formt(isize+1)-32
         if(formtext(isize:isize).eq.'|'.and.
     1    formtext(isize+1:isize+1).ne.'T'.and.
     2    formtext(isize+1:isize+1).ne.'H') numitems=numitems+1
         if(formtext(isize:isize).eq.'\') 
     1    numcommentlines=numcommentlines+1
         isize=isize+1
      end do
      if(formtext(1:1).eq.'T'.or.formtext(1:1).eq.'H') 
     1 numitems=numitems-1
      isize=isize-1
      do j=1,numitems
         item(j)=itemselected(j)
         value(j)=valueitem(j)
      enddo
      TextBuffer=''c
      if(init(hinstance,hwndmain,hwnd)
     1 .eq.TRUE) ierr=msgloop(hinstance,hwnd)
      form=confirm
      if(confirm) then
         do j=1,numitems
            itemselected(j)=item(j)
            valueitem(j)=value(j)
         enddo
      endif
      return
      end

       Integer*4 Function Init(
     1 hInstance,hwndmain,hwnd)
       include 'form32.fd'
       external wndproc
       Integer*4 hInstance,hPrev,nCmdShow
       Integer*4 CreateWindowEx,loadcursor,registerclass
      Character*80 TextBuffer 
      character*2000 formtext
      Integer*4 hinst,hwndmain 
      Integer*4 hWndEdit 
      Integer*4 hwndbutton1,hwndbutton2,hwndItem(20)
      integer*1 item(20)
      logical*1 confirm
      real*8 value(20)
      common/glob/ TextBuffer,hinst,hWndEdit,hWndItem,
     1 hwndbutton1,hwndbutton2,formtext,item,value,
     1 numitems,numcommentlines,isize,confirm
      record /wndclass/ windowclass
        Integer*4   hWnd
c       integer*4 idc_arrow
c       data idc_arrow/32512/
        data hprev/false/
      Init = true
c     assign value to global variable for use in WndProc
      hinst = hInstance
c     if no previous instance of the application fill in WNDCLASS
      if (hPrev.eq.false) then
         WindowClass.lpszClassName = locfar('FORM_ENTRY'C)
         WindowClass.hInstance     = hInstance
         WindowClass.lpfnWndProc   = locfar(wndproc)
         WindowClass.hCursor       = LoadCursor(null,idc_arrow)
         WindowClass.hIcon         = NULL
         WindowClass.lpszMenuName  = NULL
         WindowClass.hbrBackground = COLOR_WINDOW + 1
         WindowClass.style         = 0
         WindowClass.cbClsExtra    = 0
         WindowClass.cbWndExtra    = 0
         hprev=true
c        Register the class
         if (RegisterClass (WindowClass).eq.false) Init = false
      end if
      hWnd = CreateWindowEx(0, locfar('FORM_ENTRY'C),locfar('FORM'C),            
     1 WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,0,CW_USEDEFAULT,0,hWndMain,               
     1 NULL,hInstance,NULL)           
c     show the window as it is not visible by default
      nCmdShow=sw_shownormal
      call ShowWindow (hWnd,nCmdShow)
      call UpdateWindow(hWnd)
      return 
      end

      Integer*4 Function MsgLoop(hinstance,hwnd)
       include 'form32.fd'
       Integer*4 idm_itemup,idm_itemdown,idm_escape,idm_confirm
       Integer*4 return,escape,control_backspace,control_return
       parameter (return=13)
       parameter (escape=27)
       parameter (tab=9)
       parameter (control_backspace=127)
       parameter (control_return=10)
      parameter (idm_itemup=301)
      parameter (idm_itemdown=302)
      parameter (idm_escape=303)
      parameter (idm_confirm=304)
       Integer*4 hinstance,hwnd
       Record /tagmsg/ msg
       integer*4 SendMessage
       integer*4 lberr
       Integer*4 GetMessage
      DO WHILE (GetMessage(msg,null,0,0).ne.false)
          if(msg.message.eq.WM_Char.and.(msg.wparam.eq.return.or.
     1     msg.wparam.eq.tab)) then
               lberr=SendMessage(hwnd,WM_COMMAND,IDM_itemdown,1)
          else if(msg.message.eq.WM_Char.and.msg.wparam.eq.
     1     control_return) then
               lberr=SendMessage(hwnd,WM_COMMAND,IDM_confirm,1)
          else if(msg.message.eq.WM_Char.and.msg.wparam.eq.escape) then
               lberr=SendMessage(hwnd,WM_COMMAND,IDM_escape,1)
          else if(msg.message.eq.WM_Char.and.msg.wparam.eq.
     1     control_backspace) then
               lberr=SendMessage(hwnd,WM_COMMAND,IDM_itemup,1)
          else
             Call TranslateMessage(msg)
             Call DispatchMessage(msg)
          endif
        MsgLoop=msg.wParam
      End Do
      return
      end

       INTERFACE TO SUBROUTINE MOVETEXT 
     1  (A,ANS)
       character*(*) A [REFERENCE]
       Integer*4 ANS [VALUE]
       END

       INTERFACE TO SUBROUTINE MOVEBACK 
     1  (A,ANS)
       character*(*) A [REFERENCE]
       Integer*4 ANS [VALUE]
       END

      Integer*4 Function wndproc [PASCAL,LOADDS,
     1alias:'_WNDPROC']
     1 (hWnd[VALUE],wMsgID[VALUE],wParam[VALUE],lParam[VALUE])
      include 'form32.fd'
      Integer*4 idokbutton,idcancelbutton,idm_itemup,idm_itemdown
      Integer*4 idbutton1,idbutton2,idbutton3,idbutton4,idbutton5
      Integer*4 idbutton6,idbutton7,idbutton8,idbutton9,idbutton10
      Integer*4 idbutton11,idbutton12,idbutton13,idbutton14,idbutton15
      Integer*4 idbutton16,idbutton17,idbutton18,idbutton19,idbutton20
      Integer*4 iditem1,iditem2,iditem3,iditem4,iditem5,idm_confirm
      Integer*4 iditem6,iditem7,iditem8,iditem9,iditem10
      Integer*4 iditem11,iditem12,iditem13,iditem14,iditem15
      Integer*4 iditem16,iditem17,iditem18,iditem19,iditem20
      character*1 term,space
      real*4 big
      logical*1 listdown(30)
      character*1 pulldown
      parameter (pulldown='~')
      parameter (big=1.0E13)
      parameter (term=0)
      parameter (space=' ')
      parameter (idokbutton=200)
      parameter (idcancelbutton=201)
      parameter (iditem1=202)
      parameter (iditem2=203)
      parameter (iditem3=204)
      parameter (iditem4=205)
      parameter (iditem5=206)
      parameter (iditem6=207)
      parameter (iditem7=208)
      parameter (iditem8=209)
      parameter (iditem9=210)
      parameter (iditem10=211)
      parameter (iditem11=212)
      parameter (iditem12=213)
      parameter (iditem13=214)
      parameter (iditem14=215)
      parameter (iditem15=216)
      parameter (iditem16=217)
      parameter (iditem17=218)
      parameter (iditem18=219)
      parameter (iditem19=220)
      parameter (iditem20=221)
      parameter (idm_itemup=301)
      parameter (idm_itemdown=302)
      parameter (idm_escape=303)
      parameter (idm_confirm=304)
      parameter (idbutton1=305)
      parameter (idbutton2=306)
      parameter (idbutton3=307)
      parameter (idbutton4=308)
      parameter (idbutton5=309)
      parameter (idbutton6=310)
      parameter (idbutton7=311)
      parameter (idbutton8=312)
      parameter (idbutton9=313)
      parameter (idbutton10=314)
      parameter (idbutton11=315)
      parameter (idbutton12=316)
      parameter (idbutton13=317)
      parameter (idbutton14=318)
      parameter (idbutton15=319)
      parameter (idbutton16=320)
      parameter (idbutton17=321)
      parameter (idbutton18=322)
      parameter (idbutton19=323)
      parameter (idbutton20=324)
      Integer*4 hwndit,none
      parameter (hwndit=201)
      Integer*4 hWnd,wMsgID,wParam,hparent,iditem(20),idbutton(20)
      Integer*4 lParam,lberr,lselected
      Character*80 TextBuffer 
      Character*2000 formtext
      Integer*4 hinst 
      Integer*4 SelectObject,GetWindowText
      integer*4 i,nowitem
      Integer*4 hWndEdit,xmax,ymax 
      Integer*4 hwndbutton1,hwndbutton2,hwndItem(20),buttonindex(20)
      Integer*4 hwndbuttons(20),numbuttonsrow(20),button_item(20)
      integer*1 item(20)
      logical*1 confirm
      character*1 select_indicator(25)
      real*8 value(20)
      common/glob/ TextBuffer,hinst,hWndEdit,hWndItem,
     1 hwndbutton1,hwndbutton2,formtext,item,value,
     2 numitems,numcommentlines,isize,confirm
      integer*4 defwindowproc
       integer*4 ws_mybutton,loword,hiword,current_item
      Integer*4 CreateWindowEx,setfocus,destroywindow
      Integer*4 SetBkMode,BeginPaint,TextOut
      Integer*4 cxChar,cyChar,hdc,ierr,numread
      Integer*4 GetDC,GetTextMetrics,GetStockObject,ReleaseDC
      INTEGER*4 ipreviouscolor
      integer*4 SetTextColor,SetBkColor,GetSysColor
      integer*4 SendMessage
      character*60 textbuf(25)
      character*30 buttontext(8)
      logical*1 precarettext,errflag
      character entrytype,icharnow,itemtypebuf(20)
      Record /tagTextMetric/ tm
      Record /tagRect/ rect
      Record /tagPAINTSTRUCT/ ps
      integer*4 value_int4
      integer*2 value_int2
      integer*4 charcount
      real*4 value_real4
      real*8 val
      integer*4 ws_dropdown
      integer*4 ws_dropdownlist
      Equivalence(value_int4,value_int2,value_real4,val)
      data ws_mybutton/#50000000/
      data ws_dropdown/#50A00002/
      data ws_dropdownlist/#50A00003/
      data idbutton/idbutton1,idbutton2,idbutton3,idbutton4,idbutton5,
     1  idbutton6,idbutton7,idbutton8,idbutton9,idbutton10,
     2  idbutton11,idbutton12,idbutton13,idbutton14,idbutton15,
     3  idbutton16,idbutton17,idbutton18,idbutton19,idbutton20/
      data iditem/iditem1,iditem2,iditem3,iditem4,iditem5,
     1  iditem6,iditem7,iditem8,iditem9,iditem10,
     2  iditem11,iditem12,iditem13,iditem14,iditem15,
     3  iditem16,iditem17,iditem18,iditem19,iditem20/
c     return TRUE unless unless handles by DefWindowProc
      wndproc = true
      select case (wMsgID)
         case (WM_CREATE)
           ibuttontotal=0
           icurbutton=0
           hdc=GetDC(hWnd)
           ierr=SelectObject(hdc,GetStockObject(SYSTEM_FIXED_FONT))
           ierr=GetTextMetrics(hdc,tm)
           cxChar=tm.tmAveCharWidth
           cyChar=tm.tmHeight+tm.tmExternalLeading
           ierr=ReleaseDC(hwnd,hdc)
           numlines=numitems+numcommentlines
           do i=1,numlines
              select_indicator(i)=space
              listdown(i)=.false.
           enddo
           ysc=2.
           yscbox=7./4.
           o=1.
c          reduce dimensions if long form
           if(numlines.gt.10) then
              ysc=1.2
              yscbox=1.2
              o=0.
           endif
           ymax=(numlines+4)*cyChar*ysc
           if(numlines.gt.10) ymax=(numlines+4.3)*cychar*ysc
           xmax=64*cxChar
           Call MoveWindow (hWnd,0,0,xmax,ymax,1)
           entrytype=formtext(1:1)
           precarettext=.TRUE.
           line=0
           linecomment=0
           lineentry=0
           itemstart=2
           j=2
           do while (j.le.isize) 
            icharnow=formtext(j:j)
            select case (icharnow)
             case('^')
              itemend=j-1
              icharcount=j-itemstart
              if(precarettext) then
               line=line+1
               lineentry=lineentry+1
               textbuf(line)(1:icharcount)=
     1          formtext(itemstart:itemend)
               if(icharcount.lt.30) then
                 do m=icharcount+1,30
                   textbuf(line)(m:m)=space
                 end do
               endif
               textbuf(line)(31:31)=term
               m=lineentry
               i=line-1
               select case(entrytype)
                case('B')  !count buttons on this row save text
                  ibuttonrow=1
                  ibuttontotal=ibuttontotal+1
                  buttontext(ibuttonrow)(1:icharcount)=
     1             formtext(itemstart:itemend)
                  buttontext(ibuttonrow)(icharcount+1:icharcount+1)=
     1             term
                case('I')  !integer*2
                  hWndItem(m) = CreateWindowEx(0,locfar('combobox'c),
     1             locfar(''c),WS_DropDown,30*cxChar,cyChar*(o+ysc*i),
     2             30*cxCHar,yscbox*cyChar*6,hWnd,IDitem(m),hinst,NULL)
                  val=value(m)
                  write(TextBuffer,1) value_int2,term
1                 format(I8,a1)
                  call squash_int(Textbuffer)
                  call SetWindowText(hWndItem(m),TextBuffer)
                case('R')  !real*4
                  hWndItem(m) = CreateWindowEx(0,locfar('combobox'c),
     1             locfar(''c),WS_DropDown,30*cxChar,cyChar*(o+ysc*i),
     2            30*cxCHar,yscbox*cyChar*6,hWnd,IDitem(m),hinst,NULL)
                   val=value(m)
                   if(value_real4.lt.1..and.-value_real4.lt.1.) then
                     write(TextBuffer,2) value_real4,term
2                    format(f29.27,a1)
                   else if (value_real4.gt.big.or.
     1              -value_real4.gt.big) then
                     write(TextBuffer,9) value_real4,term
9                    format(f29.0,a1)
                   else
                     write(TextBuffer,3) value_real4,term
3                    format(f29.14,a1)
                   endif
                   call squash_real(textbuffer)
                   call SetWindowText(hWndItem(m),TextBuffer)
                 case('S')  !choice
                   hWndItem(m) = CreateWindowEx(0,locfar('combobox'c),
     1              locfar(''c),WS_DropDownList,30*cxChar,cyChar*(o+ysc
     2              *i),30*cxCHar,yscbox*cyChar*6,hWnd,IDitem(m),hinst,
     3              NULL)
                 case('C')  !string
                   hWndItem(m) = CreateWindowEx(0,locfar('combobox'c),
     1              locfar(''c),WS_DropDown,30*cxChar,cyChar*(o+ysc*i),
     2             30*cxCHar,yscbox*cyChar*6,hWnd,IDitem(m),hinst,NULL)
                   val=value(m)
                   if(value_int4.ne.null) 
     1              call moveback(TextBuffer,value_int4)
                   call SetWindowText(hWndItem(m),TextBuffer)
                 case('D')  !real*8
                   hWndItem(m) = CreateWindowEx(0,locfar('combobox'c),
     1             locfar(''c),WS_DropDown,30*cxChar,cyChar*(o+ysc*i),
     2             30*cxCHar,yscbox*cyChar*6,hWnd,IDitem(m),hinst,NULL)
                   val=value(m)
                   if(val.lt.1..and.-val.lt.1.) then
                      write(TextBuffer,2) val,term
                   else if (val.gt.big.or.-val.gt.big) then
                     write(TextBuffer,9) value_real4,term
                   else
                      write(TextBuffer,3) val,term
                   endif
                   call squash_real(textbuffer)
                   call SetWindowText(hWndItem(m),TextBuffer)
                 case('L')  !integer*4
                   hWndItem(m) = CreateWindowEx(0,locfar('combobox'c),
     1              locfar(''c),WS_Dropdown,30*cxChar,cyChar*(o+ysc*i),
     2             30*cxCHar,yscbox*cyChar*6,hWnd,IDitem(m),hinst,NULL)
                   val=value(m)
                   write(TextBuffer,4) value_int4,term
4                  format(I18,a1)
                   call squash_int(TextBuffer)
                   call SetWindowText(hWndItem(m),TextBuffer)
                 end select
              else
c              add item to list
               itemend=j-1
               icharcount=j-itemstart
               TextBuffer(1:icharcount)=
     1          formtext(itemstart:itemend)
               TextBuffer(icharcount+1:icharcount+1)=0
               if(entrytype.eq.'B') then
                  ibuttonrow=ibuttonrow+1
                  ibuttontotal=ibuttontotal+1
                  buttontext(ibuttonrow)=textbuffer
               else
                  listdown(m)=.true.
                  lberr=SendMessage(hwnditem(m),CB_AddString,-1,
     1             locfar(TextBuffer))
                  select_indicator(line)=pulldown
               endif
              endif
              itemstart=j+1
              precarettext=.FALSE.
             case('\')
              itemend=j-1
              icharcount=j-itemstart
              line=line+1
              linecomment=linecomment+1
              textbuf(line)(1:icharcount)=
     1         formtext(itemstart:itemend)
               if(icharcount.lt.60) then
                 do m=icharcount+1,60
                   textbuf(line)(m:m)=space
                 end do
                 nrear=(60-icharcount)
                 nfront=nrear/2
                 nrear=nrear-nfront
                 if(nfront.ge.1) then
                    do m=60-nrear,nfront,-1
                       mm=m-nfront
                       textbuf(line)(m:m)=textbuf(line)(mm:mm)
                    enddo
                    do m=1,nfront
                       textbuf(line)(m:m)=space
                    enddo
                 endif
               endif
               itemstart=j+1
             case('|')
                select case(entrytype)
                  case('I','R','S','C','D','L')
                    itemtypebuf(lineentry)=entrytype
                  case('T')  !comment
                  case('H')  !form title
                    itemend=j-1
                    icharcount=j-itemstart
                    TextBuffer(1:icharcount)=
     1               formtext(itemstart:itemend)
                    call SetWindowText(hWnd,TextBuffer)
                  case('B')  ! make row of action buttons
                     itemtypebuf(lineentry)=entrytype
                     ibuttonrownow=1
                     ipos=1
                     iwidth=60/ibuttonrow
                     iwsize=iwidth-1
                     ibuttonbase=ibuttontotal-ibuttonrow
                     do i=ibuttonbase+1,ibuttontotal
                      textbuffer=buttontext(ibuttonrownow)
                      hWndbuttons(i) = CreateWindowEx(0,
     1                 locfar('button'c),
     1                 locfar(TextBuffer),WS_MyButton,cxChar*ipos,
     2                 cyChar*(o+ysc*(line-1)),iwsize*cxChar,yscbox*
     3                 cyChar,hWnd,IDbutton(i),hinst,NULL)
                      button_item(i)=lineentry
                      ibuttonrownow=ibuttonrownow+1
                      ipos=iwidth+ipos
                     enddo
                     textbuf(line)(1:1)=term
                     numbuttonsrow(lineentry)=ibuttonrow
                     buttonindex(lineentry)=ibuttonbase
                end select
                j=j+1
                if(j.le.isize) entrytype=formtext(j:j)
                itemstart=j+1
                precarettext=.TRUE.
             case default
            end select
            j=j+1
           end do
           do m=1,numitems
              nowitem=item(m)-1
c              if(itemtypebuf(m).eq.'S'.or.item(m).ne.term) then
              if(itemtypebuf(m).eq.'S'.or.listdown(m)) then
                 if(itemtypebuf(m).eq.'S'.or.item(m).ne.term) then
                    lberr=SendMessage(hwnditem(m),CB_SETCURSEL,
     1               nowitem,null)
                 endif
                 lberr=SendMessage(hwnditem(m),CB_SETITEMHEIGHT,0,
     1            yscbox*cyChar)
                 lberr=SendMessage(hwnditem(m),CB_SETITEMHEIGHT,-1,
     1            yscbox*cyChar)
              else
                 lberr=SendMessage(hwnditem(m),CB_SETITEMHEIGHT,0,
     1            yscbox*cyChar*7)
              endif
           end do
           hWndEdit=hWndItem(1)
           current_item=1
           i=numlines
c          create a window of the "pushbutton" class
           hWndbutton1 = CreateWindowEx(0,locfar('button'c),
     1      locfar('O.K.'c),WS_MyButton,cxChar,cyChar*(o+ysc*i),
     2      26*cxChar,yscbox*cyChar,hWnd,IDOKbutton,hinst,NULL)
           hWndbutton2 = CreateWindowEx(0,locfar('button'c),
     1      locfar('CANCEL'c),WS_MyButton,32*cxChar,cyChar*(o+ysc*i),
     2      26*cxCHar,yscbox*cyChar,hWnd,IDCANCELbutton,hinst,NULL)
       case (WM_PAINT)
          hDC=BeginPaint(hWnd,ps)
          ierr=SelectObject(hDC,GetStockObject(SYSTEM_FIXED_FONT))
           ierr=GetTextMetrics(hDC,tm)
           cxChar=tm.tmAveCharWidth
           cyChar=tm.tmHeight+tm.tmExternalLeading
          ierr=SetBkMode(hDC,TRANSPARENT)
          ipreviouscolor=SetTextColor(hdc,
     1      GetSysColor(COLOR_WINDOWTEXT))
          ipreviouscolor=SetBkColor(hdc,GetSysColor(COLOR_WINDOW))
          do j=1,numlines
             i=j-1
             charcount=60
             if(textbuf(j)(31:31).eq.term) charcount=30
             If(textbuf(j)(1:1).ne.term) Ierr=Textout(hDC,cxChar,
     1        cyChar*(o+ysc*i),textbuf(j),charcount)
             Ierr=Textout(hDC,60.7*cxChar,cyChar*(o+.3+ysc*i),
     1        select_indicator(j),1)
          end do
          i=numlines+2
          TextBuffer=
     1     'ENTER or TAB=down   CTRL-BACKSPACE=up   ESCAPE = Cancel'
          Ierr=Textout(hDC,cxChar,cyChar*(ysc*i+o-1),TextBuffer,55)
          TextBuffer=
     1     'SPACE BAR presses button       CNTR-ENTER=confirms form'
          Ierr=Textout(hDC,cxChar,cyChar*(o+ysc*i),TextBuffer,55)
          Call EndPaint(hwnd,ps)
      case (WM_SETFOCUS)
c        give the current window focus for keyboard input
         if (numitems.eq.0) hWndEdit=hwndbutton1
         hparent=SetFocus (hWndEdit)
      case (WM_COMMAND)
         select case (wParam)
             case (IDbutton1:IDbutton20,IDOKbutton,IDM_CONFIRM)
                if(wparam.eq.IDM_CONFIRM.OR.HiWord(wParam).eq.
     1           BN_CLICKED) then
                  confirm=.TRUE.
                  errflag=.true.
                  do current_item=1,numitems
                     entrytype=itemtypebuf(current_item)
                     if(entrytype.eq.'B') then
                        lselected=-1
                        ibuttonnum=wParam-IDM_CONFIRM
                        if(button_item(ibuttonnum).eq.current_item) 
     1                   lselected=ibuttonnum-
     2                   buttonindex(current_item)-1
                     else
                        lselected=SendMessage(hwnditem(current_item),
     1                   CB_GETCURSEL,none,not_used)
                        if(lselected.eq.CB_ERR) lselected=-1
                     endif
                     item(current_item)=lselected+1
                     numread=GetWindowText(hwndItem(current_item),
     1                 TextBuffer,80)
                     if(itemtypebuf(current_item).ne.'C'.and.
     1                numread.lt.1.and.item(current_item).eq.term) then
                       numread=1
                       textbuffer(1:1)='0'
                     endif
                     if(itemtypebuf(current_item).ne.'C'.and.numread
     1                .lt.30.and.item(current_item).eq.term) then
                         numfront=30-numread
                         do j=30,1,-1
                            if(j.le.numfront) then
                               Textbuffer(j:j)=space
                            else
                               jj=j-numfront
                               Textbuffer(j:j)=textbuffer(jj:jj)
                            endif
                         enddo
                     endif
18                   format(I3,5x,a)
                    if(item(current_item).eq.term) then
                     Select Case (entrytype)
                      CASE('C') !text string
                       Textbuffer(numread+1:numread+1)=term
                       val=value(current_item)
                       if(value_int4.ne.null) 
     1                  call movetext(TextBuffer,value_int4)
                      case('I') !integer*2
                       read(textbuffer,10,err=14) value_int2
10                     format(i30)
                       value(current_item)=val
                      case('R') !real*4
                       read(textbuffer,11,err=14) value_real4
11                     format(f30.0)
                       value(current_item)=val
                      case('L') !integer*4
                       read(textbuffer,10,err=14) value_int4
                       value(current_item)=val
                      case('D') !real*8
                       read(textbuffer,11,err=14) val
                       value(current_item)=val
                     EndSelect
                    endif
                  end do
                  errflag=.false.
14                if(errflag) then
                     hwndEdit=hwndItem(current_item)
                     hparent=SetFocus (hWndEdit)
                  else
                     nerr=destroywindow(hwnd)
                  endif
                endif
             case (IDCANCELbutton,IDM_ESCAPE)
                if(wparam.eq.IDM_ESCAPE.OR.HiWord(wParam).eq.
     1           BN_CLICKED) then
                  confirm=.FALSE.
                  nerr=destroywindow(hwnd)
                endif
              case (IDM_ITEMDOWN)
                 if(itemtypebuf(current_item).eq.'B') then
                   icurbutton=icurbutton+1
                   if(icurbutton.le.numbuttonsrow(current_item)) then
                      current_item=current_item-1
                   else
                      icurbutton=0
                   endif
                 else
                    icurbutton=0
                 endif
                 k=current_item+1
                 if(k.gt.numitems+2) k=1
                 current_item=k
                 if(k.le.numitems) then
                    hwndEdit=hwndItem(k)
                    if(itemtypebuf(k).eq.'B') then
                       if(icurbutton.eq.0) icurbutton=1
                       hwndEdit=hwndbuttons(buttonindex(k)+
     1                  icurbutton)
                    endif
                 else if(k.eq.numitems+1) then
                    hwndEdit=hwndbutton1
                    icurbutton=0
                 else
                    hwndEdit=hwndbutton2
                    icurbutton=0
                 endif
                 hparent=SetFocus (hWndEdit)
              case (IDM_ITEMUP)
                 if(itemtypebuf(current_item).eq.'B') then
                   if(icurbutton.eq.0) icurbutton=
     1              numbuttonsrow(current_item)+1
                   icurbutton=icurbutton-1
                   if(icurbutton.gt.0) then
                      current_item=current_item+1
                   else
                      icurbutton=0
                   endif
                 else
                    icurbutton=0
                 endif
                 k=current_item-1
                 if(k.lt.1) k=numitems+2
                 current_item=k
                 if(k.le.numitems) then
                    hwndEdit=hwndItem(k)
                    if(itemtypebuf(k).eq.'B') then
                       if(icurbutton.eq.0) icurbutton=
     1                  numbuttonsrow(current_item)
                       hwndEdit=hwndbuttons(buttonindex(k)+
     1                  icurbutton)
                    endif
                 else if(k.eq.numitems+1) then
                    hwndEdit=hwndbutton1
                    icurbutton=0
                 else
                    hwndEdit=hwndbutton2
                    icurbutton=0
                 endif
                 hparent=SetFocus (hWndEdit)
         END SELECT
      case (WM_CLOSE)
         nerr=destroywindow(hwnd)
      case (WM_DESTROY)
         Call PostQuitMessage(0)
      case DEFAULT
         wndproc = DefWindowProc (hWnd, 
     1    wMsgID, wParam, lParam)
      END SELECT
      return
      end
      
      Integer*4 Function LOWORD(lParam)
      Integer*4 lparam,mparam
      Integer*2 kparam(2)
      Equivalence (mparam,kparam(1))
      mparam=lparam
      LOWORD=kparam(1)
      return
      end

      Integer*4 Function HIWORD(lParam)
      Integer*4 lparam,mparam
      Integer*2 kparam(2)
      Equivalence (mparam,kparam(1))
      mparam=lparam
      HIWORD=kparam(2)
      return
      end

      Subroutine Squash_Int(TextBuffer)
      Character*80 TextBuffer 
      character*1 term
      data term/0/
      TextBuffer(31:31)=term
      do while (TextBuffer(1:1).eq.' ')
         do j=1,30
            TextBuffer(j:j)=TextBuffer(j+1:j+1)
         enddo
      enddo
      return
      end
      
      Subroutine Squash_Real(TextBuffer)
      Character*80 TextBuffer 
      character*1 term
      character*4 zero
      data term/0/,zero/'0.0\0'c/
      Call Squash_int(TextBuffer)
      i=1
      do while (TextBuffer(i:i).ne.term)
         i=i+1
      enddo
      if(i.gt.1) i=i-1
      do while(TextBuffer(i:i).eq.'0')
         TextBuffer(i:i)=term
         i=i-1
      enddo
      if(i.le.1) TextBuffer(1:4)=zero
      return
      end
