home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / KTOOLS / KTLSDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-29  |  6.5 KB  |  221 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; {definováno v ktools.tpu jako array[1..4004] of byte }
  23.     MyMenu : Array[1..9] of MenuItemType; {menuitemtype definováno v ktools.tpu}
  24.                                           {jako string[30]                     }
  25.     MyDesc : Array[1..9] of MenuDescType; {menudesctype definováno in ktools.tpu}
  26.                                           {jako 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; {p⌐eçtená klávesa z klávesnice}
  83.  
  84.    CRT.TextAttr := Random(127) OR 128;   {CRT. p⌐ed TextAttr není nutné}
  85.    KFill(5,10,15,60,'*',TextAttr);       {Je pouæito pouze pro objasnêní}
  86.    Delay(3000);
  87.    CRT.TextAttr := CRT.TextAttr MOD 128;
  88.    KFill(5,10,15,60,'*',TextAttr);
  89.    TextAttr := 7; {Aæ si p⌐estaneme hrát, vrátíme attr na jeho normální hodnotu }
  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. {  Nyní pouæijeme BIOS k posunutí obrazovky nahoru o jeden ⌐ádek abychom si
  142.    udêlali místo pro ná¿ p⌐íkaz na ⌐ádku 24 aniæ bychom poru¿ili okraj menu. }
  143.    Regs.AH:=$06;  { scroll funkce }
  144.    Regs.AL:=1;    { poçet ⌐ádek pro rolování }
  145.    Regs.CH:=3;    { çíslo nejvy¿¿ího ⌐ádku }
  146.    Regs.CL:=0;    {    "             sloupce }
  147.    Regs.DH:=24;   { çíslo spodního ⌐ádku }
  148.    Regs.DL:=79;   { çíslo nejpravêj¿ího sloupce }
  149.    Regs.BH:=15;   { attribut pro smazané ⌐ádky }
  150.    Intr($10,Regs);{ 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.    {  Scrolling  }
  167.    Regs.AH:=$06;  { scroll funkce }
  168.    Regs.AL:=25;   { poç. ⌐ádkû pro scroll  }
  169.    Regs.CH:=0;    { nejvy¿¿í ⌐ádek }
  170.    Regs.CL:=0;    { nejlevêj¿í sloupec }
  171.    Regs.DH:=24;   { spodní ⌐ádek }
  172.    Regs.DL:=79;   { nejpravêj¿í sloupec }
  173.    Regs.BH:=15;   { attribut pro mazané ⌐ádky }
  174.    Intr($10,Regs); { interrupt }
  175.  
  176.    (*
  177.       Pokud si myslíte, æe toto je pouæitelné p⌐i va¿em programování,
  178.       pouæijte tento zpûsob stejnê jako v p⌐íkladu popsaném níæe.        
  179.    *)
  180.  
  181.  
  182.    KWrite(5,1,15,'Press any key to continue...');
  183.    Ch := ReadKey;
  184.  
  185.    Str2 := KUCase(ParamStr(1));
  186.    Ch := Str2[1];
  187.    IF Ch IN['A'..'F'] THEN
  188.    BEGIN
  189.       YesNo := KUCase(ParamStr(2))='TRUE';
  190.  
  191.       Str255 := PikDir(ParamStr(1)+'\*.*',YesNo);
  192.  
  193.       KTrim(Str255);
  194.       Str255:=KLCase(Str255);
  195.       Str255 := 'You chose <<  '+Str255+'  >>';
  196.       KTrim(Str255);
  197.       KWrite(10,1,13,Str255);
  198.    END;
  199.  
  200.    TextAttr:=15;
  201.    KWrite(15,34,14+128,'<< THE END >>');
  202.    CursorOn;
  203.    Halt;
  204.  
  205. End.
  206.  
  207. (*
  208.  
  209. PROCEDURE Scroll(AL,CH,CL,DH,DL,BH:Byte);
  210. BEGIN
  211.    Regs.AH:=$06; { scroll funkce }
  212.    Regs.AL:=AL; { ⌐ádky pro scroll  }
  213.    Regs.CH:=CH; { vrchní ⌐ádek }
  214.    Regs.CL:=CL; { levÿ sloupec }
  215.    Regs.DH:=DH; { spodní ⌐ádek }
  216.    Regs.DL:=DL; { pravÿ sloupec }
  217.    Regs.BH:=BH; { attribut pro mazané ⌐ádky }
  218.    Intr($10,Regs); { interrupt }
  219. END;
  220.  
  221. *)