home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp6goodi / finput / finput.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-01-01  |  12.6 KB  |  423 lines
  1. unit FInput;
  2. {$X+}
  3. {
  4.   This unit implements a derivative of TInputLine that supports several
  5.   data types dynamically.  It also provides formatted input for all the
  6.   numerical types, keystroke filtering and uppercase conversion, field
  7.   justification, and range checking.
  8.  
  9.   When the field is initialized, many filtering and uppercase converions
  10.   are implemented pertinent to the particular data type.
  11.  
  12.   The CheckRange and ErrorHandler methods should be overridden if the
  13.   user wants to implement then.
  14.  
  15.   This is just an initial implementation and comments are welcome. You
  16.   can contact me via Compuserve. (76066,3202)
  17.  
  18.   I am releasing this into the public domain and anyone can use or modify
  19.   it for their own personal use.
  20.  
  21.   Copyright (c) 1990 by Allen Bauer (76066,3202)
  22.  
  23.   This is version 1.1 - fixed input validation functions
  24.  
  25. }
  26.  
  27. interface
  28. uses Objects, Drivers, Dialogs;
  29.  
  30. type
  31.   VKeys = set of char;
  32.  
  33.   PFInputLine = ^TFInputLine;
  34.   TFInputLine = object(TInputLine)
  35.     ValidKeys : VKeys;
  36.     DataType,Decimals : byte;
  37.     imMode : word;
  38.     Validated, ValidSent : boolean;
  39.     constructor Init(var Bounds: TRect; AMaxLen: integer;
  40.                      ChrSet: VKeys;DType, Dec: byte);
  41.     constructor Load(var S: TStream);
  42.     procedure Store(var S: TStream);
  43.     procedure HandleEvent(var Event: TEvent); virtual;
  44.     procedure GetData(var Rec); virtual;
  45.     procedure SetData(var Rec); virtual;
  46.     function DataSize: word; virtual;
  47.     procedure Draw; virtual;
  48.     function CheckRange: boolean; virtual;
  49.     procedure ErrorHandler; virtual;
  50.   end;
  51.  
  52. const
  53.   imLeftJustify   = $0001;
  54.   imRightJustify  = $0002;
  55.   imConvertUpper  = $0004;
  56.  
  57.   DString   = 0;
  58.   DChar     = 1;
  59.   DReal     = 2;
  60.   DByte     = 3;
  61.   DShortInt = 4;
  62.   DInteger  = 5;
  63.   DLongInt  = 6;
  64.   DWord     = 7;
  65.   DDate     = 8;
  66.   DTime     = 9;
  67.  
  68.   DRealSet      : VKeys = [#1..#31,'+','-','0'..'9','.','E','e'];
  69.   DSignedSet    : VKeys = [#1..#31,'+','-','0'..'9'];
  70.   DUnSignedSet  : VKeys = [#1..#31,'0'..'9'];
  71.   DCharSet      : VKeys = [#1..#31,' '..'~'];
  72.   DUpperSet     : VKeys = [#1..#31,' '..'`','{'..'~'];
  73.   DAlphaSet     : VKeys = [#1..#31,'A'..'Z','a'..'z'];
  74.   DFileNameSet  : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..'9','@'..'Z','^'..'{','}'..'~'];
  75.   DPathSet      : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..':','@'..'Z','^'..'{','}'..'~','\'];
  76.   DFileMaskSet  : VKeys = [#1..#31,'!','#'..'*','-'..'.','0'..':','?'..'Z','^'..'{','}'..'~','\'];
  77.   DDateSet      : VKeys = [#1..#31,'0'..'9','/'];
  78.   DTimeSet      : VKeys = [#1..#31,'0'..'9',':'];
  79.  
  80.   cmValidateYourself = 2000;
  81.  
  82. procedure RegisterFInputLine;
  83.  
  84. const
  85.   RFInputLine : TStreamRec = (
  86.     ObjType: 20000;
  87.     VmtLink: Ofs(typeof(TFInputLine)^);
  88.     Load:    @TFInputLine.Load;
  89.     Store:   @TFinputLine.Store
  90.   );
  91.  
  92. implementation
  93.  
  94. uses Views, MsgBox, StrFmt, Dos;
  95.  
  96. function CurrentDate : string;
  97. var
  98.   Year,Month,Day,DOW : word;
  99.   DateStr : string[10];
  100. begin
  101.   GetDate(Year,Month,Day,DOW);
  102.   DateStr := SFLongint(Month,2)+'/'
  103.             +SFLongInt(Day,2)+'/'
  104.             +SFLongInt(Year mod 100,2);
  105.   for DOW := 1 to length(DateStr) do
  106.     if DateStr[DOW] = ' ' then
  107.       DateStr[DOW] := '0';
  108.   CurrentDate := DateStr;
  109. end;
  110.  
  111. function CurrentTime : string;
  112. var
  113.   Hour,Minute,Second,Sec100 : word;
  114.   TimeStr : string[10];
  115. begin
  116.   GetTime(Hour,Minute,Second,Sec100);
  117.   TimeStr := SFLongInt(Hour,2)+':'
  118.             +SFLongInt(Minute,2)+':'
  119.             +SFLongInt(Second,2);
  120.   for Sec100 := 1 to length(TimeStr) do
  121.     if TimeStr[Sec100] = ' ' then
  122.       TimeStr[Sec100] := '0';
  123.   CurrentTime := TimeStr;
  124. end;
  125.  
  126. procedure RegisterFInputLine;
  127. begin
  128.   RegisterType(RFInputLine);
  129. end;
  130.  
  131. constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
  132.                              ChrSet: VKeys; DType, Dec: byte);
  133. begin
  134.   if (DType in [DDate,DTime]) and (AMaxLen < 8) then
  135.     AMaxLen := 8;
  136.  
  137.   TInputLine.Init(Bounds,AMaxLen);
  138.  
  139.   ValidKeys:= ChrSet;
  140.   DataType := DType;
  141.   Decimals := Dec;
  142.   Validated := true;
  143.   ValidSent := false;
  144.   case DataType of
  145.     DReal,DByte,DLongInt,
  146.     DShortInt,DWord      : imMode := imRightJustify;
  147.  
  148.     DChar,DString,
  149.     DDate,DTime          : imMode := imLeftJustify;
  150.   end;
  151.   if ValidKeys = DUpperSet then
  152.     imMode := imMode or imConvertUpper;
  153.   EventMask := EventMask or evMessage;
  154. end;
  155.  
  156. constructor TFInputLine.Load(var S: TStream);
  157. begin
  158.   TInputLine.Load(S);
  159.   S.Read(ValidKeys, sizeof(VKeys));
  160.   S.Read(DataType,  sizeof(byte));
  161.   S.Read(Decimals,  sizeof(byte));
  162.   S.Read(imMode,    sizeof(word));
  163.   S.Read(Validated, sizeof(boolean));
  164.   S.Read(ValidSent, sizeof(boolean));
  165. end;
  166.  
  167. procedure TFInputLine.Store(var S: TStream);
  168. begin
  169.   TInputLine.Store(S);
  170.   S.Write(ValidKeys, sizeof(VKeys));
  171.   S.Write(DataType,  sizeof(byte));
  172.   S.Write(Decimals,  sizeof(byte));
  173.   S.Write(imMode,    sizeof(word));
  174.   S.Write(Validated, sizeof(boolean));
  175.   S.Write(ValidSent, sizeof(boolean));
  176. end;
  177.  
  178. procedure TFInputLine.HandleEvent(var Event: TEvent);
  179. var
  180.   NewEvent: TEvent;
  181. begin
  182.   case Event.What of
  183.     evKeyDown :  begin
  184.                    if (imMode and imConvertUpper) <> 0 then
  185.                      Event.CharCode := upcase(Event.CharCode);
  186.                    if not(Event.CharCode in [#0..#31]) then
  187.                    begin
  188.                      Validated := false;
  189.                      ValidSent := false;
  190.                    end;
  191.                    if (Event.CharCode <> #0) and not(Event.CharCode in ValidKeys) then
  192.                      ClearEvent(Event);
  193.                  end;
  194.     evBroadcast: begin
  195.                    if (Event.Command = cmReceivedFocus) and
  196.                       (Event.InfoPtr <> @Self) and
  197.                      ((Owner^.State and sfSelected) <> 0) and
  198.                         not(Validated) and not(ValidSent) then
  199.                    begin
  200.                      NewEvent.What := evBroadcast;
  201.                      NewEvent.InfoPtr := @Self;
  202.                      NewEvent.Command := cmValidateYourself;
  203.                      PutEvent(NewEvent);
  204.                      ValidSent := true;
  205.                    end;
  206.                    if (Event.Command = cmValidateYourself) and
  207.                       (Event.InfoPtr = @Self) then
  208.                    begin
  209.                      if not CheckRange then
  210.                      begin
  211.                        ErrorHandler;
  212.                        Select;
  213.                      end
  214.                      else
  215.                        Validated := true;
  216.                      ValidSent := false;
  217.                      ClearEvent(Event);
  218.                    end;
  219.                  end;
  220.   end;
  221.   TInputLine.HandleEvent(Event);
  222. end;
  223.  
  224. procedure TFInputLine.GetData(var Rec);
  225. var
  226.   Code : integer;
  227. begin
  228.   case DataType of
  229.     Dstring,
  230.     DDate,
  231.     DTime     : TInputLine.GetData(Rec);
  232.     DChar     : char(Rec) := Data^[1];
  233.     DReal     : val(Data^, real(Rec)     , Code);
  234.     DByte     : val(Data^, byte(Rec)     , Code);
  235.     DShortInt : val(Data^, shortint(Rec) , Code);
  236.     DInteger  : val(Data^, integer(Rec)  , Code);
  237.     DLongInt  : val(Data^, longint(Rec)  , Code);
  238.     DWord     : val(Data^, word(Rec)     , Code);
  239.   end;
  240. end;
  241.  
  242. procedure TFInputLine.SetData(var Rec);
  243. begin
  244.   case DataType of
  245.     DString,
  246.     DDate,
  247.     DTime     : TInputLine.SetData(Rec);
  248.     DChar     : Data^ := char(Rec);
  249.     DReal     : Data^ := SFDReal(real(Rec),MaxLen,Decimals);
  250.     DByte     : Data^ := SFLongInt(byte(Rec),MaxLen);
  251.     DShortInt : Data^ := SFLongInt(shortint(Rec),MaxLen);
  252.     DInteger  : Data^ := SFLongInt(integer(Rec),MaxLen);
  253.     DLongInt  : Data^ := SFLongInt(longint(Rec),MaxLen);
  254.     DWord     : Data^ := SFLongInt(word(Rec),MaxLen);
  255.   end;
  256.   SelectAll(true);
  257. end;
  258.  
  259. function TFInputLine.DataSize: word;
  260. begin
  261.   case DataType of
  262.     DString,
  263.     DDate,
  264.     DTime     : DataSize := TInputLine.DataSize;
  265.     DChar     : DataSize := sizeof(char);
  266.     DByte     : DataSize := sizeof(byte);
  267.     DShortInt : DataSize := sizeof(shortint);
  268.     DInteger  : DataSize := sizeof(integer);
  269.     DLongInt  : DataSize := sizeof(longint);
  270.     DWord     : DataSize := sizeof(word);
  271.   end;
  272. end;
  273.  
  274. procedure TFInputLine.Draw;
  275. var
  276.   RD : real;
  277.   Code : integer;
  278. begin
  279.   case DataType of
  280.     DReal    : begin
  281.                  if Data^ = '' then
  282.                    Data^ := SFDReal(0.0,MaxLen,Decimals)
  283.                  else
  284.                  begin
  285.                    val(Data^, RD, Code);
  286.                    Data^ := SFDReal(RD,MaxLen,Decimals);
  287.                  end;
  288.                end;
  289.  
  290.     DByte,
  291.     DShortInt,
  292.     DInteger,
  293.     DLongInt,
  294.     DWord    : if Data^ = '' then Data^ := SFLongInt(0,MaxLen);
  295.  
  296.     DDate    : if Data^ = '' then Data^ := CurrentDate;
  297.     DTime    : if Data^ = '' then Data^ := CurrentTime;
  298.  
  299.   end;
  300.  
  301.   if State and (sfFocused+sfSelected) <> 0 then
  302.   begin
  303.     if (imMode and imRightJustify) <> 0 then
  304.       while (length(Data^) > 0) and (Data^[1] = ' ') do
  305.         delete(Data^,1,1);
  306.   end
  307.   else
  308.   begin
  309.     if ((imMode and imRightJustify) <> 0) and (Data^ <> '') then
  310.       while (length(Data^) < MaxLen) do
  311.         insert(' ',Data^,1);
  312.     if (imMode and imLeftJustify) <> 0 then
  313.       while (length(Data^) > 0) and (Data^[1] = ' ') do
  314.         delete(Data^,1,1);
  315.  
  316.   end;
  317.   TInputLine.Draw;
  318. end;
  319.  
  320. function TFInputLine.CheckRange: boolean;
  321. var
  322.   MH,DM,YS : longint;
  323.   Code : integer;
  324.   MHs,DMs,YSs : string[2];
  325.   Delim : char;
  326.   Ok : boolean;
  327. begin
  328.   Ok := true;
  329.   case DataType of
  330.     DDate,
  331.     DTime : begin
  332.               if DataType = DDate then Delim := '/' else Delim := ':';
  333.               if pos(Delim,Data^) > 0 then
  334.               begin
  335.                 MHs := copy(Data^,1,pos(Delim,Data^));
  336.                 DMs := copy(Data^,pos(Delim,Data^)+1,2);
  337.                 delete(Data^,pos(Delim,Data^),1);
  338.                 YSs := copy(Data^,pos(Delim,Data^)+1,2);
  339.                 if length(MHs) < 2 then MHs := '0' + MHs;
  340.                 if length(DMs) < 2 then DMs := '0' + DMs;
  341.                 if length(YSs) < 2 then YSs := '0' + YSs;
  342.                 Data^ := MHs + DMs + YSs;
  343.               end;
  344.               if (length(Data^) >= 6) and (pos(Delim,Data^) = 0) then
  345.               begin
  346.                 val(copy(Data^,1,2), MH, Code);
  347.                 if Code <> 0 then MH := 0;
  348.                 val(copy(Data^,3,2), DM, Code);
  349.                 if Code <> 0 then DM := 0;
  350.                 val(copy(Data^,5,2), YS, Code);
  351.                 if Code <> 0 then YS := 0;
  352.                 if DataType = DDate then
  353.                 begin
  354.                   if (MH > 12) or (MH < 1) or
  355.                      (DM > 31) or (DM < 1) then Ok := false;
  356.                 end
  357.                 else
  358.                 begin
  359.                   if (MH > 23) or (MH < 0) or
  360.                      (DM > 59) or (DM < 0) or
  361.                      (YS > 59) or (YS < 0) then Ok := false;
  362.                 end;
  363.                 insert(Delim,Data^,5);
  364.                 insert(Delim,Data^,3);
  365.               end
  366.               else
  367.                 Ok := false;
  368.             end;
  369.  
  370.     DByte : begin
  371.               val(Data^, MH, Code);
  372.               if (Code <> 0) or (MH > 255) or (MH < 0) then Ok := false;
  373.             end;
  374.  
  375.     DShortint :
  376.             begin
  377.               val(Data^, MH, Code);
  378.               if (Code <> 0) or (MH < -127) or (MH > 127) then Ok := false;
  379.             end;
  380.  
  381.     DInteger :
  382.             begin
  383.               val(Data^, MH, Code);
  384.               if (Code <> 0) or (MH < -32768) or (MH > 32767) then Ok := false;
  385.             end;
  386.  
  387.     DWord : begin
  388.               val(Data^, MH, Code);
  389.               if (Code <> 0) or (MH < 0) or (MH > 65535) then Ok := false;
  390.             end;
  391.   end;
  392.   CheckRange := Ok;
  393. end;
  394.  
  395. procedure TFInputLine.ErrorHandler;
  396. var
  397.   MsgString : string[80];
  398.   Params : array[0..1] of longint;
  399.   Event: TEvent;
  400. begin
  401.   fillchar(Params,sizeof(params),#0);
  402.   MsgString := '';
  403.   case DataType of
  404.     DDate     : MsgString := ' Invalid Date Format!  Enter Date as MM/DD/YY ';
  405.     DTime     : MsgString := ' Invalid Time Format!  Enter Time as HH:MM:SS ';
  406.     DByte,
  407.     DShortInt,
  408.     DInteger,
  409.     DWord     : begin
  410.                   MsgString := ' Number must be between %d and %d ';
  411.                   case DataType of
  412.                     DByte     : Params[1] := 255;
  413.                     DShortInt : begin Params[0] := -128; Params[1] := 127; end;
  414.                     DInteger  : begin Params[0] := -32768; Params[1] := 32768; end;
  415.                     DWord     : Params[1] := 65535;
  416.                   end;
  417.                 end;
  418.   end;
  419.   MessageBox(MsgString, @Params, mfError + mfOkButton);
  420. end;
  421.  
  422. end.
  423.