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