home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / turbo55 / tp55 / tccellsp.pas < prev    next >
Pascal/Delphi Source File  |  1989-05-02  |  6KB  |  228 lines
  1.  
  2. { Copyright (c) 1989 by Borland International, Inc. }
  3.  
  4. unit TCCellSp;
  5. { Turbo Pascal 5.5 object-oriented example cell support routines.
  6.   This unit is used by TCALC.PAS.
  7.   See TCALC.DOC for an more information about this example.
  8. }
  9.  
  10. {$N+,S-}
  11.  
  12. interface
  13.  
  14. uses TCUtil, TCLStr, TCScreen, TCInput, TCCell;
  15.  
  16. function GetColumn(Prompt : String; MaxCols, ColSpace : Word) : Word;
  17.  
  18. function GetRow(Prompt : String; MaxRows : Word) : Word;
  19.  
  20. function GetCellPos(Prompt : String; MaxCols, MaxRows, ColSpace,
  21.                     RowNumberSpace : Word; var P : CellPos) : Boolean;
  22.  
  23. function FormulaStart(Inp : LStringPtr; Start, MaxCols, MaxRows : Word;
  24.                       var P : CellPos; var FormLen : Word) : Boolean;
  25.  
  26. procedure FixFormulaCol(CP : CellPtr; Diff : Longint;
  27.                         MaxCols, MaxRows : Word);
  28.  
  29. procedure FixFormulaRow(CP : CellPtr; Diff : Longint;
  30.                         MaxCols, MaxRows : Word);
  31.  
  32. implementation
  33.  
  34. function GetColumn(Prompt : String; MaxCols, ColSpace : Word) : Word;
  35. { Lets the user enter a column from the keyboard }
  36. var
  37.   I : InputField;
  38.   S : String;
  39.   C : Word;
  40. begin
  41.   with I do
  42.   begin
  43.     if not Init(Length(Prompt) + 3, 0, -1, ColSpace, AllUpper) then
  44.     begin
  45.       GetColumn := 0;
  46.       Exit;
  47.     end;
  48.     WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
  49.     repeat
  50.       Edit(0);
  51.       S := InputData^.ToString;
  52.       if (not GetQuit) and (S <> '') then
  53.       begin
  54.         C := StringToCol(S, MaxCols);
  55.         if C = 0 then
  56.           Scr.PrintError(ErrColumnError1 + ColToString(1) +
  57.                          ErrColumnError2 + ColToString(MaxCols));
  58.       end
  59.       else
  60.         C := 0;
  61.     until (C <> 0) or (S = '');
  62.     InputArea.Clear;
  63.     Done;
  64.   end; { with }
  65.   ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
  66.   GetColumn := C;
  67. end; { GetColumn }
  68.  
  69. function GetRow(Prompt : String; MaxRows : Word) : Word;
  70. { Lets the user enter a row from the keyboard }
  71. var
  72.   R : Word;
  73.   Good : Boolean;
  74. begin
  75.   R := GetNumber(Prompt, 1, MaxRows, Good);
  76.   if Good then
  77.     GetRow := R
  78.   else
  79.     GetRow := 0;
  80. end; { GetRow }
  81.  
  82. function GetCellPos(Prompt : String; MaxCols, MaxRows, ColSpace,
  83.                     RowNumberSpace : Word; var P : CellPos) : Boolean;
  84. { Lets the user enter a cell position from the keyboard }
  85. var
  86.   I : InputField;
  87.   S : String;
  88.   FormLen : Word;
  89. begin
  90.   GetCellPos := False;
  91.   with I do
  92.   begin
  93.     if not Init(Length(Prompt) + 3, 0, -1, Pred(ColSpace + RowNumberSpace),
  94.                 AllUpper) then
  95.       Exit;
  96.     WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
  97.     repeat
  98.       Edit(0);
  99.       S := InputData^.ToString;
  100.       if (not GetQuit) and (S <> '') then
  101.       begin
  102.         if FormulaStart(InputData, 1, MaxCols, MaxRows, P, FormLen) then
  103.           GetCellPos := True
  104.         else
  105.           Scr.PrintError(ErrCellError);
  106.       end
  107.       else
  108.         FormLen := 0;
  109.     until (FormLen <> 0) or (S = '');
  110.     InputArea.Clear;
  111.     Done;
  112.   end; { with }
  113.   ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
  114. end; { GetCellPos }
  115.  
  116. function FormulaStart(Inp : LStringPtr; Start, MaxCols, MaxRows : Word;
  117.                       var P : CellPos; var FormLen : Word) : Boolean;
  118. { Checks to see if a place in a long string is the beginning of a formula }
  119. var
  120.   Col, Row : Word;
  121.   CS : String[10];
  122.   RS : String[10];
  123. begin
  124.   with Inp^ do
  125.   begin
  126.     FormulaStart := False;
  127.     FormLen := 0;
  128.     FillChar(P, SizeOf(P), 0);
  129.     CS := '';
  130.     while (Start <= Length) and (Data^[Start] in Letters) do
  131.     begin
  132.       CS := CS + Data^[Start];
  133.       Inc(Start);
  134.     end;
  135.     Col := StringToCol(CS, MaxCols);
  136.     if Col = 0 then
  137.       Exit;
  138.     RS := '';
  139.     while (Start <= Length) and (Data^[Start] in Numbers) do
  140.     begin
  141.       RS := RS + Data^[Start];
  142.       Inc(Start);
  143.     end;
  144.     Row := StringToRow(RS, MaxRows);
  145.     if Row = 0 then
  146.       Exit;
  147.     P.Col := Col;
  148.     P.Row := Row;
  149.     FormLen := System.Length(CS) + System.Length(RS);
  150.     FormulaStart := True;
  151.   end; { with }
  152. end; { FormulaStart }
  153.  
  154. procedure FixFormulaCol(CP : CellPtr; Diff : Longint;
  155.                         MaxCols, MaxRows : Word);
  156. { Adjusts a formula for a new column }
  157. var
  158.   FormLen, Place, OldLen, NewLen : Word;
  159.   P : CellPos;
  160.   S : String[10];
  161.   Good : Boolean;
  162. begin
  163.   with FormulaCellPtr(CP)^, GetFormula^ do
  164.   begin
  165.     Place := 1;
  166.     Good := True;
  167.     while Good and (Place <= Length) do
  168.     begin
  169.       if FormulaStart(GetFormula, Place, MaxCols, MaxRows, P, FormLen) then
  170.       begin
  171.         OldLen := System.Length(ColToString(P.Col));
  172.         S := ColToString(Longint(P.Col) + Diff);
  173.         NewLen := System.Length(S);
  174.         if NewLen > OldLen then
  175.           Good := Insert(FillString(NewLen - OldLen, ' '), Place)
  176.         else if NewLen < OldLen then
  177.           Delete(Place, OldLen - NewLen);
  178.         if Good then
  179.         begin
  180.           Move(S[1], Data^[Place], System.Length(S));
  181.           Inc(Place, FormLen + NewLen - OldLen);
  182.         end;
  183.       end
  184.       else
  185.         Inc(Place);
  186.     end;
  187.   end; { with }
  188. end; { FixFormulaCol }
  189.  
  190. procedure FixFormulaRow(CP : CellPtr; Diff : Longint;
  191.                         MaxCols, MaxRows : Word);
  192. { Adjusts a formula for a new row }
  193. var
  194.   ColLen, FormLen, Place, OldLen, NewLen : Word;
  195.   P : CellPos;
  196.   S : String[10];
  197.   Good : Boolean;
  198. begin
  199.   with FormulaCellPtr(CP)^, GetFormula^ do
  200.   begin
  201.     Place := 1;
  202.     Good := True;
  203.     while Good and (Place <= Length) do
  204.     begin
  205.       if FormulaStart(GetFormula, Place, MaxCols, MaxRows, P, FormLen) then
  206.       begin
  207.         OldLen := System.Length(RowToString(P.Row));
  208.         S := RowToString(P.Row + Diff);
  209.         NewLen := System.Length(S);
  210.         ColLen := System.Length(ColToString(P.Col));
  211.         if NewLen > OldLen then
  212.           Good := Insert(FillString(NewLen - OldLen, ' '), Place + ColLen)
  213.         else if NewLen < OldLen then
  214.           Delete(Place + ColLen, OldLen - NewLen);
  215.         if Good then
  216.         begin
  217.           Move(S[1], Data^[Place + ColLen], System.Length(S));
  218.           Inc(Place, FormLen + NewLen - OldLen);
  219.         end;
  220.       end
  221.       else
  222.         Inc(Place);
  223.     end;
  224.   end; { with }
  225. end; { FixFormulaRow }
  226.  
  227. end.
  228.