home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TVTOOL.ZIP / TVINPUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-08  |  28.1 KB  |  268 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Unpacked source is available to registered users.
  7. *
  8. *}
  9. UNIT TvInput;{$V-}{$X+}{$I TVDEFS.INC}INTERFACE USES Dialogs,Drivers,Objects,Views,MsgBox,{$IFDEF USE_TVSCROLL}TvScroll,
  10. {$ENDIF}TvConst,TvString,TvType;CONST HideChar:Char='*';DecimalPt='.';CommaChar=',';Left=True;Right=False;
  11. C3DInputLine=#45#45#46#47;TYPE P3DInputLine=^T3DInputLine;T3DInputLine=Object(TInputLine)Constructor Init(var Bounds:TRect;
  12. AMaxLen:Integer);Function GetPalette:PPalette;Virtual;end;PEditLine=^TEditLine;{$IFDEF USE_TVSCROLL}
  13. TEditLine=Object(TScrollInputLine){$ELSE}TEditLine=Object(TInputLine){$ENDIF}PadChar:Char;XPos:Byte;First:Byte;Mask:PString;
  14. ID:Word;LLabel:PView;PostEdit:Pointer;EditFlags:Word;Constructor Init(var Bounds:TRect;EditMask:String);
  15. Destructor Done;Virtual;Procedure Merge(var St:String;Justify:Boolean);Virtual;Function Remove(St:String):String;
  16. Function CanScroll(ScrollLeft:Boolean):Boolean;Procedure Draw;Virtual;Procedure SelectAll(Enable:Boolean);
  17. Procedure SetState(AState:Word;Enable:Boolean);Virtual;Function NextPos(Pos:Integer):Integer;Virtual;
  18. Function PrevPos(Pos:Integer):Integer;Virtual;Function HomePos:Integer;Virtual;Procedure SetData(var Rec);Virtual;
  19. Procedure GetData(var Rec);Virtual;Function DataSize:Word;Virtual;Function EditToMaskPos(Pos:Integer):Integer;
  20. Function MaskToEditPos(Pos:Integer):Integer;Procedure DeleteMarked;Procedure InsertChar(Ch:Char);Virtual;
  21. Procedure HandleEvent(var Event:TEvent);Virtual;Function Valid(Command:Word):Boolean;Virtual;
  22. Procedure SetPostEdit(P:Pointer);Function Empty:Boolean;Virtual;Procedure SetEditFlag(AFlag:Word;Enable:Boolean);
  23. Procedure AddLabel(ALabel:PView);Procedure Lock;Procedure UnLock;Procedure SetID(AFieldID:Word);Function GetID:Word;
  24. {$IFDEF HAVE_RTL}Procedure Select;Virtual;{$ENDIF}end;PNumericEdit=^TNumericEdit;TNumericEdit=Object(TEditLine)
  25. ErrCode:Integer;Procedure HandleEvent(var Event:TEvent);Virtual;Function Valid(Command:Word):Boolean;Virtual;
  26. Function OutOfRange:Boolean;Virtual;Function OutOfRangeMsg:String;Virtual;end;PLongEdit=^TLongEdit;
  27. TLongEdit=Object(TNumericEdit)Min:LongInt;Max:LongInt;Constructor Init(var Bounds:TRect;EditMask:String;AMin:LongInt;
  28. AMax:LongInt);Function DataSize:Word;Virtual;Procedure GetData(var Rec);Virtual;Procedure SetData(var Rec);Virtual;
  29. Function OutOfRange:Boolean;Virtual;Function OutOfRangeMsg:String;Virtual;end;PIntegerEdit=^TIntegerEdit;
  30. TIntegerEdit=Object(TLongEdit)Constructor Init(var Bounds:TRect;EditMask:String;AMin:Integer;AMax:Integer);
  31. Function DataSize:Word;Virtual;Procedure GetData(var Rec);Virtual;Procedure SetData(var Rec);Virtual;end;
  32. PWordEdit=^TWordEdit;TWordEdit=Object(TLongEdit)Constructor Init(var Bounds:TRect;EditMask:String;AMin:Word;AMax:Word);
  33. Function DataSize:Word;Virtual;Procedure GetData(var Rec);Virtual;Procedure SetData(var Rec);Virtual;end;
  34. PByteEdit=^TByteEdit;TByteEdit=Object(TLongEdit)Constructor Init(var Bounds:TRect;EditMask:String;AMin:Byte;AMax:Byte);
  35. Function DataSize:Word;Virtual;Procedure GetData(var Rec);Virtual;Procedure SetData(var Rec);Virtual;end;PHexEdit=^THexEdit;
  36. THexEdit=Object(TLongEdit)Procedure SetData(var Rec);Virtual;Function OutOfRangeMsg:String;Virtual;end;
  37. PFloatEdit=^TFloatEdit;TFloatEdit=Object(TNumericEdit)DP:Byte;Constructor Init(var Bounds:TRect;EditMask:String);
  38. Procedure HandleEvent(var Event:TEvent);Virtual;Procedure Merge(var St:String;Justify:Boolean);Virtual;end;{$IFOPT N+}
  39. PDoubleEdit=^TDoubleEdit;TDoubleEdit=Object(TFloatEdit)Min:Double;Max:Double;Constructor Init(var Bounds:TRect;
  40. EditMask:String;AMin:Double;AMax:Double);Function DataSize:Word;Virtual;Procedure GetData(var Rec);Virtual;
  41. Procedure SetData(var Rec);Virtual;Function OutOfRange:Boolean;Virtual;Function OutOfRangeMsg:String;Virtual;end;{$ENDIF}
  42. PRealEdit=^TRealEdit;TRealEdit=Object(TFloatEdit)Min:Real;Max:Real;Constructor Init(var Bounds:TRect;EditMask:String;
  43. AMin:Real;AMax:Real);Function DataSize:Word;Virtual;Procedure GetData(var Rec);Virtual;Procedure SetData(var Rec);Virtual;
  44. Function OutOfRange:Boolean;Virtual;Function OutOfRangeMsg:String;Virtual;end;
  45. PEntryDialog=^TEntryDialog;{$IFDEF USE_TVSCROLL}TEntryDialog=Object(TScrollDialog){$ELSE}TEntryDialog=Object(TDialog){$ENDIF}
  46. Constructor Init(var Bounds:TRect;ATitle:TTitleStr);Function FindField(ID:Word):Pointer;Procedure LockField(ID:Word;
  47. Enable:Boolean);Procedure HandleEvent(var Event:TEvent);Virtual;{$IFDEF USE_TVSCROLL}Procedure Insert(P:PView);{$ENDIF}end;
  48. PNewCheckBoxes=^TNewCheckBoxes;TNewCheckBoxes=Object(TCheckBoxes)PostEdit:Pointer;ID:Word;LLabel:PView;EditFlags:Word;
  49. Constructor Init(var Bounds:TRect;AStrings:PSItem);Procedure SetPostEdit(P:Pointer);Function Empty:Boolean;Virtual;
  50. Procedure SetEditFlag(AFlag:Word;Enable:Boolean);Procedure AddLabel(ALabel:PView);Procedure Lock;Procedure UnLock;
  51. Procedure SetID(AFieldID:Word);Function GetID:Word;{$IFDEF HAVE_RTL}Procedure Select;Virtual;{$ENDIF}
  52. Procedure HandleEvent(var Event:TEvent);Virtual;Function Valid(Command:Word):Boolean;Virtual;Procedure SetState(AState:Word;
  53. Enable:Boolean);Virtual;end;PNewRadioButtons=^TNewRadioButtons;TNewRadioButtons=Object(TRadioButtons)PostEdit:Pointer;
  54. ID:Word;LLabel:PView;EditFlags:Word;Constructor Init(var Bounds:TRect;AStrings:PSItem);Procedure SetPostEdit(P:Pointer);
  55. Function Empty:Boolean;Virtual;Procedure SetEditFlag(AFlag:Word;Enable:Boolean);Procedure AddLabel(ALabel:PView);
  56. Procedure Lock;Procedure UnLock;Procedure SetID(AFieldID:Word);Function GetID:Word;{$IFDEF HAVE_RTL}Procedure Select;Virtual;
  57. {$ENDIF}Procedure HandleEvent(var Event:TEvent);Virtual;Function Valid(Command:Word):Boolean;Virtual;
  58. Procedure SetState(AState:Word;Enable:Boolean);Virtual;end;CONST AnyChar='X';ForceUp='U';ForceLo='L';AlphaOnly='a';
  59. UpperAlpha='u';LowerAlpha='l';NumberOnly='#';DigitOnly='9';HexOnly='&';
  60. EditMaskChars:TCharSet=[AnyChar,ForceUp,ForceLo,AlphaOnly,UpperAlpha,LowerAlpha,NumberOnly,DigitOnly,HexOnly];
  61. AnyCharSet:TCharSet=[#32..#255];AlphaOnlySet:TCharSet=['0'..'9','A'..'Z','a'..'z',' '];DigitOnlySet:TCharSet=['0'..'9'];
  62. NumberOnlySet:TCharSet=['0'..'9','-'];HexOnlySet:TCharSet=['0'..'9','A'..'F','a'..'f','$'];
  63. DateMaskSet:TCharSet=['m','M','d','D','y','Y',DateSlash];IMPLEMENTATION Function LoCase(C:Char):Char;begin
  64.     ASM
  65.           mov   al,C
  66.           cmp   al,'A'
  67.           jb    @1
  68.           cmp   al,'Z'
  69.           ja    @1
  70.           add   al,'a' - 'A'
  71.       @1: mov   @RESULT,al
  72. end;end;Constructor T3DInputLine.Init(var Bounds:TRect;AMaxLen:Integer);var R:TRect;P:PView;begin
  73. TInputLine.Init(Bounds,AMaxLen);end;Function T3DInputLine.GetPalette:PPalette;Const
  74. P:String[Length(C3DInputLine)]=C3DInputLine;begin GetPalette:=@P;end;Constructor TEditLine.Init(var Bounds:TRect;
  75. EditMask:String);var i:Byte;x:Byte;begin x:=0;for i:=1 to Byte(EditMask[0])do if(EditMask[i]in EditMaskChars)then Inc(x);
  76. TInputLine.Init(Bounds,x);Mask:=NewStr(EditMask);First:=1;PadChar:=' ';While(First<=Length(Mask^))and
  77. not(EditMask[First]in EditMaskChars)do Inc(First);PostEdit:=nil;LLabel:=nil;ID:=0;EditFlags:=0;
  78. EventMask:=EventMask or evBroadcast;end;Destructor TEditLine.Done;begin TInputLine.Done;DisposeStr(Mask);end;
  79. Function TEditLine.DataSize:Word;begin DataSize:=Length(Mask^)+1;end;Procedure TEditLine.SetData(var Rec);begin
  80. DisposeStr(Data);Data:=NewStr(Remove(String(Rec)));SelectAll(True);end;Procedure TEditLine.GetData(var Rec);var Temp:String;
  81. SaveFlag:Word;begin SaveFlag:=EditFlags;EditFlags:=EditFlags and NOT efHide;Merge(Temp,True);EditFlags:=SaveFlag;
  82. Move(Temp,Rec,DataSize);end;Procedure TEditLine.Merge(var St:String;Justify:Boolean);var i,j:Byte;Temp:String;begin j:=0;
  83. for i:=1 to Byte(Mask^[0])do begin if(Mask^[i]in EditMaskChars)then begin if(j<Byte(Data^[0]))Then begin Inc(j);
  84. if((EditFlags and efHide)<>0)then St[i]:=HideChar else St[i]:=Data^[j];end else begin St[i]:=PadChar;end;end else begin
  85. St[i]:=Mask^[i];end;end;Byte(St[0]):=i;if Justify then begin if((EditFlags and efRJustify)<>0)then begin TrimCh(St,PadChar);
  86. LeftPadCh(St,MaxLen,PadChar);end else if((EditFlags and efLJustify)<>0)then begin TrimCh(St,PadChar);
  87. PadCh(St,MaxLen,PadChar);end else if((EditFlags and efTrim)<>0)then TrimCh(St,PadChar)else PadCh(St,MaxLen,PadChar);end;end;
  88. Function TEditLine.Remove(St:String):String;var i,j:Byte;Temp:String;begin j:=0;for i:=1 to Byte(St[0])do begin
  89. if(Mask^[i]in EditMaskChars)then begin Inc(j);Temp[j]:=St[i];end end;Byte(Temp[0]):=i;Remove:=Temp;end;
  90. Procedure TEditLine.Draw;var St:String;Color:Byte;B:TDrawBuffer;L,R:Integer;begin Merge(St,(State and sfSelected=0));
  91. if(State and sfFocused=0)then Color:=GetColor(1)else Color:=GetColor(2);MoveChar(B,' ',Color,Size.X);
  92. MoveStr(B[1],Copy(St,FirstPos,Size.X-2),Color);if CanScroll(Right)then MoveChar(B[Size.X-1],#16,GetColor(4),1);
  93. if State and sfSelected<>0 then begin if CanScroll(Left)then MoveChar(B[0],#17,GetColor(4),1);L:=SelStart-FirstPos+1;
  94. if(L<1)then L:=1;R:=SelEnd-FirstPos+1;if(R>Size.X-1)then R:=Size.X-1;if(L<R)then MoveChar(B[L],#0,GetColor(3),R-L+1);end;
  95. WriteLine(0,0,Size.X,Size.Y,B);SetCursor(CurPos-FirstPos+1,0);end;Procedure TEditLine.SelectAll(Enable:Boolean);begin
  96. CurPos:=HomePos;XPos:=MaskToEditPos(CurPos);FirstPos:=1;SelStart:=1;if Enable and(Length(Data^)>0)then SelEnd:=Length(Mask^)
  97. else SelEnd:=1;DrawView;end;Procedure TEditLine.SetState(AState:Word;Enable:Boolean);begin TView.SetState(AState,Enable);
  98. if(AState=sfSelected)or ((AState=sfActive)and(State and sfSelected<>0))then SelectAll(Enable)else if(AState=sfDisabled)then
  99. if(LLabel<>nil)then LLabel^.SetState(sfDisabled,Enable);end;Function TEditLine.NextPos(Pos:Integer):Integer;var x:Integer;
  100. begin x:=Pos+1;While(x<=Length(Mask^))and not(Mask^[x]in EditMaskChars)do Inc(x);if(x<=Length(Mask^)+1)then NextPos:=x else
  101. NextPos:=Pos;end;Function TEditLine.PrevPos(Pos:Integer):Integer;var x:Integer;begin x:=Pos-1;
  102. While(x>0)and not(Mask^[x]in EditMaskChars)do Dec(x);if(x>0)then PrevPos:=x else PrevPos:=Pos;end;
  103. Function TEditLine.HomePos:Integer;begin HomePos:=First;end;Function TEditLine.EditToMaskPos(Pos:Integer):Integer;var
  104. x:Integer;Count:Integer;begin Count:=0;for x:=1 to Pos do Repeat Inc(Count);Until(Mask^[Count]in EditMaskChars);
  105. EditToMaskPos:=Count;end;Function TEditLine.MaskToEditPos(Pos:Integer):Integer;var x:Integer;Count:Integer;begin Count:=0;
  106. for x:=1 to Pos do if(Mask^[x]in EditMaskChars)then Inc(Count);MaskToEditPos:=Count;end;Procedure TEditLine.DeleteMarked;
  107. begin if(SelStart<>SelEnd)then begin Delete(Data^,SelStart,SelEnd-SelStart+1);XPos:=SelStart;CurPos:=EditToMaskPos(XPos);end;
  108. end;Function TEditLine.CanScroll(ScrollLeft:Boolean):Boolean;begin if((EditFlags and efRJustify)<>0)then CanScroll:=False
  109. else if ScrollLeft then CanScroll:=(FirstPos>1)else CanScroll:=((Length(Mask^)-FirstPos+1)>(Size.X-2));end;
  110. Procedure TEditLine.InsertChar(Ch:Char);begin if(State and sfCursorIns<>0)then Delete(Data^,XPos,1)else DeleteMarked;
  111. if(Length(Data^)<MaxLen)then begin if(FirstPos>CurPos)then FirstPos:=CurPos;Insert(Ch,Data^,XPos);if(XPos<=MaxLen)then begin
  112. Inc(XPos);CurPos:=NextPos(CurPos);end;end;end;Procedure TEditLine.HandleEvent(var Event:TEvent);
  113. Function MouseScroll(var Dir:Boolean):Boolean;var Mouse:TPoint;begin MakeLocal(Event.Where,Mouse);if(Mouse.X<=0)then begin
  114. MouseScroll:=True;Dir:=Left;end else if(Mouse.X>=Size.X-1)then begin MouseScroll:=True;Dir:=Right;end else begin
  115. MouseScroll:=False;end;end;Function MousePos:Integer;var Pos:Integer;Mouse:TPoint;begin MakeLocal(Event.Where,Mouse);
  116. if(Mouse.X<1)then Mouse.X:=1;Pos:=Mouse.X+FirstPos-1;if(Pos<1)then Pos:=1 else if(Pos>EditToMaskPos(Length(Data^)))then
  117. Pos:=EditToMaskPos(Length(Data^));if not(Mask^[Pos]in EditMaskChars)then Pos:=NextPos(Pos);
  118. if not(Mask^[Pos]in EditMaskChars)then Pos:=PrevPos(Pos);MousePos:=Pos;end;Procedure Scroll(Dir:Boolean);begin
  119. if CanScroll(Dir)then begin if(Dir=Left)then begin Dec(XPos);Dec(FirstPos);CurPos:=PrevPos(CurPos);end else begin Inc(XPos);
  120. Inc(FirstPos);CurPos:=NextPos(CurPos);end;end;end;var Anchor:Integer;x:Integer;ValidCh:Boolean;ScrollDir:Boolean;Temp:String;
  121. begin TView.HandleEvent(Event);Case Event.What of evMouseDown:begin if(State and sfSelected=0)then 
  122. else if MouseScroll(ScrollDir)then begin Repeat Scroll(ScrollDir);DrawView;Until not MouseEvent(Event,evMouseAuto);end 
  123. else if Event.Double then begin SelectAll(True);end else begin Anchor:=MousePos;Repeat if(Event.What=evMouseAuto)then begin
  124. if MouseScroll(ScrollDir)then Scroll(ScrollDir);end else begin CurPos:=MousePos;XPos:=MaskToEditPos(CurPos);end;
  125. if(CurPos<Anchor)then begin SelStart:=CurPos;SelEnd:=Anchor;end else begin SelStart:=Anchor;SelEnd:=CurPos;end;DrawView;
  126. Until not MouseEvent(Event,evMouseMove+evMouseAuto);end;ClearEvent(Event);end;evKeyDown:begin
  127. Case CtrlToArrow(Event.KeyCode)of kbLeft:begin if(XPos>1)then begin Dec(XPos);CurPos:=PrevPos(CurPos);end;end;kbRight:begin
  128. if(XPos<=Length(Data^))then if(XPos<=MaxLen)then begin Inc(XPos);CurPos:=NextPos(CurPos);end;end;kbHome:begin XPos:=1;
  129. CurPos:=HomePos;end;kbEnd:begin XPos:=Length(Data^);CurPos:=NextPos(EditToMaskPos(XPos));Inc(XPos);end;kbBack:begin
  130. if(XPos>1)then begin Dec(XPos);CurPos:=PrevPos(CurPos);Delete(Data^,XPos,1);if(FirstPos>1)then Dec(FirstPos);end;end;kbDel:
  131. begin if(SelStart=SelEnd)then Delete(Data^,XPos,1)else DeleteMarked;end;kbIns:begin
  132. SetState(sfCursorIns,State and sfCursorIns=0);end;else Case Event.CharCode of ' '..#255:begin Case(Mask^[CurPos])of HexOnly:
  133. begin ValidCh:=Event.CharCode in HexOnlySet;end;DigitOnly:begin ValidCh:=Event.CharCode in DigitOnlySet;end;AnyChar:begin
  134. ValidCh:=True;end;ForceUp:begin Event.CharCode:=UpCase(Event.CharCode);ValidCh:=True;end;ForceLo:begin
  135. Event.CharCode:=LoCase(Event.CharCode);ValidCh:=True;end;AlphaOnly:begin ValidCh:=Event.CharCode in AlphaOnlySet;end;
  136. UpperAlpha:begin Event.CharCode:=UpCase(Event.CharCode);ValidCh:=Event.CharCode in AlphaOnlySet;end;LowerAlpha:begin
  137. Event.CharCode:=LoCase(Event.CharCode);ValidCh:=Event.CharCode in AlphaOnlySet;end;NumberOnly:begin
  138. ValidCh:=Event.CharCode in NumberOnlySet;end;else ValidCh:=False;end;if ValidCh then begin InsertChar(Event.CharCode);end;
  139. end;^Y:begin Data^:='';XPos:=1;CurPos:=HomePos;end;else Exit;end;end;SelStart:=1;SelEnd:=1;if(FirstPos>CurPos)then begin
  140. if(CurPos=HomePos)then FirstPos:=1 else FirstPos:=CurPos;end;x:=CurPos-Size.X+2;if(FirstPos<x)then FirstPos:=x;DrawView;
  141. ClearEvent(Event);end;evBroadcast:begin Case Event.Command of cmLoseFocus:begin if(PostEdit<>nil)then begin 
  142. if PostEditFunc(PostEdit)(@Self,ID)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;end else if not Valid(cmOK)then begin
  143. ClearEvent(Event);Event.InfoPtr:=@Self;end;end;cmIdentify:if(Event.InfoWord=ID)then begin ClearEvent(Event);
  144. Event.InfoPtr:=@Self;end;end;end;end;end;Function TEditLine.Valid(Command:Word):Boolean;var Name:String;begin Valid:=True;
  145. if(Command<>cmCancel)and(Command<>cmValid)then begin if((EditFlags AND efRequired)<>0)and Empty then begin Name:='';
  146. if(LLabel<>nil)then begin Name:=PLabel(LLabel)^.Text^;Strip(Name,['~']);Name:=Name+^M;end;
  147. ErrorMsg:=Name+'Field is required.';Message(Owner,evBroadcast,cmFieldError,@ErrorMsg);Valid:=False;Select;SelectAll(True);end 
  148. else Valid:=TInputLine.Valid(Command);end else begin Valid:=TInputLine.Valid(Command);end;end;{$IFDEF HAVE_RTL}
  149. Procedure TEditLine.Select;begin if(Owner^.Current<>@Self)then begin
  150. if(Message(Owner^.Current,evBroadcast,cmLoseFocus,nil)=nil)then TInputLine.Select;end else TInputLine.Select;end;{$ENDIF}
  151. Procedure TEditLine.SetEditFlag(AFlag:Word;Enable:Boolean);begin if Enable then EditFlags:=EditFlags or AFlag else
  152. EditFlags:=EditFlags and not AFlag;end;Procedure TEditLine.AddLabel(ALabel:PView);begin LLabel:=ALabel;end;
  153. Procedure TEditLine.Lock;begin SetState(sfDisabled,True);end;Procedure TEditLine.UnLock;begin SetState(sfDisabled,False);end;
  154. Procedure TEditLine.SetID(AFieldID:Word);begin ID:=AFieldID;end;Function TEditLine.GetID:Word;begin GetID:=ID;end;
  155. Function TEditLine.Empty:Boolean;begin Empty:=AllBlanks(Data^);end;Procedure TEditLine.SetPostEdit(P:Pointer);begin
  156. PostEdit:=P;end;Procedure TNumericEdit.HandleEvent(var Event:TEvent);var ValidCh:Boolean;begin if(Event.What=evKeyDown)then
  157. begin Case Event.CharCode of ' '..#255:begin Case(Mask^[CurPos])of DigitOnly:ValidCh:=(Event.CharCode in DigitOnlySet);
  158. NumberOnly:ValidCh:=(Event.CharCode in NumberOnlySet);HexOnly:ValidCh:=(Event.CharCode in HexOnlySet);else ValidCh:=False;
  159. end;if not ValidCh then ClearEvent(Event)else Case Event.CharCode of '-','$':begin if(Length(Data^)>0)then begin
  160. if(Data^[1]<>Event.CharCode)and(Length(Data^)<MaxLen)then begin Insert(Event.CharCode,Data^,1);CurPos:=NextPos(CurPos);end 
  161. else if(Data^[1]=Event.CharCode)then begin Delete(Data^,1,1);CurPos:=PrevPos(CurPos);end;XPos:=MaskToEditPos(CurPos);
  162. DrawView;ClearEvent(Event);end;end;end;end;end;end;TEditLine.HandleEvent(Event);end;
  163. Function TNumericEdit.Valid(Command:Word):Boolean;var Name:String;begin Valid:=True;
  164. if(Command<>cmCancel)and(Command<>cmValid)then begin if OutOfRange then begin Valid:=False;Select;Name:='';
  165. if(LLabel<>nil)then begin Name:=PLabel(LLabel)^.Text^;Strip(Name,['~']);Name:=Name+^M;end;ErrorMsg:=Name+OutOfRangeMsg;
  166. Message(Owner,evBroadcast,cmFieldError,@ErrorMsg);SelectAll(True);end else Valid:=TEditLine.Valid(Command);end else begin
  167. Valid:=TEditLine.Valid(Command);end;end;Function TNumericEdit.OutOfRangeMsg:String;begin
  168. OutOfRangeMsg:='Entry is not in valid range';end;Function TNumericEdit.OutOfRange:Boolean;begin OutOfRange:=False;end;
  169. Constructor TLongEdit.Init(var Bounds:TRect;EditMask:String;AMin:LongInt;AMax:LongInt);begin
  170. TNumericEdit.Init(Bounds,EditMask);if(AMin<=AMax)then begin Min:=AMin;Max:=AMax;end else begin Min:=AMax;Max:=AMin;end;end;
  171. Function TLongEdit.OutOfRange:Boolean;var Value:LongInt;begin OutOfRange:=False;if(Min<>0)or(Max<>0)then begin
  172. TLongEdit.GetData(Value);if(ErrCode<>0)or(Value<Min)or(Value>Max)then OutOfRange:=True end;end;
  173. Function TLongEdit.OutOfRangeMsg:String;var MinStr,MaxStr:String[11];begin Str(Min,MinStr);Str(Max,MaxStr);
  174. OutOfRangeMsg:='Range is '+MinStr+' to '+MaxStr;end;Function TLongEdit.DataSize:Word;begin DataSize:=SizeOf(LongInt);end;
  175. Procedure TLongEdit.GetData(var Rec);begin if(Data^='')or(Data^='$')or(Data^='-')then Data^:='0';
  176. Val(Data^,LongInt(Rec),ErrCode);if(ErrCode<>0)then LongInt(Rec):=0;end;Procedure TLongEdit.SetData(var Rec);begin
  177. if(Min<>0)and(Max<>0)then if((LongInt(Rec)<Min)or(LongInt(Rec)>Max))then LongInt(Rec):=0;Str(LongInt(Rec),Data^);
  178. SelectAll(True);end;Procedure THexEdit.SetData(var Rec);var S:String[9];begin Data^:=HexString(LongInt(Rec));SelectAll(True);
  179. end;Function THexEdit.OutOfRangeMsg:String;var MinStr,MaxStr:String[16];begin
  180. OutOfRangeMsg:='Range is '+HexString(Min)+' to '+HexString(Max);end;Constructor TIntegerEdit.Init(var Bounds:TRect;
  181. EditMask:String;AMin:Integer;AMax:Integer);begin TLongEdit.Init(Bounds,EditMask,AMin,AMax);end;
  182. Function TIntegerEdit.DataSize:Word;begin DataSize:=SizeOf(Integer);end;Procedure TIntegerEdit.GetData(var Rec);var L:LongInt;
  183. begin TLongEdit.GetData(L);Integer(Rec):=L;end;Procedure TIntegerEdit.SetData(var Rec);var L:LongInt;begin L:=Integer(Rec);
  184. TLongEdit.SetData(L);end;Constructor TWordEdit.Init(var Bounds:TRect;EditMask:String;AMin:Word;AMax:Word);begin
  185. TLongEdit.Init(Bounds,EditMask,AMin,AMax);end;Function TWordEdit.DataSize:Word;begin DataSize:=SizeOf(Word);end;
  186. Procedure TWordEdit.GetData(var Rec);var L:LongInt;begin TLongEdit.GetData(L);Word(Rec):=L;end;
  187. Procedure TWordEdit.SetData(var Rec);var L:LongInt;begin L:=Word(Rec);TLongEdit.SetData(L);end;
  188. Constructor TByteEdit.Init(var Bounds:TRect;EditMask:String;AMin:Byte;AMax:Byte);begin
  189. TLongEdit.Init(Bounds,EditMask,AMin,AMax);end;Function TByteEdit.DataSize:Word;begin DataSize:=SizeOf(Byte);end;
  190. Procedure TByteEdit.GetData(var Rec);var L:LongInt;begin TLongEdit.GetData(L);Byte(Rec):=L;end;
  191. Procedure TByteEdit.SetData(var Rec);var L:LongInt;begin L:=Byte(Rec);TLongEdit.SetData(L);end;
  192. Constructor TFloatEdit.Init(var Bounds:TRect;EditMask:String);var x:Byte;begin x:=Pos(DecimalPt,EditMask);if(x<>0)then
  193. Delete(EditMask,x,1);TNumericEdit.Init(Bounds,EditMask);if(x<>0)then begin DP:=Length(EditMask)+1-x;FreeMem(Data,MaxLen+1);
  194. GetMem(Data,MaxLen+2);Data^:='';end else begin DP:=0;end;end;Procedure TFloatEdit.HandleEvent(var Event:TEvent);var x:Byte;
  195. begin Case Event.What of evKeyDown:begin Case CtrlToArrow(Event.KeyCode)of kbBack:begin if(XPos>1)then
  196. if(Data^[XPos-1]=DecimalPt)then ClearEvent(Event);end;kbDel:begin if(XPos<=Length(Data^))then if(Data^[XPos]=DecimalPt)then
  197. ClearEvent(Event);end;else Case Event.CharCode of DecimalPt:begin if(DP=0)then begin ClearEvent(Event);end 
  198. else if(Pos(DecimalPt,Data^)<>0)then begin XPos:=Pos(DecimalPt,Data^);CurPos:=NextPos(EditToMaskPos(XPos));Inc(XPos);
  199. ClearEvent(Event);DrawView;end else begin InsertChar(DecimalPt);ClearEvent(Event);DrawView;end;end;'0'..'9':begin
  200. if(DP<>0)then begin x:=Pos(DecimalPt,Data^);if(x<>0)then if(XPos>x)then if((Length(Data^)-x)=DP)then ClearEvent(Event);end;
  201. end;end;end;end;end;TNumericEdit.HandleEvent(Event);end;Procedure TFloatEdit.Merge(var St:String;Justify:Boolean);begin
  202. TNumericEdit.Merge(St,Justify);end;{$IFOPT N+}Constructor TDoubleEdit.Init(var Bounds:TRect;EditMask:String;AMin:Double;
  203. AMax:Double);begin TFloatEdit.Init(Bounds,EditMask);if(AMin<=AMax)then begin Min:=AMin;Max:=AMax;end else begin Min:=AMax;
  204. Max:=AMin;end;end;Function TDoubleEdit.OutOfRange:Boolean;var Value:Double;begin OutOfRange:=False;
  205. if(Min<>0.0)or(Max<>0.0)then begn GetData(Value);if(ErrCode<>0)or(Value<Min)or(Value>Max)then OutOfRange:=True end;end;
  206. Function TDoubleEdit.OutOfRangeMsg:String;var MinStr,MaxStr:String[20];W:Byte;begin if(DP>0)then W:=20-DP-1 else W:=20;
  207. Str(Min:W:DP,MinStr);Str(Max:W:DP,MaxStr);OutOfRangeMsg:='Range is '+MinStr+' to '+MaxStr;end;
  208. Function TDoubleEdit.DataSize:Word;begin DataSize:=SizeOf(Double);end;Procedure TDoubleEdit.GetData(var Rec);begin
  209. if(Data^='')or(Data^='$')or(Data^='-')then Data^:='0';Val(Data^,Double(Rec),ErrCode);if(ErrCode<>0)then Double(Rec):=0;end;
  210. Procedure TDoubleEdit.SetData(var Rec);var W:Byte;begin if(DP>0)then W:=MaxLen-DP-1 else W:=MaxLen;if(Min<>0)and(Max<>0)then
  211. if((Double(Rec)<Min)or(Double(Rec)>Max))then Double(Rec):=0;Str(Double(Rec):W:DP,Data^);SelectAll(True);end;{$ENDIF}
  212. Constructor TRealEdit.Init(var Bounds:TRect;EditMask:String;AMin:Real;AMax:Real);begin TFloatEdit.Init(Bounds,EditMask);
  213. if(AMin<=AMax)then begin Min:=AMin;Max:=AMax;end else begin Min:=AMax;Max:=AMin;end;end;
  214. Function TRealEdit.OutOfRange:Boolean;var Value:Real;begin OutOfRange:=False;if(Min<>0.0)or(Max<>0.0)then begin
  215. TRealEdit.GetData(Value);if(ErrCode<>0)or(Value<Min)or(Value>Max)then OutOfRange:=True end;end;
  216. Function TRealEdit.OutOfRangeMsg:String;var MinStr,MaxStr:String[20];W:Byte;begin if(DP>0)then W:=20-DP-1 else W:=20;
  217. Str(Min:W:DP,MinStr);Str(Max:W:DP,MaxStr);OutOfRangeMsg:='Range is '+MinStr+' to '+MaxStr;end;
  218. Function TRealEdit.DataSize:Word;begin DataSize:=SizeOf(Real);end;Procedure TRealEdit.GetData(var Rec);begin
  219. if(Data^='')or(Data^='$')or(Data^='-')then Data^:='0';Val(Data^,Real(Rec),ErrCode);if(ErrCode<>0)then Real(Rec):=0;end;
  220. Procedure TRealEdit.SetData(var Rec);var W:Byte;begin if(DP>0)then W:=MaxLen-DP-1 else W:=MaxLen;if(Min<>0)and(Max<>0)then
  221. if((Real(Rec)<Min)or(Real(Rec)>Max))then Real(Rec):=0;Str(Real(Rec):W:DP,Data^);SelectAll(True);end;
  222. Constructor TEntryDialog.Init(var Bounds:TRect;ATitle:TTitleStr);begin TDialog.Init(Bounds,ATitle);
  223. EventMask:=EventMask or evBroadcast;end;{$IFDEF USE_TVSCROLL}Procedure TEntryDialog.Insert(P:PView);begin
  224. TScrollDialog.InsertToScroll(P);end;{$ENDIF}Function TEntryDialog.FindField(ID:Word):Pointer;
  225. Function CheckID(P:PView):Boolean;FAR;var Event:TEvent;begin Event.What:=evBroadcast;Event.Command:=cmIdentify;
  226. Event.InfoWord:=ID;P^.HandleEvent(Event);CheckID:=(Event.What=evNothing);end;begin FindField:=FirstThat(@CheckID);end;
  227. Procedure TEntryDialog.LockField(ID:Word;Enable:Boolean);var P:PView;begin P:=FindField(ID);if(P<>nil)then
  228. P^.SetState(sfDisabled,Enable);end;Procedure TEntryDialog.HandleEvent(var Event:TEvent);begin TDialog.HandleEvent(Event);
  229. if(Event.What=evBroadcast)then if(Event.Command=cmFieldError)then MessageBox(ErrorMsg,nil,mfError+mfOkButton);end;
  230. Constructor TNewCheckBoxes.Init(var Bounds:TRect;AStrings:PSItem);begin TCheckBoxes.Init(Bounds,AStrings);PostEdit:=nil;
  231. LLabel:=nil;ID:=0;EditFlags:=0;EventMask:=EventMask or evBroadcast;end;Function TNewCheckBoxes.Empty:Boolean;begin
  232. Empty:=(Value=0);end;Procedure TNewCheckBoxes.SetEditFlag(AFlag:Word;Enable:Boolean);begin if Enable then
  233. EditFlags:=EditFlags or AFlag else EditFlags:=EditFlags and not AFlag;end;Procedure TNewCheckBoxes.AddLabel(ALabel:PView);
  234. begin LLabel:=ALabel;end;Procedure TNewCheckBoxes.Lock;begin SetState(sfDisabled,True);end;Procedure TNewCheckBoxes.UnLock;
  235. begin SetState(sfDisabled,False);end;Procedure TNewCheckBoxes.SetID(AFieldID:Word);begin ID:=AFieldID;end;
  236. Function TNewCheckBoxes.GetID:Word;begin GetID:=ID;end;Procedure TNewCheckBoxes.SetPostEdit(P:Pointer);begin PostEdit:=P;end;
  237. Function TNewCheckBoxes.Valid(Command:Word):Boolean;var Name:String;begin Valid:=True;
  238. if(Command<>cmCancel)and(Command<>cmValid)then begin if((EditFlags AND efRequired)<>0)and Empty then begin
  239. ErrorMsg:=^M'Field is required.';Message(Owner,evBroadcast,cmFieldError,@ErrorMsg);Valid:=False;Select;end;end else begin
  240. Valid:=TCheckBoxes.Valid(Command);end;end;{$IFDEF HAVE_RTL}Procedure TNewCheckBoxes.Select;begin if(Owner^.Current<>@Self)then
  241. begin if(Message(Owner^.Current,evBroadcast,cmLoseFocus,nil)=nil)then TCheckBoxes.Select;end else TCheckBoxes.Select;end;
  242. {$ENDIF}Procedure TNewCheckBoxes.SetState(AState:Word;Enable:Boolean);begin TCheckBoxes.SetState(AState,Enable);
  243. if(AState=sfDisabled)then if(LLabel<>nil)then LLabel^.SetState(sfDisabled,Enable);end;
  244. Procedure TNewCheckBoxes.HandleEvent(var Event:TEvent);begin TCheckBoxes.HandleEvent(Event);Case Event.What of evMouseDown:
  245. begin if(State and sfSelected=0)then ClearEvent(Event);end;evBroadcast:begin Case Event.Command of cmLoseFocus:begin
  246. if(PostEdit<>nil)then begin if PostEditFunc(PostEdit)(@Self,ID)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;end 
  247. else if not Valid(cmOK)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;end;cmIdentify:if(Event.InfoWord=ID)then begin
  248. ClearEvent(Event);Event.InfoPtr:=@Self;end;end;end;end;end;Constructor TNewRadioButtons.Init(var Bounds:TRect;
  249. AStrings:PSItem);begin TRadioButtons.Init(Bounds,AStrings);PostEdit:=nil;LLabel:=nil;ID:=0;EditFlags:=0;
  250. EventMask:=EventMask or evBroadcast;end;Function TNewRadioButtons.Empty:Boolean;begin Empty:=False;end;
  251. Procedure TNewRadioButtons.SetEditFlag(AFlag:Word;Enable:Boolean);begin if Enable then EditFlags:=EditFlags or AFlag else
  252. EditFlags:=EditFlags and not AFlag;end;Procedure TNewRadioButtons.AddLabel(ALabel:PView);begin LLabel:=ALabel;end;
  253. Procedure TNewRadioButtons.Lock;begin SetState(sfDisabled,True);end;Procedure TNewRadioButtons.UnLock;begin
  254. SetState(sfDisabled,False);end;Procedure TNewRadioButtons.SetID(AFieldID:Word);begin ID:=AFieldID;end;
  255. Function TNewRadioButtons.GetID:Word;begin GetID:=ID;end;Procedure TNewRadioButtons.SetPostEdit(P:Pointer);begin PostEdit:=P;
  256. end;Function TNewRadioButtons.Valid(Command:Word):Boolean;var Name:String;begin Valid:=True;
  257. if(Command<>cmCancel)and(Command<>cmValid)then begin if((EditFlags AND efRequired)<>0)and Empty then begin
  258. ErrorMsg:=^M'Field is required.';Message(Owner,evBroadcast,cmFieldError,@ErrorMsg);Valid:=False;Select;end;end else begin
  259. Valid:=TRadioButtons.Valid(Command);end;end;{$IFDEF HAVE_RTL}Procedure TNewRadioButtons.Select;begin
  260. if(Owner^.Current<>@Self)then begin if(Message(Owner^.Current,evBroadcast,cmLoseFocus,nil)=nil)then TRadioButtons.Select;end 
  261. else TRadioButtons.Select;end;{$ENDIF}Procedure TNewRadioButtons.SetState(AState:Word;Enable:Boolean);begin
  262. TRadioButtons.SetState(AState,Enable);if(AState=sfDisabled)then if(LLabel<>nil)then LLabel^.SetState(sfDisabled,Enable);end;
  263. Procedure TNewRadioButtons.HandleEvent(var Event:TEvent);begin TRadioButtons.HandleEvent(Event);Case Event.What of
  264. evMouseDown:begin if(State and sfSelected=0)then ClearEvent(Event);end;evBroadcast:begin Case Event.Command of cmLoseFocus:
  265. begin if(PostEdit<>nil)then begin if PostEditFunc(PostEdit)(@Self,ID)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;
  266. end else if not Valid(cmOK)then begin ClearEvent(Event);Event.InfoPtr:=@Self;end;end;cmIdentify:if(Event.InfoWord=ID)then
  267. begin ClearEvent(Event);Event.InfoPtr:=@Self;end;end;end;end;end;END.
  268.