eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Now 1:1 with ANSI class

This commit is contained in:
mysticbbs 2012-09-24 13:47:32 -04:00
parent 0087df705f
commit 3a5e73f312
1 changed files with 245 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

341
mdl/m_menubox.pas
View File

@ -1,7 +1,7 @@
{$I M_OPS.PAS}
Unit m_MenuBox; Unit m_MenuBox;
{$I M_OPS.PAS}
Interface Interface
Uses Uses
@ -36,6 +36,7 @@ Type
End; End;
TMenuListStatusProc = Procedure (Num: Word; Str: String); TMenuListStatusProc = Procedure (Num: Word; Str: String);
TMenuListSearchProc = Procedure (Var Owner: Pointer; Str: String);
TMenuListBoxRec = Record TMenuListBoxRec = Record
Name : String; Name : String;
@ -43,10 +44,9 @@ Type
End; End;
TMenuList = Class TMenuList = Class
Screen : TOutput;
List : Array[1..65535] of ^TMenuListBoxRec;
Box : TMenuBox;
InKey : TInput; InKey : TInput;
List : Array[1..10000] of ^TMenuListBoxRec;
Box : TMenuBox;
HiAttr : Byte; HiAttr : Byte;
LoAttr : Byte; LoAttr : Byte;
PosBar : Boolean; PosBar : Boolean;
@ -66,10 +66,15 @@ Type
Marked : Word; Marked : Word;
StatusProc : TMenuListStatusProc; StatusProc : TMenuListStatusProc;
Width : Integer; Width : Integer;
Length : Integer; WinSize : Integer;
X1 : Byte; X1 : Byte;
Y1 : Byte; Y1 : Byte;
NoInput : Boolean; NoInput : Boolean;
LastBarPos : Byte;
SearchProc : TMenuListSearchProc;
SearchX : Byte;
SearchY : Byte;
SearchA : Byte;
Constructor Create (Var S: TOutput); Constructor Create (Var S: TOutput);
Destructor Destroy; Override; Destructor Destroy; Override;
@ -78,9 +83,11 @@ Type
Procedure Add (Str: String; B: Byte); Procedure Add (Str: String; B: Byte);
Procedure Get (Num: Word; Var Str: String; Var B: Boolean); Procedure Get (Num: Word; Var Str: String; Var B: Boolean);
Procedure SetStatusProc (P: TMenuListStatusProc); Procedure SetStatusProc (P: TMenuListStatusProc);
Procedure SetSearchProc (P: TMenuListSearchProc);
Procedure Clear; Procedure Clear;
Procedure Delete (RecPos : Word); Procedure Delete (RecPos : Word);
{ Procedure Focus (Num: Word);} Procedure UpdatePercent;
Procedure UpdateBar (X, Y: Byte; RecPos: Word; IsHi: Boolean);
Procedure Update; Procedure Update;
End; End;
@ -211,7 +218,6 @@ Constructor TMenuList.Create (Var S: TOutput);
Begin Begin
Inherited Create; Inherited Create;
Screen := S;
Box := TMenuBox.Create(S); Box := TMenuBox.Create(S);
InKey := TInput.Create; InKey := TInput.Create;
ListMax := 0; ListMax := 0;
@ -224,45 +230,33 @@ Begin
NoWindow := False; NoWindow := False;
AllowTag := False; AllowTag := False;
TagChar := '*'; TagChar := '*';
TagKey := #32; TagKey := #09;
TagPos := 0; TagPos := 0;
TagAttr := 15 + 7 * 16; TagAttr := 15 + 7 * 16;
Marked := 0; Marked := 0;
Picked := 1; Picked := 1;
NoInput := False; NoInput := False;
LastBarPos := 0;
StatusProc := NIL; StatusProc := NIL;
SearchProc := NIL;
Screen.BufFlush; // SearchProc := DefListBoxSearch;
SearchX := 0;
SearchY := 0;
SearchA := 0;
TopPage := 1;
End; End;
Procedure TMenuList.Clear; Procedure TMenuList.Clear;
Var Var
A : Word; Count : Word;
Begin Begin
For A := 1 to ListMax Do Dispose(List[A]); For Count := 1 to ListMax Do
Dispose(List[Count]);
ListMax := 0; ListMax := 0;
Marked := 0; Marked := 0;
End; End;
(*
Procedure TMenuList.Focus (Num: Word);
Var
NewPicked : Word;
NewTopPage : Word;
Count : Word;
Begin
If Num > ListMax Then Exit;
Picked := 1;
ListMax :=
For Count := 1 to ListMax Do
If Picked < ListMax Then Inc (Picked);
If Picked > TopPage + Length - 1 Then Inc (TopPage);
End;
*)
Procedure TMenuList.Delete (RecPos : Word); Procedure TMenuList.Delete (RecPos : Word);
Var Var
Count : Word; Count : Word;
@ -287,58 +281,116 @@ Begin
Inherited Destroy; Inherited Destroy;
End; End;
Procedure TMenuList.Update; Procedure TMenuList.UpdateBar (X, Y: Byte; RecPos: Word; IsHi: Boolean);
Var Var
A : LongInt; Str : String;
S : String; Attr : Byte;
B : Integer;
C : Integer;
Begin Begin
For A := 0 to Length - 1 Do Begin If IsHi Then
C := TopPage + A; Attr := HiAttr
If C <= ListMax Then Begin Else
S := ' ' + List[C]^.Name + ' '; Attr := LoAttr;
If RecPos <= ListMax Then Begin
Str := ' ' + List[RecPos]^.Name + ' ';
Case Format of Case Format of
0 : S := strPadR (S, Width, ' '); 0 : Str := strPadR(Str, Width, ' ');
1 : S := strPadL (S, Width, ' '); 1 : Str := strPadL(Str, Width, ' ');
2 : S := strPadC (S, Width, ' '); 2 : Str := strPadC(Str, Width, ' ');
End; End;
End Else End Else
S := strRep(' ', Width); Str := strRep(' ', Width);
If C = Picked Then B := HiAttr Else B := LoAttr; Box.Console.WriteXY (X, Y, Attr, Str);
Screen.WriteXY (X1 + 1, Y1 + 1 + A, B, S);
If PosBar Then
Screen.WriteXY (X1 + Width + 1, Y1 + 1 + A, Box.BoxAttr2, '°');
If AllowTag Then If AllowTag Then
If (C <= ListMax) and (List[C]^.Tagged = 1) Then If (RecPos <= ListMax) and (List[RecPos]^.Tagged = 1) Then
Screen.WriteXY (TagPos, Y1 + 1 + A, TagAttr, TagChar) Box.Console.WriteXY (TagPos, Y, TagAttr, TagChar)
Else Else
Screen.WriteXY (TagPos, Y1 + 1 + A, TagAttr, ' '); Box.Console.WriteXY (TagPos, Y, TagAttr, ' ');
End; End;
If PosBar Then Procedure TMenuList.UpdatePercent;
If (ListMax > 0) and (Length > 0) Then Begin Var
A := (Picked * Length) DIV ListMax; NewPos : LongInt;
If Picked >= ListMax Then A := Pred(Length); Begin
If (A < 0) or (Picked = 1) Then A := 0; If Not PosBar Then Exit;
Screen.WriteXY (X1 + Width + 1, Y1 + 1 + A, Box.BoxAttr2, '²');
If (ListMax > 0) and (WinSize > 0) Then Begin
NewPos := (Picked * WinSize) DIV ListMax;
If Picked >= ListMax Then NewPos := Pred(WinSize);
If (NewPos < 0) or (Picked = 1) Then NewPos := 0;
NewPos := Y1 + 1 + NewPos;
If LastBarPos <> NewPos Then Begin
If LastBarPos > 0 Then
Box.Console.WriteXY (X1 + Width + 1, LastBarPos, Box.BoxAttr2, #176);
LastBarPos := NewPos;
Box.Console.WriteXY (X1 + Width + 1, NewPos, Box.BoxAttr2, #178);
End; End;
End; End;
End;
Procedure TMenuList.Update;
Var
Loop : LongInt;
CurRec : Integer;
Begin
For Loop := 0 to WinSize - 1 Do Begin
CurRec := TopPage + Loop;
UpdateBar (X1 + 1, Y1 + 1 + Loop, CurRec, CurRec = Picked);
End;
UpdatePercent;
End;
Procedure TMenuList.Open (BX1, BY1, BX2, BY2 : Byte); Procedure TMenuList.Open (BX1, BY1, BX2, BY2 : Byte);
Procedure DownArrow;
Begin
If Picked < ListMax Then Begin
If Picked >= TopPage + WinSize - 1 Then Begin
Inc (TopPage);
Inc (Picked);
Update;
End Else Begin
UpdateBar (X1 + 1, Y1 + Picked - TopPage + 1, Picked, False);
Inc (Picked);
UpdateBar (X1 + 1, Y1 + Picked - TopPage + 1, Picked, True);
UpdatePercent;
End;
End;
End;
Var Var
Ch : Char; Ch : Char;
A : Word; Count : Word;
sPos : Word; StartPos : Word;
ePos : Word; EndPos : Word;
First : Boolean; First : Boolean;
SavedRec : Word;
SavedTop : Word;
SearchStr : String;
LastWasChar : Boolean;
Begin Begin
If Not NoWindow Then If Not NoWindow Then
Box.Open (BX1, BY1, BX2, BY2); Box.Open (BX1, BY1, BX2, BY2);
If SearchX = 0 Then SearchX := BX1 + 2;
If SearchY = 0 Then SearchY := BY2;
If SearchA = 0 Then SearchA := Box.BoxAttr4;
X1 := BX1; X1 := BX1;
Y1 := BY1; Y1 := BY1;
@ -348,14 +400,32 @@ Begin
End; End;
Width := BX2 - X1 - 1; Width := BX2 - X1 - 1;
Length := BY2 - Y1 - 1; WinSize := BY2 - Y1 - 1;
TagPos := X1 + 1; TagPos := X1 + 1;
While Picked > TopPage + WinSize - 1 Do
Inc (TopPage);
If PosBar Then
For Count := 1 to WinSize Do
Box.Console.WriteXY (X1 + Width + 1, Y1 + Count, Box.BoxAttr2, #176);
If NoInput Then Exit; If NoInput Then Exit;
Repeat
Update; Update;
LastWasChar := False;
SearchStr := '';
Repeat
If Not LastWasChar Then Begin
If Assigned(SearchProc) And (SearchStr <> '') Then
SearchProc (Self, '');
SearchStr := ''
End Else
LastWasChar := False;
If Assigned(StatusProc) Then If Assigned(StatusProc) Then
If ListMax > 0 Then If ListMax > 0 Then
StatusProc(Picked, List[Picked]^.Name) StatusProc(Picked, List[Picked]^.Name)
@ -363,41 +433,61 @@ Begin
StatusProc(Picked, ''); StatusProc(Picked, '');
Ch := InKey.ReadKey; Ch := InKey.ReadKey;
Case Ch of Case Ch of
#00 : Begin #00 : Begin
Ch := InKey.ReadKey; Ch := InKey.ReadKey;
Case Ch of Case Ch of
#71 : Begin { home } #71 : If Picked > 1 Then Begin { home }
Picked := 1; Picked := 1;
TopPage := 1; TopPage := 1;
Update;
End; End;
#72 : Begin { up arrow } #72 : If (Picked > 1) Then Begin
If Picked > 1 Then Dec (Picked); If Picked <= TopPage Then Begin
If Picked < TopPage Then Dec (TopPage); Dec (Picked);
Dec (TopPage);
Update;
End Else Begin
UpdateBar (X1 + 1, Y1 + Picked - TopPage + 1, Picked, False);
Dec (Picked);
UpdateBar (X1 + 1, Y1 + Picked - TopPage + 1, Picked, True);
UpdatePercent;
End; End;
#73 : Begin { page up }
If Picked - Length > 1 Then Dec (Picked, Length) Else Picked := 1;
If TopPage - Length < 1 Then TopPage := 1 Else Dec(TopPage, Length);
End; End;
#79 : Begin { end } #73,
If ListMax > Length Then TopPage := ListMax - Length + 1; #75 : If (TopPage > 1) or (Picked > 1) Then Begin
If Picked - WinSize > 1 Then Dec (Picked, WinSize) Else Picked := 1;
If TopPage - WinSize < 1 Then TopPage := 1 Else Dec(TopPage, WinSize);
Update;
End;
#79 : If Picked < ListMax Then Begin
If ListMax > WinSize Then TopPage := ListMax - WinSize + 1;
Picked := ListMax; Picked := ListMax;
Update;
End; End;
#80 : Begin { down arrow } #80 : DownArrow;
If Picked < ListMax Then Inc (Picked); #77,
If Picked > TopPage + Length - 1 Then Inc (TopPage); #81 : If (Picked <> ListMax) Then Begin
End; If ListMax > WinSize Then Begin
#81 : If ListMax > 0 Then Begin { page down } If Picked + WinSize > ListMax Then
If ListMax > Length Then Begin
If Picked + Length > ListMax Then
Picked := ListMax Picked := ListMax
Else Else
Inc (Picked, Length); Inc (Picked, WinSize);
Inc (TopPage, Length);
If TopPage + Length > ListMax Then TopPage := ListMax - Length + 1; Inc (TopPage, WinSize);
If TopPage + WinSize > ListMax Then TopPage := ListMax - WinSize + 1;
End Else Begin End Else Begin
Picked := ListMax; Picked := ListMax;
End; End;
Update;
End; End;
Else Else
If Pos(Ch, HiChars) > 0 Then Begin If Pos(Ch, HiChars) > 0 Then Begin
@ -415,44 +505,78 @@ Begin
List[Picked]^.Tagged := 1; List[Picked]^.Tagged := 1;
Inc (Marked); Inc (Marked);
End; End;
If Picked < ListMax Then Inc (Picked);
If Picked > TopPage + Length - 1 Then Inc (TopPage); DownArrow;
End Else End Else
If Pos(Ch, LoChars) > 0 Then Begin If Pos(Ch, LoChars) > 0 Then Begin
ExitCode := Ch; ExitCode := Ch;
Exit; Exit;
End Else Begin End Else Begin
Ch := UpCase(Ch); If Ch <> #01 Then Begin
First := True; If Ch = #25 Then Begin
sPos := Picked + 1; LastWasChar := False;
ePos := ListMax; Continue;
End;
If sPos > ListMax Then sPos := 1; If Ch = #8 Then Begin
If Length(SearchStr) > 0 Then
A := sPos; Dec(SearchStr[0])
Else
While (A <= ePos) Do Begin Continue;
If UpCase(List[A]^.Name[1]) = Ch Then Begin
While A <> Picked Do Begin
If Picked < A Then Begin
If Picked < ListMax Then Inc (Picked);
If Picked > TopPage + Length - 1 Then Inc (TopPage);
End Else End Else
If Picked > A Then Begin If Ord(Ch) < 32 Then
Continue
Else
SearchStr := SearchStr + UpCase(Ch);
End;
SavedTop := TopPage;
SavedRec := Picked;
LastWasChar := True;
First := True;
StartPos := Picked + 1;
EndPos := ListMax;
If Assigned(SearchProc) Then
SearchProc(Self, SearchStr);
If StartPos > ListMax Then StartPos := 1;
Count := StartPos;
While (Count <= EndPos) Do Begin
If Pos(strUpper(SearchStr), strUpper(List[Count]^.Name)) > 0 Then Begin
While Count <> Picked Do Begin
If Picked < Count Then Begin
If Picked < ListMax Then Inc (Picked);
If Picked > TopPage + WinSize - 1 Then Inc (TopPage);
End Else
If Picked > Count Then Begin
If Picked > 1 Then Dec (Picked); If Picked > 1 Then Dec (Picked);
If Picked < TopPage Then Dec (TopPage); If Picked < TopPage Then Dec (TopPage);
End; End;
End; End;
Break; Break;
End; End;
If (A = ListMax) and First Then Begin
A := 0; If (Count = ListMax) and First Then Begin
sPos := 1; Count := 0;
ePos := Picked - 1; StartPos := 1;
EndPos := Picked - 1;
First := False; First := False;
End; End;
Inc (A); Inc (Count);
End;
If TopPage <> SavedTop Then
Update
Else
If Picked <> SavedRec Then Begin
UpdateBar (X1 + 1, Y1 + SavedRec - SavedTop + 1, SavedRec, False);
UpdateBar (X1 + 1, Y1 + Picked - TopPage + 1, Picked, True);
UpdatePercent;
End; End;
End; End;
End; End;
@ -468,6 +592,7 @@ Procedure TMenuList.Add (Str : String; B : Byte);
Begin Begin
Inc (ListMax); Inc (ListMax);
New (List[ListMax]); New (List[ListMax]);
List[ListMax]^.Name := Str; List[ListMax]^.Name := Str;
List[ListMax]^.Tagged := B; List[ListMax]^.Tagged := B;
@ -478,12 +603,18 @@ Procedure TMenuList.Get (Num : Word; Var Str : String; Var B : Boolean);
Begin Begin
Str := ''; Str := '';
B := False; B := False;
If Num <= ListMax Then Begin If Num <= ListMax Then Begin
Str := List[Num]^.Name; Str := List[Num]^.Name;
B := List[Num]^.Tagged = 1; B := List[Num]^.Tagged = 1;
End; End;
End; End;
Procedure TMenuList.SetSearchProc (P: TMenuListSearchProc);
Begin
SearchProc := P;
End;
Procedure TMenuList.SetStatusProc (P: TMenuListStatusProc); Procedure TMenuList.SetStatusProc (P: TMenuListStatusProc);
Begin Begin
StatusProc := P; StatusProc := P;