// ==================================================================== // Mystic BBS Software Copyright 1997-2013 By James Coyle // ==================================================================== // // This file is part of Mystic BBS. // // Mystic BBS is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 3 of the License, or // (at your option) any later version. // // Mystic BBS is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Mystic BBS. If not, see . // // ==================================================================== Program TESTIO_2; {$I M_OPS.PAS} Uses m_Types, m_Strings, m_Input, m_Output, m_MenuBox, m_MenuForm; Const { TheDraw Pascal Crunched Screen Image. Date: 09/03/02 } TESTMAIN_WIDTH=80; TESTMAIN_LENGTH=128; TESTMAIN : array [1..128] of Char = ( #15,#16,#26,'N','Ü', #7,'Ü',#24,#15,'Û',#23,#25,'M', #8,#16,'Û',#24, #7,'ß', #8,#26,'N','ß',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O', '°',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O','°', #24,#26,'O','°',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O','°',#24, #26,'O','°',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O','°',#24,#26, 'O','°',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O','°',#24,#26,'O', '°',#24,#26,'@','Ä',' ',#26, #3,'Ä',' ','Ä','Ä',' ',' ','Ä',' ',' ', 'ù',#24,#15,':', #7,':', #8,':',#24); Var Screen : TOutput; Menu : TMenuForm; Box : TMenuBox; Image : TConsoleImageRec; MenuPosition : Byte; Res : Char; Procedure BoxOpen (X1, Y1, X2, Y2: Byte); Begin Box := TMenuBox.Create(Screen); Box.Open(X1, Y1, X2, Y2); End; Procedure BoxClose; Begin Box.Close; Box.Free; End; Procedure CoolBoxOpen (X1: Byte; Text: String); Var Len : Byte; Begin Len := Length(Text) + 6; Screen.GetScreenImage(X1, 1, X1 + Len, 3, Image); Screen.WriteXYPipe (X1, 1, 8, Len, 'Ü|15Ü|11ÜÜ|03ÜÜ|09Ü|03Ü|09' + strRep('Ü', Len - 9) + '|08Ü'); Screen.WriteXYPipe (X1 ,2, 8, Len, 'Ý|09|17² |15' + Text + ' |00°|16|08Þ'); Screen.WriteXYPipe (X1, 3, 8, Len, 'ß|01²|17 |11À|03ÄÄ|08' + strRep('Ä', Length(Text) - 4) + '|00¿ ±|16|08ß'); End; Procedure CoolBoxClose; Begin Screen.PutScreenImage(Image); End; Procedure AboutBox; Begin BoxOpen (19, 7, 62, 19); Screen.WriteXY (21, 8, 31, strPadC('Test IO Program', 40, ' ')); Screen.WriteXY (21, 9, 112, strRep('-', 40)); Screen.WriteXY (26, 11, 113, 'Copyright (C) 2003 By No One'); Screen.WriteXY (31, 12, 113, 'All Rights Reserved'); Screen.WriteXY (21, 14, 113, strPadC('Version 1.00', 40, ' ')); Screen.WriteXY (32, 16, 113, 'www.someplace.com'); Screen.WriteXY (21, 17, 112, strRep('-', 40)); Screen.WriteXY (21, 18, 31, strPadC('(PRESS A KEY)', 40, ' ')); Menu.Input.ReadKey; BoxClose; End; Procedure FormTest; Var MyBox : TMenuBox; MyForm : TMenuForm; Data : Array[1..9] of String; Begin FillChar (Data, SizeOf(Data), #0); MyBox := TMenuBox.Create(Screen); MyForm := TMenuForm.Create(Screen); MyBox.Header := ' Input Test '; MyBox.Open (5, 6, 75, 18); MyForm.AddStr ('1', ' String Test #1 ', 8, 8, 28, 8, 16, 45, 60, @Data[1], 'String input test #1'); MyForm.AddStr ('2', ' String Test #2 ', 8, 9, 28, 9, 16, 45, 60, @Data[2], 'String input test #2'); MyForm.AddStr ('3', ' String Test #3 ', 8, 10, 28, 10, 16, 45, 60, @Data[3], 'String input test #3'); MyForm.AddStr ('4', ' String Test #4 ', 8, 11, 28, 11, 16, 45, 60, @Data[4], 'String input test #4'); MyForm.AddStr ('5', ' String Test #5 ', 8, 12, 28, 12, 16, 45, 60, @Data[5], 'String input test #5'); MyForm.AddStr ('6', ' String Test #6 ', 8, 13, 28, 13, 16, 45, 60, @Data[6], 'String input test #6'); MyForm.AddStr ('7', ' String Test #7 ', 8, 14, 28, 14, 16, 45, 60, @Data[7], 'String input test #7'); MyForm.AddStr ('8', ' String Test #8 ', 8, 15, 28, 15, 16, 45, 60, @Data[8], 'String input test #8'); MyForm.AddStr ('9', ' String Test #9 ', 8, 16, 28, 16, 16, 45, 60, @Data[9], 'String input test #9'); MyForm.Execute; Box.Close; MyForm.Free; MyBox.Free; End; Begin Screen := TOutput.Create(True); Menu := TMenuForm.Create(Screen); Screen.SetWindowTitle('IO TEST #2'); Screen.LoadScreenImage(TESTMAIN, TESTMAIN_LENGTH, TESTMAIN_WIDTH, 1, 1); MenuPosition := 0; Repeat Menu.Clear; If MenuPosition = 0 Then Begin Menu.HiExitChars := #80; Menu.ExitOnFirst := False; End Else Begin Menu.HiExitChars := #75#77; Menu.ExitOnFirst := True; End; Case MenuPosition of 0 : Begin Menu.AddNone('M', ' Main Menu ', 3, 2, 11, 'Menu menu options'); Menu.AddNone('X', ' Exit ' , 16, 2, 6, 'Exit/About options'); Res := Menu.Execute; If Menu.WasHiExit Then MenuPosition := Menu.ItemPos Else Case Res of #27 : Break; 'M' : MenuPosition := 1; 'X' : MenuPosition := 2; End; End; 1 : Begin BoxOpen (2, 4, 20, 9); CoolBoxOpen (1, 'Main Menu'); Menu.AddNone ('F', ' Form/Input Test ', 3, 5, 17, 'Test form and input functions'); Menu.AddNone ('N', ' Nothing #1' , 3, 6, 17, 'Nothing at all #1'); Menu.AddNone ('N', ' Nothing #2' , 3, 7, 17, 'Nothing at all #2'); Menu.AddNone ('N', ' Nothing #3' , 3, 8, 17, 'Nothing at all #3'); Res := Menu.Execute; BoxClose; CoolBoxClose; If Menu.WasHiExit Then Begin Case Res of #75 : MenuPosition := 2; #77 : MenuPosition := 2; End; End Else Case Res of 'F' : FormTest; 'N' : ; Else MenuPosition := 0; End; End; 2 : Begin BoxOpen (15, 4, 23, 7); CoolBoxOpen (14, 'Exit'); Menu.AddNone ('A', ' About ', 16, 5, 7, 'About this test program'); Menu.AddNone ('X', ' Exit ' , 16, 6, 7, 'Exit this program'); Res := Menu.Execute; BoxClose; CoolBoxClose; If Menu.WasHiExit Then Begin Case Res of #75 : MenuPosition := 1; #77 : MenuPosition := 1; End; End Else Case Res of 'A' : AboutBox; 'X' : Break; Else MenuPosition := 0; End; End; End; Until False; Screen.ClearScreen; Screen.WriteLine('MDL: Test Program #2 Completed'); Menu.Free; Screen.Free; End.