home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / tricks / verzerre.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-10  |  6.6 KB  |  235 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     VERZERRE.PAS                       *)
  3. (*    Programm zum Verzerren von beliebigen Bildschirm-   *)
  4. (*    bereichen.                                          *)
  5. (*        (c) 1991 Raimond Reichert & TOOLBOX             *)
  6. (* ------------------------------------------------------ *)
  7. PROGRAM Bildschirmbereiche_verzerren;
  8.  
  9. USES Graph, Crt, Dos;
  10.  
  11. TYPE
  12.   ImageRec = RECORD
  13.                Size : INTEGER;
  14.                Img  : POINTER;
  15.              END;
  16.  
  17. CONST
  18.   AK         : INTEGER = 50;
  19.   PutMode    : BYTE    = NotPut;
  20.   TargetPage : BYTE    = 0;
  21.   DeleteOld  : BOOLEAN = FALSE;
  22.   AktPage    : BYTE    = 0;
  23.  
  24. VAR
  25.   GraphMode,
  26.   GraphDriver : INTEGER;
  27.   GraphPath   : STRING;
  28.  
  29.  
  30.   PROCEDURE CatchImage(x1, y1, x2, y2 : INTEGER;
  31.                        VAR ImgVar     : ImageRec);
  32.   BEGIN
  33.     WITH ImgVar DO BEGIN
  34.       Img  := NIL;
  35.       Size := ImageSize(x1, y1, x2, y2);
  36.       GetMem(Img, Size);
  37.       GetImage(x1, y1, x2, y2, Img^);
  38.     END;
  39.   END;
  40.  
  41.   PROCEDURE FreeImage(VAR ImgVar : ImageRec);
  42.   BEGIN
  43.     IF ImgVar.Img <> NIL THEN BEGIN
  44.       FreeMem(ImgVar.Img, ImgVar.Size);
  45.       ImgVar.Size := 0;
  46.       ImgVar.Img  := NIL;
  47.     END;
  48.   END;
  49.  
  50.   PROCEDURE Verzerre(x1, y1, x2, y2         : INTEGER;
  51.                      tx1, ty1, StepY, StepX : INTEGER;
  52.                      SourcePage             : BYTE);
  53.   VAR
  54.     im : ImageRec;
  55.     j  : INTEGER;
  56.   BEGIN
  57.     IF (tx1 = -1) AND (ty1 = -1) THEN BEGIN
  58.       tx1 := x1;  ty1 := y1;
  59.     END;
  60.     FOR j := 1 TO (x2-x1) DIV StepX+1 DO BEGIN
  61.       SetActivePage(SourcePage);
  62.       CatchImage(x1 + StepX*j - StepX+1, y1,
  63.                  x1 + StepX*j, y2, im);
  64.       SetActivePage(TargetPage);
  65.       PutImage(tx1 + StepX*j - StepX+1,
  66.                ty1 + j*StepY, im.Img^, PutMode);
  67.       IF DeleteOld THEN BEGIN
  68.         SetActivePage(SourcePage);
  69.         PutImage(x1 + StepX*j - StepX+1,
  70.                  y1, im.Img^, XorPut);
  71.       END;
  72.       FreeImage(im);
  73.     END;
  74.   END;
  75.  
  76.   PROCEDURE CosKurve(x1, y1, x2, y2   : INTEGER;
  77.                      tx1, ty1, Height : INTEGER;
  78.                      SourcePage       : BYTE);
  79.   VAR
  80.     im : ImageRec;
  81.     j  : INTEGER;
  82.   BEGIN
  83.     IF (tx1 = -1) AND (ty1 = -1) THEN BEGIN
  84.       tx1 := x1;  ty1 := y1;
  85.     END;
  86.     FOR j := 0 TO (x2-x1)+1 DO BEGIN
  87.       SetActivePage(SourcePage);
  88.       CatchImage(x1+j, y1, x1+j, y2, im);
  89.       SetActivePage(TargetPage);
  90.       PutImage(tx1+j,
  91.                ty1 + Round(Height*
  92.                      Cos((0-(x2-x1) DIV 2+j)/AK)),
  93.                im.Img^, PutMode);
  94.       IF DeleteOld THEN BEGIN
  95.         SetActivePage(SourcePage);
  96.         PutImage(x1+j, y1, im.Img^, XorPut);
  97.       END;
  98.       FreeImage(im);
  99.     END;
  100.     SetActivePage(AktPage);
  101.   END;
  102.  
  103.   PROCEDURE SinKurve(x1, y1, x2, y2   : INTEGER;
  104.                      tx1, ty1, Height : INTEGER;
  105.                      SourcePage       : BYTE);
  106.   VAR
  107.     im : ImageRec;
  108.     j  : INTEGER;
  109.   BEGIN
  110.     IF (tx1 = -1) AND (ty1 = -1) THEN BEGIN
  111.       tx1 := x1;  ty1 := y1;
  112.     END;
  113.     FOR j := 0 TO (x2-x1)+1 DO BEGIN
  114.       SetActivePage(SourcePage);
  115.       CatchImage (x1+j,y1,x1+j,y2,im);
  116.       SetActivePage (TargetPage);
  117.       PutImage(tx1+j,
  118.                ty1 + Round(Height*
  119.                      Sin((0-(x2-x1) DIV 2+j)/AK)),
  120.                im.Img^, PutMode);
  121.       IF DeleteOld THEN BEGIN
  122.         SetActivePage(SourcePage);
  123.         PutImage(x1+j, y1, im.Img^, XorPut)
  124.       END;
  125.       FreeImage(im);
  126.     END;
  127.     SetActivePage(AktPage);
  128.   END;
  129.  
  130.   PROCEDURE ArcTanKurve(x1, y1, x2, y2   : INTEGER;
  131.                         tx1, ty1, Height : INTEGER;
  132.                         SourcePage       : BYTE);
  133.   VAR
  134.     im : ImageRec;
  135.     j  : INTEGER;
  136.   BEGIN
  137.     IF (tx1 = -1) AND (ty1 = -1) THEN BEGIN
  138.       tx1 := x1; ty1 := y1
  139.     END;
  140.     FOR j := 0 TO (x2-x1)+1 DO BEGIN
  141.       SetActivePage(SourcePage);
  142.       CatchImage(x1+j, y1, x1+j, y2, im);
  143.       SetActivePage(TargetPage);
  144.       PutImage(tx1 + j,
  145.                ty1 + Round(Height*
  146.                      ArcTan((0-(x2-x1) DIV 2+j)/AK)),
  147.                im.Img^, PutMode);
  148.       IF DeleteOld THEN BEGIN
  149.         SetActivePage(SourcePage);
  150.         PutImage(x1+j, y1, im.Img^, XorPut);
  151.       END;
  152.       FreeImage(im);
  153.     END;
  154.     SetActivePage(AktPage);
  155.   END;
  156.  
  157.   PROCEDURE Endlos(x1, y1, x2, y2, Step : INTEGER);
  158.   VAR
  159.     i, m : ImageRec;
  160.     j    : INTEGER;
  161.     ch   : CHAR;
  162.     Quit : BOOLEAN;
  163.   BEGIN
  164.     REPEAT
  165.       CatchImage(x1,      y1, x1+Step, y2, m);
  166.       CatchImage(x1+Step, y1, x2,      y2, i);
  167.       PutImage(x2-Step, y1, m.Img^, CopyPut);
  168.       PutImage(x1,      y1, i.Img^, CopyPut);
  169.       FreeImage(i);
  170.       FreeImage(m);
  171.       Quit := FALSE;
  172.       IF KeyPressed THEN BEGIN
  173.         ch := ReadKey;
  174.         IF ch = #0 THEN BEGIN
  175.           ch := ReadKey;
  176.           CASE ch OF
  177.             #75 : IF Step > 1         THEN Dec(Step);
  178.             #77 : IF Step < (x2-x1-1) THEN Inc(Step);
  179.           END;
  180.         END ELSE
  181.           Quit := TRUE;
  182.       END;
  183.     UNTIL Quit;
  184.   END;
  185.  
  186.   PROCEDURE Invers(x1, y1, x2, y2 : INTEGER);
  187.   VAR
  188.     im : ImageRec;
  189.   BEGIN
  190.     CatchImage(x1, y1, x2, y2, im);
  191.     PutImage(x1, y1, im.Img^, NotPut);
  192.     FreeImage(im);
  193.   END;
  194.  
  195. BEGIN
  196.   GraphDriver := Detect;
  197.   GraphPath   := GetEnv('BGIPATH');
  198.   InitGraph(GraphDriver, GraphMode, GraphPath);
  199.  
  200.   Rectangle(0, 0, GetMaxX, 12);
  201.   OutTextXY(0, 2,
  202.            ' Sinus - Cosinus - Sinus - Cosinus - Sinus - ' +
  203.            'Cosinus - Sinus - Cosinus - Sinus - Cosinus');
  204.   Invers(0, 0, GetMaxX, 12);
  205.   Endlos(0, 0, GetMaxX, 12, 10);
  206.   Invers(0, 0, GetMaxX, 12);
  207.   CosKurve( 0, 0, GetMaxX, 12, 0, 50, 20, AktPage);
  208.   ReadLn;
  209.   SinKurve(0, 0, GetMaxX, 12, 0, 120, 20, AktPage);
  210.   ReadLn;
  211.   ArcTanKurve(0, 0, GetMaxX, 12, 0, 200, 20, AktPage);
  212.   ReadLn;
  213.   ClearViewPort;
  214.   Rectangle(0, 0, GetMaxX, 12);
  215.   OutTextXY(0, 2, ' Verzerren - Verzerren - Verzerren' +
  216.                   ' - Verzerren - Verzerren - Verzerren' +
  217.                   ' - Verzerren - ');
  218.   Invers(0, 0, GetMaxX, 12);
  219.   Endlos(0, 0, GetMaxX, 12, 10);
  220.   Invers(0, 0, GetMaxX, 12);
  221.   Verzerre(0, 0, GetMaxX DIV 2, 12, 0, 15, 1, 2, AktPage);
  222.   ReadLn;
  223.   Verzerre(0, 0, GetMaxX DIV 2, 12,
  224.             GetMaxX DIV 2, GetMaxY DIV 2+24,
  225.             -1, 2, AktPage);
  226.   ReadLn;
  227.   Verzerre(0, 0, GetMaxX, 12, 0, 120,  12, 50, AktPage);
  228.   ReadLn;
  229.   Verzerre(0, 0, GetMaxX, 12, 0, 300, -12, 50, AktPage);
  230.   ReadLn;
  231.   CloseGraph;
  232. END.
  233. (* ------------------------------------------------------ *)
  234. (*                Ende von VERZERRE.PAS                   *)
  235.