home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbopas / pull15.arc / PULLDE15.INC < prev    next >
Encoding:
Text File  |  1987-08-31  |  11.9 KB  |  413 lines
  1. { PullDE15.inc - Data entry window module for Pull15.inc    ver 1.5, 08-31-87 }
  2. { (c) 1987 James H. LeMay                                                     }
  3. type
  4.   DataPadRec = record
  5.               StoreMode,Valid,DataStored,NewData: boolean;
  6.               case TypeOfData: TypeOfDataType of
  7.                 Bytes:        (Bdata:  byte);
  8.                 Integers:     (Idata:  integer);
  9.                 Reals:        (Rdata:  real);
  10.                 UserNums:     (UNdata: MaxString);
  11.                 Chars:        (Cdata:  char);
  12.                 Strings:      (Sdata:  MaxString);
  13.                 UserStrings:  (USdata: MaxString);
  14.             end;
  15.  
  16. var
  17.   DataPad, OldDataPad: DataPadRec;
  18.   DataWndwWattr, DataWndwBattr: byte;
  19.   DataWndwBrdr: Borders;
  20.   AutoNumLock:  boolean;
  21.   NumLockCol:   byte;
  22.   LastKeyStat:  byte;
  23.   Null:         boolean;
  24.   DataEntryStr: MaxString;  { Global variable for Work window (not affected by
  25.                               DataWndw entries). }
  26.   OldWorkWndwStep: integer;
  27.   UserCharSet: set of char;
  28.  
  29. const
  30.   DelKey = #83;
  31.   BSKey  = #08;
  32.   NullKey= #00;
  33.  
  34. { This is a forward procedure for access outside of PULLDE15.INC. }
  35. procedure DataTransfer (VAR ErrMsg: integer);  forward;
  36.  
  37. procedure NumLock (Switch: Toggle);
  38. var  KeyStat: byte absolute $0000:$0417;
  39. begin
  40.   case Switch of
  41.     On:  begin
  42.            LastKeyStat:=KeyStat;
  43.            KeyStat:=LastKeyStat or $20
  44.          end;
  45.     Off: KeyStat:=(KeyStat and $DF) or (LastKeyStat and $20);
  46.   end
  47. end;
  48.  
  49. procedure ShowDataWndw (VAR Menu: MenuRec; VAR DWndw: DataWndwRec);
  50. var DataPadStr: MaxString;
  51.     PadStrCol:  integer;
  52.  
  53. {}procedure FindRowCol;
  54. {}begin
  55. {}  with DWndw do
  56. {}    if RowAlt+ColAlt=0 then
  57. {}      begin
  58. {}        Row:=Menu.Row+HiLited;
  59. {}        if (Row+Rows)>CRTrows-2 then Row:=pred(CRTrows-Rows);
  60. {}        case Menu.LinkDir of
  61. {}          Right: Col:=Menu.Col+(Menu.Cols-2);
  62. {}          Left:  Col:=Menu.Col-(Cols-2)
  63. {}        end
  64. {}      end
  65. {}    else
  66. {}      begin
  67. {}        Row:=RowAlt;
  68. {}        Col:=ColAlt
  69. {}      end;
  70. {}end;
  71.  
  72. {}procedure ConvertDataToStr;
  73. {}var  i,Lead: integer;
  74. {}begin
  75. {}  with DataPad,DWndw do
  76. {}    begin
  77. {}      DataPad.TypeOfData := DWndw.TypeOfData;
  78. {}      StoreMode := false;
  79. {}      DataTransfer (i);    { No error messages needed }
  80. {}      case TypeOfData of
  81. {}        Bytes:     Str(Bdata:Field,DataPadStr);
  82. {}        Integers:  Str(Idata:Field,DataPadStr);
  83. {}        Reals:     if Decimals<0 then Str(Rdata:Field,DataPadStr)
  84. {}                   else
  85. {}                     begin
  86. {}                       Str(Rdata:Field:Decimals,DataPadStr);
  87. {}                       if ord(DataPadStr[0])>Field then
  88. {}                         Str(Rdata:Field,DataPadStr)
  89. {}                     end;
  90. {}        UserNums:  DataPadStr:=UNdata;
  91. {}        Chars:     DataPadStr:='"'+Cdata+'"';
  92. {}      else         DataPadStr:='"'+Sdata+'"';
  93. {}      end;
  94. {}      PadStrCol:=Col+FirstCol;
  95. {}      if Justify=Left then
  96. {}        case TypeOfData of Bytes..Reals:
  97. {}          begin
  98. {}            i:=1;
  99. {}            while (DataPadStr[i]=' ') and (i<Field) do i:=succ(i);
  100. {}            DataPadStr[0]:=char(succ(Field-i));
  101. {}            move (DataPadStr[i],DataPadStr[1],ord(DataPadStr[0]));
  102. {}          end;
  103. {}        end
  104. {}      else  { Right justified }
  105. {}        begin
  106. {}          Lead:=Field-ord(DataPadStr[0]);
  107. {}          case TypeOfData of
  108. {}            UserNums:            PadStrCol:=PadStrCol+Lead;
  109. {}            Strings,UserStrings: PadStrCol:=PadStrCol+Lead+2;
  110. {}          end;
  111. {}        end;
  112. {}      case TypeOfData of Chars..UserStrings:
  113. {}        PadStrCol:=pred(PadStrCol);
  114. {}      end;  { case }
  115. {}    end;    { with }
  116. {}end;
  117.  
  118. begin
  119.   with DWndw do
  120.     begin
  121.       FindRowCol;
  122.       MakeWindow (Row,Col,Rows,Cols,Wattr,Battr,Border);
  123.       for i:=1 to 2 do
  124.         QwriteV (Row+i,Col+2,-1,Line[i]);
  125.       ConvertDataToStr;
  126.       QwriteV (succ(Row),PadStrCol,-1,DataPadStr);
  127.       ShowMsg (MsgLineNum);
  128.     end
  129. end;
  130.  
  131. procedure PutDataOnPad (VAR DataEntryStr: MaxString);
  132. var Errors: integer;
  133. begin
  134.   DataPad.Valid:=false;
  135.   if ((DataEntryStr<>'') or Null) then
  136.     with DataPad do
  137.       begin
  138.         Errors:=0;
  139.         case TypeOfData of
  140.           Bytes..Reals:
  141.             begin
  142.               case TypeOfData of
  143.                 Bytes:    begin
  144.                             val(DataEntryStr,Idata,Errors);
  145.                             if (Errors=0)and(Idata>255) then Errors:=1;
  146.                           end;
  147.                 Integers: val(DataEntryStr,Idata,Errors);
  148.                 Reals:    val(DataEntryStr,Rdata,Errors);
  149.               end;  { case }
  150.               if Errors<>0 then ShowErrorMsg (1);
  151.             end;
  152.           Chars:   if Null then
  153.                         Cdata:=#00
  154.                    else Cdata:=DataEntryStr[1];
  155.         else  Sdata:=DataEntryStr;
  156.         end;  { case }
  157.         if Errors=0 then Valid:=true
  158.       end
  159. end;
  160.  
  161. procedure Transfer (VAR UserVariable);
  162. var  Size:      integer;
  163.      StrLength: byte absolute UserVariable;
  164. begin
  165.   with DataPad do
  166.     begin
  167.       case TypeOfData of
  168.         Bytes,Chars: Size:=1;
  169.         Integers:    Size:=2;
  170.         Reals:       Size:=sizeof(Rdata);
  171.       else
  172.         if StoreMode then
  173.              Size:=succ(ord(Sdata[0]))
  174.         else Size:=succ(StrLength);
  175.       end;
  176.       if StoreMode then
  177.            Move (Bdata,UserVariable,Size)
  178.       else Move (UserVariable,Bdata,Size);
  179.     end
  180. end;
  181.  
  182. procedure StoreMenuData;
  183. var  Errors: integer;
  184. begin
  185.   with DataPad do
  186.     begin
  187.       Errors:=0;
  188.       StoreMode:=true;
  189.       DataTransfer (Errors);
  190.       if Errors<>0 then
  191.         begin
  192.           ShowErrorMsg (Errors);
  193.           DataStored:=false
  194.         end
  195.       else DataStored:=true
  196.     end   { with }
  197. end;
  198.  
  199. procedure EnterData (Row,Col,Field: integer; VAR DataEntryStr: MaxString;
  200.                      TypeOfData: TypeOfDataType; Justify: DirType;
  201.                      HelpWndwNum: integer; HelpTitle: MaxString);
  202. var  ValidCharSet: set of char;
  203. {}procedure MonitorNumLock;
  204. {}var  KeyStat: byte absolute $0040:$0017;
  205. {}     NumStr:  string[7];
  206. {}begin
  207. {}  repeat
  208. {}    if (KeyStat and $20)=$20 then
  209. {}         NumStr:='NUMLOCK'
  210. {}    else NumStr:='       ';
  211. {}    QwriteV (CRTrows,NumLockCol,-1,NumStr)
  212. {}  until keypressed;
  213. {}end;
  214.  
  215. {}procedure DisplayStrAndCursor;
  216. {}var L,Index,CursorCol: integer;
  217. {}    VideoStr:          MaxString;
  218. {}begin
  219. {}  L:=ord(DataEntryStr[0]);
  220. {}  fillchar (VideoStr[1],Field,' ');
  221. {}  VideoStr[0]:=char(Field);
  222. {}  case Justify of
  223. {}    Left:  begin
  224. {}             Index:=1;
  225. {}             CursorCol:=Col+L;
  226. {}           end;
  227. {}    Right: begin
  228. {}             Index:=succ(Field)-L;
  229. {}             CursorCol:=Col+pred(Field);
  230. {}           end;
  231. {}  end;
  232. {}  move (DataEntryStr[1],VideoStr[Index],L);
  233. {}  QwriteV (Row,Col,-1,VideoStr);
  234. {}  GotoRC  (Row,CursorCol);
  235. {}end;
  236.  
  237. {}procedure AppendStr;
  238. {}var L: integer;
  239. {}begin
  240. {}  L:=ord(DataEntryStr[0]);
  241. {}  Null:=false;
  242. {}  if Key=BSKey then
  243. {}    begin
  244. {}      if L>0 then
  245. {}        DataEntryStr[0]:=pred(DataEntryStr[0]);
  246. {}    end
  247. {}  else
  248. {}    if L<Field then DataEntryStr:=DataEntryStr+Key;
  249. {}end;
  250.  
  251. begin
  252.   case TypeOfData of
  253.     Bytes:           ValidCharSet:=['0'..'9',BSKey];
  254.     Integers:        ValidCharSet:=['0'..'9','-','+',BSKey];
  255.     Reals:           ValidCharSet:=['0'..'9','-','+','.','E','e',BSKey];
  256.     Chars, Strings:  ValidCharSet:=[' '..'~',BSKey,NullKey]
  257.   else               ValidCharSet:=UserCharSet;   { UserNums and UserStrings }
  258.   end;
  259.   case TypeOfData of
  260.     Bytes..UserNums: if AutoNumLock then NumLock(On);
  261.   end;  { case }
  262.   if WorkWndwStep<>OldWorkWndwStep then DataPad.NewData:=true;
  263.   if DataPad.NewData then
  264.     begin
  265.       DataEntryStr:='';
  266.       Null:=false;
  267.       DataPad.NewData:=false;
  268.       OldWorkWndwStep:=WorkWndwStep
  269.     end;
  270.   Qwrite  (Row,pred(Col)     ,-1,'»');
  271.   Qwrite  (Row,     Col+Field,-1,'«');
  272.   DisplayStrAndCursor;
  273.   repeat
  274.     MonitorNumLock;
  275.     ReadKB (ExtKey,Key);
  276.     if ExtKey then
  277.       case Key of
  278.         HelpKey: PullHelpWndw (HelpWndwNum,HelpTitle); { F1 }
  279.         DelKey:  if NullKey in ValidCharSet then
  280.                  begin
  281.                    DataEntryStr:='';
  282.                    DisplayStrAndCursor;
  283.                    Null:=true;
  284.                  end;
  285.         PopKey:  PopToWorkWndw:=true;  { F2 }
  286.         TopKey1: PopToTop:=true;       { F10 }
  287.       end      { end case }
  288.     else
  289.       if Key in ValidCharSet then
  290.         begin
  291.           AppendStr;
  292.           DisplayStrAndCursor;
  293.         end
  294.       else
  295.         if TopKeyPressed then PopToTop:=true;
  296.     if (Key=RetKey) then PutDataOnPad (DataEntryStr);
  297.   until (Key=RetKey) or (Key=EscKey) or PopToWorkWndw or PopToTop;
  298.   case TypeOfData of
  299.     Bytes..UserNums: if AutoNumLock then NumLock(Off);
  300.   end;  { case }
  301. end;
  302.  
  303. procedure PullDataWndw;  { (VAR Menu: MenuRec; WndwNum: integer) }
  304. var  DataEntryStr: MaxString;
  305. begin
  306.   TurnArrows (On,Menu);
  307.   ShowDataWndw (Menu,DataWndw[WndwNum]);
  308.   CursorOn;
  309.   with Menu,DataPad do
  310.     begin
  311.       CmdSeq:=CmdSeq+CmdLtrs[HiLited];
  312.       Pull:=false;
  313.       NewData:=true;
  314.       repeat
  315.         with DataWndw[WndwNum] do
  316.           { DataEntryStr is LOCAL here! }
  317.           EnterData (Row+2,Col+FirstCol,Field,DataEntryStr,TypeOfData,Justify,
  318.                      HelpWndwNum,Menu.Line[HiLited]);
  319.         if (Key=RetKey) and Valid then
  320.           begin
  321.             StoreMenuData;   { Sets Key:=' ' if there's a range error. }
  322.             if DataStored then Changed:=true;
  323.           end;
  324.       until DataStored or (Key<>' ');
  325.       CheckForPop;
  326.       CmdSeq[0]:=pred(CmdSeq[0]);
  327.       if (Key=RetKey) then
  328.         if (MenuMode<=ExecMultipleChoice) or (LineMode[HiLited]=ExecOnly) then
  329.           Process(MPulled,SPulled,HiLited);
  330.     end;
  331.   Key:=' ';
  332.   CursorOff;
  333.   RemoveWindow;
  334.   TurnArrows (Off,Menu)
  335. end;
  336.  
  337. procedure RestoreData (VAR UserVariable; ErrMsg: integer);
  338. { RestoreData is used for WorkWndw Data Entries in the main program. }
  339. begin
  340.   ShowErrorMsg (ErrMsg);   { Makes Key:=' '. }
  341.   DataPad:=OldDataPad;
  342.   with DataPad do
  343.     begin
  344.       DataStored:=false;
  345.       NewData:=false;
  346.       StoreMode:=true
  347.     end;
  348.   Transfer (UserVariable);
  349. end;
  350.  
  351. procedure WorkWndwEntry (Row,Col,Field: integer; VAR UserVariable;
  352.                          TOD: TypeOfDataType; Justify: DirType;
  353.                          HelpWndwNum: integer; HelpTitle: MaxString);
  354. begin
  355.   with DataPad do
  356.     begin
  357.       StoreMode:=false;
  358.       TypeOfData:=TOD;
  359.       Transfer (UserVariable);
  360.       OldDataPad:=DataPad;
  361.       ShowMsg (9);
  362.       { DataEntryStr is GLOBAL here! }
  363.       EnterData (Row,Col,Field,DataEntryStr,TOD,Justify,HelpWndwNum,HelpTitle);
  364.       if (Key=RetKey) and Valid then
  365.         begin
  366.           StoreMode:=true;
  367.           Transfer (UserVariable);
  368.           DataStored:=true
  369.         end
  370.       else DataStored:=false;
  371.     end;
  372.   if PopToWorkWndw or (Key=EscKey) or PopToTop then
  373.     Pull:=true;   { PTWW really means pull menus here. }
  374.   if not Pull then ShowMsg (1);
  375. end;
  376.  
  377. { The following procedures are only used once and never used again. }
  378.  
  379. procedure InitDataWndwSize;
  380. var Lmax,L,L2: integer;
  381. begin
  382.   for i:=1 to NumOfDataWndws do
  383.     with DataWndw[i] do
  384.       begin
  385.         Rows := 4;
  386.         L  := ord(Line[1][0]);
  387.         L2 := ord(Line[2][0]);
  388.         if L>=L2 then Lmax:=L else Lmax:=L2;
  389.         Cols := Lmax+7+Field;
  390.         FirstCol := Lmax+4;
  391.         Border := DataWndwBrdr;
  392.         { specify justification if omitted }
  393.         case Justify of
  394.           Left,Right: ;
  395.         else
  396.           case TypeOfData of
  397.             Bytes..UserNums: Justify:=Right;
  398.           else Justify:=Left;
  399.           end;
  400.         end   { case Justify }
  401.       end
  402. end;
  403.  
  404. procedure InitDataWndwColor;
  405. begin
  406.   for i:=1 to NumOfDataWndws do
  407.     with DataWndw[i] do
  408.       begin
  409.         Wattr  := DataWndwWattr;
  410.         Battr  := DataWndwBattr;
  411.       end
  412. end;
  413.