Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / EDITORES / TSCREDD2.ZIP / SCRDISK5.EXE / DEMOWIND.PAS < prev next >

Wrap

Pascal/Delphi Source File | 1990-04-16 | 48.5 KB | 2,136 lines

{$M 30000,0,198000} Uses Dos,Crt, ScrEdit, Windows, ScrMouse; Type ScrEditConfigType = Record MenuLiteBg, MenuLiteFg, MenuNameBg, MenuNameFg, MenuBorderBg, MenuBorderFg, MenuTextBg, MenuTextFg, MenuSelectBg, MenuSelectFg, MenuErrorBg, MenuErrorFg, MenuBarBg, MenuBarFg: Byte; PopUpBorderBg, PopUpBorderFg, PopUpTextBg, PopUpTextFg, PopUpFootBg, PopUpFootFg, PopUpBarBg, PopUpBarFg: Byte; ChgName, ChgFooter : String[30]; ChgNameBg, ChgNameFg, ChgNamePos, ChgBorderBg, ChgBorderFg, ChgBorderStyle, ChgFootBg, ChgFootFg, ChgFootPos, ChgTextBg, ChgTextFg :Byte; End; Var ConfigRec : ScrEditConfigType; WorkStr : S_Str80; WindowNo, WindowRow, WindowCol, WindowLength, WindowLines : Integer; BorderStyle, BorderBg, BorderFg :Byte; WindowName :S_Str80; WindowNameBg, WindowNameFg, WindowNamePos :Byte; WindowFoot :S_Str80; WindowFootBg, WindowFootFg, WindowFootPos, TextBg, TextFg :Byte; X,Y,Z, PrevOption, NewLine, LastLine, CurrentCol, DemoOption, ColorOption, MainOption : Integer; DoMouse : Boolean; Menus : Array[1..100] of Integer; Holdscreen : Array[1..4000] of Char; Const WindowActive: Boolean = False; MenuBarItems = 4; MenuBarSpacing = ' '; MenuBarStr : S_Str80 = ''; MenuBarFields : Array[1..MenuBarItems] of String = ('General Demo', 'Data Entry', 'Color Changes', 'Quit'); MenuBarLines: Array[1..MenuBarItems] of Integer = (12,0,4,0); DemoMenu : Array[1..12] of String[30] = (' Fast video mode is now <OFF>', ' Open & shut 50 windows', ' Moving a window', ' Dragging a window', ' Moving several windows', ' Writing lines to windows', ' Writing with scrollings', ' Reading lines from windows', ' Shuffling windows', ' Popping windows', ' Changing backgrounds', ' Standard I/O'); ColorMenu: Array[1..4] of String[8] = ('Border','Name','Footer','Text'); Procedure Initialize; Begin If S_BW Then With ConfigRec Do Begin MenuLiteBg := 7; MenuLiteFg := 0; MenuNameBg := 7; MenuNameFg := 0; MenuBorderBg := 0; MenuBorderFg := 7; MenuTextBg := 0; MenuTextFg := 7; MenuBarBg := 0; MenuBarFg := 7; MenuSelectBg := 7; MenuSelectFg := 0; PopUpBorderBg := 0; PopUpBorderFg := 15; PopUpTextBg := 0; PopUpTextFg := 7; PopUpFootBg := 7; PopUpFootFg := 0; PopUpBarBg := 7; PopUpBarFg := 0; ChgName := 'Name'; ChgFooter := 'Footer'; ChgNameBg := LightGray; ChgNameFg := Black; ChgNamePos := 3; ChgBorderBg := Black; ChgBorderFg := White; ChgBorderStyle:= 3; ChgFootBg := LightGray; ChgFootFg := Black; ChgFootPos := 3; ChgTextBg := Black; ChgTextFg := White; End Else With ConfigRec Do Begin MenuLiteBg := LightGray; MenuLiteFg := Blue; MenuNameBg := 0; MenuNameFg := 0; MenuBorderBg := Green; MenuBorderFg := Black; MenuTextBg := Blue; MenuTextFg := Cyan; MenuBarBg := 0; MenuBarFg := 0; MenuSelectBg := 0; MenuSelectFg := 0; PopUpBorderBg := LightGray; PopUpBorderFg := Blue; PopUpTextBg := Blue; PopUpTextFg := Cyan; PopUpFootBg := LightGray; PopUpFootFg := Blue; PopUpBarBg := LightGray; PopUpBarFg := Blue; ChgName := 'Name'; ChgFooter := 'Footer'; ChgNameBg := LightGray; ChgNameFg := Black; ChgNamePos := 3; ChgBorderBg := Black; ChgBorderFg := White; ChgBorderStyle:= 3; ChgFootBg := LightGray; ChgFootFg := Black; ChgFootPos := 3; ChgTextBg := Black; ChgTextFg := White; End; End; Procedure RandomWindows(Count:Integer); Const ColorSets : Array[1..8,1..7] of Byte = ((3,LightGray, Black, LightGray,White, Black,White), (2,Blue, Cyan, Blue, White, Blue, Cyan), (3,Black, Yellow, Green, Yellow, Black, Yellow), (2,Green, Black, Green, Yellow, Green, White), (1,Red, Yellow, Red, Yellow, Red, White), (3,Brown, Yellow, LightGray,White, Brown, White), (1,Magenta, Yellow, Magenta, White, Magenta, Black), (2,Blue, Black, LightGray,Blue, LightGray, Black)); Begin For X := 1 to Count Do Begin Repeat WindowRow := Random(21); Until WindowRow In [1..20]; Repeat WindowCol := Random(60); Until WindowCol In [1..65]; Repeat WindowLength := Random(80-WindowCol); Until WindowLength In [10..40]; Repeat WindowLines := Random(15); Until WindowLines In [3..12]; Str(X:2,WindowName); WindowName := 'Window '+ WindowName; Repeat WindowNamePos:= Random(3); Until WindowNamePos in [1..3]; WindowFoot := WindowName; Repeat WindowFootPos:= Random(3); Until WindowFootPos in [1..3]; BorderStyle := ColorSets[(X Mod 6)+1,1]; BorderBg := ColorSets[(X Mod 6)+1,2]; BorderFg := ColorSets[(X Mod 6)+1,3]; WindowNameBg := ColorSets[(X Mod 6)+1,4]; WindowNameFg := ColorSets[(X Mod 6)+1,5]; WindowFootBg := ColorSets[(X Mod 6)+1,4]; WindowFootFg := ColorSets[(X Mod 6)+1,5]; TextBg := ColorSets[(X Mod 6)+1,6]; TextFg := ColorSets[(X Mod 6)+1,7]; Menus[X+3] := DefineWindow(WindowRow,WindowCol,WindowLength,WindowLines, BorderStyle,BorderBg,BorderFg, WindowName,WindowNameBg,WindowNameFg,WindowNamePos, WindowFoot,WindowNameBg,WindowNameFg,WindowFootPos, TextBg,TextFg); End; WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; End; Procedure BuildOneWindow(N,R,C,W,L:Integer); Begin With ConfigRec Do Begin WindowRow := R; WindowCol := C; WindowLength := W; WindowLines := L; BorderStyle := 2; Menus[N] := DefineWindow(WindowRow,WindowCol,WindowLength,WindowLines, BorderStyle,PopUpBorderBg,PopUpBorderFg, WindowName,PopUpFootBg,PopUpFootFg,WindowNamePos, WindowFoot,PopUpFootBg,PopUpFootFg,WindowFootPos, PopUpTextBg,PopUpTextFg); End; End; Procedure BuildMainMenu; Const LeftA = #27; RightA = #26; UpA = #24; DnA = #25; Begin For X := 1 to MenuBarItems Do MenuBarStr := MenuBarStr + MenuBarSpacing + MenuBarFields[X]; If S_MouseInstalled Then MenuBarStr := MenuBarStr+' Mouse:YES Use:<ENTER> '+LeftA+' '+ RightA Else MenuBarStr := MenuBarStr+' Mouse:NO Use:<ENTER> '+LeftA+' '+ RightA; With ConfigRec Do Begin WindowRow := 1; WindowCol := 1; WindowLength := 80; WindowLines := 1; BorderStyle := 0; WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; Menus[1] := DefineWindow(WindowRow,WindowCol,WindowLength,WindowLines, BorderStyle,MenuBorderBg,MenuBorderFg, WindowName,MenuNameBg,MenuNameFg,WindowNamePos, WindowFoot,WindowFootBg,WindowFootFg,WindowFootPos, MenuTextBg,MenuTextFg); WindowNamePos := 0; WriteWindowLine('',Menus[1],1,W_Off,0,MenuBarBg,MenuBarFg,MenuBarStr); WindowRow := 2; WindowCol := Pos(MenuBarFields[1],MenuBarStr) - 1; WindowFoot := 'Use <ENTER> '+UpA+' '+DnA+' '+LeftA+' '+RightA; WindowFootPos := 3; WindowLength := 30; WindowLines := 12; BorderStyle := 3; Menus[2] := DefineWindow(WindowRow,WindowCol,WindowLength,WindowLines, BorderStyle,PopUpBorderBg,PopUpBorderFg, '',0,0,0, WindowFoot,PopUpFootBg,PopUpFootFg,WindowFootPos, PopUpTextBg,PopUpTextFg); For X := 1 to 12 do WriteWindowLine('',Menus[2],X,W_Off,0,0,0,DemoMenu[X]); WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; WindowCol := Pos(MenuBarFields[3],MenuBarStr) - 1; WindowFoot := ''; WindowLength := 9; WindowLines := 4; BorderStyle := 3; Menus[3] := DefineWindow(WindowRow,WindowCol,WindowLength,WindowLines, BorderStyle,PopUpBorderBg,PopUpBorderFg, '',0,0,0, WindowFoot,PopUpFootBg,PopUpFootFg,WindowFootPos, PopUpTextBg,PopUpTextFg); For X := 1 to 4 do WriteWindowLine('',Menus[3],X,W_Off,0,0,0,ColorMenu[X]); End; End; Procedure GetNextKey; Begin DoMouse := False; S_NextKey; If S_MouseEvent Then Begin S_AnalizeMouse; If S_MsRow = 1 Then Begin Case S_MsCol of 4..15 : Begin DoMouse := True; MainOption := 1; If CurrentCol In [4..15] Then S_Enter := True Else CurrentCol := S_MsCol; End; 19..28 : Begin DoMouse := True; MainOption := 2; If CurrentCol In [19..28] Then S_Enter := True Else CurrentCol := S_MsCol; End; 33..44 : Begin DoMouse := True; MainOption := 3; If CurrentCol In [33..44] Then S_Enter := True Else CurrentCol := S_MsCol; End; 48..51 : Begin DoMouse := True; MainOption := 4; If CurrentCol In [48..51] Then S_Enter := True Else CurrentCol := S_MsCol; End; End; End; If (WindowActive) Then If (MainOption = 1) And (S_MsRow In [3..15]) And (S_MsCol in [4..29]) Then Begin S_Enter := True; NewLine := S_MsRow - 2; End; If (MainOption = 3) And (S_MsRow In [3..6]) And (S_MsCol in [32..44]) Then Begin S_Enter := True; NewLine := S_MsRow - 2; End; S_ResetMouseFlags; End; End; Procedure ChangeWindowDemo; Var PassStr,TextStr:S_Str80; Row,Col,Typ,Len, NewValue, Offset , Pos_Style, Bg, Fg : Integer; Const Text1 : Array[1..11] of String[40]= (' This procedure will demonstrate how to ', ' change the windows visable attributes:', '', ' - Change the windows border style and ', ' colors.', '', ' - Change the Heading and footer text,', ' position, and colors.', '', ' - Change the Text background and', ' forground colors.'); Text2 : Array[1..20] of String[30] = ('Border', '', ' Style............(1..3)[ ]', ' BackGround.......(0..7)[ ]', ' ForeGround.......(0.15)[ ]', 'Window Name', ' Text:[ ]', ' Position.........(0..3)[ ]', ' BackGround.......(0..7)[ ]', ' ForeGround.......(0.15)[ ]', 'Window Footer', ' Text:[ ]', ' Position.........(0..3)[ ]', ' BackGround.......(0..7)[ ]', ' ForeGround.......(0.15)[ ]', 'Text', '', '', ' BackGround.......(0..7)[ ]', ' ForeGround.......(0.15)[ ]'); Begin S_HideMouse; S_SetMouseEvent('00000000'); OffSet := (((LastLine - 1)*5)+1); With ConfigRec Do Menus[4] := DefineWindow(7,37,40,11, ChgBorderStyle,ChgBorderBg,ChgBorderFg, ChgName,ChgNameBg,ChgNameFg,ChgNamePos, ChgFooter,ChgFootBg,ChgFootFg,ChgFootPos, ChgTextBg,ChgTextFg); WindowName := Text2[OffSet]; WindowNamePos := 1; WindowFoot := '<ESC> to Quit'; WindowFootPos := 1; BuildOneWindow(5,11,7,30,4); WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; For X := 1 to 4 Do WriteWindowLine('',5,X,W_Off,0,0,0,Text2[OffSet + X]); For X := 1 to 11 Do WriteWindowLine('',4,X,W_Off,0,0,0,Text1[X]); OpenWindow('',4); OpenWindow('',5); X := 1; Repeat With ConfigRec Do Begin Case LastLine Of 2 : PassStr := ChgName; 3 : PassStr := ChgFooter; Else PassStr := ''; End; WriteWindowField('',5,1,8,9,20, PopUpTextBg,PopUpTextFg, PopUpTextBg,PopUpTextFg,PassStr); Case LastLine Of 1 : Str(ChgBorderStyle:2,PassStr); 2 : Str(ChgNamePos:2,PassStr); 3 : Str(ChgFootPos:2,PassStr); Else PassStr := ''; End; WriteWindowField('',5,2,26,0,2, PopUpTextBg,PopUpTextFg, PopUpTextBg,PopUpTextFg,PassStr); Case LastLine Of 1 : Str(ChgBorderBg:2,PassStr); 2 : Str(ChgNameBg:2,PassStr); 3 : Str(ChgFootBg:2,PassStr); 4 : Str(ChgTextBg:2,PassStr); End; WriteWindowField('',5,3,26,0,2, PopUpTextBg,PopUpTextFg, PopUpTextBg,PopUpTextFg,PassStr); Case LastLine Of 1 : Str(ChgBorderFg:2,PassStr); 2 : Str(ChgNameFg:2,PassStr); 3 : Str(ChgFootFg:2,PassStr); 4 : Str(ChgTextFg:2,PassStr); End; WriteWindowField('',5,4,26,0,2, PopUpTextBg,PopUpTextFg, PopUpTextBg,PopUpTextFg,PassStr); Case LastLine of 1: Begin If X < 3 Then Begin Str(ChgBorderStyle:2,PassStr); X := 2; Row := 2; End; If X = 3 Then Begin Str(ChgBorderBg:2,PassStr); Row := 3; End; If X = 4 Then Begin Str(ChgBorderFg:2,PassStr); Row := 4; End; Col := 26; Typ := 0; Len := 2; End; 2: Begin If X = 1 Then Begin PassStr := ChgName; Row := 1; Col := 8; Typ := 9; Len := 20; End Else Begin If X = 2 Then Begin Str(ChgNamePos:2,PassStr); X := 2; Row := 2; End; If X = 3 Then Begin Str(ChgNameBg:2,PassStr); Row := 3; End; If X = 4 Then Begin Str(ChgNameFg:2,PassStr); Row := 4; End; Col := 26; Typ := 0; Len := 2; End; End; 3: Begin If X = 1 Then Begin PassStr := ChgFooter; Row := 1; Col := 8; Typ := 9; Len := 20; End Else Begin If X = 2 Then Begin Str(ChgFootPos:2,PassStr); X := 2; Row := 2; End; If X = 3 Then Begin Str(ChgFootBg:2,PassStr); Row := 3; End; If X = 4 Then Begin Str(ChgFootFg:2,PassStr); Row := 4; End; Col := 25; Typ := 0; Len := 2; End; End; 4: Begin If X < 4 Then Begin X := 3; Str(ChgTextBg:2,PassStr); Row := 3; End; If X = 4 Then Begin Str(ChgTextFg:2,PassStr); Row := 4; End; Col := 26; Typ := 0; Len := 2; End; End; End; PauseWindowUpdates(False); With ConfigRec Do ReadWindowField('',5,Row,Col,Typ,Len,PopUpBarBg,PopUpBarFg,PassStr); Val(PassStr,NewValue,Y); PauseWindowUpdates(True); With ConfigRec Do Begin Case LastLine Of 1 : Begin Case X Of 2 : ChgBorderStyle := NewValue; 3 : ChgBorderBg := NewValue; 4 : ChgBorderFg := NewValue; End; End; 2 : Begin Case X Of 1 : ChgName := PassStr; 2 : ChgNamePos := NewValue; 3 : ChgNameBg := NewValue; 4 : ChgNameFg := NewValue; End; End; 3 : Begin Case X Of 1 : ChgFooter := PassStr; 2 : ChgFootPos := NewValue; 3 : ChgFootBg := NewValue; 4 : ChgFootFg := NewValue; End; End; 4 : Begin Case X Of 3 : ChgTextBg := NewValue; 4 : ChgTextFg := NewValue; End; End; End; ChangeWindow('',4, ChgBorderStyle,ChgBorderBg,ChgBorderFg, ChgName,ChgNameBg,ChgNameFg,ChgNamePos, ChgFooter,ChgFootBg,ChgFootFg,ChgFootPos, ChgTextBg,ChgTextFg); End; If (S_Up) Then Begin S_Tab := True; S_Shift := True; End; If (S_Down) Then S_Tab := True; If (S_Tab) Then If S_Shift Then Dec(X) Else Inc(X); Case LastLine Of 1 : If X > 4 Then X := 2 Else If X < 2 Then X := 4; 2..3: If X > 4 Then X := 1 Else If X < 1 Then X := 4; 4 : If X > 4 Then X := 3 Else If X < 3 Then X := 4; End; Until S_Esc; EraseWindow('',4); EraseWindow('',5); S_ReSetKeyFlags; S_ReSetMouseFlags; S_SetMouseEvent('01000000'); S_ShowMouse; End; Procedure DataEntryDemo; Var PassStr:S_Str80; Months : Array[1..12] of LongInt; Row, Col, Mth, Range, Amount : LongInt; Const Graph : Array[1..19] of S_Str80 = (' ** 1989 Bakery Sales ** ', '──────────────────────────────────────────────────────────────────', ' + - - + ', 'G 110,000 - -110,000', 'r - - ', 'o 90,000 - - 90,000', 's - - ', 's 70,000 - - 70,000', ' - - ', 'S 50,000 - - 50,000', 'a - - ', 'l 30,000 - - 30,000', 'e - - ', 's 10,000 - - 10,000', '──────────────────────────────────────────────────────────────────', ' Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ', '──────────────────────────────────────────────────────────────────', 'Jan 120000 Feb 110000 Mar 100000 Apr 90000 May 80000 Jun 70000 ', 'Jul 60000 Aug 50000 Sep 40000 Oct 30000 Nov 20000 Dec 10000 '); Begin S_HideMouse; S_SetMouseEvent('00000000'); WindowFoot := '<ENTER> = redraw graph <ESC> = exit'; WindowFootPos := 3; BuildOneWindow(4,2,4,70,19); WindowFootPos := 0; Range := 120000; For X := 1 to 19 Do Begin If X < 13 Then Months[X] := Range; Range := Range - 10000; If X In [1..2,15..19] Then WriteWindowLine('',4,X,W_OFF,0,0,0,Graph[X]) Else WriteWindowLine('',4,X,W_OFF,0,ConfigRec.PopUpTextBg,15,Graph[X]); End; OpenWindow('',4); Row := 18; Col := 0; Mth := 1; Z := 1; X := 1; PassStr :=''; S_Enter := True; Repeat If S_Enter Then Begin Range := 110000; For X := 3 to 14 Do Begin For Y := 1 To 12 Do Begin If ((X=3) And (Months[Y] > Range)) Or ((X>3) And (Months[Y] >=Range)) Then Begin TextColor(Y+1); PassStr := '▒▒▒'; End Else Begin PassStr := ' '; TextColor(15); End; GoToXy(8+(Y*4),X); Write(PassStr); End; If X > 3 then Range := Range - 10000; End; X := 1; End; SaveWindow; PassStr := ''; Str(Months[Mth]:6,PassStr); ReadWindowField('',4,Row,(Col*11)+4,0,6,7,0,PassStr); Val(PassStr,Months[Mth],Y); If S_Tab Then Begin If S_Shift Then Begin Dec(Col); Dec(Mth); If Col < 0 Then Begin Col := 5; Mth := 6; If Row = 19 then Row := 18 Else Begin Row := 19; Mth := 12; End; End; End Else Begin Inc(Col); Inc(Mth); If Col > 5 Then Begin Col := 0; Mth := 1; If Row = 19 then Row := 18 Else Begin Row := 19; Mth := 7; End; End; End; End; Until S_Esc; EraseWindow('',4); S_ReSetKeyFlags; S_ReSetMouseFlags; S_SetMouseEvent('01000000'); S_ShowMouse; End; Procedure OpenAndShutFiftyWindows; Begin PauseWindowUpdates(False); RandomWindows(50); PopWindow('',1); PopWindow('',2); For X := 4 to 53 Do OpenWindow('',X); PopWindow('',53); ClearWindow('',53,0,0); WriteLn('** Press Any Key To Continue **'); S_NextKey; For X := 53 DownTo 4 Do ShutWindow('',X); PauseWindowUpdates(True); For X := 4 to 53 Do EraseWindow('',X); End; Procedure MoveAWindow; Begin BuildOneWindow(4,10,10,40,6); WriteWindowLine('',4,1,W_Off,0,0,0,'A windows can be moved to any location'); WriteWindowLine('',4,2,W_Off,0,0,0,'on the screen by using the MOVEWINDOW'); WriteWindowLine('',4,3,W_Off,0,0,0,'statement......'); WriteWindowLine('',4,4,W_Off,0,0,0,''); WriteWindowLine('',4,5,W_Off,0,0,0,'Each Time you press the Enter Key I will'); WriteWindowLine('',4,6,W_Off,0,0,0,'MOVE this window.. Press ESC to Quit'); PauseWindowUpdates(False); S_HideMouse; S_SetMouseEvent('00000000'); OpenWindow('',4); Repeat S_NextKey; If S_Enter Then MoveWindow('',4,Random(18),Random(40),'a'); Until S_Esc; EraseWindow('',4); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; S_SetMouseEvent('01000000'); S_ShowMouse; End; Procedure DragAWindow; Var Row,Col:Integer; Begin Row := 3; Col := 10; BuildOneWindow(4,Row,Col,40,6); WriteWindowLine('',4,1,W_Off,0,0,0,'"DRAGGING" windows around on the screen'); WriteWindowLine('',4,2,W_Off,0,0,0,'is easy using the MOVEWINDOW statement'); WriteWindowLine('',4,3,W_Off,0,0,0,'and specifying rows and columns. Use the'); WriteWindowLine('',4,4,W_Off,0,0,0,'keypad keys to move this window or hold '); WriteWindowLine('',4,5,W_Off,0,0,0,'the left mouse button down and drag it..'); WriteWindowLine('',4,6,W_Off,0,0,0,'------------ Pess ESC to Quit-----------'); PauseWindowUpdates(False); OpenWindow('',4); Repeat S_NextKey; If S_MouseEvent Then Begin S_SetMouseEvent('10100000'); S_AnalizeMouse; Repeat MoveWindow('',4,S_MsRow,S_MsCol,'a'); {a = Absolute screen location} S_NextKey; If S_MouseEvent Then S_AnalizeMouse; Until S_MsLeftReleased; S_SetMouseEvent('01000000'); S_ReSetMouseFlags; End Else Begin Row := 0; Col := 0; If (S_Up) Or (S_PgUp) Or (S_Home) Then Row := -1; If (S_Down) Or (S_PgDn) Or (S_End) Then Row := 1;; If (S_Left) Or (S_Home) Or (S_End) Then Col := -1; If (S_Right)Or (S_PgUp) Or (S_PgDn) Then Col := 1; MoveWindow('',4,Row,Col,'r'); {r = Relative screen location} End; Until S_Esc; EraseWindow('',4); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure MoveSeveralWindows; Var Row,Col:Integer; Begin RandomWindows(10); Row := 20; Col := 1; BuildOneWindow(14,20,1,78,3); WriteWindowLine('',14,1,W_Off,0,0,0, 'Turbo ScrEdit allows you to perform many window functions concurrently on the'); WriteWindowLine('',14,2,W_Off,0,0,0, 'screen with one or more windows. Press Enter to see how smoothly 10 windows'); WriteWindowLine('',14,3,W_Off,0,0,0, 'can be moved at the same time.. <ESC> to exit <ENTER> for demo.'); PauseWindowUpdates(False); for X := 4 to 14 Do OpenWindow('',X); Repeat S_NextKey; If S_MouseEvent then S_AnalizeMouse; If S_Enter Then Begin For Z := 1 to 2 Do Begin For Y := 1 to 20 Do Begin PauseWindowUpdates(True); For X := 4 to 13 Do Begin If (X Mod 4)=0 Then MoveWindow('',X,-1,0,'r'); If (X Mod 4)=1 Then MoveWindow('',X,0,-3,'r'); If (X Mod 4)=2 Then MoveWindow('',X,1,0,'r'); If (X Mod 4)=3 Then MoveWindow('',X,0,4,'r'); End; PauseWindowUpdates(False); End; For Y := 1 to 20 Do Begin PauseWindowUpdates(True); For X := 4 to 13 Do Begin If (X Mod 4)=0 Then MoveWindow('',X,1,0,'r'); If (X Mod 4)=1 Then MoveWindow('',X,0,4,'r'); If (X Mod 4)=2 Then MoveWindow('',X,-1,0,'r'); If (X Mod 4)=3 Then MoveWindow('',X,0,-3,'r'); End; PauseWindowUpdates(False); End; End; End; ClearWindow('',14,0,0); WriteWindowLine('',14,2,W_Off,0,0,0, 'Press ENTER again to repeat or ESC to exit back to the menu... '); Until S_Esc; For X := 4 to 14 Do EraseWindow('',X); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure WriteToWindowLines; Var Row : Integer; LineIn : String; Texts : String; PassStr: S_Str80; Begin S_HideMouse; S_SetMouseEvent('00000000'); BuildOneWindow(4,20,1,78,4); BuildOneWindow(5,10,1,78,6); WriteWindowLine('',4,1,W_Off,0,0,0, 'Enter a line number and a string of text to be written to the specified line'); WriteWindowLine('',4,2,W_Off,0,0,0, 'in the window above.. Press <ESC> to exit...................................'); WriteWindowLine('',4,3,W_Off,0,0,0, 'Line Number Text:'); WriteWindowLine('',5,1,W_Off,0,0,0,'1 -'); WriteWindowLine('',5,2,W_Off,0,0,0,'2 -'); WriteWindowLine('',5,3,W_Off,0,0,0,'3 -'); WriteWindowLine('',5,4,W_Off,0,0,0,'4 -'); WriteWindowLine('',5,5,W_Off,0,0,0,'5 -'); WriteWindowLine('',5,6,W_Off,0,0,0,'6 -'); OpenWindow('',4); OpenWindow('',5); PauseWindowUpdates(False); S_SetCursor(S_Bold); Repeat PassStr := ''; ReadWindowField('',4,3,13,0,1,7,0,PassStr); LineIn := PassStr; If Not S_Esc Then Begin Val(PassStr,Row,x); If Row In [1..6] Then Begin WriteWindowLine('',4,4,W_Off,0,0,0,' '); PassStr := ''; ReadWindowField('',4,3,23,9,54,7,0,PassStr); PassStr := LineIn + ' - ' + PassStr; WriteWindowLine('',5,Row,W_Off,0,0,0,PassStr); End Else WriteWindowLine('',4,4,W_Off,0,Red,Yellow, '**** ERROR **** WindowField Must be in range of 1 to 6..'); End; Until S_Esc; S_SetCursor(S_OFF); EraseWindow('',4); EraseWindow('',5); S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure WritingWithScrolling; Var PassStr: S_Str80; Const Message : Array[1..14] of S_Str80 = ('..................................................', 'With Turbo ScrEdit Windows you can turn on scrol- ', 'ling and have a specified number of lines scroll ', 'up in the window before the new line is written. ', 'PRESS ENTER for a demonstration.', '..................................................', 'Turbo ScrEdit Windows adds a new twist by allowing', 'you specify any number of lines in the window that', 'are to be scrolled DOWN in the window before the ', 'new line is written. PRESS ENTER to continue.', 'You can use these features to write and scroll', 'text independently in more than one area of a ', 'window at the same time.. You can even write to', 'more than one window at a time.. PRESS ENTER'); Begin S_HideMouse; S_SetMouseEvent('00000000'); BuildOneWindow(4,10,1 ,50,14); BuildOneWindow(5,5 ,15,50,14); BuildOneWindow(6,1 ,30,50,14); PauseWindowUpdates(False); Popwindow ('',5); OpenWindow('',4); OpenWindow('',5); OpenWindow('',6); PassStr[0] := #80; For X := 1 to 6 Do Begin PauseWindowUpdates(True); WriteWindowLine('',4,14,W_Up,0,Black,White,Message[X]); WriteWindowLine('',5,14,W_Up,0,Black,White,Message[X]); WriteWindowLine('',6,14,W_Up,0,Black,White,Message[X]); PauseWindowUpdates(False); End; S_NextKey; For X := 1 to 8 Do Begin PauseWindowUpdates(True); FillChar(PassStr[1],80,32); FillChar(PassStr[X],5,64+X); WriteWindowLine('',4,14,W_Up,0,0,0,PassStr); WriteWindowLine('',5,14,W_Up,0,0,0,PassStr); WriteWindowLine('',6,14,W_Up,0,0,0,PassStr); PauseWindowUpdates(False); End; For X := 7 to 10 Do Begin PauseWindowUpdates(True); WriteWindowLine('',4,5,W_Up,3,Black,White,Message[X]); WriteWindowLine('',5,5,W_Up,3,Black,White,Message[X]); WriteWindowLine('',6,5,W_Up,3,Black,White,Message[X]); PauseWindowUpdates(False); End; S_NextKey; For X := 1 to 4 Do Begin PauseWindowUpdates(True); FillChar(PassStr[1],80,32); FillChar(PassStr[X],5,64+X); WriteWindowLine('',4,1,W_Down,0,0,0,PassStr); WriteWindowLine('',5,1,W_Down,0,0,0,PassStr); WriteWindowLine('',6,1,W_Down,0,0,0,PassStr); PauseWindowUpdates(False); End; For X := 10 to 14 Do Begin PauseWindowUpdates(True); WriteWindowLine('',4,9,W_Up,3,Black,White,Message[X]); WriteWindowLine('',5,9,W_Up,3,Black,White,Message[X]); WriteWindowLine('',6,9,W_Up,3,Black,White,Message[X]); PauseWindowUpdates(False); End; S_NextKey; For X := 1 to 45 Do Begin FillChar(PassStr[1],80,32); FillChar(PassStr[X],5,64+X); PausewindowUpdates(True); WriteWindowLine('',4,4, W_Up, 4,0,0,PassStr); WriteWindowLine('',4,11,W_Down,4,0,0,PassStr); WriteWindowLine('',5,4, W_Up, 4,0,0,PassStr); WriteWindowLine('',5,11,W_Down,4,0,0,PassStr); WriteWindowLine('',6,4, W_Up, 4,0,0,PassStr); WriteWindowLine('',6,11,W_Down,4,0,0,PassStr); PauseWindowUpdates(False); End; For X := 45 downto 1 Do Begin FillChar(PassStr[1],80,32); FillChar(PassStr[X],5,64+X); PausewindowUpdates(True); WriteWindowLine('',4,4, W_Up, 4,0,0,PassStr); WriteWindowLine('',4,11,W_Down,4,0,0,PassStr); WriteWindowLine('',5,4, W_Up, 4,0,0,PassStr); WriteWindowLine('',5,11,W_Down,4,0,0,PassStr); WriteWindowLine('',6,4, W_Up, 4,0,0,PassStr); WriteWindowLine('',6,11,W_Down,4,0,0,PassStr); PauseWindowUpdates(False); End; S_NextKey; EraseWindow('',4); EraseWindow('',5); EraseWindow('',6); S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure ReadingWindowLines; Var PassStr : S_Str80; Begin S_HideMouse; S_SetMouseEvent('00000000'); BuildOneWindow(4,5,1,30,10); BuildOneWindow(5,5,50,30,10); BuildOneWindow(6,18,20,40,4); OpenWindow('',4); OpenWindow('',5); OpenWindow('',6); PopWindow('',5); PauseWindowUpdates(False); TextColor(Yellow); TextBackGround(Black); ClrScr; PassStr[0] := #28; For X := 1 to 10 Do Begin FillChar(PassStr[1],28,64+X); WriteLn(PassStr); End; SaveWindow; PopWindow('',5); WriteWindowLine('',6,1,W_Off,0,0,0,'Each time you press the ENTER key I '); WriteWindowLine('',6,2,W_Off,0,0,0,'will read a line of text from the '); WriteWindowLine('',6,3,W_Off,0,0,0,'window on the RIGHT and write it to '); WriteWindowLine('',6,4,W_Off,0,0,0,'window on the left.... ESC to EXIT'); X := 0; Repeat S_NextKey; If S_Enter Then Begin Inc(X); If X > 9 Then Begin ClearWindow('',4,0,0); X := 1; End; WriteWindowLine('',4,X,W_OFF,0,0,0,ReadWindowLine('',5,X)); End; Until S_Esc; EraseWindow('',4); EraseWindow('',5); EraseWindow('',6); S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure ShuffleWindows; Var PassStr : S_Str80; FromWindow, ToLevel : Integer; Begin S_HideMouse; S_SetMouseEvent('00000000'); PauseWindowUpdates(False); Z := 1; For X := 4 to 9 do Begin Str(X-3,PassStr); PassStr := PassStr + '╘═══════════╛ Window '+PassStr+' ╘═══════════╛'+ PassStr; WindowName := PassStr; WindowNamePos := 3; WindowFoot := PassStr; WindowFootPos := 3; BuildOneWindow(X,Z*2,((Z-1)*6)+1,40,6); Str(X,PassStr); PassStr := '<'+PassStr+'> --------------Level------------- <'+PassStr+'>'; WriteWindowLine('',X,1,W_Off,0,0,0,PassStr); WriteWindowLine('',X,6,W_Off,0,0,0,PassStr); Inc(Z); OpenWindow('',X); End; WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; BuildOneWindow(10,22,1,78,2); OpenWindow('',10); PauseWindowUpdates(False); X := 1; PassStr :=''; Repeat If PassStr > '' Then WriteWindowLine('',10,2,W_OFF,0,RED,YELLOW,PassStr) Else WriteWindowLine('',10,2,W_OFF,0,0,0,PassStr); If X = 1 Then Begin PassStr := ''; WriteWindowLine('',10,1,W_OFF,0,0,0, 'ESC to EXIT or select the WINDOW to be pushed [ ]'); ReadWindowField('',10,1,48,0,2,7,0,PassStr); Val(PassStr,FromWindow,Y); If FromWindow In [1..6] Then Begin Inc(X); Inc(FromWindow,3); PassStr := ''; End Else PassStr := '*** ERROR *** Window number must be in range of 1..6'; End; If X = 2 Then Begin PassStr := ''; WriteWindowLine('',10,1,W_OFF,0,0,0, 'Select the stack LEVEL where this window is to be inserted [ ]'); ReadWindowField('',10,1,61,0,2,7,0,PassStr); Val(PassStr,ToLevel,Y); If ToLevel In [4..9] Then Begin Inc(X); PassStr := ''; End Else PassStr := '*** ERROR *** Insert LEVEL must be in range of 4..9'; End; If X = 3 Then Begin PauseWindowUpdates(True); PushWindow('',FromWindow,ToLevel); For X := 4 to 9 do Begin Y := WindAry[X].Handel; Str(X,PassStr); PassStr := '<'+PassStr + '> --------------Level------------- <'+PassStr+'>'; WriteWindowLine('',Y,1,W_Off,0,0,0,PassStr); WriteWindowLine('',Y,6,W_Off,0,0,0,PassStr); End; PauseWindowUpdates(False); PassStr := ''; X := 1; End; Until S_Esc; for X := 4 to 10 Do EraseWindow('',X); WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure PopWindowDemo; Var PassStr : S_Str80; FromWindow, ToLevel : Integer; Begin S_HideMouse; S_SetMouseEvent('00000000'); PauseWindowUpdates(False); Z := 1; BuildOneWindow(4,22,1,78,2); For X := 5 to 10 do Begin Str(X-4,PassStr); PassStr := PassStr + '╘═══════════╛ Window '+PassStr+' ╘═══════════╛'+ PassStr; WindowName := PassStr; WindowNamePos := 3; WindowFoot := PassStr; WindowFootPos := 3; BuildOneWindow(X,Z*2,((Z-1)*6)+1,40,6); Str(X,PassStr); PassStr := '<'+PassStr+'> --------------Level------------- <'+PassStr+'>'; WriteWindowLine('',X,1,W_Off,0,0,0,PassStr); WriteWindowLine('',X,6,W_Off,0,0,0,PassStr); Inc(Z); OpenWindow('',X); End; WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; OpenWindow('',4); PauseWindowUpdates(False); X := 1; PassStr :=''; Repeat If PassStr > '' Then WriteWindowLine('',4,2,W_OFF,0,RED,YELLOW,PassStr) Else WriteWindowLine('',4,2,W_OFF,0,0,0,PassStr); If X = 1 Then Begin PassStr := ''; WriteWindowLine('',4,1,W_OFF,0,0,0, 'ESC to EXIT or Select the window to be Popped [ ]'); ReadWindowField('',4,1,48,0,2,7,0,PassStr); Val(PassStr,FromWindow,Y); If FromWindow In [1..6] Then Begin PushWindow('',4,4); Inc(X); Inc(FromWindow,4); PassStr := ''; End Else PassStr := '*** ERROR *** Window number must be in range of 1..6'; End; If X = 2 Then Begin PauseWindowUpdates(True); PopWindow('',FromWindow); For X := 5 to 10 do Begin Y := WindAry[X].Handel; Str(X,PassStr); PassStr := '<'+PassStr + '> --------------Level------------- <'+PassStr+'>'; WriteWindowLine('',Y,1,W_Off,0,0,0,PassStr); WriteWindowLine('',Y,6,W_Off,0,0,0,PassStr); End; PauseWindowUpdates(False); PassStr := ''; X := 1; End; Until S_Esc; for X := 4 to 10 Do EraseWindow('',X); WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure ChangingWindowBackgrounds; Var NewScreen : Array[1..4000] of Char; HS : Array[1..24,1..80,1..2] of Char Absolute NewScreen; const Texts : Array[1..6] of String[44] = (' TURBO ╔══╗ (tm) ╔══╗ ╥ 1.6 ', ' ║ ║ ║ ─╥─ ', ' ╚══╗ ╔══╗ ╔══╗ ╠═ ╔══╣ ╥ ║ ', ' ║ ║ ╠═╦╝ ║ ║ ║ ║ ║ ', ' ╚══╝ ╚══╝ ╨ ╨ ╚══╝ ╚══╝ ╨ ╨ ', ' The professional`s screen developement tool '); Begin X := 2; FillChar(NewScreen,4000,176); Repeat NewScreen[X] := #02; Inc(X,2); Until X > 4000; Y := 15; For X := 1 to 44 Do Begin HS[Y ,X+19,1] := Texts[1][X]; HS[Y+1,X+19,1] := Texts[2][X]; HS[Y+2,X+19,1] := Texts[3][X]; HS[Y+3,X+19,1] := Texts[4][X]; HS[Y+4,X+19,1] := Texts[5][X]; HS[Y+5,X+19,1] := Texts[6][X]; End; S_HideMouse; S_SetMouseEvent('00000000'); BuildOneWindow(4,22,1,78,1); WriteWindowLine('',4,1,W_Off,0,0,0, ' Press ESC to exit or "S" to swap screen backgrounds..'); PauseWindowUpdates(False); OpenWindow('',4); X := 1; Repeat S_NextKey; If (UpCase(S_Ch) = 'S') Then If X = 1 Then Begin X := 2; ChgWindowBackground(Seg(NewScreen),Ofs(NewScreen),3840); End Else Begin X := 1; ChgWindowBackground(Seg(HoldScreen),Ofs(HoldScreen),3840); End; Until S_Esc; ChgWindowBackground(Seg(HoldScreen),Ofs(HoldScreen),3840); EraseWindow('',4); S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure StandardIO; Begin S_HideMouse; S_SetMouseEvent('00000000'); BuildOneWindow(4,5,10,60,14); PauseWindowUpdates(False); OpenWindow('',4); S_WorkStr := '***** Standard I/O *****'; S_SetCursor(S_Bold); Repeat For X := 0 to 15 Do Begin TextColor(X); Write(' <' +S_WorkStr + '>'); End; WriteLn; WriteLn; WriteLN('...........................................................'); WriteLn(' Type "quit" to exit or type something and Press ENTER.'); WriteLN('...........................................................'); ReadLn(S_WorkStr); Until S_UpShiftedStr(S_WorkStr) = 'QUIT'; S_SetCursor(S_Off); EraseWindow('',4); S_ShowMouse; S_SetMouseEvent('01000000'); PauseWindowUpdates(True); S_ReSetKeyFlags; S_ReSetMouseFlags; End; Procedure FastVideoCheck; Begin With ConfigRec Do If Not S_FastVideo Then Begin WriteWindowLine('',2,1,W_OFF,0,PopUpBarBg,PopUpBarFg ,' Fast video mode is now <ON>'); S_FastVideo := True; End Else Begin WriteWindowLine('',2,1,W_OFF,0,PopUpBarBg,PopUpBarFg, ' Fast video mode is now <OFF>'); S_FastVideo := False; End; End; Begin S_GetScrMem(Mem[S_Seg:S_Ofs],Mem[Seg(HoldScreen[1]):Ofs(HoldScreen)],4000); Randomize; S_FastVideo := False; S_Cursor := S_Normal; S_Sound := False; S_ShowStatus := False; If Not WindowsInit Then Begin S_Msg := ' Insufficent memeory to use windows.. '; S_NextKey; Halt; End; Initialize; MainOption := 1; DemoOption := 1; ColorOption := 1; BuildMainMenu; S_ActivateMouse; S_SetMouseEvent('0100000'); S_ResetMouseFlags; S_ShowMouse; DoMouse := False; WindowName := ''; WindowNamePos := 0; WindowFoot := ''; WindowFootPos := 0; OpenWindow('',Menus[1]); Repeat If MainOption > MenuBarItems Then MainOption := 1; If MainOption < 1 Then MainOption := MenuBarItems; WorkStr := MenuBarFields[MainOPtion]; WritewindowField('', Menus[1], 1, Pos(MenuBarFields[MainOption],MenuBarStr)-1, 9, Length(MenuBarFields[MainOption]), ConfigRec.MenuLiteBg, ConfigRec.MenuLiteFg, 0, 0, WorkStr); GetNextKey; If (((S_Enter) Or (S_Down)) And (MenuBarLines[MainOption] > 0)) Then WindowActive := True Else WindowActive := False; If (S_Enter) And (MainOption = 2) Then Begin DataEntryDemo; End; If WindowActive = True Then Begin If MainOption = 1 Then Begin PrevOption := 2; LastLine := DemoOption; End; If MainOption = 3 Then Begin PrevOption := 3; LastLine := ColorOption; End; OpenWindow('',Menus[PrevOption]); PauseWindowUpdates(True); S_Enter := False; Repeat WriteWindowLine('', Menus[PrevOption], LastLine, W_Off, 0, ConfigRec.PopUpBarBg, ConfigRec.PopUpBarFg, ReadWindowLine('',Menus[PrevOption],LastLine)); If MainOption = 1 Then If S_Enter Then Case LastLine Of 1 : FastVideoCheck; 2 : OpenAndShutFiftyWindows; 3 : MoveAWindow; 4 : DragAWindow; 5 : MoveSeveralWindows; 6 : WriteToWindowLines; 7 : WritingWithScrolling; 8 : ReadingWindowLines; 9 : ShuffleWindows; 10: PopWindowDemo; 11: ChangingWindowBackgrounds; 12: StandardIO; End; If MainOption = 3 Then If S_Enter Then ChangeWindowDemo; PauseWindowUpdates(False); NewLine := 0; GetNextKey; PauseWindowUpdates(True); WriteWindowLine('', Menus[PrevOption], LastLine, W_Off, 0, ConfigRec.PopUpTextBg, ConfigRec.PopUpTextFg, ReadWindowLine('',Menus[PrevOption],LastLine)); If S_Up Then Dec(LastLine); If S_Down Then Inc(LastLine); If LastLine > MenuBarLines[MainOption] Then LastLine := 1; If LastLine < 1 Then LastLine := MenuBarLines[MainOption]; If NewLine > 0 Then LastLine := NewLine; Until DoMouse Or S_Alt Or S_Left Or S_Right; PauseWindowUpdates(False); If PrevOption = 2 Then DemoOption := LastLine; If PrevOption = 2 Then ColorOption := LastLine; ShutWindow('',Menus[PrevOption]); End; If S_Left Then MainOption := MainOption -1; If S_Tab Or S_Right Then MainOption := MainOption +1; WriteWindowLine('', Menus[1], 1, W_Off, 0, ConfigRec.MenuBarBg, ConfigRec.MenuBarFg, MenuBarStr); Until (S_Enter) and (MainOption=4); S_DisableMouse; EraseWindow('',1); EraseWindow('',2); S_SetCursor(S_Normal); End.