home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pctchnqs
/
1992
/
number1
/
finput
/
finput.pas
next >
Wrap
Pascal/Delphi Source File
|
1991-01-19
|
13KB
|
437 lines
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)
1.1 - fixed input validation functions
This is version 1.2 - fixed DataSize method to include reals.
fixed Draw method to not format the data
while the view is selected.
}
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 = 5000;
cmValidatedOK = 5001;
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
begin
NewEvent.What := evBroadCast;
NewEvent.InfoPtr := @Self;
NewEvent.Command := cmValidatedOK;
PutEvent(NewEvent);
Validated := true;
end;
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);
DReal : DataSize := sizeof(real);
DByte : DataSize := sizeof(byte);
DShortInt : DataSize := sizeof(shortint);
DInteger : DataSize := sizeof(integer);
DLongInt : DataSize := sizeof(longint);
DWord : DataSize := sizeof(word);
else
DataSize := TInputLine.DataSize;
end;
end;
procedure TFInputLine.Draw;
var
RD : real;
Code : integer;
begin
if not((State and sfSelected) <> 0) then
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.