home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / OTHERUTI / TPASCAL3.ZIP / TVDEMOS.ZIP / FIELDS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-11  |  4KB  |  154 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Forms Demo                      }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit Fields;
  10.  
  11. {$F+,O+,X+,S-,D-}
  12.  
  13. interface
  14.  
  15. uses Objects, Drivers, Dialogs;
  16.  
  17. type
  18.  
  19.   { Same as TInputLine, except invalid if empty }
  20.   PKeyInputLine = ^TKeyInputLine;
  21.   TKeyInputLine = object(TInputLine)
  22.     function Valid(Command: Word): Boolean; virtual;
  23.   end;
  24.  
  25.   { Accepts only valid numeric input between Min and Max }
  26.   PNumInputLine = ^TNumInputLine;
  27.   TNumInputLine = object(TInputLine)
  28.     Min: Longint;
  29.     Max: Longint;
  30.     constructor Init(var Bounds: TRect; AMaxLen: Integer;
  31.       AMin, AMax: Longint);
  32.     constructor Load(var S: TStream);
  33.     function DataSize: Word; virtual;
  34.     procedure GetData(var Rec); virtual;
  35.     procedure SetData(var Rec); virtual;
  36.     procedure Store(var S: TStream);
  37.     function Valid(Command: Word): Boolean; virtual;
  38.   end;
  39.  
  40. procedure RegisterFields;
  41.  
  42. const
  43.   RKeyInputLine: TStreamRec = (
  44.      ObjType: 10060;
  45.      VmtLink: Ofs(TypeOf(TKeyInputLine)^);
  46.      Load:    @TKeyInputLine.Load;
  47.      Store:   @TKeyInputLine.Store
  48.   );
  49.   RNumInputLine: TStreamRec = (
  50.      ObjType: 10061;
  51.      VmtLink: Ofs(TypeOf(TNumInputLine)^);
  52.      Load:    @TNumInputLine.Load;
  53.      Store:   @TNumInputLine.Store
  54.   );
  55.  
  56. implementation
  57.  
  58. uses Views, MsgBox;
  59.  
  60. procedure RegisterFields;
  61. begin
  62.   RegisterType(RKeyInputLine);
  63.   RegisterType(RNumInputLine);
  64. end;
  65.  
  66. { TKeyInputLine }
  67.  
  68. function TKeyInputLine.Valid(Command: Word): Boolean;
  69. var
  70.   Ok: Boolean;
  71. begin
  72.   Ok := True;
  73.   if (Command <> cmCancel) and (Command <> cmValid) then
  74.   begin
  75.     if Data^ = '' then
  76.     begin
  77.       Select;
  78.       MessageBox('This field cannot be empty.', nil, mfError + mfOkButton);
  79.       Ok := False;
  80.     end;
  81.   end;
  82.   if Ok then Valid := TInputLine.Valid(Command)
  83.   else Valid := False;
  84. end;
  85.  
  86. { TNumInputLine }
  87. constructor TNumInputLine.Init(var Bounds: TRect; AMaxLen: Integer;
  88.   AMin, AMax: Longint);
  89. begin
  90.   TInputLine.Init(Bounds, AMaxLen);
  91.   Min := AMin;
  92.   Max := AMax;
  93. end;
  94.  
  95. constructor TNumInputLine.Load(var S: TStream);
  96. begin
  97.   TInputLine.Load(S);
  98.   S.Read(Min, SizeOf(LongInt) * 2);
  99. end;
  100.  
  101. function TNumInputLine.DataSize: Word;
  102. begin
  103.   DataSize := SizeOf(LongInt);
  104. end;
  105.  
  106. procedure TNumInputLine.GetData(var Rec);
  107. var
  108.   Code: Integer;
  109. begin
  110.   Val(Data^, Longint(Rec), Code);
  111. end;
  112.  
  113. procedure TNumInputLine.Store(var S: TStream);
  114. begin
  115.   TInputLine.Store(S);
  116.   S.Write(Min, SizeOf(Longint) * 2);
  117. end;
  118.  
  119. procedure TNumInputLine.SetData(var Rec);
  120. var
  121.   S: string[12];
  122. begin
  123.   Str(Longint(Rec), Data^);
  124.   SelectAll(True);
  125. end;
  126.  
  127. function TNumInputLine.Valid(Command: Word): Boolean;
  128. var
  129.   Code: Integer;
  130.   Value: Longint;
  131.   Params: array[0..1] of LongInt;
  132.   Ok: Boolean;
  133. begin
  134.   Ok := True;
  135.   if (Command <> cmCancel) and (Command <> cmValid) then
  136.   begin
  137.     if Data^ = '' then Data^ := '0';
  138.     Val(Data^, Value, Code);
  139.     if (Code <> 0) or (Value < Min) or (Value > Max) then
  140.     begin
  141.       Select;
  142.       Params[0] := Min;
  143.       Params[1] := Max;
  144.       MessageBox('Number must be from %D to %D.', @Params, mfError + mfOkButton);
  145.       SelectAll(True);
  146.       Ok := False;
  147.     end;
  148.   end;
  149.   if Ok then Valid := TInputLine.Valid(Command)
  150.   else Valid := False;
  151. end;
  152.  
  153. end.
  154.