home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0024_Rotate PIC.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  2.6 KB  |  99 lines
  1. {
  2. WILLIAM SITCH
  3.  
  4. > I've been trying For some time to get a Pascal
  5. > Procedure that can SCALE and/or ROTATE Graphic images. if
  6. > anyone has any idea how to do this, or has a source code,
  7. > PLEEEAASSEE drop me a line.. THANK YOU!
  8.  
  9. Here is some code to rotate an image (in MCGA screen mode $13) ... but it has a
  10. few drawbacks... its kinda slow and the image falls apart during rotation... it
  11. hasn't been tested fully either...
  12. }
  13.  
  14. Procedure rotate(x1, y1, x2, y2 : Word; ang, ainc : Real);
  15. Var
  16.   ca, sa :  Real;
  17.   cx, cy :  Real;
  18.   dx, dy :  Real;
  19.   h, i,
  20.   j, k   :  Word;
  21.  
  22.   pinf   :  Array [1..12500] of Record
  23.     x, y :  Word;
  24.     col  :  Byte;
  25.   end;
  26.  
  27. begin
  28.   ca := cos((ainc / 180) * pi);
  29.   sa := sin((ainc / 180) * pi);
  30.  
  31.   For h := 1 to round(ang / ainc) do
  32.   begin
  33.     k  := 0;
  34.     cx := x1 + ((x2 - x1) / 2);
  35.     cy := y1 + ((y2 - y1) / 2);
  36.     For i := x1 to x2 do
  37.       For j := y1 to y2 do
  38.       begin
  39.         inc(k);
  40.  
  41.         dx := cx + (((i - cx) * ca) - ((j - cy) * sa));
  42.         dy := cy + (((i - cx) * sa) + ((j - cy) * ca));
  43.  
  44.         if (round(dx) > 0) and (round(dy) > 0) and
  45.            (round(dx) < 65000) and (round(dy) < 65000) then
  46.         begin
  47.           pinf[k].x   := round(dx);
  48.           pinf[k].y   := round(dy);
  49.           pinf[k].col := mem[$A000 : j * 320 + i];
  50.         end
  51.         else
  52.         begin
  53.           pinf[k].x   := 0;
  54.           pinf[k].y   := 0;
  55.           pinf[k].col := 0;
  56.         end;
  57.       end;
  58.  
  59.       For i := x1 to x2 do
  60.         For j := y1 to y2 do
  61.           mem[$A000 : j * 320 + i] := 0;
  62.  
  63.       x1 := 320;
  64.       x2 := 1;
  65.       y1 := 200;
  66.       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. }