home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SDI.ZIP / SDITEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-11-26  |  3.4 KB  |  130 lines
  1.  
  2. {a quick little demo program to show the use of SDImage and ExpBox}
  3. {written by Michael Day 22 November 1988}
  4. {released to the public domain}
  5.  
  6. program sditest;
  7.  
  8. uses crt,graph,sdimage,expbox;
  9.  
  10. const
  11.     xSpeed   : word = 50;   {explosion speed}
  12.     xStep    : byte = 5;    {explosion count}
  13.     xStyle   : byte = 0;    {explosion style}
  14.     xSound   : byte = $10;  {explosion sound}
  15.     xRect    : byte = $80;  {explosion rectangles}
  16.     xColor   : byte = blue; {explosion color}
  17.     xPattern : byte = solidfill; {explosion pattern}
  18.     xRColor  : byte = black; {explosion rectangle}
  19.     {- if you have ega/vga display, try setting xRColor to yellow -}
  20. var
  21.     gr,gd:integer;
  22.     ch : char;
  23.     IT,IE:integer;
  24.     x1,y1,x2,y2:integer;
  25.  
  26. function fstr(I:integer):string;  {functionalized Str procedure}
  27. var S:string[8];
  28. begin
  29.   str(I,S);
  30.   fstr := S;
  31. end;
  32.  
  33. procedure bomb(I:integer);  {rats! show what went wrong}
  34. begin
  35.   setfillstyle(solidfill,black);
  36.   bar(0,0,100,10);
  37.   setcolor(green);
  38.   moveto(0,0);
  39.   outtext('OOPS!:'+fstr(i)+':'+fstr(ImageError));
  40.   Halt;
  41. end;
  42.  
  43. procedure ShowStr(S:string);   {display a string clipped to window edge}
  44. var x,y:integer;
  45. begin
  46.   y := y1+4;
  47.   while y < (succ(y2)-TextHeight('X')) do
  48.   begin
  49.     x := x1+4;
  50.     while x < x2 do
  51.     begin
  52.       moveto(x,y);
  53.       outtext(copy(S,1, pred(x2 div TextWidth('X')) - (x div TextWidth('X'))));
  54.       x := x + (length(S)*TextWidth('X'))+TextWidth('X');
  55.     end;
  56.     y := y + TextHeight('X');
  57.   end;
  58. end;
  59.  
  60.  
  61. {--------------------------------------------}
  62. {here is where it all begins}
  63.  
  64. begin
  65.   gr := cga;
  66.   gd := cgac0;
  67.   initgraph(gr,gd,'');
  68.  
  69.  {  to direct the image to a ram disk, put your path in here }
  70. {  if not SetImagePath('F:\SDI') then bomb(4); }
  71.  
  72.   x1 := 20;            {defines the image area we will be using}
  73.   y1 := 20;
  74.   x2 := 620;
  75.   y2 := 180;
  76.  
  77.   {this allows you to change the buffer size}
  78.   {if you want to see how it affects things}
  79. { if not AllocImageBuf(1,1000) then Bomb(3); }
  80.  
  81.   moveto(1,1);
  82.   outtext('The following special effects are available:');
  83.   for IT := 0 to 7 do       {create the images}
  84.   begin
  85.     setfillstyle(solidfill,black);
  86.     bar(x1,y1,x2,y2);
  87.     setColor(white);
  88.     case IT of
  89.       0:ShowStr('Pull Down (Vertical)');
  90.       1:ShowStr('Pull Up (Vertical)');
  91.       2:ShowStr('Pull Right (Horizontal)');
  92.       3:ShowStr('Pull Left (Horizontal)');
  93.       4:ShowStr('Merge Vertical');
  94.       5:ShowStr('Expand Vertical');
  95.       6:ShowStr('Merge Horizontal');
  96.       7:ShowStr('Expand Horizontal');
  97.     end;
  98.     if not saveImage(IT,1, x1,y1,x2,y2, IT) then bomb(1);
  99.     setfillstyle(solidfill,black);
  100.     bar(x1,y1,x2,y2);
  101.   end;
  102.  
  103.   setfillstyle(solidfill,black); {now clear the dispay}
  104.   bar(0,0,GetMaxX,GetMaxY);
  105.   setColor(white);
  106.  
  107.   IT := 0;    {now we show all the great stuff we can do}
  108.   IE := 0;
  109. repeat
  110.   xStyle := ie or xRect or xSound;
  111.   ExplodeBox(x1-10,y1-10,x2+10,y2+10,
  112.              xSpeed,xStep,xStyle,
  113.              xColor,xPattern,xrColor);
  114.  
  115.   if not displayImage(IT,1, false) then bomb(2);
  116.   delay(1000);
  117.   inc(IT);
  118.   if IT > 7 then IT := 0;
  119.   Inc(IE);
  120.   if IE > 8 then IE := 0;
  121.  
  122.   setfillstyle(solidfill,black);  {clear the display between images}
  123.   bar(0,0,GetMaxX,GetMaxY);
  124.   setColor(white);
  125.   ch := #255;
  126.   if keypressed then ch := readkey;  {stop when they tell us to}
  127. until ch < #32;
  128.  
  129. end.
  130.