home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pgraph2.zip / DEMOPG.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-19  |  14KB  |  468 lines
  1. program gdat;
  2.  
  3. uses Os2Base;
  4.  
  5. {&cdecl+}
  6.  
  7. {$IFDEF DYNAMIC_VERSION}
  8.   {$Dynamic System}
  9.   {$L VPRTL.LIB}
  10. {$ENDIF}
  11.  
  12. label 0,1,2,3,4,5,6;
  13.  
  14. {$I E:\VP11\PGRAPH2.INC}
  15.  
  16. var c,b: byte;
  17.     x,y,xx,yy: integer;
  18.     txt: string[35];
  19.     i: word;
  20.     j,k,l,m:longint;
  21.     d: double;
  22.     p: array[1..8] of pointtype;
  23.     po: pointer;
  24.     dx,dy:byte;
  25.     cx,cy:integer;
  26.     ch:char;
  27.  
  28.  
  29. procedure RGB(s:s127);
  30. const p:array[0..15] of byte = (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
  31. var i,j,k,n:integer; b1,b2,b3:byte; sb:text;
  32. begin
  33.  assign(sb,getgfdir+s); reset(sb);
  34.  if ioresult>0 then begin
  35.   restorecrtmode; writeln('File '+getgfdir+s+' was not found!'); halt end;
  36.  readln(sb,b1,b2,b3);
  37.  for n:=0 to 15 do begin
  38.   readln(sb,i,j,k); setrgbpalette(p[n],i,j,k) end;
  39.  close(sb)
  40. end;
  41.  
  42. procedure PE;
  43. begin gotoxyg(65,18); writeg('... press Enter'); gotoxyg(1,1) end;
  44.  
  45. procedure SWY(b:byte);
  46. begin fbc(15,b); gotoxyg(73,1); writeg(' SW Yes'); gotoxyg(1,1) end;
  47.  
  48. procedure SWN(b:byte);
  49. begin fbc(15,b); gotoxyg(73,1); writeg(' SW No '); gotoxyg(1,1) end;
  50.  
  51.  
  52. begin
  53.  case GraphInit(paramstr(1)) of
  54.   1: begin write('Wrong path to the font files'); halt end;
  55.   2: begin write('Cannot access video screen selector'); halt end;
  56.   3: begin write('VGA display required'); halt end
  57.  end;
  58.  
  59.  ch:=klic;
  60.  
  61.  GrafFont(24);
  62.  
  63.  setrst(170);
  64.  fbc(1,8);  fillrectangle(20,78,400,348);
  65.  setliwi(3);
  66.  setcolor(6);     rectangle(20,78,400,348);
  67.  
  68.  fbc(15,1);
  69.  
  70.  gotoxyg(11, 6); writeg('Demonstration of PGRAPH functions');
  71.  gotoxyg( 7, 8); writeg('Any improvements, advices and suggestions');
  72.  gotoxyg(11, 9); writeg('are invited in the e-mail address:');
  73.  gotoxyg(17,11); writeg('geogas@gggn.anet.cz');
  74.  
  75.  fbc(15,0);
  76.  graffont(14);
  77.  gotoxyg(1,25);
  78.  writegn('"SW Yes" in the upper right corner of the screen indicates,');
  79.  writegn('you may press task switching keys'); writegn('');
  80.  writegn('"SW No"  in the upper right corner of the screen indicates,');
  81.  writegn('you may not press task switching keys');
  82.  
  83.  graffont(24);
  84.  pe; swy(2);
  85.  
  86.  ch:=klic;
  87.  
  88. 0: fbc(15,0); pe; swn(4); fbc(15,0);
  89.  writegn('Putpixel demonstration');
  90.  writegn('^^^^^^^^^^^^^^^^^^^^^^');
  91.  
  92.  randomize;
  93.  repeat
  94.   c:=random(15);
  95.   x:=random(420);
  96.   y:=random(310);
  97.   putpixel(x,y+58,c)
  98.  until keypressed;
  99.  ch:=readkey;
  100.  
  101.  cleardevice; pe; swy(2); fbc(15,0);
  102.  writegn('Demonstration of font sizes');
  103.  writegn('^^^^^^^^^^^^^^^^^^^^^^^^^^^'); writegn('');
  104.  graffont(14); writegn('Font - size 14');
  105.  graffont(16); writegn('Font - size 16');
  106.  graffont(24); writegn('Font - size 24');
  107.  
  108.  writegn(''); writegn('');
  109.  writegn('Demonstration of text and number editing');
  110.  writegn('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
  111.  writegn('Edit the following text and press Enter');
  112.  
  113.  setcolor(14); backcolor(1);
  114.  txt:='Test of edited text';
  115.  editg(10,46,13,txt);
  116.  
  117.  setcolor(15); backcolor(0);
  118.  gotoxyg(1,18); writeg('Enter new number:');
  119.  d:=3.1415927; setcolor(14); backcolor(1);
  120.  num(20,18,d,'d',11,7);
  121.  
  122.  
  123.  fbc(15,0); cleardevice; pe; swy(2); fbc(15,0);
  124.  writegn('Demonstration of various text outputs');
  125.  writegn('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
  126.  writegn(''); backcolor(1);
  127.  writegn('Superfast text output using LineMode_on procedure');
  128.  writegn('');
  129.  gotoxyg(getwhx+7,getwhy);
  130.  setcolor(11); backcolor(8);
  131.  writegn('Slow text output using PutPixel porcedure');
  132.  graffont(16);
  133.  setcolor(0); backcolor(10);
  134.  cestextc(10,465,'Slow text output can have two directions',false);
  135.  
  136.  ch:=klic;
  137.  
  138.  
  139.  fbc(15,0); cleardevice; graffont(24);
  140.  pe; swy(2); fbc(15,0);
  141.  writegn('Demonstration of line font');
  142.  writegn('^^^^^^^^^^^^^^^^^^^^^^^^^^');
  143.  
  144.  setliwi(1); setcolor(11); linefont(0);
  145.  cesltext(10,70,'Test of CesLText procedure',2,true);
  146.  setliwi(1); setcolor(14); linefont(1);
  147.  cesltext(10,110,'in different size,',1,true);
  148.  setcolor(13);
  149.  cesltext(10,190,'different colors,',3,true);
  150.  setliwi(3); setcolor(15);
  151.  cesltext(10,250,'different thickness',3,true);
  152.  setliwi(3); setcolor(12);
  153.  cesltext(400,450,'and different direction',3,false);
  154.  
  155.  ch:=klic;
  156.  
  157.  
  158.  cleardevice; setliwi(2); setcolor(11); setrst(170);
  159.  vline(15,5,400);
  160.  hline(15,541,5);
  161.  setliwi(1); setcolor(15); ellipse(320,240,317,237);
  162.  setcolor(1); fillellipse(300,200,50,50);
  163.  setliwi(2); setcolor(14); ellipse(300,200,50,50);
  164.  
  165.  
  166.  setdot(true); setcolor(10);
  167.  setliwi(1); rectangle(400,180,468,104);
  168.  setliwi(2); rectangle(410,200,478,114);
  169.  setliwi(3); rectangle(420,220,488,124);
  170.  
  171.  setliwi(1); setdot(false);
  172.  fillellipse(520,340,19,25);
  173.  setcolor(14); ellipse(520,340,19,25);
  174.  
  175.  setcolor(11);         fillrectangle(470,276,340,245);
  176.  setcolor(12); setliwi(2); rectangle(470,276,340,245);
  177.  
  178.  setcolor(15);
  179.  gotoxyg(19,3); writeg('Demonstration of line width, ellipse drawing,');
  180.  gotoxyg(19,4); writeg('XORput and fill capabilities');
  181.  
  182.  setcolor(14);
  183.  
  184.  setliwi(1);
  185.  moveto(35,50);
  186.  lineto(55,45);
  187.  lineto(115,135);
  188.  lineto(120,186);
  189.  lineto(185,190);
  190.  lineto( 5,350);
  191.  
  192.  setliwi(2);
  193.  moveto(40,40);
  194.  lineto(60,35);
  195.  lineto(120,125);
  196.  lineto(125,176);
  197.  lineto(190,180);
  198.  lineto(10,340);
  199.  
  200.  setliwi(3);
  201.  moveto(45,30);
  202.  lineto(65,25);
  203.  lineto(125,115);
  204.  lineto(130,166);
  205.  lineto(195,170);
  206.  lineto(15,330);
  207.  
  208.  fbc(15,0); swy(2); fbc(15,0);
  209.  setcolor(11);         fillrectangle(79,367,462,297);
  210.  setcolor(12); setliwi(2); rectangle(79,367,462,297);
  211.  graffont(16); setcolor(0); backcolor(11);
  212.  
  213.  gotoxyg(12,18); writeg(' Use arrow keys to move cross, ');
  214.  gotoxyg(12,19); writeg(' 1,2,3 or 4 to change speed of cross movement ');
  215.  gotoxyg(12,20); writeg(' or press Enter to contnue ');
  216.  
  217.  gotoxyg(45,15); writeg('X='); gotoxyg(53,15); writeg('Y=');
  218.  
  219.  MoveCross(#0,true);
  220.  1:
  221.  cx:=getcrx; cy:=getcry;
  222.  gotoxyg(47,15);  writenum(cx,'i',3,0);
  223.  gotoxyg(55,15);  writenum(cy,'i',3,0);
  224.  ch:=klic;
  225.  if not (ch in [#27,#13]) then begin MoveCross(ch,getfkl); goto 1 end;
  226.  
  227.  
  228.  setliwi(1); graffont(24);
  229.  fbc(15,0); cleardevice; ch:='t';
  230.  
  231.  2: i:=0; setcolor(15); graffont(24);
  232.  swn(4); fbc(15,0); writegn('Figure drawing demonstration');
  233.  writeg('Use "e","r" or "t" key to change figure, or press Enter to continue');
  234.  graffont(14);
  235.  
  236.  repeat
  237.   c:=random(15); x:=random(63); y:=random(63);
  238.   inc(i); setcolor(15); gotoxyg(70,3); writenum(i,'w',5,0); setcolor(c);
  239.   case ch of
  240.    'e': ellipse(80+x*7+c*5,100+c*10+y*5,x*3,y*2);
  241.    'r': rectangle(100+c*13+x*7,100+x*2+y*6,100+y*4+x,100+c*7+y);
  242.    't': triangle(60+x*7,70+c*13,200+y*3,400+c*5,100+y*9,150+x*3);
  243.    end;
  244.  
  245.  until keypressed;
  246.  
  247.  ch:=klic; pixelmode_off;
  248.  if ch=#13 then begin
  249.   graffont(24); swy(2);
  250.   setcolor(15); gotoxyg(70,3); writenum(i,'w',5,0);
  251.   ch:=klic end;
  252.  if ch in['r','e','t','p'] then begin
  253.  fbc(15,0); cleardevice; goto 2 end;
  254.  
  255.  rgb('DIAMO.PAL'); fbc(15,0); cleardevice; graffont(24);
  256.  
  257.  writegn('The following demonstration will use this palette');
  258.  writeg('Press Enter to continue'); swy(5);
  259.  
  260.  setrst($AA55);
  261.  {setrst($FFFF);}
  262.  
  263.  for i:=0 to 15 do begin
  264.   backcolor(i);
  265.   for j:=0 to 15 do begin
  266.    setcolor(j);
  267.    fillrectangle(i*40,80+j*25,(i+1)*40,80+(j+1)*25) end end;
  268.  
  269.  setcolor(0);
  270.  for i:=0 to 15 do
  271.   for j:=0 to 15 do
  272.    rectangle(i*40,80+j*25,(i+1)*40,80+(j+1)*25);
  273.  
  274.  
  275.  ch:=klic;
  276.  
  277.  fbc(15,0); cleardevice; ch:='e';
  278.  
  279.  3: i:=0; setcolor(15); graffont(24);
  280.  swn(14); fbc(15,0); writegn('Figure filling demonstration');
  281.  writeg('Use "e","r" or "t" key to change figure, or press Enter to exit');
  282.  graffont(14);
  283.  repeat
  284.   c:=random(15); x:=random(63); y:=random(63);
  285.   inc(i); setcolor(15); gotoxyg(70,3); writenum(i,'w',5,0);
  286.   setcolor(c); backcolor(y div 4);
  287.  
  288.   case ch of
  289.    'e': fillellipse(80+x*7+c*5,100+c*10+y*5,x*3,y*2);
  290.    'r': fillrectangle(100+c*13+x*7,100+x*2+y*6,100+y*4+x,100+c*7+y);
  291.    't': filltriangle(60+x*7,70+c*13,200+y*5,400+c*5,100+y*9,150+x*3);
  292.    'p': begin p[1].x:=100-c*5+x*4; p[1].y:=200+c*13-y*2;
  293.               p[2].x:=200+x*3;     p[2].y:=400+x*3-y*2;
  294.               p[3].x:=450-y*4+x*2; p[3].y:=450-y*3+c*5;
  295.               p[4].x:=550+x*2-y*3; p[4].y:=100+c*11+x*2;
  296.               p[5].x:=p[1].x;      p[5].y:=p[1].y;
  297.          fillpolygon(5,p) end;
  298.    end;
  299.  
  300.  until keypressed;
  301.  
  302.  ch:=klic;
  303.  if ch=#13 then begin graffont(24); swy(5); ch:=klic end;
  304.  if ch in['e','r','t','p'] then begin
  305.  backcolor(0); cleardevice; goto 3 end;
  306.  
  307.  
  308.  fbc(15,0); cleardevice; ch:='e';
  309.  
  310.  4: i:=0; setcolor(15); graffont(24);
  311.  swn(14); fbc(15,0); writegn('Figure drawing and filling demonstration');
  312.  writeg('Use "e","r" or "t" key to change figure, or press Enter to continue');
  313.  graffont(14);
  314.  repeat
  315.   c:=random(15);
  316.   x:=random(63);
  317.   y:=random(63);
  318.   inc(i); setcolor(15); gotoxyg(70,3); writenum(i,'w',5,0);
  319.   case ch of
  320.    'e': begin
  321.          setcolor(c); backcolor(y div 4);
  322.          fillellipse(80+x*7+c*5,100+c*10+y*5,x*3,y*2);
  323.          setcolor(0);
  324.          ellipse(80+x*7+c*5,100+c*10+y*5,x*3,y*2) end;
  325.    'r': begin
  326.          setcolor(c); backcolor(y div 4);
  327.          fillrectangle(100+c*13+x*7,100+x*2+y*6,100+y*4+x,100+c*7+y);
  328.          setcolor(0);
  329.          rectangle(100+c*13+x*7,100+x*2+y*6,100+y*4+x,100+c*7+y) end;
  330.    't': begin
  331.          setcolor(c); backcolor(x div 4);
  332.          filltriangle(60+x*7,70+c*13,200+y*5,400+c*5,100+y*9,150+x*3);
  333.          setcolor(0);
  334.          triangle(60+x*7,70+c*13,200+y*5,400+c*5,100+y*9,150+x*3) end;
  335.    'p': begin
  336.          setcolor(c); backcolor(x div 4);
  337.          p[1].x:=60+x*7;    p[1].y:=70+c*13;
  338.          p[2].x:=200+y*5;   p[2].y:=400+c*5;
  339.          p[3].x:=100+y*9;   p[3].y:=150+x*3;
  340.          p[4].x:=p[1].x;    p[4].y:=p[1].y;
  341.          fillpolygon(4,p);
  342.          setcolor(0); triangle(p[1].x,p[1].y,p[2].x,p[2].y,p[3].x,p[3].y) end;
  343.  
  344.    end;
  345.  
  346.  until keypressed;
  347.  
  348.  ch:=klic;
  349.  if ch=#13 then begin graffont(24); swy(5); ch:=klic end;
  350.  if ch in['e','r','t','p'] then begin
  351.  backcolor(0); cleardevice; goto 4 end;
  352.  
  353.  graffont(24); fbc(15,0); cleardevice; pe; swy(5); fbc(15,0);
  354.  
  355.  writegn('Comparison of drawing (filling) speed with');
  356.  writegn('Turbo Pascal 6.0   (DOS real mode) and');
  357.  writegn('Borland Pascal 7.0 (DOS protected mode)');
  358.  writegn('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
  359.  graffont(16); fbc(7,0);
  360.  writegn('');
  361.  writegn('');
  362.  writegn('  ┌───────────────┬────────┬────────┬────────┐');
  363.  writegn('  │    Drawing    │ PGRAPH │  TP6   │  BP7   │');
  364.  writegn('  ├───────────────┼────────┼────────┼────────┤');
  365.  writegn('  │Ellipses/sec   │   535  │ ! 355  │ ! 220  │');
  366.  writegn('  │Rectangles/sec │  1060  │ ! 960  │ ! 370  │');
  367.  writegn('  │Triangles/sec  │   835  │ ! 735  │ ! 330  │');
  368.  writegn('  └───────────────┴────────┴────────┴────────┘');
  369.  writegn('  ┌───────────────┬────────┬────────┬────────┐');
  370.  writegn('  │Filling+drawing│ PGRAPH │  TP6   │  BP7   │');
  371.  writegn('  ├───────────────┼────────┼────────┼────────┤');
  372.  writegn('  │Ellipses/sec   │   325  │ ! 140  │ ! 120  │');
  373.  writegn('  │Bars/sec *     │   535  │ ! 465  │ ! 260  │');
  374.  writegn('  │Triangles/sec  │   260  │ ! 130  │ ! 110  │');
  375.  writegn('  └───────────────┴────────┴────────┴────────┘');
  376.  writegn('');
  377.  writegn('Notes: ! ... PGRAPH is faster');
  378.  writegn('       * ... only filling');
  379.  writegn(''); fbc(15,0);
  380.  writegn(' Test was performed with CPU 486-DX4, 100 MHz');
  381.  writegn(' and graphics adapter CL-GD6440, 1MB VideoRAM');
  382.  
  383.  
  384.  ch:=klic; graffont(16);
  385.  
  386.  6:
  387.  setrgbpalette(1,0,5,10);
  388.  backcolor(1); cleardevice; setrst($FFFF);
  389.  
  390.  randomize;
  391.  
  392.  xx:=random(200); yy:=random(420);
  393.  for i:=1 to 3 do begin
  394.   c:=random(5)+3; b:=random(3)+6;
  395.   for j:=1 to 7 do begin
  396.    x:=xx+random(55*b); y:=yy+random(19*c);
  397.    l:=random(33)+4; k:=random(29)+5;
  398.    for m:=1 to 44*(random(17)+2) do begin
  399.     putpixel(x+round(random(l*3)*cos(m/13)),
  400.              y+round(random(k)*sin(m/13+7*b)),13-i);
  401.     x:=x+random((m div (33*c*b))*round(cos(m/17+c))) div 2 ;
  402.     y:=y-round(sin(random(m))) end end end;
  403.  
  404.  for i:=1 to 144 do begin
  405.   x:=random(639); y:=random(479); l:=random(19); c:=random(7)+6;
  406.   for m:=1 to l*l do
  407.   putpixel(x+(m div {43}(4*c))*round(random(m)/27*cos(m)),
  408.            y+(m div {43}(4*c))*round(random(m)/27*sin(m)),c) end;
  409.  
  410.  for i:=1 to 2 do begin
  411.   c:=random(5)+3; b:=random(4)+7;
  412.   dx:=random(4)+6;
  413.   case i of 1: d:=(60-25*b)/180; 2: d:=(-60+25*c)/180 end;
  414.   l:=random(17)+9; k:=random(6)+5;
  415.   x:=random(500)+50; y:=random(230)+(i-1)*230;
  416.   for m:=1 to 222 do
  417.    putpixel(x+round(random(k+6)*cos(m/23)),y+round(random(k+6)*sin(m/23)),b);
  418.   for j:=1 to 44*dx do begin
  419.    x:=x+round(j/(k)*cos(j/33)); y:=y+round(j/(l)*sin(j/33+d));
  420.    putpixel(x+random(j div 37),y+random(j div 37),b);
  421.    x:=x-round(j/(k)*cos(j/33)); y:=y-round(j/(l)*sin(j/33+d));
  422.    putpixel(x+random(j div 37),y+random(j div 37),b) end;
  423.   for j:=1 to 44*dx do begin
  424.    x:=x+round(j/(k)*cos(j/33+pi)); y:=y+round(j/(l)*sin(j/33+d+pi));
  425.    putpixel(x+random(j div 37),y+random(j div 37),b);
  426.    x:=x-round(j/(k)*cos(j/33+pi)); y:=y-round(j/(l)*sin(j/33+d+pi));
  427.    putpixel(x+random(j div 37),y+random(j div 37),b) end end;
  428.  
  429.  
  430.  setcolor(15); swn(14); fbc(12,0);
  431.  writegn('PutArea - GetArea demo  (0...9 - change speed, r - redraw, Enter - exit)');
  432.  
  433.  l:=areasize(0,0,80,60); getmem(po,l); setcolor(15); setliwi(3);
  434.  x:=320; y:=240; getarea(x-40,y-30,x+40,y+30,po^);
  435.  j:=0; k:=random(133); c:=20;
  436.  
  437.  repeat
  438.   putarea(x-40,y-30,po^); inc(j);
  439.   x:=x+round(j/7*cos(j/10)); y:=y+round(j/10*sin(j/13));
  440.   if j>k then begin k:=random(181); j:=0 end;
  441.  
  442.   if x<40 then x:=40; if x>599 then x:=599;
  443.   if y<30 then y:=30; if y>449 then y:=449;
  444.  
  445.   dx:=39-round(39*j/182); dy:=27-round(27*j/182);
  446.   getarea(x-40,y-30,x+40,y+30,po^);
  447.  
  448.   filltriangle(x,y,x,y-dy,x-dx,y);
  449.   filltriangle(x,y,x,y+dy,x+dx,y);
  450.   line(x,y+dy,x-dx,y);
  451.   line(x+dx,y,x,y-dy);
  452.  
  453.   for m:=1 to 24000*c do ;
  454.  
  455.   if keypressed then begin
  456.    ch:=klic;
  457.    if ch in ['0'..'9'] then c:=(ord(ch)-48); c:=c*c;
  458.    if ch in [#13,#27] then goto 5 end;
  459.    if ch in ['r','z'] then begin ch:='4'; goto 6 end;
  460.  
  461.  until keypressed;
  462.  
  463.  5: freemem(po,l);
  464.  
  465.  restorecrtmode;
  466. end.
  467.  
  468.