home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 12 / CD_ASCQ_12_0294.iso / maj / 535 / inplong.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-27  |  8KB  |  296 lines
  1. {$B-,X+}
  2.  
  3. Unit InpLong;
  4.  
  5. (*--
  6. TInputLong is a derivitave of TInputline designed to accept LongInt
  7. numeric input.  Since both the upper and lower limit of acceptable numeric
  8. input can be set, TInputLong may be used for Integer, Word, or Byte input
  9. as well.  Option flag bits allow optional hex input and display.  A blank
  10. field may optionally be rejected or interpreted as zero.
  11.  
  12. Methods
  13.  
  14. constructor Init(var R : TRect; AMaxLen : Integer;
  15.                 LowerLim, UpperLim : LongInt; Flgs : Word);
  16.  
  17. Calls TInputline.Init and saves the desired limits and Flags.  Flags may
  18. be a combination of:
  19.  
  20. ilHex          will accept hex input (preceded by '$')  as well as decimal.
  21. ilBlankEqZero  if set, will interpret a blank field as '0'.
  22. ilDisplayHex   if set, will display numeric as hex when possible.
  23.  
  24.  
  25. constructor Load(var S : TStream);
  26. procedure Store(var S : TStream);
  27.  
  28. The usual Load and Store routines.  Be sure to call RegisterType(RInputLong)
  29. to register the type.
  30.  
  31.  
  32. FUNCTION DataSize : Word; virtual;
  33. PROCEDURE GetData(var Rec); virtual;
  34. PROCEDURE SetData(var Rec); virtual;
  35.  
  36. The transfer methods.  DataSize is Sizeof(LongInt) and Rec should be
  37. the address of a LongInt.
  38.  
  39.  
  40. FUNCTION RangeCheck : Boolean; virtual;
  41.  
  42. Returns True if the entered string evaluates to a number >= LowerLim and
  43. <= UpperLim.
  44.  
  45.  
  46. PROCEDURE Error; virtual;
  47.  
  48. Error is called when RangeCheck fails.  It displays a messagebox indicating
  49. the label (if any) of the faulting view, as well as the allowable range.
  50.  
  51.  
  52. PROCEDURE HandleEvent(var Event : TEvent); virtual;
  53.  
  54. HandleEvent filters out characters which are not appropriate to numeric
  55. input.  Tab and Shift Tab cause a call to RangeCheck and a call to Error
  56. if RangeCheck returns false.  The input must be valid to Tab from the view.
  57. There's no attempt made to stop moving to another view with the mouse.
  58.  
  59.  
  60. FUNCTION Valid(Cmd : Word) : Boolean; virtual;
  61.  
  62. if TInputline.Valid is true and Cmd is neither cmValid or cmCancel, Valid
  63. then calls RangeCheck.  If RangeCheck is false, then Error is called and
  64. Valid returns False.
  65.  
  66. ----*)
  67.  
  68. Interface
  69. uses Objects, Drivers, Views, Dialogs, MsgBox;
  70.  
  71. {flags for TInputLong constructor}
  72. const
  73.   ilHex = 1;          {will enable hex input with leading '$'}
  74.   ilBlankEqZero = 2;  {No input (blank) will be interpreted as '0'}
  75.   ilDisplayHex = 4;   {Number displayed as hex when possible}
  76. Type
  77.   TInputLong = Object(TInputLine)
  78.     ILOptions : Word;
  79.     LLim, ULim : LongInt;
  80.     constructor Init(var R : TRect; AMaxLen : Integer;
  81.         LowerLim, UpperLim : LongInt; Flgs : Word);
  82.     constructor Load(var S : TStream);
  83.     procedure Store(var S : TStream);
  84.     FUNCTION DataSize : Word; virtual;
  85.     PROCEDURE GetData(var Rec); virtual;
  86.     PROCEDURE SetData(var Rec); virtual;
  87.     FUNCTION RangeCheck : Boolean; virtual;
  88.     PROCEDURE Error; virtual;
  89.     PROCEDURE HandleEvent(var Event : TEvent); virtual;
  90.     FUNCTION Valid(Cmd : Word) : Boolean; virtual;
  91.     end;
  92.   PInputLong = ^TInputLong;
  93.  
  94. const
  95.   RInputLong : TStreamRec = (
  96.     ObjType: 711;
  97.     VmtLink: Ofs(Typeof(TInputLong)^);
  98.     Load : @TInputLong.Load;
  99.     Store : @TInputLong.Store);
  100.  
  101. Implementation
  102.  
  103. {-----------------TInputLong.Init}
  104. constructor TInputLong.Init(var R : TRect; AMaxLen : Integer;
  105.         LowerLim, UpperLim : LongInt; Flgs : Word);
  106. begin
  107. if not TInputLine.Init(R, AMaxLen) then fail;
  108. ULim := UpperLim;
  109. LLim := LowerLim;
  110. if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
  111. ILOptions := Flgs;
  112. if ILOptions and ilBlankEqZero <> 0 then Data^ := '0';
  113. end;
  114.  
  115. {-------------------TInputLong.Load}
  116. constructor TInputLong.Load(var S : TStream);
  117. begin
  118. TInputLine.Load(S);
  119. S.Read(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
  120. end;
  121.  
  122. {-------------------TInputLong.Store}
  123. procedure TInputLong.Store(var S : TStream);
  124. begin
  125. TInputLine.Store(S);
  126. S.Write(ILOptions, Sizeof(ILOptions)+Sizeof(LLim)+Sizeof(ULim));
  127. end;
  128.  
  129. {-------------------TInputLong.DataSize}
  130. FUNCTION TInputLong.DataSize: Word;
  131. begin
  132. DataSize := Sizeof(LongInt);
  133. end;
  134.  
  135. {-------------------TInputLong.GetData}
  136. PROCEDURE TInputLong.GetData(var Rec);
  137. var code : Integer;
  138. begin
  139. Val(Data^, LongInt(Rec), code);
  140. end;
  141.  
  142. FUNCTION Hex2(B : Byte) : String;
  143. Const
  144.   HexArray : array[0..15] of char = '0123456789ABCDEF';
  145. begin
  146. Hex2[0] := #2;
  147. Hex2[1] := HexArray[B shr 4];
  148. Hex2[2] := HexArray[B and $F];
  149. end;
  150.  
  151. FUNCTION Hex4(W : Word) : String;
  152. begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
  153.  
  154. FUNCTION Hex8(L : LongInt) : String;
  155. begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
  156.  
  157. function FormHexStr(L : LongInt) : String;
  158. var
  159.   Minus : boolean;
  160.   S : string[20];
  161. begin
  162. Minus := L < 0;
  163. if Minus then L := -L;
  164. S := Hex8(L);
  165. while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
  166. S := '$' + S;
  167. if Minus then System.Insert('-', S, 2);
  168. FormHexStr := S;
  169. end;
  170.  
  171. {-------------------TInputLong.SetData}
  172. PROCEDURE TInputLong.SetData(var Rec);
  173. var
  174.   L : LongInt;
  175.   S : string;
  176. begin
  177. L := LongInt(Rec);
  178. if L > ULim then L := ULim
  179. else if L < LLim then L := LLim;
  180. if ILOptions and ilDisplayHex <> 0 then
  181.   S := FormHexStr(L)
  182. else
  183.   Str(L : -1, S);
  184. if Length(S) > MaxLen then S[0] := chr(MaxLen);
  185. Data^ := S;
  186. end;
  187.  
  188. {-------------------TInputLong.RangeCheck}
  189. FUNCTION TInputLong.RangeCheck : Boolean;
  190. var
  191.   L : LongInt;
  192.   code : Integer;
  193. begin
  194. if (Data^ = '') and (ILOptions and ilBlankEqZero <> 0) then
  195.   Data^ := '0';
  196. Val(Data^, L, code);
  197. RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
  198. end;
  199.  
  200. {-------------------TInputLong.Error}
  201. PROCEDURE TInputLong.Error;
  202. var
  203.   SU, SL : string[40];
  204.   PMyLabel : PLabel;
  205.   Labl : string;
  206.   I : Integer;
  207.  
  208.   function FindIt(P : PView) : boolean; far;
  209.   begin
  210.   FindIt := (Typeof(P^) = Typeof(TLabel)) and (PLabel(P)^.Link = @Self);
  211.   end;
  212.  
  213. begin
  214. Str(LLim : -1, SL);
  215. Str(ULim : -1, SU);
  216. if ILOptions and ilHex <> 0 then
  217.   begin
  218.   SL := SL+'('+FormHexStr(LLim)+')';
  219.   SU := SU+'('+FormHexStr(ULim)+')';
  220.   end;
  221. if Owner <> Nil then
  222.   PMyLabel := PLabel(Owner^.FirstThat(@FindIt))
  223. else PMyLabel := Nil;
  224. if PMyLabel <> Nil then PMyLabel^.GetText(Labl)
  225. else Labl := '';
  226. if Labl <> '' then
  227.   begin
  228.   I := Pos('~', Labl);
  229.   while I > 0 do
  230.     begin
  231.     System.Delete(Labl, I, 1);
  232.     I := Pos('~', Labl);
  233.     end;
  234.   Labl := '"'+Labl+'"';
  235.   end;
  236. MessageBox(Labl + ^M^J'Value not within range '+SL+' to '+SU, Nil,
  237.                             mfError+mfOKButton);
  238. end;
  239.  
  240. {-------------------TInputLong.HandleEvent}
  241. PROCEDURE TInputLong.HandleEvent(var Event : TEvent);
  242. var
  243.   SU, SL : string[50];
  244.   Code : Integer;
  245.   L : LongInt;
  246. begin
  247. if (Event.What = evKeyDown) then
  248.   begin
  249.     case Event.KeyCode of
  250.        kbTab, kbShiftTab
  251.           : if not RangeCheck then
  252.               begin
  253.               Error;
  254.               SelectAll(True);
  255.               ClearEvent(Event);
  256.               end;
  257.       end;
  258.   if Event.CharCode <> #0 then  {a character key}
  259.     begin
  260.     Event.Charcode := Upcase(Event.Charcode);
  261.     case Event.Charcode of
  262.       '0'..'9', #1..#$1B : ;       {acceptable}
  263.  
  264.       '-'       : if (LLim >= 0) or (CurPos <> 0) then
  265.                         ClearEvent(Event);
  266.       '$'       : if ILOptions and ilHex = 0 then ClearEvent(Event);
  267.       'A'..'F'  : if Pos('$', Data^) = 0 then ClearEvent(Event);
  268.  
  269.       else ClearEvent(Event);
  270.       end;
  271.     end;
  272.   end;
  273. TInputLine.HandleEvent(Event);
  274. end;
  275.  
  276. {-------------------TInputLong.Valid}
  277. FUNCTION TInputLong.Valid(Cmd : Word) : Boolean;
  278. var
  279.   Rslt : boolean;
  280. begin
  281. Rslt := TInputLine.Valid(Cmd);
  282. if Rslt and (Cmd <> 0) and (Cmd <> cmCancel) then
  283.   begin
  284.   Rslt := RangeCheck;
  285.   if not Rslt then
  286.     begin
  287.     Error;
  288.     Select;
  289.     SelectAll(True);
  290.     end;
  291.   end;
  292. Valid := Rslt;
  293. end;
  294.  
  295. end.
  296.