home *** CD-ROM | disk | FTP | other *** search
/ Computer Select (Limited Edition) / Computer Select.iso / dobbs / v16n11 / struprog.asc < prev   
Encoding:
Text File  |  1991-11-15  |  27.9 KB  |  932 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4.  
  5.  
  6. [LISTING ONE]
  7.  
  8. PROGRAM HCalc;   { By Jeff Duntemann; Update of 10/31/91 }
  9.                  { Requires Turbo Pascal 6.0! }
  10.  
  11. USES App,Dialogs,Objects,Views,Menus,Drivers,
  12.      FInput,    { By Allen Bauer; on CompuServe BPROGA }
  13.      Mortgage;  { By Jeff Duntemann; from DDJ 10/91 }
  14.  
  15. CONST
  16.   cmNewMortgage  = 199;
  17.   cmExtraPrin    = 198;
  18.   cmCloseAll     = 197;
  19.   cmCloseBC      = 196;
  20.   cmPrintSummary = 195;
  21.   WindowCount : Integer = 0;
  22.  
  23. TYPE
  24.   MortgageDialogData =
  25.     RECORD
  26.       PrincipalData : Real;
  27.       InterestData  : Real;
  28.       PeriodsData   : Integer;
  29.     END;
  30.  
  31.   ExtraPrincipalDialogData =
  32.     RECORD
  33.       PaymentNumber : Integer;
  34.       ExtraDollars  : Real;
  35.     END;
  36.  
  37.   THouseCalcApp =
  38.     OBJECT(TApplication)
  39.       InitDialog  : PDialog;  { Dialog for initializing a mortgage }
  40.       ExtraDialog : PDialog;  { Dialog for entering extra principal }
  41.       CONSTRUCTOR Init;
  42.       PROCEDURE   InitMenuBar; VIRTUAL;
  43.       PROCEDURE   CloseAll;
  44.       PROCEDURE   HandleEvent(VAR Event : TEvent); VIRTUAL;
  45.       PROCEDURE   NewMortgage;
  46.     END;
  47.  
  48.   PMortgageTopInterior = ^TMortgageTopInterior;
  49.   TMortgageTopInterior =
  50.     OBJECT(TView)
  51.       Mortgage    : PMortgage;
  52.       CONSTRUCTOR Init(VAR Bounds : TRect);
  53.       PROCEDURE   Draw; VIRTUAL;
  54.     END;
  55.  
  56.  
  57.   PMortgageBottomInterior = ^TMortgageBottomInterior;
  58.   TMortgageBottomInterior =
  59.     OBJECT(TScroller)
  60.       { Points to Mortgage object owned by TMortgageView }
  61.       Mortgage    : PMortgage;
  62.       CONSTRUCTOR Init(VAR Bounds : TRect;
  63.                        AHScrollBar, AVScrollbar : PScrollBar);
  64.       PROCEDURE   Draw; VIRTUAL;
  65.     END;
  66.  
  67.   PMortgageView = ^TMortgageView;
  68.   TMortgageView =
  69.     OBJECT(TWindow)
  70.       Mortgage    : TMortgage;
  71.       CONSTRUCTOR Init(VAR Bounds  : TRect;
  72.                        ATitle  : TTitleStr;
  73.                        ANumber : Integer;
  74.                        InitMortgageData :
  75.                        MortgageDialogData);
  76.       PROCEDURE   HandleEvent(Var Event : TEvent); VIRTUAL;
  77.       PROCEDURE   ExtraPrincipal;
  78.       PROCEDURE   PrintSummary;
  79.       DESTRUCTOR  Done; VIRTUAL;
  80.     END;
  81.  
  82.  
  83. CONST
  84.   DefaultMortgageData : MortgageDialogData =
  85.     (PrincipalData : 100000;
  86.      InterestData  : 10.0;
  87.      PeriodsData   : 360);
  88.  
  89.  
  90. VAR
  91.   HouseCalc : THouseCalcApp;  { This is the application object itself }
  92.  
  93.  
  94.  
  95. {------------------------------}
  96. {   METHODS: THouseCalcApp     }
  97. {------------------------------}
  98.  
  99.  
  100. CONSTRUCTOR THouseCalcApp.Init;
  101.  
  102. VAR
  103.   R : TRect;
  104.   aView      : PView;
  105.  
  106. BEGIN
  107.   TApplication.Init;  { Always call the parent's constructor first! }
  108.  
  109.   { Create the dialog for initializing a mortgage: }
  110.   R.Assign(20,5,60,16);
  111.   InitDialog := New(PDialog,Init(R,'Define Mortgage Parameters'));
  112.   WITH InitDialog^ DO
  113.     BEGIN
  114.       { First item in the dialog box is input line for principal: }
  115.       R.Assign(3,3,13,4);
  116.       aView := New(PFInputLine,Init(R,8,DRealSet,DReal,0));
  117.       Insert(aView);
  118.       R.Assign(2,2,12,3);
  119.       Insert(New(PLabel,Init(R,'Principal',aView)));
  120.  
  121.       { Next is the input line for interest rate: }
  122.       R.Assign(17,3,26,4);
  123.       aView := New(PFInputLine,Init(R,6,DRealSet,DReal,3));
  124.       Insert(aView);
  125.       R.Assign(16,2,25,3);
  126.       Insert(New(PLabel,Init(R,'Interest',aView)));
  127.       R.Assign(26,3,27,4);   { Add a static text "%" sign }
  128.       Insert(New(PStaticText,Init(R,'%')));
  129.  
  130.       { Up next is the input line for number of periods: }
  131.       R.Assign(31,3,36,4);
  132.       aView := New(PFInputLine,Init(R,3,DUnsignedSet,DInteger,0));
  133.       Insert(aView);
  134.       R.Assign(29,2,37,3);
  135.       Insert(New(PLabel,Init(R,'Periods',aView)));
  136.  
  137.       { These are standard buttons for the OK and Cancel commands: }
  138.       R.Assign(8,8,16,10);
  139.       Insert(New(PButton,Init(R,'~O~K',cmOK,bfDefault)));
  140.       R.Assign(22,8,32,10);
  141.       Insert(New(PButton,Init(R,'Cancel',cmCancel,bfNormal)));
  142.     END;
  143.  
  144.   { Create the dialog for adding additional principal to a payment: }
  145.   R.Assign(20,5,60,16);
  146.   ExtraDialog := New(PDialog,Init(R,'Apply Extra Principal to Mortgage'));
  147.   WITH ExtraDialog^ DO
  148.     BEGIN
  149.       { First item in the dialog is the payment number to which }
  150.       { we're going to apply the extra principal:               }
  151.       R.Assign(9,3,18,4);
  152.       aView := New(PFInputLine,Init(R,6,DUnsignedSet,DInteger,0));
  153.       Insert(aView);
  154.       R.Assign(3,2,12,3);
  155.       Insert(New(PLabel,Init(R,'Payment #',aView)));
  156.  
  157.       { Next item in the dialog box is input line for extra principal: }
  158.       R.Assign(23,3,33,4);
  159.       aView := New(PFInputLine,Init(R,8,DRealSet,DReal,2));
  160.       Insert(aView);
  161.       R.Assign(20,2,35,3);
  162.       Insert(New(PLabel,Init(R,'Extra Principal',aView)));
  163.  
  164.       { These are standard buttons for the OK and Cancel commands: }
  165.       R.Assign(8,8,16,10);
  166.       Insert(New(PButton,Init(R,'~O~K',cmOK,bfDefault)));
  167.       R.Assign(22,8,32,10);
  168.       Insert(New(PButton,Init(R,'Cancel',cmCancel,bfNormal)));
  169.     END;
  170.  
  171. END;
  172.  
  173.  
  174. { This method sends out a broadcast message to all views.  Only the
  175. { mortgage windows know how to respond to it, so when cmCloseBC is
  176. { issued, only the mortgage windows react--by closing. }
  177.  
  178. PROCEDURE THouseCalcApp.CloseAll;
  179.  
  180. VAR
  181.   Who : Pointer;
  182.  
  183. BEGIN
  184.   Who := Message(Desktop,evBroadcast,cmCloseBC,@Self);
  185. END;
  186.  
  187.  
  188. PROCEDURE THouseCalcApp.HandleEvent(VAR Event : TEvent);
  189.  
  190. BEGIN
  191.   TApplication.HandleEvent(Event);
  192.   IF Event.What = evCommand THEN
  193.     BEGIN
  194.       CASE Event.Command OF
  195.         cmNewMortgage : NewMortgage;
  196.         cmCloseAll    : CloseAll;
  197.       ELSE
  198.         Exit;
  199.       END; { CASE }
  200.       ClearEvent(Event);
  201.     END;
  202. END;
  203.  
  204.  
  205. PROCEDURE THouseCalcApp.NewMortgage;
  206.  
  207. VAR
  208.   Code       : Integer;
  209.   R          : TRect;
  210.   Control    : Word;
  211.   ThisMortgage     : PMortgageView;
  212.   InitMortgageData : MortgageDialogData;
  213.  
  214. BEGIN
  215.   { First we need a dialog to get the intial mortgage values from }
  216.   { the user.  The dialog appears *before* the mortgage window!   }
  217.   WITH InitMortgageData DO
  218.     BEGIN
  219.       PrincipalData := 100000;
  220.       InterestData  := 10.0;
  221.       PeriodsData   := 360;
  222.     END;
  223.   InitDialog^.SetData(InitMortgageData);
  224.   Control := Desktop^.ExecView(InitDialog);
  225.    IF Control <> cmCancel THEN  { Create a new mortgage object: }
  226.      BEGIN
  227.        R.Assign(5,5,45,20);
  228.        Inc(WindowCount);
  229.        { Get data from the initial mortgage dialog: }
  230.        InitDialog^.GetData(InitMortgageData);
  231.        { Call the constructor for the mortgage window: }
  232.        ThisMortgage :=
  233.          New(PMortgageView,Init(R,'Mortgage',WindowCount,
  234.                                 InitMortgageData));
  235.  
  236.        { Insert the mortgage window into the desktop: }
  237.        Desktop^.Insert(ThisMortgage);
  238.      END;
  239. END;
  240.  
  241.  
  242. PROCEDURE THouseCalcApp.InitMenuBar;
  243.  
  244. VAR
  245.   R : TRect;
  246.  
  247. BEGIN
  248.   GetExtent(R);
  249.   R.B.Y := R.A.Y + 1;  { Define 1-line menu bar }
  250.  
  251.   MenuBar := New(PMenuBar,Init(R,NewMenu(
  252.     NewSubMenu('~M~ortgage',hcNoContext,NewMenu(
  253.       NewItem('~N~ew','F6',kbF6,cmNewMortgage,hcNoContext,
  254.       NewItem('~E~xtra Principal    ','',0,cmExtraPrin,hcNoContext,
  255.       NewItem('~C~lose all','F7',kbF7,cmCloseAll,hcNoContext,
  256.       NewItem('E~x~it','Alt-X',kbAltX,cmQuit,hcNoContext,
  257.       NIL))))),
  258.     NIL)
  259.   )));
  260. END;
  261.  
  262.  
  263. {---------------------------------}
  264. {   METHODS: TMortgageTopInterior }
  265. {---------------------------------}
  266.  
  267. CONSTRUCTOR TMortgageTopInterior.Init(VAR Bounds : TRect);
  268.  
  269. BEGIN
  270.   TView.Init(Bounds);     { Call ancestor's constructor }
  271.   GrowMode := gfGrowHiX;  { Permits pane to grow in X but not Y }
  272. END;
  273.  
  274.  
  275. PROCEDURE TMortgageTopInterior.Draw;
  276.  
  277. VAR
  278.   YRun  : Integer;
  279.   Color : Byte;
  280.   B     : TDrawBuffer;
  281.   STemp : String[20];
  282.  
  283. BEGIN
  284.   Color := GetColor(1);
  285.   MoveChar(B,' ',Color,Size.X);    { Clear the buffer to spaces }
  286.   MoveStr(B,'  Principal    Interest   Periods',Color);
  287.   WriteLine(0,0,Size.X,1,B);
  288.  
  289.   MoveChar(B,' ',Color,Size.X);    { Clear the buffer to spaces }
  290.   { Here we convert payment data to strings for display: }
  291.   Str(Mortgage^.Principal:7:2,STemp);
  292.   MoveStr(B[2],STemp,Color);         { At beginning of buffer B }
  293.   Str(Mortgage^.Interest*100:7:2,STemp);
  294.   MoveStr(B[14],STemp,Color);      { At position 14 of buffer B }
  295.   Str(Mortgage^.Periods:4,STemp);
  296.   MoveStr(B[27],STemp,Color);      { At position 27 of buffer B }
  297.   WriteLine(0,1,Size.X,1,B);
  298.  
  299.   MoveChar(B,' ',Color,Size.X);    { Clear the buffer to spaces }
  300.   MoveStr(B,
  301.   '                                      Extra        Principal      Interest',
  302.   Color);
  303.   WriteLine(0,2,Size.X,1,B);
  304.  
  305.   MoveChar(B,' ',Color,Size.X);    { Clear the buffer to spaces }
  306.   MoveStr(B,
  307.   'Paymt #  Prin.   Int.     Balance     Principal    So far         So far ',
  308.   Color);
  309.   WriteLine(0,3,Size.X,1,B);
  310.  
  311. END;
  312.  
  313.  
  314. {------------------------------------}
  315. {   METHODS: TMortgageBottomInterior }
  316. {------------------------------------}
  317.  
  318. CONSTRUCTOR TMortgageBottomInterior.Init(VAR Bounds : TRect;
  319.                                          AHScrollBar, AVScrollBar :
  320.                                          PScrollBar);
  321.  
  322. BEGIN
  323.   { Call ancestor's constructor: }
  324.   TScroller.Init(Bounds,AHScrollBar,AVScrollBar);
  325.   GrowMode := gfGrowHiX + gfGrowHiY;
  326.   Options := Options OR ofFramed;
  327. END;
  328.  
  329.  
  330. PROCEDURE TMortgageBottomInterior.Draw;
  331.  
  332. VAR
  333.   Color : Byte;
  334.   B     : TDrawBuffer;
  335.   YRun  : Integer;
  336.   STemp : String[20];
  337.  
  338. BEGIN
  339.   Color := GetColor(1);
  340.   FOR YRun := 0 TO Size.Y-1 DO
  341.     BEGIN
  342.       MoveChar(B,' ',Color,80);    { Clear the buffer to spaces }
  343.       Str(Delta.Y+YRun+1:4,STemp);
  344.       MoveStr(B,STemp+':',Color);        { At beginning of buffer B }
  345.       { Here we convert payment data to strings for display: }
  346.       Str(Mortgage^.Payments^[Delta.Y+YRun+1].PayPrincipal:7:2,STemp);
  347.       MoveStr(B[6],STemp,Color);         { At beginning of buffer B }
  348.       Str(Mortgage^.Payments^[Delta.Y+YRun+1].PayInterest:7:2,STemp);
  349.       MoveStr(B[15],STemp,Color);      { At position 15 of buffer B }
  350.       Str(Mortgage^.Payments^[Delta.Y+YRun+1].Balance:10:2,STemp);
  351.       MoveStr(B[24],STemp,Color);      { At position 24 of buffer B }
  352.       { There isn't an extra principal value for every payment, so }
  353.       { display the value only if it is nonzero:                   }
  354.       STemp := '';
  355.       IF  Mortgage^.Payments^[Delta.Y+YRun+1].ExtraPrincipal > 0
  356.       THEN
  357.         Str(Mortgage^.Payments^[Delta.Y+YRun+1].ExtraPrincipal:10:2,STemp);
  358.       MoveStr(B[37],STemp,Color);      { At position 37 of buffer B }
  359.       Str(Mortgage^.Payments^[Delta.Y+YRun+1].PrincipalSoFar:10:2,STemp);
  360.       MoveStr(B[50],STemp,Color);      { At position 50 of buffer B }
  361.       Str(Mortgage^.Payments^[Delta.Y+YRun+1].InterestSoFar:10:2,STemp);
  362.       MoveStr(B[64],STemp,Color);      { At position 64 of buffer B }
  363.       { Here we write the line to the window, taking into account the }
  364.       { state of the X scroll bar: }
  365.       WriteLine(0,YRun,Size.X,1,B[Delta.X]);
  366.     END;
  367. END;
  368.  
  369.  
  370. {------------------------------}
  371. {   METHODS: TMortgageView     }
  372. {------------------------------}
  373.  
  374. CONSTRUCTOR TMortgageView.Init(VAR Bounds  : TRect;
  375.                                    ATitle  : TTitleStr;
  376.                                    ANumber : Integer;
  377.                                    InitMortgageData :
  378.                                    MortgageDialogData);
  379. VAR
  380.   TopInterior    : PMortgageTopInterior;
  381.   BottomInterior : PMortgageBottomInterior;
  382.   HScrollBar,VScrollBar : PScrollBar;
  383.   R,S  : TRect;
  384.  
  385. BEGIN
  386.   TWindow.Init(Bounds,ATitle,ANumber); { Call ancestor's constructor }
  387.   { Call the Mortgage object's constructor using dialog data: }
  388.   WITH InitMortgageData DO
  389.     Mortgage.Init(PrincipalData,
  390.                   InterestData / 100,
  391.                   PeriodsData,
  392.                   12);
  393.  
  394.   { Here we set up a window with *two* interiors, one scrollable, one }
  395.   { static.  It's all in the way that you define the bounds, mostly:  }
  396.   GetClipRect(Bounds);             { Get bounds for interior of view  }
  397.   Bounds.Grow(-1,-1);      { Shrink those bounds by 1 for both X & Y  }
  398.  
  399.   { Define a rectangle to embrace the upper of the two interiors:     }
  400.   R.Assign(Bounds.A.X,Bounds.A.Y,Bounds.B.X,Bounds.A.Y+4);
  401.   TopInterior := New(PMortgageTopInterior,Init(R));
  402.   TopInterior^.Mortgage := @Mortgage;
  403.   Insert(TopInterior);
  404.  
  405.   { Define a rectangle to embrace the lower of two interiors: }
  406.   R.Assign(Bounds.A.X,Bounds.A.Y+5,Bounds.B.X,Bounds.B.Y);
  407.  
  408.   { Create scroll bars for both mouse & keyboard input: }
  409.   VScrollBar := StandardScrollBar(sbVertical + sbHandleKeyboard);
  410.   { We have to adjust vertical bar to fit bottom interior: }
  411.   VScrollBar^.Origin.Y := R.A.Y;       { Adjust top Y value }
  412.   VScrollBar^.Size.Y := R.B.Y - R.A.Y; { Adjust size }
  413.   { The horizontal scroll bar, on the other hand, is standard: }
  414.   HScrollBar := StandardScrollBar(sbHorizontal + sbHandleKeyboard);
  415.  
  416.   { Create bottom interior object with scroll bars: }
  417.   BottomInterior :=
  418.     New(PMortgageBottomInterior,Init(R,HScrollBar,VScrollBar));
  419.   { Make copy of pointer to mortgage object: }
  420.   BottomInterior^.Mortgage := @Mortgage;
  421.   { Set the limits for the scroll bars: }
  422.   BottomInterior^.SetLimit(80,InitMortgageData.PeriodsData);
  423.   { Insert the interior into the window: }
  424.   Insert(BottomInterior);
  425. END;
  426.  
  427.  
  428. PROCEDURE TMortgageView.HandleEvent(Var Event : TEvent);
  429.  
  430. BEGIN
  431.   TWindow.HandleEvent(Event);
  432.   IF Event.What = evCommand THEN
  433.     BEGIN
  434.       CASE Event.Command OF
  435.         cmExtraPrin    : ExtraPrincipal;
  436.         cmPrintSummary : PrintSummary;
  437.       ELSE
  438.         Exit;
  439.       END; { CASE }
  440.       ClearEvent(Event);
  441.     END
  442.   ELSE
  443.     IF Event.What = evBroadcast THEN
  444.       CASE Event.Command OF
  445.         cmCloseBC : Done
  446.       END; { CASE }
  447. END;
  448.  
  449.  
  450. PROCEDURE TMortgageView.ExtraPrincipal;
  451.  
  452. VAR
  453.   Control : Word;
  454.   ExtraPrincipalData : ExtraPrincipalDialogData;
  455.  
  456. BEGIN
  457.   { Execute the "extra principal" dialog box: }
  458.   Control := Desktop^.ExecView(HouseCalc.ExtraDialog);
  459.    IF Control <> cmCancel THEN  { Update the active mortgage window: }
  460.      BEGIN
  461.        { Get data from the extra principal dialog: }
  462.        HouseCalc.ExtraDialog^.GetData(ExtraPrincipalData);
  463.        Mortgage.Payments^[ExtraPrincipalData.PaymentNumber].ExtraPrincipal :=
  464.          ExtraPrincipalData.ExtraDollars;
  465.        Mortgage.Recalc;   { Recalculate the amortization table... }
  466.        Redraw;            { ...and redraw the mortgage window     }
  467.      END;
  468. END;
  469.  
  470.  
  471. PROCEDURE TMortgageView.PrintSummary;
  472.  
  473. BEGIN
  474. END;
  475.  
  476.  
  477. DESTRUCTOR TMortgageView.Done;
  478.  
  479. BEGIN
  480.   Mortgage.Done;  { Dispose of the mortgage object's memory }
  481.   TWindow.Done;   { Call parent's destructor to dispose of window }
  482. END;
  483.  
  484.  
  485.  
  486. BEGIN
  487.   HouseCalc.Init;
  488.   HouseCalc.Run;
  489.   HouseCalc.Done;
  490. END.
  491.  
  492.  
  493. [THE FOLLOWING IS SOURCE FOR FINPUT.PAS]
  494.  
  495. unit FInput;
  496. {$X+}
  497. {
  498.   This unit implements a derivative of TInputLine that supports several
  499.   data types dynamically.  It also provides formatted input for all the
  500.   numerical types, keystroke filtering and uppercase conversion, field
  501.   justification, and range checking.
  502.  
  503.   When the field is initialized, many filtering and uppercase converions
  504.   are implemented pertinent to the particular data type.
  505.  
  506.   The CheckRange and ErrorHandler methods should be overridden if the
  507.   user wants to implement then.
  508.  
  509.   This is just an initial implementation and comments are welcome. You
  510.   can contact me via Compuserve. (76066,3202)
  511.  
  512.   I am releasing this into the public domain and anyone can use or modify
  513.   it for their own personal use.
  514.  
  515.   Copyright (c) 1990 by Allen Bauer (76066,3202)
  516.  
  517.   1.1 - fixed input validation functions
  518.  
  519.   This is version 1.2 - fixed DataSize method to include reals.
  520.                         fixed Draw method to not format the data
  521.                         while the view is selected.
  522. }
  523.  
  524. interface
  525. uses Objects, Drivers, Dialogs;
  526.  
  527. type
  528.   VKeys = set of char;
  529.  
  530.   PFInputLine = ^TFInputLine;
  531.   TFInputLine = object(TInputLine)
  532.     ValidKeys : VKeys;
  533.     DataType,Decimals : byte;
  534.     imMode : word;
  535.     Validated, ValidSent : boolean;
  536.     constructor Init(var Bounds: TRect; AMaxLen: integer;
  537.                      ChrSet: VKeys;DType, Dec: byte);
  538.     constructor Load(var S: TStream);
  539.     procedure Store(var S: TStream);
  540.     procedure HandleEvent(var Event: TEvent); virtual;
  541.     procedure GetData(var Rec); virtual;
  542.     procedure SetData(var Rec); virtual;
  543.     function DataSize: word; virtual;
  544.     procedure Draw; virtual;
  545.     function CheckRange: boolean; virtual;
  546.     procedure ErrorHandler; virtual;
  547.   end;
  548.  
  549. const
  550.   imLeftJustify   = $0001;
  551.   imRightJustify  = $0002;
  552.   imConvertUpper  = $0004;
  553.  
  554.   DString   = 0;
  555.   DChar     = 1;
  556.   DReal     = 2;
  557.   DByte     = 3;
  558.   DShortInt = 4;
  559.   DInteger  = 5;
  560.   DLongInt  = 6;
  561.   DWord     = 7;
  562.   DDate     = 8;
  563.   DTime     = 9;
  564.  
  565.   DRealSet      : VKeys = [#1..#31,'+','-','0'..'9','.','E','e'];
  566.   DSignedSet    : VKeys = [#1..#31,'+','-','0'..'9'];
  567.   DUnSignedSet  : VKeys = [#1..#31,'0'..'9'];
  568.   DCharSet      : VKeys = [#1..#31,' '..'~'];
  569.   DUpperSet     : VKeys = [#1..#31,' '..'`','{'..'~'];
  570.   DAlphaSet     : VKeys = [#1..#31,'A'..'Z','a'..'z'];
  571.   DFileNameSet  : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..'9','@'..'Z','^'..'{','}'..'~'];
  572.   DPathSet      : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..':','@'..'Z','^'..'{','}'..'~','\'];
  573.   DFileMaskSet  : VKeys = [#1..#31,'!','#'..'*','-'..'.','0'..':','?'..'Z','^'..'{','}'..'~','\'];
  574.   DDateSet      : VKeys = [#1..#31,'0'..'9','/'];
  575.   DTimeSet      : VKeys = [#1..#31,'0'..'9',':'];
  576.  
  577.   cmValidateYourself = 5000;
  578.   cmValidatedOK      = 5001;
  579.  
  580. procedure RegisterFInputLine;
  581.  
  582. const
  583.   RFInputLine : TStreamRec = (
  584.     ObjType: 20000;
  585.     VmtLink: Ofs(typeof(TFInputLine)^);
  586.     Load:    @TFInputLine.Load;
  587.     Store:   @TFinputLine.Store
  588.   );
  589.  
  590. implementation
  591.  
  592. uses Views, MsgBox, StrFmt, Dos;
  593.  
  594. function CurrentDate : string;
  595. var
  596.   Year,Month,Day,DOW : word;
  597.   DateStr : string[10];
  598. begin
  599.   GetDate(Year,Month,Day,DOW);
  600.   DateStr := SFLongint(Month,2)+'/'
  601.             +SFLongInt(Day,2)+'/'
  602.             +SFLongInt(Year mod 100,2);
  603.   for DOW := 1 to length(DateStr) do
  604.     if DateStr[DOW] = ' ' then
  605.       DateStr[DOW] := '0';
  606.   CurrentDate := DateStr;
  607. end;
  608.  
  609. function CurrentTime : string;
  610. var
  611.   Hour,Minute,Second,Sec100 : word;
  612.   TimeStr : string[10];
  613. begin
  614.   GetTime(Hour,Minute,Second,Sec100);
  615.   TimeStr := SFLongInt(Hour,2)+':'
  616.             +SFLongInt(Minute,2)+':'
  617.             +SFLongInt(Second,2);
  618.   for Sec100 := 1 to length(TimeStr) do
  619.     if TimeStr[Sec100] = ' ' then
  620.       TimeStr[Sec100] := '0';
  621.   CurrentTime := TimeStr;
  622. end;
  623.  
  624. procedure RegisterFInputLine;
  625. begin
  626.   RegisterType(RFInputLine);
  627. end;
  628.  
  629. constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
  630.                              ChrSet: VKeys; DType, Dec: byte);
  631. begin
  632.   if (DType in [DDate,DTime]) and (AMaxLen < 8) then
  633.     AMaxLen := 8;
  634.  
  635.   TInputLine.Init(Bounds,AMaxLen);
  636.  
  637.   ValidKeys:= ChrSet;
  638.   DataType := DType;
  639.   Decimals := Dec;
  640.   Validated := true;
  641.   ValidSent := false;
  642.   case DataType of
  643.     DReal,DByte,DLongInt,
  644.     DShortInt,DWord      : imMode := imRightJustify;
  645.  
  646.     DChar,DString,
  647.     DDate,DTime          : imMode := imLeftJustify;
  648.   end;
  649.   if ValidKeys = DUpperSet then
  650.     imMode := imMode or imConvertUpper;
  651.   EventMask := EventMask or evMessage;
  652. end;
  653.  
  654. constructor TFInputLine.Load(var S: TStream);
  655. begin
  656.   TInputLine.Load(S);
  657.   S.Read(ValidKeys, sizeof(VKeys));
  658.   S.Read(DataType,  sizeof(byte));
  659.   S.Read(Decimals,  sizeof(byte));
  660.   S.Read(imMode,    sizeof(word));
  661.   S.Read(Validated, sizeof(boolean));
  662.   S.Read(ValidSent, sizeof(boolean));
  663. end;
  664.  
  665. procedure TFInputLine.Store(var S: TStream);
  666. begin
  667.   TInputLine.Store(S);
  668.   S.Write(ValidKeys, sizeof(VKeys));
  669.   S.Write(DataType,  sizeof(byte));
  670.   S.Write(Decimals,  sizeof(byte));
  671.   S.Write(imMode,    sizeof(word));
  672.   S.Write(Validated, sizeof(boolean));
  673.   S.Write(ValidSent, sizeof(boolean));
  674. end;
  675.  
  676. procedure TFInputLine.HandleEvent(var Event: TEvent);
  677. var
  678.   NewEvent: TEvent;
  679. begin
  680.   case Event.What of
  681.     evKeyDown :  begin
  682.                    if (imMode and imConvertUpper) <> 0 then
  683.                      Event.CharCode := upcase(Event.CharCode);
  684.                    if not(Event.CharCode in [#0..#31]) then
  685.                    begin
  686.                      Validated := false;
  687.                      ValidSent := false;
  688.                    end;
  689.                    if (Event.CharCode <> #0) and not(Event.CharCode in ValidKeys) then
  690.                      ClearEvent(Event);
  691.                  end;
  692.     evBroadcast: begin
  693.                    if (Event.Command = cmReceivedFocus) and
  694.                       (Event.InfoPtr <> @Self) and
  695.                      ((Owner^.State and sfSelected) <> 0) and
  696.                         not(Validated) and not(ValidSent) then
  697.                    begin
  698.                      NewEvent.What := evBroadcast;
  699.                      NewEvent.InfoPtr := @Self;
  700.                      NewEvent.Command := cmValidateYourself;
  701.                      PutEvent(NewEvent);
  702.                      ValidSent := true;
  703.                    end;
  704.                    if (Event.Command = cmValidateYourself) and
  705.                       (Event.InfoPtr = @Self) then
  706.                    begin
  707.                      if not CheckRange then
  708.                      begin
  709.                        ErrorHandler;
  710.                        Select;
  711.                      end
  712.                      else
  713.                      begin
  714.                        NewEvent.What := evBroadCast;
  715.                        NewEvent.InfoPtr := @Self;
  716.                        NewEvent.Command := cmValidatedOK;
  717.                        PutEvent(NewEvent);
  718.                        Validated := true;
  719.                      end;
  720.                      ValidSent := false;
  721.                      ClearEvent(Event);
  722.                    end;
  723.                  end;
  724.   end;
  725.   TInputLine.HandleEvent(Event);
  726. end;
  727.  
  728. procedure TFInputLine.GetData(var Rec);
  729. var
  730.   Code : integer;
  731. begin
  732.   case DataType of
  733.     Dstring,
  734.     DDate,
  735.     DTime     : TInputLine.GetData(Rec);
  736.     DChar     : char(Rec) := Data^[1];
  737.     DReal     : val(Data^, real(Rec)     , Code);
  738.     DByte     : val(Data^, byte(Rec)     , Code);
  739.     DShortInt : val(Data^, shortint(Rec) , Code);
  740.     DInteger  : val(Data^, integer(Rec)  , Code);
  741.     DLongInt  : val(Data^, longint(Rec)  , Code);
  742.     DWord     : val(Data^, word(Rec)     , Code);
  743.   end;
  744. end;
  745.  
  746. procedure TFInputLine.SetData(var Rec);
  747. begin
  748.   case DataType of
  749.     DString,
  750.     DDate,
  751.     DTime     : TInputLine.SetData(Rec);
  752.     DChar     : Data^ := char(Rec);
  753.     DReal     : Data^ := SFDReal(real(Rec),MaxLen,Decimals);
  754.     DByte     : Data^ := SFLongInt(byte(Rec),MaxLen);
  755.     DShortInt : Data^ := SFLongInt(shortint(Rec),MaxLen);
  756.     DInteger  : Data^ := SFLongInt(integer(Rec),MaxLen);
  757.     DLongInt  : Data^ := SFLongInt(longint(Rec),MaxLen);
  758.     DWord     : Data^ := SFLongInt(word(Rec),MaxLen);
  759.   end;
  760.   SelectAll(true);
  761. end;
  762.  
  763. function TFInputLine.DataSize: word;
  764. begin
  765.   case DataType of
  766.     DString,
  767.     DDate,
  768.     DTime     : DataSize := TInputLine.DataSize;
  769.     DChar     : DataSize := sizeof(char);
  770.     DReal     : DataSize := sizeof(real);
  771.     DByte     : DataSize := sizeof(byte);
  772.     DShortInt : DataSize := sizeof(shortint);
  773.     DInteger  : DataSize := sizeof(integer);
  774.     DLongInt  : DataSize := sizeof(longint);
  775.     DWord     : DataSize := sizeof(word);
  776.   else
  777.     DataSize := TInputLine.DataSize;
  778.   end;
  779. end;
  780.  
  781. procedure TFInputLine.Draw;
  782. var
  783.   RD : real;
  784.   Code : integer;
  785. begin
  786.   if not((State and sfSelected) <> 0) then
  787.   case DataType of
  788.     DReal    : begin
  789.                  if Data^ = '' then
  790.                    Data^ := SFDReal(0.0,MaxLen,Decimals)
  791.                  else
  792.                  begin
  793.                    val(Data^, RD, Code);
  794.                    Data^ := SFDReal(RD,MaxLen,Decimals);
  795.                  end;
  796.                end;
  797.  
  798.     DByte,
  799.     DShortInt,
  800.     DInteger,
  801.     DLongInt,
  802.     DWord    : if Data^ = '' then Data^ := SFLongInt(0,MaxLen);
  803.  
  804.     DDate    : if Data^ = '' then Data^ := CurrentDate;
  805.     DTime    : if Data^ = '' then Data^ := CurrentTime;
  806.  
  807.   end;
  808.  
  809.   if State and (sfFocused+sfSelected) <> 0 then
  810.   begin
  811.     if (imMode and imRightJustify) <> 0 then
  812.       while (length(Data^) > 0) and (Data^[1] = ' ') do
  813.         delete(Data^,1,1);
  814.   end
  815.   else
  816.   begin
  817.     if ((imMode and imRightJustify) <> 0) and (Data^ <> '') then
  818.       while (length(Data^) < MaxLen) do
  819.         insert(' ',Data^,1);
  820.     if (imMode and imLeftJustify) <> 0 then
  821.       while (length(Data^) > 0) and (Data^[1] = ' ') do
  822.         delete(Data^,1,1);
  823.  
  824.   end;
  825.   TInputLine.Draw;
  826. end;
  827.  
  828. function TFInputLine.CheckRange: boolean;
  829. var
  830.   MH,DM,YS : longint;
  831.   Code : integer;
  832.   MHs,DMs,YSs : string[2];
  833.   Delim : char;
  834.   Ok : boolean;
  835. begin
  836.   Ok := true;
  837.   case DataType of
  838.     DDate,
  839.     DTime : begin
  840.               if DataType = DDate then Delim := '/' else Delim := ':';
  841.               if pos(Delim,Data^) > 0 then
  842.               begin
  843.                 MHs := copy(Data^,1,pos(Delim,Data^));
  844.                 DMs := copy(Data^,pos(Delim,Data^)+1,2);
  845.                 delete(Data^,pos(Delim,Data^),1);
  846.                 YSs := copy(Data^,pos(Delim,Data^)+1,2);
  847.                 if length(MHs) < 2 then MHs := '0' + MHs;
  848.                 if length(DMs) < 2 then DMs := '0' + DMs;
  849.                 if length(YSs) < 2 then YSs := '0' + YSs;
  850.                 Data^ := MHs + DMs + YSs;
  851.               end;
  852.               if (length(Data^) >= 6) and (pos(Delim,Data^) = 0) then
  853.               begin
  854.                 val(copy(Data^,1,2), MH, Code);
  855.                 if Code <> 0 then MH := 0;
  856.                 val(copy(Data^,3,2), DM, Code);
  857.                 if Code <> 0 then DM := 0;
  858.                 val(copy(Data^,5,2), YS, Code);
  859.                 if Code <> 0 then YS := 0;
  860.                 if DataType = DDate then
  861.                 begin
  862.                   if (MH > 12) or (MH < 1) or
  863.                      (DM > 31) or (DM < 1) then Ok := false;
  864.                 end
  865.                 else
  866.                 begin
  867.                   if (MH > 23) or (MH < 0) or
  868.                      (DM > 59) or (DM < 0) or
  869.                      (YS > 59) or (YS < 0) then Ok := false;
  870.                 end;
  871.                 insert(Delim,Data^,5);
  872.                 insert(Delim,Data^,3);
  873.               end
  874.               else
  875.                 Ok := false;
  876.             end;
  877.  
  878.     DByte : begin
  879.               val(Data^, MH, Code);
  880.               if (Code <> 0) or (MH > 255) or (MH < 0) then Ok := false;
  881.             end;
  882.  
  883.     DShortint :
  884.             begin
  885.               val(Data^, MH, Code);
  886.               if (Code <> 0) or (MH < -127) or (MH > 127) then Ok := false;
  887.             end;
  888.  
  889.     DInteger :
  890.             begin
  891.               val(Data^, MH, Code);
  892.               if (Code <> 0) or (MH < -32768) or (MH > 32767) then Ok := false;
  893.             end;
  894.  
  895.     DWord : begin
  896.               val(Data^, MH, Code);
  897.               if (Code <> 0) or (MH < 0) or (MH > 65535) then Ok := false;
  898.             end;
  899.   end;
  900.   CheckRange := Ok;
  901. end;
  902.  
  903. procedure TFInputLine.ErrorHandler;
  904. var
  905.   MsgString : string[80];
  906.   Params : array[0..1] of longint;
  907.   Event: TEvent;
  908. begin
  909.   fillchar(Params,sizeof(params),#0);
  910.   MsgString := '';
  911.   case DataType of
  912.     DDate     : MsgString := ' Invalid Date Format!  Enter Date as MM/DD/YY ';
  913.     DTime     : MsgString := ' Invalid Time Format!  Enter Time as HH:MM:SS ';
  914.     DByte,
  915.     DShortInt,
  916.     DInteger,
  917.     DWord     : begin
  918.                   MsgString := ' Number must be between %d and %d ';
  919.                   case DataType of
  920.                     DByte     : Params[1] := 255;
  921.                     DShortInt : begin Params[0] := -128; Params[1] := 127; end;
  922.                     DInteger  : begin Params[0] := -32768; Params[1] := 32768; end;
  923.                     DWord     : Params[1] := 65535;
  924.                   end;
  925.                 end;
  926.   end;
  927.   MessageBox(MsgString, @Params, mfError + mfOkButton);
  928. end;
  929.  
  930. end.
  931.  
  932.