Comment ========================================================== This include file exports definitions that create a block menu look and feel. This is one of several look and feel files that export the same procedures. Useful Routines Exported: LookSetup Call this to initialize the screen. Set MenuTitle and StatusLineText before calling this routine. CornerStretchBox (Header,Col,Row) Creates a window from the array Choices with the upper left corner at Row/Col. LastKey is set to the letter that is chosen. CenterStretchBox (Header,Col,Row) Creates a window from the array Choices with the center at Row/Col. if a 0 is passed for either the Row or Col then the center of the screen is assumed. LastKey is set to the letter that is chosen. Leave Puts up an exit box. ========================================================== EndComment var VertLine = "³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³" VertLine2 = "³³³³³³³³³³³³³³³³³³³³" VertLine3 = "ÚÄÁÁÁÁÄ¿" VertLine4 = "ÀÄÂÂÂÂÄÙ" Grid1 = "ÌÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎÍÎ͹" Grid2 = "ÃÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄÅÄ´" Grid3 = "ÌÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎÎι" Grid4 = "ÃÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅÅ´" Choices MenuTitle StatusLineText HeightDifference Greek = False var BackGroundFG BackGroundBG TitleBoxBorderFG TitleBoxBG TitleBoxInsideFG ClockColorFG StatusLineFG StatusLineBG MenuInsideFG MenuBG MenuHeaderFG MenuHeaderBG MenuBorderFG MenuVertLinesFG MenuInverseFG MenuInverseBG MenuCapColorFG ConsoleInsideFG GreekFG GreekBG ;------ This is where you set your favorite colors. Procedure SetColors if ColorScreen BackGroundFG = LBlue BackGroundBG = Black TitleBoxBG = Brown TitleBoxBorderFG = White TitleBoxInsideFG = Yellow ClockColorFG = Yellow StatusLineFG = Yellow StatusLineBG = Mag MenuBG = Black MenuInsideFG = Yellow MenuBorderFG = LRed MenuHeaderFG = White MenuHeaderBG = Green MenuVertLinesFG = LGreen MenuInverseFG = Yellow MenuInverseBG = Mag MenuCapColorFG = White ConsoleInsideFG = White GreekFG = Black GreekBG = Brown else BackGroundFG = Grey BackGroundBG = Black TitleBoxBG = Grey TitleBoxBorderFG = Black TitleBoxInsideFG = Black ClockColorFG = Black StatusLineFG = Black StatusLineBG = Grey MenuBG = Black MenuInsideFG = Grey MenuBorderFG = White MenuHeaderFG = Black MenuHeaderBG = Grey MenuVertLinesFG = White MenuInverseFG = Black MenuInverseBG = Grey MenuCapColorFG = White ConsoleInsideFG = Grey GreekFG = Black GreekBG = Grey endif EndProc ;------ Sets up main window to block look. Procedure LookSetup if MenuInsideFG = 0 then SetColors NoExit ;------ Clear the screen with a textured background TextColor BackGroundFG BackGroundBG ClearScreen GotoXY 1 3 loop ScreenHeight - 3 Writeln Grid3 endloop ;------ If Greek is true then draw greek columns ; if Greek then GreekColumns ;------ Draw Status Line NoBoxBorder Explode Off BoxInsideColor StatusLineFG StatusLineBG DrawBox 1 25 ScreenWidth 1 WriteCenter(StatusLineText) ;------ Draw the Title Box SingleLineBox Explode Off BoxInsideColor TitleBoxInsideFG TitleBoxBG BoxBorderColor TitleBoxBorderFG TitleBoxBG DrawBox 1 1 ScreenWidth 3 GotoXY(ScreenWidth - Length(MenuTitle) - 3,1) Write MenuTitle ;------ Display the clock ClockColor ClockColorFG TitleBoxBG ClockPos 3 2 ;------ Setup Console ConsolePos 42 5 ConsoleHeaderColor MenuInverseFG MenuInverseBG ConsoleInsideColor ConsoleInsideFG MenuBG BoxHeaderColor MenuHeaderFG MenuHeaderBG HeightDifference = 2 SmallShadow Shadow EndProc Procedure CenterStretchBox (Header,Col,Row) MakeBox(Header,Col,Row,True) EndProc Procedure CornerStretchBox (Header,Col,Row) MakeBox(Header,Col,Row,False) EndProc Procedure MakeBox(Header,Col,Row,Center) var NumElem Height Width Width = Length(Header) + 1 NumElem = NumberOfElements(Choices) ;Get the widest element in the Choices Array if Length(Choices[1]) > 0 loop NumElem Trim(Choices[LoopIndex]) Choices[LoopIndex] = " " + Char(64 + LoopIndex) + ". " + Choices[LoopIndex] Width = Max(Width,Length(Choices[LoopIndex])) endloop else Width = 71 endif Height = NumElem + 2 Width = Width + 5 if Center if Row = 0 ;Center window verticaly Row = ((ScreenHeight - Height) / 2) + 2 else ;Center window with X Coordinate Row = (Row - (Height / 2) + 1) endif if Col = 0 ;Center window horizonitly Col = (ScreenWidth - Width) / 2 + 1 else ;Center window with Y Coordinate Col = (Col - (Width / 2) + 1) endif endif ;Make Sure Row and Col are within their range Row = Max(Row,5) Row = Min(Row,ScreenHeight - Height - 2) Col = Max(Col,2) Col = Min(Col,ScreenWidth - Width - 2) DrawTheBox(Col,Row,Width,Height,Header) ;Write the menu choices loop(NumElem - 1) Writeln(Choices[LoopIndex]) endloop Write Choices[NumElem] UseArrows On Dispose(Choices) EndProc ;------ Draw the Box Procedure DrawTheBox (Col,Row,Width,Height,Header) ;Draw the main window DoubleLineBox InActiveBox SingleLineBox BoxInsideColor(MenuInsideFG,MenuBG) BoxBorderColor(MenuBorderFG,MenuBG) if Header > '' then Header = ' ' + Header + ' ' BoxHeader = Header DrawBox(Col, Row, Width, Height) if Header > '' TextColor MenuInsideFG MenuBG CapsColor(MenuCapColorFG,MenuBG) InverseColor(MenuInverseFG,MenuInverseBG) Window(Col + 2, Row + 1, Width - 4, Height - 2) else CapsColor Black Black endif EndProc ;------ MenuExit Procedure Procedure LeaveMenu AppendArray(Choices,'Yes') AppendArray(Choices,'No') CenterStretchBox ('Exit Menu',0,0) OnScreenOnly Off OnKey "A" |ExitMenu OnKey "B" |LastKey = Esc OnKey "Y" |ExitMenu OnKey "N" |LastKey = Esc EndProc ;------ Read a Text Line Procedure Procedure ReadTextLine(St,Header,Col,Row) var AnswerLine Choices[1] = "" CenterStretchBox(Header,Col,Row) Write " " St " " TextColor(MenuCapColorFG,MenuBG) AnswerLine = Readln EraseTopWindow Dispose Choices Return AnswerLine EndProc Procedure GreekColumns TextColor GreekFG GreekBG GotoXY 4,4 WriteVertical VertLine2 GotoXY 5,4 WriteVertical VertLine2 GotoXY 6,4 WriteVertical VertLine2 GotoXY 7,4 WriteVertical VertLine2 GotoXY 74,4 WriteVertical VertLine2 GotoXY 75,4 WriteVertical VertLine2 GotoXY 76,4 WriteVertical VertLine2 GotoXY 77,4 WriteVertical VertLine2 GotoXY 2,4 Write VertLine4 GotoXY 72,4 Write VertLine4 GotoXY 2,24 Write VertLine3 GotoXY 72,24 Write VertLine3 EndProc