334 lines
9.6 KiB
Plaintext
334 lines
9.6 KiB
Plaintext
|
|
|||
|
|
{ Copyright (c) 1989 by Borland International, Inc. }
|
|||
|
|
|
|||
|
|
unit TCInput;
|
|||
|
|
{ Turbo Pascal 5.5 object-oriented example input routines.
|
|||
|
|
This unit is used by TCALC.PAS.
|
|||
|
|
See TCALC.DOC for an more information about this example.
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
{$S-}
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
uses Crt, TCUtil, TCScreen, TCLStr;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
LeftInputArrow = #17;
|
|||
|
|
RightInputArrow = #16;
|
|||
|
|
YesNo = 'Y/N';
|
|||
|
|
LegalYesNo = ['Y', 'N'];
|
|||
|
|
AllUpper = True;
|
|||
|
|
NotUpper = False;
|
|||
|
|
ErrNumberError1 = 'You must enter a number from ';
|
|||
|
|
ErrNumberError2 = ' to ';
|
|||
|
|
ErrColumnError1 = 'You must enter a column from ';
|
|||
|
|
ErrColumnError2 = ' to ';
|
|||
|
|
ErrCellError = 'You must enter a legal cell';
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
InputField = object
|
|||
|
|
StartCol : ScreenColRange;
|
|||
|
|
StopCol : Integer;
|
|||
|
|
InputRow : Integer;
|
|||
|
|
MaxInputLen : Word;
|
|||
|
|
Quit : Boolean;
|
|||
|
|
InputData : LStringPtr;
|
|||
|
|
UCase : Boolean;
|
|||
|
|
InputArea : ScreenArea;
|
|||
|
|
constructor Init(C1 : ScreenColRange; C2 : Integer; R : Integer;
|
|||
|
|
InitMaxInputLen : Word; InitUCase : Boolean);
|
|||
|
|
destructor Done;
|
|||
|
|
function GetQuit : Boolean;
|
|||
|
|
procedure Edit(StartCursor : Word);
|
|||
|
|
procedure ClearInput;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ReadString(Prompt : String; Len : Word;
|
|||
|
|
var ESCPressed : Boolean) : String;
|
|||
|
|
|
|||
|
|
function GetLegalChar(Prompt : String; Legal : CharSet;
|
|||
|
|
var ESCPressed : Boolean) : Char;
|
|||
|
|
|
|||
|
|
function GetYesNo(Prompt : String; var ESCPressed : Boolean) : Boolean;
|
|||
|
|
|
|||
|
|
function GetNumber(Prompt : String; Low, High : Longint;
|
|||
|
|
var Result : Boolean) : Longint;
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
constructor InputField.Init(C1 : ScreenColRange; C2 : Integer; R : Integer;
|
|||
|
|
InitMaxInputLen : Word; InitUCase : Boolean);
|
|||
|
|
{ Sets up an input field }
|
|||
|
|
begin
|
|||
|
|
InputData := New(LStringPtr, Init);
|
|||
|
|
if InputData = nil then
|
|||
|
|
Fail;
|
|||
|
|
StartCol := C1;
|
|||
|
|
StopCol := C2;
|
|||
|
|
InputRow := R;
|
|||
|
|
if InitMaxInputLen = 0 then
|
|||
|
|
MaxInputLen := 65521 { Maximum area that a pointer can allocate }
|
|||
|
|
else
|
|||
|
|
MaxInputLen := InitMaxInputLen;
|
|||
|
|
UCase := InitUCase;
|
|||
|
|
Quit := False;
|
|||
|
|
end; { InputField.Init }
|
|||
|
|
|
|||
|
|
destructor InputField.Done;
|
|||
|
|
{ Remove memory used by an input field }
|
|||
|
|
begin
|
|||
|
|
Dispose(InputData, Done);
|
|||
|
|
end; { InputField.Done }
|
|||
|
|
|
|||
|
|
function InputField.GetQuit : Boolean;
|
|||
|
|
{ Check to see if an input field has been exited with ESC }
|
|||
|
|
begin
|
|||
|
|
GetQuit := Quit;
|
|||
|
|
end; { InputField.GetQuit }
|
|||
|
|
|
|||
|
|
procedure InputField.Edit(StartCursor : Word);
|
|||
|
|
{ Edits the input field }
|
|||
|
|
var
|
|||
|
|
CursorPos, Start, Cursor : Word;
|
|||
|
|
Ch : Word;
|
|||
|
|
Good, InsMode, Finished : Boolean;
|
|||
|
|
R : ScreenRowRange;
|
|||
|
|
SCol, ECol, EndCol : ScreenColRange;
|
|||
|
|
begin
|
|||
|
|
with InputData^ do
|
|||
|
|
begin
|
|||
|
|
Quit := False;
|
|||
|
|
SCol := StartCol; { Figure out where the field starts and stops }
|
|||
|
|
if StopCol <= 0 then
|
|||
|
|
EndCol := Scr.CurrCols + StopCol
|
|||
|
|
else
|
|||
|
|
EndCol := StopCol;
|
|||
|
|
if InputRow <= 0 then
|
|||
|
|
R := Scr.CurrRows + InputRow
|
|||
|
|
else
|
|||
|
|
R := InputRow;
|
|||
|
|
if (R = Scr.CurrRows) and (ECol = Scr.CurrCols) then
|
|||
|
|
Dec(EndCol);
|
|||
|
|
ECol := EndCol;
|
|||
|
|
InputArea.Init(SCol, R, ECol, R, Colors.InputColor);
|
|||
|
|
InputArea.Clear;
|
|||
|
|
if StartCursor = 0 then
|
|||
|
|
CursorPos := Succ(Length)
|
|||
|
|
else
|
|||
|
|
CursorPos := StartCursor;
|
|||
|
|
Finished := False;
|
|||
|
|
InsMode := True;
|
|||
|
|
Cursor := Scr.InsCursor;
|
|||
|
|
Start := Max(Longint(CursorPos) - ECol - SCol + 2, 1);
|
|||
|
|
repeat
|
|||
|
|
if CursorPos > Length then
|
|||
|
|
ECol := EndCol;
|
|||
|
|
if (CursorPos < Start) or (CursorPos > Start + ECol - SCol) then
|
|||
|
|
Start := Max(Longint(CursorPos) - ECol + SCol, 1);
|
|||
|
|
if (Start = 2) and (SCol <> StartCol) then
|
|||
|
|
begin
|
|||
|
|
SCol := StartCol;
|
|||
|
|
Start := 1;
|
|||
|
|
end;
|
|||
|
|
if Start > 1 then
|
|||
|
|
begin
|
|||
|
|
if SCol = StartCol then
|
|||
|
|
begin
|
|||
|
|
Inc(Start);
|
|||
|
|
SCol := Succ(StartCol); { Text is off left side of line }
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
SCol := StartCol;
|
|||
|
|
if Length > Start + ECol - SCol then
|
|||
|
|
begin
|
|||
|
|
if ECol = EndCol then
|
|||
|
|
begin
|
|||
|
|
if SCol <> StartCol then
|
|||
|
|
Inc(Start);
|
|||
|
|
ECol := Pred(EndCol); { Text is off right side of line }
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
ECol := EndCol;
|
|||
|
|
GotoXY(StartCol, R);
|
|||
|
|
if SCol <> StartCol then { Text is off left side of line }
|
|||
|
|
WriteColor(LeftInputArrow, Colors.InputArrowColor);
|
|||
|
|
WriteColor(LeftJustStr(InputData^.Copy(Start, Succ(ECol - SCol)),
|
|||
|
|
Succ(ECol - SCol)), Colors.InputColor);
|
|||
|
|
if ECol <> EndCol then { Text is off right side of line }
|
|||
|
|
WriteColor(RightInputArrow, Colors.InputArrowColor);
|
|||
|
|
GotoXY(CursorPos - Start + SCol, R);
|
|||
|
|
SetCursor(Cursor);
|
|||
|
|
Ch := GetKey;
|
|||
|
|
SetCursor(NoCursor);
|
|||
|
|
case Ch of
|
|||
|
|
Ord(' ')..Ord('~') : begin
|
|||
|
|
if not (InsMode and (Length = MaxInputLen)) then
|
|||
|
|
begin
|
|||
|
|
if UCase then
|
|||
|
|
Ch := Ord(UpCase(Chr(Ch)));
|
|||
|
|
if InsMode or (CursorPos > Length) then
|
|||
|
|
Good := Insert(Chr(Ch), CursorPos)
|
|||
|
|
else begin
|
|||
|
|
Good := True;
|
|||
|
|
Change(Chr(Ch), CursorPos);
|
|||
|
|
end;
|
|||
|
|
if Good then
|
|||
|
|
Inc(CursorPos);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
HomeKey : CursorPos := 1;
|
|||
|
|
EndKey : CursorPos := Succ(Length);
|
|||
|
|
BS : begin
|
|||
|
|
if CursorPos > 1 then
|
|||
|
|
begin
|
|||
|
|
Delete(Pred(CursorPos), 1);
|
|||
|
|
Dec(CursorPos);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
DelKey : begin
|
|||
|
|
if CursorPos <= Length then
|
|||
|
|
Delete(CursorPos, 1);
|
|||
|
|
end;
|
|||
|
|
LeftKey : begin
|
|||
|
|
if CursorPos > 1 then
|
|||
|
|
Dec(CursorPos);
|
|||
|
|
end;
|
|||
|
|
RightKey : begin
|
|||
|
|
if CursorPos <= Length then
|
|||
|
|
Inc(CursorPos);
|
|||
|
|
end;
|
|||
|
|
InsKey : begin
|
|||
|
|
InsMode := not InsMode;
|
|||
|
|
if InsMode then
|
|||
|
|
Cursor := Scr.InsCursor
|
|||
|
|
else
|
|||
|
|
Cursor := Scr.OldCursor;
|
|||
|
|
end;
|
|||
|
|
CtrlLeftKey : begin { Move back one word }
|
|||
|
|
if (CursorPos > 1) and (Data^[CursorPos] <> ' ') then
|
|||
|
|
Dec(CursorPos);
|
|||
|
|
while (CursorPos > 1) and (Data^[CursorPos] = ' ') do
|
|||
|
|
Dec(CursorPos);
|
|||
|
|
while (CursorPos > 1) and (Data^[Pred(CursorPos)] <> ' ') do
|
|||
|
|
Dec(CursorPos);
|
|||
|
|
end;
|
|||
|
|
CtrlRightKey : begin { Move forward one word }
|
|||
|
|
while (CursorPos <= Length) and (Data^[CursorPos] <> ' ') do
|
|||
|
|
Inc(CursorPos);
|
|||
|
|
while (CursorPos <= Length) and (Data^[CursorPos] = ' ') do
|
|||
|
|
Inc(CursorPos);
|
|||
|
|
end;
|
|||
|
|
ESC : begin
|
|||
|
|
ClearInput;
|
|||
|
|
Quit := True;
|
|||
|
|
Finished := True;
|
|||
|
|
end;
|
|||
|
|
CR : Finished := True;
|
|||
|
|
end; { case }
|
|||
|
|
until Finished;
|
|||
|
|
end; { with }
|
|||
|
|
end; { InputField.Edit }
|
|||
|
|
|
|||
|
|
procedure InputField.ClearInput;
|
|||
|
|
{ Makes the input field data a null long string }
|
|||
|
|
var
|
|||
|
|
Good : Boolean;
|
|||
|
|
begin
|
|||
|
|
Good := InputData^.FromString('');
|
|||
|
|
end; { InputField.ClearInput }
|
|||
|
|
|
|||
|
|
function ReadString(Prompt : String; Len : Word;
|
|||
|
|
var ESCPressed : Boolean) : String;
|
|||
|
|
{ Read a string from the input area }
|
|||
|
|
var
|
|||
|
|
I : InputField;
|
|||
|
|
begin
|
|||
|
|
with I do
|
|||
|
|
begin
|
|||
|
|
if not Init(Length(Prompt) + 3, 0, -1, Len, NotUpper) then
|
|||
|
|
begin
|
|||
|
|
ESCPressed := True;
|
|||
|
|
ReadString := '';
|
|||
|
|
end;
|
|||
|
|
WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
|
|||
|
|
Edit(0);
|
|||
|
|
ReadString := InputData^.ToString;
|
|||
|
|
ESCPressed := GetQuit;
|
|||
|
|
Done;
|
|||
|
|
end; { with }
|
|||
|
|
ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
|
|||
|
|
end; { ReadString }
|
|||
|
|
|
|||
|
|
function GetLegalChar(Prompt : String; Legal : CharSet;
|
|||
|
|
var ESCPressed : Boolean) : Char;
|
|||
|
|
{ Read a chanracter from the input area, only reading certain ones }
|
|||
|
|
var
|
|||
|
|
Ch : Char;
|
|||
|
|
begin
|
|||
|
|
WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
|
|||
|
|
Ch := GetKeyChar(Legal);
|
|||
|
|
ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
|
|||
|
|
GetLegalChar := Ch;
|
|||
|
|
end; { GetLegalChar }
|
|||
|
|
|
|||
|
|
function GetYesNo(Prompt : String; var ESCPressed : Boolean) : Boolean;
|
|||
|
|
{ Prints a "Yes/No" prompt, allowing the user to type Y or N to answer the
|
|||
|
|
question }
|
|||
|
|
var
|
|||
|
|
Ch : Char;
|
|||
|
|
begin
|
|||
|
|
WriteXY(Prompt + ' (' + YesNo + ')?', 1, Pred(Scr.CurrRows),
|
|||
|
|
Colors.PromptColor);
|
|||
|
|
Ch := GetKeyChar(LegalYesNo);
|
|||
|
|
ESCPressed := Ch = Chr(ESC);
|
|||
|
|
ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
|
|||
|
|
GetYesNo := Ch = 'Y';
|
|||
|
|
end; { GetYesNo }
|
|||
|
|
|
|||
|
|
function GetNumber(Prompt : String; Low, High : Longint;
|
|||
|
|
var Result : Boolean) : Longint;
|
|||
|
|
{ Prompts for a numeric value within a certain range }
|
|||
|
|
var
|
|||
|
|
I : InputField;
|
|||
|
|
S : String;
|
|||
|
|
Error : Integer;
|
|||
|
|
L : Longint;
|
|||
|
|
begin
|
|||
|
|
with I do
|
|||
|
|
begin
|
|||
|
|
if not Init(Length(Prompt) + 3, 0, -1,
|
|||
|
|
Max(Length(NumToString(Low)),
|
|||
|
|
Length(NumToString(High))), NotUpper) then
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
GetNumber := 0;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
WriteXY(Prompt + ': ', 1, Pred(Scr.CurrRows), Colors.PromptColor);
|
|||
|
|
repeat
|
|||
|
|
Edit(0);
|
|||
|
|
S := InputData^.ToString;
|
|||
|
|
if (not GetQuit) and (S <> '') then
|
|||
|
|
begin
|
|||
|
|
Val(S, L, Error);
|
|||
|
|
Result := (Error = 0) and (L >= Low) and (L <= High);
|
|||
|
|
if not Result then
|
|||
|
|
Scr.PrintError(ErrNumberError1 + NumToString(Low) +
|
|||
|
|
ErrNumberError2 + NumToString(High));
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
Result := False;
|
|||
|
|
L := 0;
|
|||
|
|
end;
|
|||
|
|
until Result or (S = '');
|
|||
|
|
Done;
|
|||
|
|
end; { with }
|
|||
|
|
ClrEOLXY(1, Pred(Scr.CurrRows), Colors.BlankColor);
|
|||
|
|
GetNumber := L;
|
|||
|
|
end; { GetNumber }
|
|||
|
|
|
|||
|
|
end.
|
|||
|
|
|