home *** CD-ROM | disk | FTP | other *** search
- {--------------------------------------------------------------------}
- {- Before compiling this demo program make sure the Unit Directories-}
- {- in the Options, Directories menu specify where to find the -}
- {- FlashPac Units. -}
- {- -}
- {- Compiler Directory -}
- {- -------- ----------------- -}
- {- TP4 A:\TP4 -}
- {- TP5 A:\TP5 -}
- {- TP55 A:\TP55 -}
- {- TP60 A:\TP60 -}
- {--------------------------------------------------------------------}
-
-
- Program Demo;
- Uses Crt,FPVideo,FPKbd,FPGetKey,FPMouse;
-
- Const { color is 1 and monochrome is 2 }
- ColorTbl : Array[1..2,0..255] Of Byte =
- ( ( 000,001,002,003,004,005,006,007,008,009,
- 010,011,012,013,014,015,016,017,018,019,
- 020,021,022,023,024,025,026,027,028,029,
- 030,031,032,033,034,035,036,037,038,039,
- 040,041,042,043,044,045,046,047,048,049,
- 050,051,052,053,054,055,056,057,058,059,
- 060,061,062,063,064,065,066,067,068,069,
- 070,071,072,073,074,075,076,077,078,079,
- 080,081,082,083,084,085,086,087,088,089,
- 090,091,092,093,094,095,096,097,098,099,
- 100,101,102,103,104,105,106,107,108,109,
- 110,111,112,113,114,115,116,117,118,119,
- 120,121,122,123,124,125,126,127,128,129,
- 130,131,132,133,134,135,136,137,138,139,
- 140,141,142,143,144,145,146,147,148,149,
- 150,151,152,153,154,155,156,157,158,159,
- 160,161,162,163,164,165,166,167,168,169,
- 170,171,172,173,174,175,176,177,178,179,
- 180,181,182,183,184,185,186,187,188,189,
- 190,191,192,193,194,195,196,197,198,199,
- 200,201,202,203,204,205,206,207,208,209,
- 210,211,212,213,214,215,216,217,218,219,
- 220,221,222,223,224,225,226,227,228,229,
- 230,231,232,233,234,235,236,237,238,239,
- 240,241,242,243,244,245,246,247,248,249,
- 250,251,252,253,254,255 ),
-
- ( 000,001,002,003,004,005,006,007,008,009,
- 010,011,012,013,014,015,016,017,018,019,
- 020,021,022,023,024,025,026,027,028,029,
- 030,031,032,033,034,035,036,037,038,039,
- 040,041,042,043,044,045,046,047,048,049,
- 050,051,052,053,054,055,056,057,058,059,
- 060,061,062,063,064,065,066,067,068,069,
- 070,071,072,073,074,075,076,077,078,079,
- 080,081,082,083,084,085,086,087,088,089,
- 090,091,092,093,094,095,096,097,098,099,
- 100,101,102,103,104,105,106,107,108,109,
- 110,111,112,113,114,115,116,117,118,119,
- 120,121,122,123,124,125,126,127,128,129,
- 130,131,132,133,134,135,136,137,138,139,
- 140,141,142,143,144,145,146,147,148,149,
- 150,151,152,153,154,155,156,157,158,159,
- 160,161,162,163,164,165,166,167,168,169,
- 170,171,172,173,174,175,176,177,178,179,
- 180,181,182,183,184,185,186,187,188,189,
- 190,191,192,193,194,195,196,197,198,199,
- 200,201,202,203,204,205,206,207,208,209,
- 210,211,212,213,214,215,216,217,218,219,
- 220,221,222,223,224,225,226,227,228,229,
- 230,231,232,233,234,235,236,237,238,239,
- 240,241,242,243,244,245,246,247,248,249,
- 250,251,252,253,254,255 )
- );
- Type
- TBuffer = Array[1..320] Of Char;
- Str4 = String[4];
- Var
- Buffer : Array[1..4000] Of Char;
- i,x,y : Integer;
- CTbl : Array[0..255] Of Byte;
- FnKeyBuf : Array[1..4] Of TBuffer;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure OpeningScreen;
- Var
- i : Integer;
- Begin
- ClrWin(1,1,80,25,CTbl[7]);
- Window(1,1,80,25);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[2]);
-
- ColorMsg(20, 4,CTbl[1],' FlashPac Pascal Library ');
- ColorMsg(20, 6,CTbl[2],' Version 3.10 ');
- ColorMsg(20, 8,CTbl[3],' Demo Program ');
- ColorMsg(20,15,CTbl[4],' SimpleSoft Inc. ');
- ColorMsg(20,16,CTbl[4],' 1209 Poplar St ');
- ColorMsg(20,17,CTbl[4],' La Crescent, MN 55947 ');
- ColorMsg(20,18,CTbl[4],' ');
- ColorMsg(14,22,CTbl[4],'(c) Copyright SimpleSoft 1986-89 - All Rights Reserved');
- ColorMsg(20,24,CTbl[5],' Press any key to continue... ');
-
- While Not DosKbdHit Do Begin
- FillRowAttr(20, 4,41,CTbl[9]);
- FillRowAttr(20, 6,41,CTbl[10]);
- FillRowAttr(20, 8,41,CTbl[11]);
- FillRowAttr(20,15,41,CTbl[12]);
- FillRowAttr(20,16,41,CTbl[12]);
- FillRowAttr(20,17,41,CTbl[12]);
- FillRowAttr(20,18,41,CTbl[12]);
- FillRowAttr(14,22,54,CTbl[13]);
- Delay(300);
- FillRowAttr(20, 4,41,CTbl[1]);
- FillRowAttr(20, 6,41,CTbl[2]);
- FillRowAttr(20, 8,41,CTbl[3]);
- FillRowAttr(20,15,41,CTbl[4]);
- FillRowAttr(20,16,41,CTbl[4]);
- FillRowAttr(20,17,41,CTbl[4]);
- FillRowAttr(20,18,41,CTbl[4]);
- FillRowAttr(14,22,54,CTbl[5]);
- Delay(300);
- End;
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure DisplayWindows;
- Const
- NumberWindows = 6;
-
- WinTbl : Array[1..NumberWindows,1..5] Of Byte = (
- ( 1, 1, 40, 10, 16 ),
- ( 4, 4, 43, 13, 36 ),
- ( 7, 7, 46, 16, 56 ),
- ( 10, 10, 49, 19, 76 ),
- ( 13, 13, 52, 21, 96 ),
- ( 16, 16, 55, 23, 116 )
- );
- Var
- i,j,k : Integer;
- St : String;
- Begin
- ClrWin(1,1,80,25,CTbl[7]);
- For i := 1 To NumberWindows Do Begin
- Window(WinTbl[i,1],WinTbl[i,2],WinTbl[i,3],WinTbl[i,4]);
- ClrWin(WinTbl[i,1],WinTbl[i,2],WinTbl[i,3],WinTbl[i,4],WinTbl[i,5]);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[WinTbl[i,5]]);
- Str(i:1,St);
- DspMsg(WinTbl[i,1]+2,WinTbl[i,2]+1,'Window - ' + St);
- Delay(500);
- End;
- ColorMsg(20,25,CTbl[96],' Press any key to continue... ');
- DosKbdClr;
- i := GetKey;
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure GetAltCtrlShft;
- Var
- i : Integer;
- Begin
- ClrWin(1,1,80,25,CTbl[7]);
-
- ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the normal lines');
- ColorMsg(10,16,CTbl[5],' Press any key to continue... ');
- ColorMsg(1,1,CTbl[6],'F1-Normal F2-Normal F3-Normal F4-Normal F5 -Normal');
- ColorMsg(1,2,CTbl[6],'F6-Normal F7-Normal F8-Normal F9-Normal F10-Normal');
- GetScrn(1,1,160,FnKeyBuf[1]);
- DosKbdClr;
- i := GetKey;
-
- ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the Shft lines ');
- ColorMsg(10,16,CTbl[5],' Press any key to continue... ');
- ColorMsg(1,1,CTbl[6],'F1-Shft F2-Shft F3-Shft F4-Shft F5 -Shft ');
- ColorMsg(1,2,CTbl[6],'F6-Shft F7-Shft F8-Shft F9-Shft F10-Shft ');
- GetScrn(1,1,160,FnKeyBuf[2]);
- DosKbdClr;
- i := GetKey;
-
- ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the Ctrl lines ');
- ColorMsg(10,16,CTbl[5],' Press any key to continue... ');
- ColorMsg(1,1,CTbl[6],'F1-Ctrl F2-Ctrl F3-Ctrl F4-Ctrl F5 -Ctrl ');
- ColorMsg(1,2,CTbl[6],'F6-Ctrl F7-Ctrl F8-Ctrl F9-Ctrl F10-Ctrl ');
- GetScrn(1,1,160,FnKeyBuf[3]);
- DosKbdClr;
- i := GetKey;
-
- ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the Alt lines ');
- ColorMsg(10,16,CTbl[5],' Press any key to continue... ');
- ColorMsg(1,1,CTbl[6],'F1-Atl F2-Alt F3-Alt F4-Alt F5 -Alt ');
- ColorMsg(1,2,CTbl[6],'F6-Alt F7-Alt F8-Alt F9-Alt F10-Alt ');
- GetScrn(1,1,160,FnKeyBuf[4]);
- DosKbdClr;
- i := GetKey;
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure DetectToggleKeys;
- Var
- i,Index : Integer;
- Begin
- ClrWin(1,1,80,25,CTbl[7]);
- Window(8,1,55,12);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[15]);
- ColorMsg(10, 3,CTbl[23],' BiosKbdStat ');
- ColorMsg(10, 5,CTbl[10],' Pressing the Alt, Shft or Ctrl Toggle Keys ');
- FillRowAttr(24,5,3,CTbl[64]);
- FillRowAttr(29,5,4,CTbl[65]);
- FillRowAttr(37,5,4,CTbl[66]);
-
- ColorMsg(10, 6,CTbl[10],' will display the function key lines at the ');
- ColorMsg(10, 7,CTbl[10],' bottom of the screen. The lines that are ');
- ColorMsg(10, 8,CTbl[10],' being used were just saved using GetScrn ');
- ColorMsg(10, 9,CTbl[10],' in the preceeding step. ');
- ColorMsg(10,11,CTbl[48],' Press <ENTER> to continue... ');
-
- i := 0;
- While ( i <> 13 ) Do Begin
- While Not DosKbdHit Do Begin
- i := BiosKbdStat;
-
- Index := 1;
- If (i And 3) <> 0 Then Index := 2
- Else If (i And 4) <> 0 Then Index := 3
- Else If (i And 8) <> 0 Then Index := 4;
-
- PutScrn(1,24,160,FnKeyBuf[Index]);
- End;
- i := GetKey;
- End;
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure DisplayVideoInformation;
- Var
- i : Integer;
- Ch : Char;
- St : String;
-
- {---------------------------------------------------------------}
- {- -}
- {---------------------------------------------------------------}
-
- Function Dec_To_Hex(Number : Word) : Str4;
- Const
- Digits : String[16] = '0123456789ABCDEF';
- Var
- i : Word;
- St : String[4];
- Begin
- FillChar(St,SizeOf(St),0);
- For i := 4 DownTo 1 Do Begin
- St[i] := Digits[Number Mod 16 + 1];
- Number := Number Div 16;
- End;
- St[0] := Chr(4);
- Dec_To_Hex := St;
- End;
-
- {------------------------------------------------------------------}
-
- Begin
- ClrWin(1,1,80,25,CTBl[7]);
- Window(24,9,57,17);
- ClrWin(24,9,57,17,CTbl[48]);
- FrameWin('╔','╗','╚','╝','═','║',48);
- ColorMsg(26,9,CTbl[48],' GetVideoInfo ');
-
- Str(GetVideoMode:1,St);
- ColorMsg(25,10,CTbl[48],' Current mode = ' + St);
-
- Str(GetVideoPage:1,St);
- ColorMsg(25,11,CTbl[48],' Active page = ' + St);
-
- Str(GetVideoCols:1,St);
- ColorMsg(25,12,CTbl[48],' Number cols = ' + St);
-
- St := Dec_To_Hex(VioBaseSeg);
- ColorMsg(25,13,CTbl[48],' Base Segment Address = ' + St);
-
- ColorMsg(25,16,CTbl[48],' Press any key to continue...');
- i := GetKey;
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure UseEditSt;
- Const
- TCSet : TSet = [13];
- VCSet : TSet = [32,65..122];
- Var
- Ch : Char;
- Char_Ofs,TE : Integer;
- St : String;
- Begin
- ClrWin(1,1,80,25,CTbl[7]);
- Window(8,8,50,14);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[48]);
-
- ColorMsg(10,10,CTbl[7],'Enter your name:');
- ColorMsg(9,12,CTbl[48],' Press <ENTER> to Quit ');
- St := '';
- Char_Ofs := 1;
- TE := 0;
- FillChar(St,SizeOf(St),0);
- EditSt(10,28,48,50,1,7,0,7000,2000,VCSet,TCSet,Char_Ofs,TE,St);
-
- ClrWin(1,1,80,25,CTbl[7]);
- Window(5,8,75,14);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[48]);
-
- GotoxyAbs(7,10);
- Writeln('Length of Input string returned = ',Length(St):1,' characters');
- GotoxyAbs(7,12);
- WriteSt('Input string = *' + St + '*');
- ColorMsg(20,20,CTbl[6],' Press any key to continue... ');
- TE := GetKey;
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure DisplayRvsAttrScreen;
- Var
- St : String;
- Ch : Char;
- i,j,k : Integer;
- HiCur,LoCur : Integer;
- begin
- HiCur := Hi(VioCursor);
- LoCur := Lo(VioCursor);
- SetCursorSize(32,32);
- ClrWin(1,1,80,25,CTbl[7]);
-
- Window(5,2,40,19);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[7]);
- ColorMsg(7,2,CTbl[7],' Text with normal attributes ');
-
- Window(45,2,80,19);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[7]);
- ColorMsg(47,2,CTbl[7],' Text with reverse attributes ');
- ColorMsg(30,23,CTbl[6],' Press <ESC> to skip... ');
- k := 0;
- j := 1;
- While ( j <= 16 ) Do Begin
- ClrWin(6,3,39,18,CTbl[7]);
- ClrWin(46,3,79,18,CTbl[7]);
- For i := 0 To 15 Do Begin
-
- TextAttr := k;
- Str(TextAttr:3,St);
- ColorMsg( 6,i+3,TextAttr,' TextAttr = '+St+' ');
-
- TextAttr := RvsAttr(TextAttr);
- Str(TextAttr:3,St);
- ColorMsg(46,i+3,TextAttr,' TextAttr = '+St+' ');
- k := k + 1;
- End;
- Delay(1500);
-
- If ( BiosKbdHit ) Then
- If ( GetKey = 1 ) Then
- j := 16;
-
- j := j + 1;
- End;
- TextAttr := 6;
- SetCursorSize(LoCur,HiCur);
- End;
-
- {------------------------------------------------------------------}
- {- -}
- {------------------------------------------------------------------}
-
- Procedure CheckMouse;
- Var
- i,NBut : Integer;
- Begin
- i := 0;
- ClrWin(1,1,80,25,CTbl[7]);
- Window(8,10,48,15);
- FrameWin('╔','╗','╚','╝','═','║',CTbl[7]);
-
- i := MResetMouse( NBut );
- If i = 0 Then
- ColorMsg( 10, 12, CTbl[6], 'Mouse NOT installed on your computer' )
- Else Begin
- ColorMsg( 10, 12, CTbl[6], 'You have a mouse in your computer' );
- ColorMsg( 10, 13, CTbl[7], 'Squeak Squeak Squeak' );
- End;
- ColorMsg( 10, 20, CTbl[6], ' Press any key to continue... ' );
- NBut := GetKey;
- End;
-
- {--------------------- Main Line -------------------------}
-
- Begin
- If VioMode = 7 Then i := 2
- Else i := 1;
- Move( ColorTbl[i,0], CTbl[0], SizeOf(CTbl) );
-
- GetScrn(1,1,2000,Buffer);
- x := WhereXAbs;
- y := WhereYAbs;
- i := 1;
-
- OpeningScreen;
- DisplayWindows;
- GetAltCtrlShft;
- DetectToggleKeys;
- DisplayVideoInformation;
- UseEditSt;
- DisplayRvsAttrScreen;
- CheckMouse;
-
- PutScrn(1,1,2000,Buffer);
- GotoxyAbs(x,y);
- End.
-