unit FInput;
{$X+}
{
  This unit implements a derivative of TInputLine that supports several
  data types dynamically.  It also provides formatted input for all the
  numerical types, keystroke filtering and uppercase conversion, field
  justification, and range checking.

  When the field is initialized, many filtering and uppercase converions
  are implemented pertinent to the particular data type.

  The CheckRange and ErrorHandler methods should be overridden if the
  user wants to implement then.

  This is just an initial implementation and comments are welcome. You
  can contact me via Compuserve. (76066,3202)

  I am releasing this into the public domain and anyone can use or modify
  it for their own personal use.

  Copyright (c) 1990 by Allen Bauer (76066,3202)

  This is version 1.1 - fixed input validation functions

}

interface
uses Objects, Drivers, Dialogs;

type
  VKeys = set of char;

  PFInputLine = ^TFInputLine;
  TFInputLine = object(TInputLine)
    ValidKeys : VKeys;
    DataType,Decimals : byte;
    imMode : word;
    Validated, ValidSent : boolean;
    constructor Init(var Bounds: TRect; AMaxLen: integer;
                     ChrSet: VKeys;DType, Dec: byte);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure GetData(var Rec); virtual;
    procedure SetData(var Rec); virtual;
    function DataSize: word; virtual;
    procedure Draw; virtual;
    function CheckRange: boolean; virtual;
    procedure ErrorHandler; virtual;
  end;

