home *** CD-ROM | disk | FTP | other *** search
/ Hráč 1997 February / Hrac_09_1997-02_cd.bin / UTILS / PROGRAM / 1SVGA.ZIP / SHOW.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-18  |  11KB  |  278 lines
  1. {┌────────────────────────────────────╖
  2.  │ VGA Show V1.1 /320x200,256 Colors  ║
  3.  │ Written by Jou-Nan Chen 1994-05-16 ║
  4.  │ Copyright (C) 1994 by Jou-Nan Chen ║
  5.  ╘════════════════════════════════════╝}
  6. {$M 20000,0,655360}
  7.  
  8. uses Dos,Show320,SVGA256,Txt;
  9. { Text,Select,Messege,Box,Title,Show, WinText,Box,Title, HelpText,Box,Title }
  10. const
  11.   C1:array[1..12] of byte=($1E,$DF,$F5,$1F,$F1,$18, $2E,$2A,$A5, $3E,$3B,$B5);
  12.   C2:array[1..12] of byte=($F0,$DF,$1F,$F1,$1F,$F8, $80,$81,$1F, $DF,$D4,$4F);
  13.   Delays:array[0..47] of byte=(
  14.     25,20,20,05,05, 12,08,05,08,15, 08,05,05,05,05,
  15.     08,03,03,08,08, 10,10,10,10,08, 05,08,03,04,04,
  16.     04,04,03,02,02, 03,70,50,50,70, 15,03,06,04,04, 06,12,12);
  17.   ShowType:integer=0; No:integer=0;
  18.   Page:integer=0;     PageSize:integer=85;
  19. var Filenames:array[0..4095] of string[12];
  20.     K,Max,PageMax:integer;
  21.     Font1:array[0..4095] of byte;
  22.     Co:array[1..12] of byte;
  23.  
  24. { ─────────────── GetFilenames ─────────────── }
  25. procedure GetFilenames(Path:string);
  26. var DirInfo:SearchRec;
  27. begin
  28.   Max:=0; FillChar(Filenames,26624,32);
  29.   FindFirst(Path,Archive,DirInfo);
  30.   while DosError=0 do begin
  31.     FileNames[Max]:=DirInfo.Name;
  32.     FileNames[Max,0]:=#12;
  33.     FindNext(DirInfo); Inc(Max);
  34.   end;
  35.   if Max=0 then begin
  36.     Writeln; Writeln('Sorry! Can''t find any file!');
  37.     Halt(1);
  38.   end;
  39.   Dec(Max);
  40. end;
  41. { ─────────────── SortFilenames ─────────────── }
  42. procedure SortFilenames(L,R:integer);
  43. var I,J:integer;
  44.     M,T:string[12];
  45. begin
  46.   I:=L; J:=R; M:=Filenames[(L+R) shr 1];
  47.   repeat
  48.     while Filenames[I]<M do Inc(I);  { Move right }
  49.     while M<Filenames[J] do Dec(J);  { Move left }
  50.     if I<=J then begin
  51.       T:=Filenames[I]; Filenames[I]:=Filenames[J]; Filenames[J]:=T;
  52.       Inc(I); Dec(J);
  53.     end;
  54.   until I>J;
  55.   if L<J then SortFilenames(L,J);
  56.   if I<R then SortFilenames(I,R);
  57. end;
  58. { ─────────────── TextWin2 ─────────────── }
  59. procedure TextWin2(X,Y,LenX,LenY,CBox,CTitle,Shadow:integer;Title:string);
  60. var I:integer;    { Shadow: 1=With, 0=No }
  61. begin
  62.   TextBar(X,Y,LenX,1,CTitle,' ');
  63.   PrintText(X+(LenX-Length(Title)) shr 1,Y,CTitle,Title);
  64.   TextBar(X,Y+1,1,LenY-2,CBox,'╫');
  65.   TextBar(X+LenX-1,Y+1,1,LenY-2,CBox,'╪');
  66.   PrintText(X,Y+LenY-1,CBox,'╤');
  67.   TextBar(X+1,Y+LenY-1,LenX-2,1,CBox,'╟');
  68.   PrintText(X+LenX-1,Y+LenY-1,CBox,'╥');
  69.   TextBar(X+1,Y+1,LenX-2,LenY-2,CBox,' ');
  70.   if Shadow=1 then TextShadow(X,Y,LenX,LenY);
  71.   for I:=0 to 1 do begin
  72.     PrintText(X+I,Y,CBox,Chr(193+I));
  73.     PrintText(X+I+LenX-2,Y,CBox,Chr(202+I));
  74.   end;
  75. end;
  76. { ─────────────── PrintNum ─────────────── }
  77. procedure PrintNum(X,Y,Color,Num:byte);
  78. var I,N:integer;
  79. begin
  80.   N:=100;
  81.   for I:=0 to 2 do begin
  82.     PrintText(X+I,Y,Color,Chr(128+Num div N mod 10));
  83.     N:=N div 10;
  84.   end;
  85. end;
  86. { ─────────────── ShowPic ─────────────── }
  87. procedure ShowPic(Ty,X,Y,LenX,LenY:integer);
  88. var S,O,D:integer;
  89.     Pic:pointer;
  90. begin
  91.   GetMem(Pic,64768);
  92.   FileRead(Filenames[PageSize*Page+No],0,FileLen(Filenames[PageSize*Page+No],1),1,Pic^);
  93.   S:=Seg(Pic^); O:=Ofs(Pic^); D:=Delays[Ty];
  94.   SetMode(1); SetPalette(0,256,Mem[S:O]); Inc(O,768);
  95.   case Ty of
  96.      0:ShowBar   (X,Y,LenX,LenY,D,Mem[S:O]);
  97.      1:ShowBox   (1,X,Y,LenX,LenY,D,Mem[S:O]);
  98.      2:ShowBox   (2,X,Y,LenX,LenY,D,Mem[S:O]);
  99.      3:ShowCircle(1,X,Y,LenX,LenY,188,D,Mem[S:O]);
  100.      4:ShowCircle(2,X,Y,LenX,LenY,188,D,Mem[S:O]);
  101.      5:ShowCell  (X,Y,LenX,LenY,8,8,D,Mem[S:O]);
  102.      6:ShowClkRnd(X,Y,LenX,LenY,D,Mem[S:O]);
  103.      7:ShowClock (X,Y,LenX,LenY,D,Mem[S:O]);
  104.      8:ShowClock2(X,Y,LenX,LenY,D,Mem[S:O]);
  105.      9:ShowColor (1,X,Y,LenX,LenY,0,256,D,Mem[S:O]);
  106.     10:ShowDot   (X,Y,LenX,LenY,D,Mem[S:O]);
  107.     11:ShowFall  (1,X,Y,LenX,LenY,10,D,Mem[S:O]);
  108.     12:ShowFall  (2,X,Y,LenX,LenY,16,D,Mem[S:O]);
  109.     13:ShowFall  (3,X,Y,LenX,LenY,16,D,Mem[S:O]);
  110.     14:ShowFall  (4,X,Y,LenX,LenY,10,D,Mem[S:O]);
  111.     15:ShowFlow  (1,X,Y,LenX,LenY,2,D,Mem[S:O]);
  112.     16:ShowFlow  (2,X,Y,LenX,LenY,2,D,Mem[S:O]);
  113.     17:ShowFlow  (3,X,Y,LenX,LenY,2,D,Mem[S:O]);
  114.     18:ShowFlow  (4,X,Y,LenX,LenY,2,D,Mem[S:O]);
  115.     19:ShowIn    (X,Y,LenX,LenY,2,D,Mem[S:O]);
  116.     20:ShowJam   (1,X,Y,LenX,LenY,10,D,Mem[S:O]);
  117.     21:ShowJam   (2,X,Y,LenX,LenY,16,D,Mem[S:O]);
  118.     22:ShowJam   (3,X,Y,LenX,LenY,16,D,Mem[S:O]);
  119.     23:ShowJam   (4,X,Y,LenX,LenY,10,D,Mem[S:O]);
  120.     24:ShowLine  (1,X,Y,LenX,LenY,D,Mem[S:O]);
  121.     25:ShowLine  (2,X,Y,LenX,LenY,D,Mem[S:O]);
  122.     26:ShowMove  (1,X,Y,LenX,LenY,2,D,Mem[S:O]);
  123.     27:ShowMove  (2,X,Y,LenX,LenY,4,D,Mem[S:O]);
  124.     28:ShowScroll(1,X,Y,LenX,LenY,4,D,Mem[S:O]);
  125.     29:ShowScroll(2,X,Y,LenX,LenY,5,D,Mem[S:O]);
  126.     30:ShowScroll(3,X,Y,LenX,LenY,5,D,Mem[S:O]);
  127.     31:ShowScroll(4,X,Y,LenX,LenY,4,D,Mem[S:O]);
  128.     32:ShowShadow(X,Y,LenX,LenY,199,D,Mem[S:O]);
  129.     33:ShowShadow(X,Y,LenX,LenY,211,D,Mem[S:O]);
  130.     34:ShowShadow(X,Y,LenX,LenY,307,D,Mem[S:O]);
  131.     35:ShowSlope (X,Y,LenX,LenY,D,Mem[S:O]);
  132.     36:ShowSplit (1,X,Y,LenX,LenY,10,D,Mem[S:O]);
  133.     37:ShowSplit (2,X,Y,LenX,LenY,10,D,Mem[S:O]);
  134.     38:ShowSplit (3,X,Y,LenX,LenY,10,D,Mem[S:O]);
  135.     39:ShowSplit (4,X,Y,LenX,LenY,10,D,Mem[S:O]);
  136.     40:ShowZoom  (X,Y,LenX,LenY,2,D,Mem[S:O]);
  137.     41:ShowZoom2 (X,Y,LenX,LenY,2,D,Mem[S:O]);
  138.     42:ShowZoom4 (1,X,Y,LenX,LenY,4,D,Mem[S:O]);
  139.     43:ShowZoom4 (2,X,Y,LenX,LenY,5,D,Mem[S:O]);
  140.     44:ShowZoom4 (3,X,Y,LenX,LenY,5,D,Mem[S:O]);
  141.     45:ShowZoom4 (4,X,Y,LenX,LenY,4,D,Mem[S:O]);
  142.     46:ShowZoomXY(1,X,Y,LenX,LenY,2,D,Mem[S:O]);
  143.     47:ShowZoomXY(2,X,Y,LenX,LenY,4,D,Mem[S:O]);
  144.   end;
  145.   FreeMem(Pic,64768);
  146. end;
  147. { ─────────────── Help ─────────────── }
  148. procedure Help(X,Y:integer);  { 40x11 }
  149. var Buf:array[0..3999] of byte;
  150. begin
  151.   GetText(X,Y,41,12,Buf);
  152.   TextWin2(X,Y,40,11,Co[11],Co[12],1,'Help');
  153.   PrintText(X+3,Y+2,Co[10],'1,2 ── Change colors');
  154.   PrintText(X+3,Y+3,Co[10],'Cursors,Enter ── Select');
  155.   PrintText(X+3,Y+4,Co[10],'+,-,*,/ ── Delay');
  156.   PrintText(X+3,Y+5,Co[10],'Esc ── Exit');
  157.   PrintText(X+3,Y+7,Co[10],'VGA Show V1.1 /320x200,256 Colors');
  158.   PrintText(X+3,Y+8,Co[10],'Copyright (C) 1994 by Jou-Nan Chen');
  159.   K:=Key; K:=0;
  160.   PutText(X,Y,41,12,Buf);
  161. end;
  162. { ─────────────── TextProc ─────────────── }
  163. procedure TextProc;
  164. begin
  165.   SetMode(0);
  166.   SetTextFont(16,0,256,Font1);
  167.   SetCurShape($20,0);
  168.   SetFlash(0);
  169. end;
  170. { ─────────────── Screen ─────────────── }
  171. procedure Screen;
  172. const C:array[0..16] of byte=(
  173.      0,1,16,17,12,33,6,7, 11,25,26,27,44,37,54,63, 0);
  174. begin
  175.   SetPalette17(C);
  176.   TextWin2(1,1,80,25,Co[4],Co[5],0,'VGA Show Version 1.1');
  177.   TextBar(2,2,78,23,Co[1],' ');
  178.   TextBox(2,3,78,22,Co[4],1);
  179.   PrintText(8,2,Co[6],'  ▄▄▄▄   ▄  ▄▄▄▄▄▄   ▄ ');
  180.   PrintText(8,3,Co[6],' ▀▄  █▄▄▄█ █   █ █ ▄ █ ');
  181.   PrintText(8,4,Co[6],'▄▄▄▀ █   █▄█▄▄▄▀ █▀ ▀█ ');
  182.   PrintText(35,4,Co[4],'F1-Help');
  183. end;
  184. { ─────────────── ShowPage ─────────────── }
  185. procedure ShowPage(PageNo:integer);  { 5x17 }
  186. var I:integer;
  187. begin
  188.   PageMax:=PageSize-1;
  189.   if (Max<PageSize-1) or (Page=Max div PageSize) then PageMax:=Max mod PageSize;
  190.   TextBar(4,8,74,15,Co[1],' ');
  191.   for I:=0 to PageMax do
  192.     PrintText(5+15*(I mod 5),6+I div 5,Co[1],Filenames[PageSize*PageNo+I]);
  193. end;
  194. { ─────────────── SelectType ─────────────── }
  195. procedure SelectType(X,Y:integer);    { 58x17 }
  196. const St:array[0..47] of string[11]=(
  197.   'Bars 16->1 ','Outside    ','Inside     ','Circle Out ',
  198.   'Circle In  ','Rnd Cells  ','Clock Rnd  ','Clock Line ',
  199.   'Clock 2Line','Color Shade','Random Dots','Fall Up    ',
  200.   'Fall Left  ','Fall Right ','Fall Down  ','Flow Up    ',
  201.   'Flow Left  ','Flow Right ','Flow Down  ','In 4 Parts ',
  202.   'Jam Up     ','Jam Left   ','Jam Right  ','Jam Down   ',
  203.   'Lines U-D  ','Lines L-R  ','Move U-D   ','Move L-R   ',
  204.   'Scroll Up  ','Scroll Left','Scroll Rght','Scroll Down',
  205.   'Shadow Smal','Shadow Mid ','Shadow Big ','Lines Slope',
  206.   'Split Up   ','Split Left ','Split Rght ','Split Down ',
  207.   'Zoom Out   ','Zoom In    ','Zoom Up    ','Zoom Left  ',
  208.   'Zoom Right ','Zoom Down  ','Zoom U-D   ','Zoom L-R   ');
  209. var I:integer;
  210.     Buf:array[0..3999] of byte;
  211. begin
  212.   GetText(X,Y,59,17,Buf);
  213.   TextWin2(X,Y,58,16,Co[8],Co[9],1,' Show Type ');
  214.   PrintText(X+3,Y,Co[9],' Delay     ');
  215.   for I:=0 to 47 do PrintText(X+4+13*(I and 3),Y+2+I shr 2,Co[7],St[I]);
  216.   repeat
  217.     PrintNum(X+10,Y,Co[9],Delays[ShowType]);
  218.     PrintText(X+3+13*(ShowType and 3),Y+2+ShowType shr 2,Co[2],' '+St[ShowType]+' ');
  219.     K:=Key;
  220.     PrintText(X+3+13*(ShowType and 3),Y+2+ShowType shr 2,Co[7],' '+St[ShowType]+' ');
  221.     case K of
  222.       $4B00:Dec(ShowType);    $4D00:Inc(ShowType);     { Left,Right }
  223.       $4800:Dec(ShowType,4);  $5000:Inc(ShowType,4);   { Up,Down }
  224.       $4700:ShowType:=0;      $4F00:ShowType:=47;      { Home,End }
  225.       $4900:Dec(ShowType,16); $5100:Inc(ShowType,16);  { PgUp,PgDn }
  226.       $4A2D:Dec(Delays[ShowType]);                     { Right - }
  227.       $4E2B:Inc(Delays[ShowType]);                     { Right + }
  228.       $352F:Dec(Delays[ShowType],10);                  { Right / }
  229.       $372A:Inc(Delays[ShowType],10);                  { Right * }
  230.       $3B00:Help(20,8);                                { F1 }
  231.     end;
  232.     if Delays[ShowType]<0   then Delays[ShowType]:=0;
  233.     if Delays[ShowType]>250 then Delays[ShowType]:=250;
  234.     if ShowType<0  then ShowType:=47;
  235.     if ShowType>47 then ShowType:=0;
  236.   until (K=$011B) or (K=$1C0D);                        { Esc,Enter }
  237.   PutText(X,Y,59,17,Buf);
  238. end;
  239. { ─────────────── SelectFile ─────────────── }
  240. procedure SelectFile;
  241. begin
  242.   TextProc; Screen; ShowPage(0);
  243.   repeat
  244.     PrintText(4+15*(No mod 5),6+No div 5,Co[2],' '+Filenames[PageSize*Page+No]+' ');
  245.     K:=Key;
  246.     PrintText(4+15*(No mod 5),6+No div 5,Co[1],' '+Filenames[PageSize*Page+No]+' ');
  247.     case K of
  248.       $4B00:Dec(No);    $4D00:Inc(No);        { Left,Right }
  249.       $4800:Dec(No,5);  $5000:Inc(No,5);      { Up,Down }
  250.       $4700:No:=0;      $4F00:No:=PageMax;    { Home,End }
  251.       $4900:if Page>0 then begin Dec(Page); ShowPage(Page); end;
  252.       $5100:if Page<Max div PageSize then begin Inc(Page); ShowPage(Page); end;
  253.       $1C0D:begin
  254.           SelectType(11,6);
  255.           if K=$1C0D then begin
  256.         ShowPic(ShowType,0,0,320,200);
  257.         K:=Key;
  258.         TextProc; Screen; ShowPage(Page);
  259.         Inc(ShowType); if ShowType>47 then ShowType:=0;
  260.           end;
  261.           K:=0;
  262.         end;
  263.       $3B00:Help(20,8);                       { F1 }
  264.       $0231:begin Move(C1,Co,12); Screen; ShowPage(Page); end;  { 1 }
  265.       $0332:begin Move(C2,Co,12); Screen; ShowPage(Page); end;  { 2 }
  266.     end;
  267.     if No<0 then No:=PageMax;
  268.     if No>PageMax then No:=0;
  269.   until K=$011B;                              { Esc }
  270.   SetMode(0);
  271. end;
  272.  
  273. begin
  274.   FileRead('0916rom.fnt',0,256,16,Font1);
  275.   GetFilenames('*.*'); SortFilenames(0,Max);
  276.   Move(C1,Co,12); SelectFile;
  277. end.
  278.