home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / KTOOLS31.ZIP / KTLSDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-19  |  6.8 KB  |  226 lines
  1. {$R+,S+,I+,D+,T-,F-,V-,B-,N-,L+ }
  2. {$M 16384,16384,16384 }
  3.  
  4. PROGRAM KTOOLSDEMO;
  5.  
  6. USES
  7.     DOS,
  8.     CRT,
  9.     KTOOLS;
  10.  
  11. VAR
  12.     Regs  : Registers;
  13.     Str255: String;
  14.     Str2  : String[2];
  15.     Str80 : String[80];
  16.     FAttr : Byte;
  17.     Ch    : Char;
  18.     Lines : array[1..6] OF Byte;
  19.     L,Z   : Integer;
  20.     YesNo : Boolean;
  21.     Fore,Back : Integer;
  22.     MyScreen : SaveScrType; {defined in ktools.tpu as array[1..4004] of byte }
  23.     MyMenu : Array[1..9] of MenuItemType; {menuitemtype defined in ktools.tpu}
  24.                                           {as string[30]                     }
  25.     MyDesc : Array[1..9] of MenuDescType; {menudesctype defined in ktools.tpu}
  26.                                           {as string[80]                     }
  27.  
  28. BEGIN
  29.  
  30.    ClrScr;
  31.  
  32.    CursorOff;
  33.  
  34.    Randomize;
  35.  
  36.    KWrite(2,1,15,'This line is passed as actual param. to KWrite');
  37.  
  38.    Str80:='Hello world, I''m Drue Kennon! was passed as a variable.';
  39.  
  40.    KWriteV(5,1,12,Str80);
  41.  
  42.    KWrite(8,1,15,'Next line is actual & centered');
  43.  
  44.    KWriteC(9,11,'Hello world, I''m Drue Kennon!');
  45.  
  46.    Str80:='Hello World, I''m a centered variable.';
  47.  
  48.    KWrite(11,1,15,'Next line is varriable & centered');
  49.  
  50.    KWriteCV(12,6,Str80);
  51.  
  52.    Str80:='          I have 10 leading blanks and 10 trailing ones          ';
  53.  
  54.    KWriteV(14,1,4,Str80);
  55.  
  56.    KTrim(Str80);
  57.  
  58.    KWrite(16,1,15, KUCase('now I have none on either side of me!') );
  59.  
  60.    Kwrite(18,1,3,Str80);
  61.  
  62.    KWrite(20,1,15,'Now to change the attributes of these lines!');
  63.  
  64.    KWrite(22,1,15,'Press any key to fill the screen via (KFill)');
  65.    NEW(MyScreen);
  66.    KSaveScr(1,1,25,80,MyScreen);
  67.  
  68.    Delay(5000);
  69.  
  70.    Lines[1]:=2;
  71.    Lines[2]:=5;
  72.    Lines[3]:=9;
  73.    Lines[4]:=12;
  74.    Lines[5]:=14;
  75.    Lines[6]:=16;
  76.  
  77.    REPEAT
  78.       FOR Z := 0 TO 15 DO
  79.       FOR L := 1 To 6 DO KAttr(Lines[l],1,1,80,Z);
  80.    UNTIL KeyPressed;
  81.  
  82.    Ch := ReadKey; {swallow keypressed character}
  83.  
  84.    CRT.TextAttr := Random(127) OR 128;   {CRT. before TextAttr isn't necessary}
  85.    KFill(5,10,15,60,'*',TextAttr);       {I used it only for clarity}
  86.    Delay(3000);
  87.    CRT.TextAttr := CRT.TextAttr MOD 128;
  88.    KFill(5,10,15,60,'*',TextAttr);
  89.    TextAttr := 7; {We'll put it back to it's normal attr after we play}
  90.  
  91.    CursorOn;
  92.  
  93.    KWrite(22,1,color(15,0),'                                                                      ');
  94.    KWrite(23,1,15,'Enter a foreground color i.e. 10, 13 etc...: ');
  95.    Read(Fore);
  96.  
  97.    KWrite(23,1,color(15,0),'                                                                      ');
  98.    Str80 := '';
  99.    Str80 := 'Enter a background color i.e. 0, 5 etc...: ';
  100.    KTrim(Str80);
  101.    KWriteV(23,1,15,Str80);
  102.    Read(Back);
  103.  
  104.    FAttr := Color(Fore,Back);
  105.    KFill(5,10,15,60,'*',FAttr);
  106.  
  107.    MyMenu[1]:=' Turbo Pascal    ';
  108.    MyMenu[2]:=' Turbo Basic     ';
  109.    MyMenu[3]:=' Turbo "C"       ';
  110.    MyMenu[4]:=' Turbo Lightning ';
  111.    MyMenu[5]:=' Turbo Prolog    ';
  112.    MyMenu[6]:=' Pascal ';
  113.    MyMenu[7]:=' Basic  ';
  114.    MyMenu[8]:='  "C"   ';
  115.    MyMenu[9]:=' ProLog ';
  116.    MyDesc[1]:='This is BORLAND''s Turbo Pascal Language';
  117.    MyDesc[2]:='This is BORLAND''s Turbo Basic Language';
  118.    MyDesc[3]:='This is BORLAND''s Turbo "C" Language';
  119.    MyDesc[4]:='This is BORLAND''s Turbo Lightning a word processor utility';
  120.    MyDesc[5]:='This is BORLAND''s Turbo Prolog Language';
  121.    MyDesc[6]:='This is description number # 6 and the first item on menu page 2.';
  122.    MyDesc[7]:='This is description number # 7 and the second item on menu page 2';
  123.    MyDesc[8]:='This is description number # 8 and the third item on menu page 2';
  124.    MyDesc[9]:='This is description number # 9 and the last menuitem; menuitemtotal=9';
  125.    CursorOff;
  126.  
  127.    KBox(7,29,11,19,Color(Yellow,Blue),15,Border2,True);
  128.    L := KVertMenu(2,MyMenu,9,30,8,30,17,15,Color(White,Red));
  129.  
  130.    KWrite(20,1,15,'                                                                             ');
  131.    KWrite(20,23,15,'Your Menu Selection Choice was ');
  132.    Str(L,Str80);
  133.    Kwrite(20,54,12,Str80);
  134.  
  135.    KWrite(22,1,15,'                                                                             ');
  136.    KWrite(23,1,15,'                                                                             ');
  137.    For L := 1 TO 9 DO KTrim (MyMenu[L]);
  138.    KBox(21,4,4,72,45,15,border5,false);
  139.    L := KHorizMenu(1,mymenu,mydesc,9,70,5,22,14,Color(White,Red),12);
  140.  
  141. {  Just to be cute, let's use BIOS to scroll the screen up one row and make
  142.    room for our statement on line 24 without messing up our menu border.     }
  143.    Regs.AH:=$06;  { scroll function }
  144.    Regs.AL:=1;    { rows to scroll  }
  145.    Regs.CH:=3;    { top row number  }
  146.    Regs.CL:=0;    { top col number  }
  147.    Regs.DH:=24;   { bottom row number }
  148.    Regs.DL:=79;   { bottom col number }
  149.    Regs.BH:=15;   { attribute for cleared lines }
  150.    Intr($10,Regs);{ call the interrupt }
  151.  
  152.    KWrite(24,1,15,'                                                                             ');
  153.    KWrite(24,23,15,'Your Menu Selection Choice was ');
  154.    Str(L,Str80);
  155.    Kwrite(24,54,12,Str80);
  156.  
  157.    KBox(1,1,25,80,55,15,border4,false);
  158.  
  159.    delay(3000);
  160.  
  161.    KRestoreScr(MyScreen);
  162.    DISPOSE(MyScreen);
  163.  
  164.    Delay(5000);
  165.  
  166.    {  Lets see that scroll feature one more time  }
  167.    Regs.AH:=$06;  { scroll function }
  168.    Regs.AL:=25;   { rows to scroll  }
  169.    Regs.CH:=0;    { top row number  }
  170.    Regs.CL:=0;    { top col number  }
  171.    Regs.DH:=24;   { bottom row number }
  172.    Regs.DL:=79;   { bottom col number }
  173.    Regs.BH:=15;   { attribute for cleared lines }
  174.    Intr($10,Regs); { call the interrupt }
  175.  
  176.    (*
  177.       actually it will happen so fast it will simply look like you called a
  178.       clear screen statement, which is why I used it.  Just to show another
  179.       way you can use BIOS and what it can do.
  180.  
  181.       If you think this would be useful in your programming then you should
  182.       set the code in a procedure like the one below and simply pass the
  183.       information to it.
  184.    *)
  185.  
  186.  
  187.    KWrite(5,1,15,'Press any key to continue...');
  188.    Ch := ReadKey;
  189.  
  190.    Str2 := KUCase(ParamStr(1));
  191.    Ch := Str2[1];
  192.    IF Ch IN['A'..'F'] THEN
  193.    BEGIN
  194.       YesNo := KUCase(ParamStr(2))='TRUE';
  195.  
  196.       Str255 := PikDir(ParamStr(1)+'\*.*',YesNo);
  197.  
  198.       KTrim(Str255);
  199.       Str255:=KLCase(Str255);
  200.       Str255 := 'You chose <<  '+Str255+'  >>';
  201.       KTrim(Str255);
  202.       KWrite(10,1,13,Str255);
  203.    END;
  204.  
  205.    TextAttr:=15;
  206.    KWrite(15,34,14+128,'<< THE END >>');
  207.    CursorOn;
  208.    Halt;
  209.  
  210. End.
  211.  
  212. (*
  213.  
  214. PROCEDURE Scroll(AL,CH,CL,DH,DL,BH:Byte);
  215. BEGIN
  216.    Regs.AH:=$06; { scroll function }
  217.    Regs.AL:=AL; { rows to scroll  }
  218.    Regs.CH:=CH; { top row number  }
  219.    Regs.CL:=CL; { top col number  }
  220.    Regs.DH:=DH; { bottom row number }
  221.    Regs.DL:=DL; { bottom col number }
  222.    Regs.BH:=BH; { attribute for cleared lines }
  223.    Intr($10,Regs); { call the interrupt }
  224. END;
  225.  
  226. *)