const
  imLeftJustify   = $0001;
  imRightJustify  = $0002;
  imConvertUpper  = $0004;

  DString   = 0;
  DChar     = 1;
  DReal     = 2;
  DByte     = 3;
  DShortInt = 4;
  DInteger  = 5;
  DLongInt  = 6;
  DWord     = 7;
  DDate     = 8;
  DTime     = 9;

  DRealSet      : VKeys = [#1..#31,'+','-','0'..'9','.','E','e'];
  DSignedSet    : VKeys = [#1..#31,'+','-','0'..'9'];
  DUnSignedSet  : VKeys = [#1..#31,'0'..'9'];
  DCharSet      : VKeys = [#1..#31,' '..'~'];
  DUpperSet     : VKeys = [#1..#31,' '..'`','{'..'~'];
  DAlphaSet     : VKeys = [#1..#31,'A'..'Z','a'..'z'];
  DFileNameSet  : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..'9','@'..'Z','^'..'{','}'..'~'];
  DPathSet      : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..':','@'..'Z','^'..'{','}'..'~','\'];
  DFileMaskSet  : VKeys = [#1..#31,'!','#'..'*','-'..'.','0'..':','?'..'Z','^'..'{','}'..'~','\'];
  DDateSet      : VKeys = [#1..#31,'0'..'9','/'];
  DTimeSet      : VKeys = [#1..#31,'0'..'9',':'];

  cmValidateYourself = 2000;

procedure RegisterFInputLine;

const
  RFInputLine : TStreamRec = (
    ObjType: 20000;
    VmtLink: Ofs(typeof(TFInputLine)^);
    Load:    @TFInputLine.Load;
    Store:   @TFinputLine.Store
  );

implementation

uses Views, MsgBox, StrFmt, Dos;

function CurrentDate : string;
var
  Year,Month,Day,DOW : word;
  DateStr : string[10];
begin
  GetDate(Year,Month,Day,DOW);
  DateStr := SFLongint(Month,2)+'/'
            +SFLongInt(Day,2)+'/'
            +SFLongInt(Year mod 100,2);
  for DOW := 1 to length(DateStr) do
    if DateStr[DOW] = ' ' then
      DateStr[DOW] := '0';
  CurrentDate := DateStr;
end;

function CurrentTime : string;
var
  Hour,Minute,Second,Sec100 : word;
  TimeStr : string[10];
begin
  GetTime(Hour,Minute,Second,Sec100);
  TimeStr := SFLongInt(Hour,2)+':'
            +SFLongInt(Minute,2)+':'
            +SFLongInt(Second,2);
  for Sec100 := 1 to length(TimeStr) do
    if TimeStr[Sec100] = ' ' then
      TimeStr[Sec100] := '0';
  CurrentTime := TimeStr;
end;

procedure RegisterFInputLine;
begin
  RegisterType(RFInputLine);
end;

constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
                             ChrSet: VKeys; DType, Dec: byte);
begin
  if (DType in [DDate,DTime]) and (AMaxLen < 8) then
    AMaxLen := 8;

  TInputLine.Init(Bounds,AMaxLen);

  ValidKeys:= ChrSet;
  DataType := DType;
  Decimals := Dec;
  Validated := true;
  ValidSent := false;
  case DataType of
    DReal,DByte,DLongInt,
    DShortInt,DWord      : imMode := imRightJustify;

    DChar,DString,
    DDate,DTime          : imMode := imLeftJustify;
  end;
  if ValidKeys = DUpperSet then
    imMode := imMode or imConvertUpper;
  EventMask := EventMask or evMessage;
end;

constructor TFInputLine.Load(var S: TStream);
begin
  TInputLine.Load(S);
  S.Read(ValidKeys, sizeof(VKeys));
  S.Read(DataType,  sizeof(byte));
  S.Read(Decimals,  sizeof(byte));
  S.Read(imMode,    sizeof(word));
  S.Read(Validated, sizeof(boolean));
  S.Read(ValidSent, sizeof(boolean));
end;

procedure TFInputLine.Store(var S: TStream);
begin
  TInputLine.Store(S);
  S.Write(ValidKeys, sizeof(VKeys));
  S.Write(DataType,  sizeof(byte));
  S.Write(Decimals,  sizeof(byte));
  S.Write(imMode,    sizeof(word));
  S.Write(Validated, sizeof(boolean));
  S.Write(ValidSent, sizeof(boolean));
end;

procedure TFInputLine.HandleEvent(var Event: TEvent);
var
  NewEvent: TEvent;
begin
  case Event.What of
    evKeyDown :  begin
                   if (imMode and imConvertUpper) <> 0 then
                     Event.CharCode := upcase(Event.CharCode);
                   if not(Event.CharCode in [#0..#31]) then
                   begin
                     Validated := false;
                     ValidSent := false;
                   end;
                   if (Event.CharCode <> #0) and not(Event.CharCode in ValidKeys) then
                     ClearEvent(Event);
                 end;
    evBroadcast: begin
                   if (Event.Command = cmReceivedFocus) and
                      (Event.InfoPtr <> @Self) and
                     ((Owner^.State and sfSelected) <> 0) and
                        not(Validated) and not(ValidSent) then
                   begin
                     NewEvent.What := evBroadcast;
                     NewEvent.InfoPtr := @Self;
                     NewEvent.Command := cmValidateYourself;
                     PutEvent(NewEvent);
                     ValidSent := true;
                   end;
                   if (Event.Command = cmValidateYourself) and
                      (Event.InfoPtr = @Self) then
                   begin
                     if not CheckRange then
                     begin
                       ErrorHandler;
                       Select;
                     end
                     else
                       Validated := true;
                     ValidSent := false;
                     ClearEvent(Event);
                   end;
                 end;
  end;
  TInputLine.HandleEvent(Event);
end;

procedure TFInputLine.GetData(var Rec);
var
  Code : integer;
begin
  case DataType of
    Dstring,
    DDate,
    DTime     : TInputLine.GetData(Rec);
    DChar     : char(Rec) := Data^[1];
    DReal     : val(Data^, real(Rec)     , Code);
    DByte     : val(Data^, byte(Rec)     , Code);
    DShortInt : val(Data^, shortint(Rec) , Code);
    DInteger  : val(Data^, integer(Rec)  , Code);
    DLongInt  : val(Data^, longint(Rec)  , Code);
    DWord     : val(Data^, word(Rec)     , Code);
  end;
end;

procedure TFInputLine.SetData(var Rec);
begin
  case DataType of
    DString,
    DDate,
    DTime     : TInputLine.SetData(Rec);
    DChar     : Data^ := char(Rec);
    DReal     : Data^ := SFDReal(real(Rec),MaxLen,Decimals);
    DByte     : Data^ := SFLongInt(byte(Rec),MaxLen);
    DShortInt : Data^ := SFLongInt(shortint(Rec),MaxLen);
    DInteger  : Data^ := SFLongInt(integer(Rec),MaxLen);
    DLongInt  : Data^ := SFLongInt(longint(Rec),MaxLen);
    DWord     : Data^ := SFLongInt(word(Rec),MaxLen);
  end;
  SelectAll(true);
end;

function TFInputLine.DataSize: word;
begin
  case DataType of
    DString,
    DDate,
    DTime     : DataSize := TInputLine.DataSize;
    DChar     : DataSize := sizeof(char);
    DByte     : DataSize := sizeof(byte);
    DShortInt : DataSize := sizeof(shortint);
    DInteger  : DataSize := sizeof(integer);
    DLongInt  : DataSize := sizeof(longint);
    DWord     : DataSize := sizeof(word);
  end;
end;

procedure TFInputLine.Draw;
var
  RD : real;
  Code : integer;
begin
  case DataType of
    DReal    : begin
                 if Data^ = '' then
                   Data^ := SFDReal(0.0,MaxLen,Decimals)
                 else
                 begin
                   val(Data^, RD, Code);
                   Data^ := SFDReal(RD,MaxLen,Decimals);
                 end;
               end;

    DByte,
    DShortInt,
    DInteger,
    DLongInt,
    DWord    : if Data^ = '' then Data^ := SFLongInt(0,MaxLen);

    DDate    : if Data^ = '' then Data^ := CurrentDate;
    DTime    : if Data^ = '' then Data^ := CurrentTime;

  end;

  if State and (sfFocused+sfSelected) <> 0 then
  begin
    if (imMode and imRightJustify) <> 0 then
      while (length(Data^) > 0) and (Data^[1] = ' ') do
        delete(Data^,1,1);
  end
  else
  begin
    if ((imMode and imRightJustify) <> 0) and (Data^ <> '') then
      while (length(Data^) < MaxLen) do
        insert(' ',Data^,1);
    if (imMode and imLeftJustify) <> 0 then
      while (length(Data^) > 0) and (Data^[1] = ' ') do
        delete(Data^,1,1);

  end;
  TInputLine.Draw;
end;

function TFInputLine.CheckRange: boolean;
var
  MH,DM,YS : longint;
  Code : integer;
  MHs,DMs,YSs : string[2];
  Delim : char;
  Ok : boolean;
begin
  Ok := true;
  case DataType of
    DDate,
    DTime : begin
              if DataType = DDate then Delim := '/' else Delim := ':';
              if pos(Delim,Data^) > 0 then
              begin
                MHs := copy(Data^,1,pos(Delim,Data^));
                DMs := copy(Data^,pos(Delim,Data^)+1,2);
                delete(Data^,pos(Delim,Data^),1);
                YSs := copy(Data^,pos(Delim,Data^)+1,2);
                if length(MHs) < 2 then MHs := '0' + MHs;
                if length(DMs) < 2 then DMs := '0' + DMs;
                if length(YSs) < 2 then YSs := '0' + YSs;
                Data^ := MHs + DMs + YSs;
              end;
              if (length(Data^) >= 6) and (pos(Delim,Data^) = 0) then
              begin
                val(copy(Data^,1,2), MH, Code);
                if Code <> 0 then MH := 0;
                val(copy(Data^,3,2), DM, Code);
                if Code <> 0 then DM := 0;
                val(copy(Data^,5,2), YS, Code);
                if Code <> 0 then YS := 0;
                if DataType = DDate then
                begin
                  if (MH > 12) or (MH < 1) or
                     (DM > 31) or (DM < 1) then Ok := false;
                end
                else
                begin
                  if (MH > 23) or (MH < 0) or
                     (DM > 59) or (DM < 0) or
                     (YS > 59) or (YS < 0) then Ok := false;
                end;
                insert(Delim,Data^,5);
                insert(Delim,Data^,3);
              end
              else
                Ok := false;
            end;

    DByte : begin
              val(Data^, MH, Code);
              if (Code <> 0) or (MH > 255) or (MH < 0) then Ok := false;
            end;

    DShortint :
            begin
              val(Data^, MH, Code);
              if (Code <> 0) or (MH < -127) or (MH > 127) then Ok := false;
            end;

    DInteger :
            begin
              val(Data^, MH, Code);
              if (Code <> 0) or (MH < -32768) or (MH > 32767) then Ok := false;
            end;

    DWord : begin
              val(Data^, MH, Code);
              if (Code <> 0) or (MH < 0) or (MH > 65535) then Ok := false;
            end;
  end;
  CheckRange := Ok;
end;

procedure TFInputLine.ErrorHandler;
var
  MsgString : string[80];
  Params : array[0..1] of longint;
  Event: TEvent;
begin
  fillchar(Params,sizeof(params),#0);
  MsgString := '';
  case DataType of
    DDate     : MsgString := ' Invalid Date Format!  Enter Date as MM/DD/YY ';
    DTime     : MsgString := ' Invalid Time Format!  Enter Time as HH:MM:SS ';
    DByte,
    DShortInt,
    DInteger,
    DWord     : begin
                  MsgString := ' Number must be between %d and %d ';
                  case DataType of
                    DByte     : Params[1] := 255;
                    DShortInt : begin Params[0] := -128; Params[1] := 127; end;
                    DInteger  : begin Params[0] := -32768; Params[1] := 32768; end;
                    DWord     : Params[1] := 65535;
                  end;
                end;
  end;
  MessageBox(MsgString, @Params, mfError + mfOkButton);
end;

end.