home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP5MENU.ZIP / INP_VAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-21  |  3.9 KB  |  137 lines
  1. {
  2. Copyright (c) 1988 BittWare Computing, ALL RIGHTS RESERVED
  3. }
  4. unit inp_var;
  5. {$v-}
  6. interface
  7.  
  8. uses
  9.         beepkey4,
  10.         menuvars,
  11.         menucode,
  12.         crt;
  13.  
  14. procedure GetMenuNum(var RtnNum,Special:longint;MenuNumber:MenuPtr);
  15. procedure ChgVar(vl:VarListPtr;var vc:byte);
  16. procedure InpVars(MenuName:MenuPtr;var RtnCode:integer;VarAddr:pointer);
  17.  
  18. implementation
  19.  
  20. procedure InpVars(MenuName:MenuPtr;var RtnCode:integer;VarAddr:pointer);
  21. var
  22.      li        :longint;
  23.      x         :integer;
  24.      w         :byte;
  25.      menuw     :byte;
  26.      r         :real;
  27.      i         :integer;
  28.      vp        :InpStrPtr;
  29.      OldTA     :byte;
  30.      tb        :byte;
  31.      rc        :byte;
  32.      ts        :linestrg;
  33.      NewString :linestrg;
  34.  
  35. begin
  36.      UnHideCurs;
  37.      vp := MenuName^.VarPtr;
  38.      OldTA := TextAttr;
  39.      TextColor(VarInpFg);
  40.      TextBackGround(VarInpBg);
  41.      menuw := MenuName^.Width - MenuName^.TxtLen - 2;
  42.      if MenuW > MaxMenuVarWidth then MenuW := MaxMenuVarWidth;
  43.      w := vp^[MenuName^.sel].VarWidth;
  44.  
  45.      tb := vp^[MenuName^.sel].typ;
  46.      ts := vp^[MenuName^.sel].str;
  47.  
  48.      if w <= menuw then begin
  49.           x := MenuW - w;
  50.           gotoxy(MenuName^.TxtLen+2+x,MenuName^.Sel);
  51.           InputString(ts,w,NewString,rc);
  52.      end
  53.      else begin
  54.           if tb = StringCode then begin
  55.                OpenIoWindow(SkinnyIO);
  56.                     write(MenuName^.str[MenuName^.sel],' : ');
  57.                     TextColor(VarInpFg);
  58.                     TextBackGround(VarInpBg);
  59.                     ts := linestring(VarAddr^);
  60.                     InputString(ts,w,NewString,rc);
  61.                CloseIoWindow(SkinnyIO);
  62.           end
  63.           else rc := InputError;
  64.      end;
  65.  
  66.      if rc = InputOk then begin
  67.           ConvertString(NewString,w,tb,rc,VarAddr);
  68.           case rc of
  69.              InputOk      :begin
  70. {
  71.                               if length(NewString) > MenuW then begin
  72.                                    Delete(NewString,MenuW+1,80);
  73.                                    NewString[MenuW-1] := ' ';
  74.                                    NewString[MenuW] := '>';
  75.                               end;
  76. }
  77.                               vp^[MenuName^.sel].str := NewString;
  78.                           end;
  79.              InputError   :begin
  80.                               ErrorNum := InvalidInput;
  81.                               ErrorMessage;
  82.                           end;
  83.           end; {case rc of}
  84.           RtnCode := rc;
  85.      end
  86.      else RtnCode := NoInput;
  87.  
  88.      HideCurs;
  89.      TextAttr := OldTA;
  90. end;
  91.  
  92. procedure ChgVar(vl:VarListPtr;var vc:byte);
  93. begin
  94.      if vc = vl^.max then vc := 1
  95.           else inc(vc);
  96. end;
  97.  
  98. procedure GetMenuNum(var RtnNum,Special:longint;MenuNumber:MenuPtr);
  99. var
  100.         x       :integer;
  101.         li      :longint;
  102.         ok      :boolean;
  103.         SpclNumLoc :byte;
  104.         Menu3   :byte;
  105. begin
  106.         SpclNumLoc := MenuNumber^.max;
  107.         x := MenuNumber^.Width - MenuNumber^.TxtLen - 2;
  108.         OpenPullDownMenu(MenuNumber);
  109.         ok := false;
  110.         repeat
  111.                UpdateMenu(MenuNumber);
  112.                menu3 := PullDownMenu(MenuNumber);
  113.                if menu3 = 0 then ok := true
  114.                else begin
  115.                     if menu3 < SpclNumLoc then begin
  116.                          val(MenuNumber^.Str[menu3],RtnNum,x);
  117.                          ok := true;
  118.                     end
  119.                     else begin
  120.                          InpVars(MenuNumber,x,@Special);
  121.                          Case x of
  122.                             0   :begin
  123.                                      ok := true;
  124.                                      RtnNum := Special;
  125.                                   end;
  126.                              1    :ok := false;
  127.                              2    :ok := false;
  128.                          end;
  129.                     end;
  130.                end;
  131.         until ok;
  132.         ClosePullDownMenu(MenuNumber);
  133. end;
  134.  
  135. end.
  136.  
  137.