[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]

    Unit TUI;
    Interface
    Uses CRT;
    Const Winsets = 1;
          WinComponents = 10;

    Var
        Item     : array[1..23] of String[80];
        Print    : Boolean;

    Function Menu( NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
                   StartX,StartY:Byte) : Byte;
    Procedure Wind(Y1,X1,Y2,X2,FGCol,BGCol : Integer);
    Function WindMen(NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
                   WinFG,WinBG,StartX,StartY:Byte) : Byte;
    Procedure Shade (FG,BG : Byte;Ch : Char);
    Procedure TXTFG(Clr : Byte);
    Procedure TXTBG(Clr : Byte);
    Procedure Locate(X,Y : Byte);
    Procedure Prnt(Strng : String);
    Procedure PrntLN(Strng : String);
    function IntToStr(I: Longint): String;
    implementation
    Procedure TXTFG(Clr : Byte);
    Begin
    Repeat Until Print;
    Print:=False;
    TextColor(CLR);
    Print:=True;
    End;
    Procedure TXTBG(Clr : Byte);
    Begin
    Repeat Until Print;
    Print:=False;
    TextBackGround(CLR);
    Print:=True;
    End;
    Procedure Locate(X,Y : Byte);
    Begin
    Repeat Until Print; Print:=False;
    GotoXY(X,Y);
    Print:=True;
    End;
    Procedure Prnt(Strng : String);
    Begin
    Repeat Until Print; Print:=False;
    Write(Strng);
    Print:=True;
    End;
    Procedure PrntLN(Strng : String);
    Begin
    Repeat Until Print; Print:=False;
    WriteLn(Strng);
    Print:=True;
    End;
    function IntToStr(I: Longint): String;
    { Convert any integer type to a string }
    var
     S: string[11];
    begin
     Str(I, S);
     IntToStr := S;
    end;

    Function Menu( NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
                   StartX,StartY:Byte) : Byte;
    Var MenuStrings : Array[1..25] of String;
        NowX,NowY,LastX,LastY,SaveAttr,SaveX,SaveY : Byte;
        ItemNow,LastItem : Byte;
        InChar : Array[1..5] of Char;
        TmpStr : String;
        Count1,Count2,Count3,Count4  : Byte;
        Done   : Boolean;
        StartItem : Byte;

    Begin
    SaveX:=WhereX;
    SaveY:=WhereY;
    StartItem:=1;
    SaveAttr:=TextAttr;
    NowX:=StartX;
    NowY:=StartY;
    LastX:=NowX;
    LastY:=NowY;
    ItemNow:=StartItem;
    LastItem:=StartItem;
    TXTFG(NormalFG);
    TXTBG(NormalBG);
    For Count2:=1 to NumItems do begin
    Locate(StartX,(Count2+StartY)-1);
    If Print then      PRNT(Item[Count2]);
                                   End;
    Done:=False;
    Repeat
     Locate(LastX,LastY);
     TXTFG(NormalFG);
     TXTBG(NormalBG);
     PRNT(Item[LastItem]);
     Locate(NowX,NowY);
     TXTFG(LightBarFG);
     TXTBG(LightBarBG);
     PRNT(Item[ItemNow]);
    Repeat Until Keypressed;
    {If NOT keypressed then begin Menu:=0; Done:=True; End;}
    Inchar[1]:=ReadKey;
    If Inchar[1]=#0 then begin Inchar[1]:=ReadKey;
    LastX:=NowX;
    LastY:=NowY;
    LastItem:=ItemNow;
     Case InChar[1] of
                     'P' : Begin Inc(NowY); Inc(ItemNow) End;
                     'H' : Begin Dec(NowY); Dec(ItemNow) End;
                     'K' : Begin Dec(NowY); Dec(ItemNow) End;
                     'M' : Begin Inc(NowY); Inc(ItemNow) End;
                     'G' : Begin NowY:=StartY; ItemNow:=1 End;
                     'O' : Begin NowY:=StartY+(NumItems-1); ItemNow:=NumItems End;
     End;
    If ItemNow>NumItems then begin ItemNow:=1; NowY:=StartY; End;
    If ItemNow<1 then begin ItemNow:=NumItems; NowY:=NowY+NumItems; End;

                         End;
    If Inchar[1]=#27 then begin Menu:=255; Done:=True; End;
    If Inchar[1]=#13 then begin Menu:=ItemNow; Done:=True; End;

    Until Done;
    TextAttr:=SaveAttr;
     Locate(SaveX,SaveY);
    End;

    Procedure Wind(Y1,X1,Y2,X2,FGCol,BGCol : Integer);
    Var
    Count : Array [1..4] of Byte;
    TmpVar : Array [1..10] of Integer;
     WinSet : Array [1..WinSets,1..WinComponents] of Char;

    Begin
              Winset[1,01]:='Û'; {Top left}
              Winset[1,02]:='ß'; {Top}
              Winset[1,03]:='Û'; {Top right}
              Winset[1,04]:='Ý'; {Left side}
              Winset[1,05]:='Þ'; {Right side}
              Winset[1,06]:='Û'; {Bottom Left}
              Winset[1,07]:='Ü'; {Bottom}
              Winset[1,08]:='Û'; {Bottom Right}
              Winset[1,09]:='±'; {Shadow}
     TXTFG(FGCol);
     TXTBG(BGCol);
     Locate(X1,Y1);
     PRNT(WinSet[1,01]);
    For Count[1]:=X1+1 to X2-2 do begin
                        PRNT(Winset[1,02]);
                       End;
     PRNT(WinSet[1,03]);
    For Count[1]:=Y1+1 to Y2-1 do begin
           TXTFG(FGCol);
           TXTBG(BGCol);
           Locate(X1,Count[1]);
           PRNT(WinSet[1,04]);
           Locate(X2-1,Count[1]);
           PRNT(WinSet[1,05]);
          If FGCol > 7 then  TXTFG(FgCol-8)
                            Else  TXTFG(8);
           TXTBG(0);
           PRNT(Winset[1,09]);
          End;
           Locate(X1,Y2);
           TXTFG(FGCol);
           TXTBG(BGCol);
                       For Count[1]:=X1 to X2-2 do begin
                       If count[1]<>X1 then  PRNT(Winset[1,07])
                       else  PRNT(Winset[1,06]);;
                       End;
                       PRNT(WinSet[1,08]);
          If FGCol > 7 then  TXTFG(FgCol-8) Else  TXTFG(8);
           TXTBG(0);
           PRNT(Winset[1,09]);
           Locate(X1+1,Y2+1);
           For Count[1]:=X1+1 to X2 do begin
            PRNT(Winset[1,09]);
           End;

    End;

    Function WindMen(NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
                   WinFG,WinBG,StartX,StartY:Byte) : Byte;
    Var SaveX,SaveY,SaveAttr,Selec : Byte;
    Begin
    SaveX:=WhereX;
    SaveY:=WhereY;
    SaveAttr:=TextAttr;
    Wind(StartY-1,StartX-1,(StartY)+NumItems,StartX+Length(Item[1])+1,WinFG,WinBG)
    ;Selec:=Menu(NumItems,LightbarFG,LightbarBG,NormalFG,NormalBG,StartX,StartY);
    Locate(SaveX,SaveY);
    TextAttr:=SaveAttr;
    WindMen:=Selec;
    End;

    Procedure Shade (FG,BG : Byte;Ch : Char);
    Var CNT : Integer;
    Begin
     TXTFG(FG);
     TXTBG(BG);
     For CNT:=0 to 4000 do begin
     If Odd(Cnt) then Mem[$B800:Cnt]:=TextAttr
                 else
                     Mem[$B800:Cnt]:=Ord(Ch);
                 end;
    End;

    Begin
    Print:=True;
    End.

[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]