home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUIN / MCGA_ROT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  3KB  |  99 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 221 of 323
  3. From : William Sitch                       1:163/542.0          04 Jun 93  18:18
  4. To   : Chris Gahan                         1:259/423.0
  5. Subj : Scaling..
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Quoting [From: Chris Gahan; To: All]
  8.  
  9. CG>         I've been trying for some time to get a Pascal
  10. CG> procedure that can SCALE and/or ROTATE graphic images. if
  11. CG> anyone has any idea how to do this, or has a source code,
  12. CG> PLEEEAASSEE drop me a line.. THANK YOU!
  13.  
  14. Here is some code to rotate an image (in MCGA screen mode $13) ... but it has a
  15. few drawbacks... its kinda slow and the image falls apart during rotation... it
  16. hasn't been tested fully either...
  17.  
  18. ---}
  19. procedure rotate (x1,y1,x2,y2:word; ang,ainc:real);
  20. var
  21.   ca,sa    :  real;
  22.   cx,cy    :  real;
  23.   dx,dy    :  real;
  24.   h,i,j,k  :  word;
  25.   pinf     :  array [1..12500] of record
  26.                                     x,y  :  word;
  27.                                     col  :  byte;
  28.                                   end;
  29. begin
  30.   ca := cos((ainc/180)*pi);
  31.   sa := sin((ainc/180)*pi);
  32.  
  33.   for h := 1 to round(ang/ainc) do
  34.     begin
  35.       k := 0;
  36.       cx := x1 + ((x2 - x1) / 2);
  37.       cy := y1 + ((y2 - y1) / 2);
  38.       for i := x1 to x2 do
  39.         for j := y1 to y2 do
  40.           begin
  41.             inc(k);
  42.  
  43.             dx := cx + (((i - cx) * ca) - ((j - cy) * sa));
  44.             dy := cy + (((i - cx) * sa) + ((j - cy) * ca));
  45.  
  46.             if (round(dx) > 0) and (round(dy) > 0) and (round(dx) < 65000) and 
  47. (round(dy) < 65000) then
  48.               begin
  49.                 pinf[k].x := round(dx);
  50.                 pinf[k].y := round(dy);
  51.                 pinf[k].col := mem[$A000:j*320+i];
  52.               end
  53.             else
  54.               begin
  55.                 pinf[k].x := 0;
  56.                 pinf[k].y := 0;
  57.                 pinf[k].col := 0;
  58.               end;
  59.           end;
  60.  
  61.       for i := x1 to x2 do
  62.         for j := y1 to y2 do
  63.           mem[$A000:j*320+i] := 0;
  64.  
  65.       x1 := 320; x2 := 1;
  66.       y1 := 200; y2 := 1;
  67.       for i := 1 to k do
  68.         begin
  69.           if (pinf[i].x < x1) then
  70.             x1 := pinf[i].x;
  71.           if (pinf[i].x > x2) then
  72.             x2 := pinf[i].x;
  73.  
  74.           if (pinf[i].y < y1) then
  75.             y1 := pinf[i].y;
  76.           if (pinf[i].y > y2) then
  77.             y2 := pinf[i].y;
  78.  
  79.           if (pinf[i].x > 0) and (pinf[i].y > 0) then
  80.             mem[$A000:pinf[i].y*320+pinf[i].x] := pinf[i].col;
  81.         end;
  82.     end;
  83. end;
  84. ---
  85.  
  86. It works, but DON'T try to use it for a main module or base a program AROUND
  87. it... instead try to change it to suit your needs, as right now it's kinda
  88. optimized for my needs...
  89.  
  90. Sorry for not editing it to work with any screen mode, but I just don't have
  91. the time.  MCGA memory is a linear block of bytes, and you can access it using:
  92. mem[$A000:offset].  So to find the color at screen position 10,10, you would
  93. go:
  94.  
  95. mem[$A000:y*320+x]
  96.           ^  ^  ^-- x val, 10
  97.           |  |----- screenwidth
  98.           |-------- y val, 10
  99.