home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Frameworks / TransSkel 3.24 / Demos / Pascal Demos / MultiSkel / MSkelZoom.p < prev    next >
Encoding:
Text File  |  1996-01-25  |  3.6 KB  |  194 lines  |  [TEXT/CWIE]
  1. unit MultiSkelZoom;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, Events, QuickDraw, Windows, Menus, TransSkel, MSkelGlobals;
  7.  
  8.     procedure ZoomWindInit;
  9.  
  10. implementation
  11.  
  12.     const
  13.  
  14.         zoomSteps = 15;
  15.         maxZoomStep = zoomSteps - 1;
  16.  
  17.     var
  18.  
  19.         zRect: array[0..maxZoomStep] of Rect;
  20.         zSrcRect: Rect;
  21.         sizeX: Integer;
  22.         sizeY: Integer;
  23.  
  24.     procedure ZDrawGrowBox (wind: WindowPtr);
  25.     forward;
  26.  
  27.  
  28.     procedure SetZoomSize;
  29.         var
  30.             r: Rect;
  31.     begin
  32.         r := zoomWind^.portRect;
  33.         r.right := r.right - 15;
  34.         sizeX := r.right;
  35.         sizeY := r.bottom;
  36.     end;
  37.  
  38.  
  39.     function Rand (max: Integer): Integer;
  40.         var
  41.             t: Integer;
  42.     begin
  43.         t := Random;
  44.         if (t < 0) then
  45.             t := -t;
  46.         Rand := t mod (max + 1);
  47.     end;
  48.  
  49.  
  50.     procedure ZoomRect (r1: Rect;
  51.                                     r2: Rect);
  52.         var
  53.             r1left: Integer;
  54.             r1top: Integer;
  55.             l: Integer;
  56.             t: Integer;
  57.             j: Integer;
  58.             hDiff: Integer;
  59.             vDiff: Integer;
  60.             widDiff: Integer;
  61.             htDiff: Integer;
  62.             r: Integer;
  63.             b: Integer;
  64.             rWid: Integer;
  65.             rHt: Integer;
  66.     begin
  67.         r1left := r1.left;
  68.         r1top := r1.top;
  69.         hDiff := r2.left - r1left;        { positive if moving to right }
  70.         vDiff := r2.top - r1top;        { positive if moving down }
  71.         rWid := r1.right - r1left;
  72.         rHt := r1.bottom - r1top;
  73.         widDiff := (r2.right - r2.left) - rWid;
  74.         htDiff := (r2.bottom - r2.top) - rHt;
  75.         for j := 1 to zoomSteps do
  76.             begin
  77.                 FrameRect(zRect[j - 1]);    { erase a rectangle }
  78.                 l := r1left + (hDiff * j) div zoomSteps;
  79.                 t := r1top + (vDiff * j) div zoomSteps;
  80.                 r := l + rWid + (widDiff * j) div zoomSteps;
  81.                 b := t + rHt + (htDiff * j) div zoomSteps;
  82.                 SetRect(zRect[j - 1], l, t, r, b);
  83.                 FrameRect(zRect[j - 1]);
  84.             end;
  85.     end;
  86.  
  87.  
  88.     procedure ZDrawGrowBox (wind: WindowPtr);
  89.         var
  90.             r: Rect;
  91.     begin
  92.         r := wind^.portRect;
  93.         r.left := r.right - 15;
  94.         r.top := r.bottom - 15;
  95.         r.right := r.right + 1;
  96.         r.bottom := r.bottom + 1;
  97.         Eraserect(r);
  98.         FrameRect(r);
  99.         if (WindowPeek(wind)^.hilited) then
  100.             begin
  101.                 r.right := r.right - 6;
  102.                 r.bottom := r.bottom - 6;
  103.                 OffsetRect(r, 4, 4);
  104.                 FrameRect(r);
  105.                 r.right := r.right - 3;
  106.                 r.bottom := r.bottom - 3;
  107.                 OffsetRect(r, -1, -1);
  108.                 EraseRect(r);
  109.                 FrameRect(r);
  110.             end;
  111.     end;
  112.  
  113.  
  114.     procedure Mouse (pt: Point;
  115.                                     t: LongInt;
  116.                                     mods: Integer);
  117.     begin
  118.         while (StillDown) do
  119.             begin
  120.             { wait until mouse button is released }
  121.             end;
  122.     end;
  123.  
  124.  
  125.     procedure Update (resized: Boolean);
  126.         var
  127.             i: Integer;
  128.     begin
  129.         EraseRect(zoomWind^.portRect);
  130.         ZDrawGrowBox(zoomWind);
  131.         SetWindClip(zoomWind);
  132.         for i := 0 to maxZoomStep do
  133.             FrameRect(zRect[i]);
  134.         ResetWindClip;
  135.         if (resized) then
  136.             SetZoomSize;
  137.     end;
  138.  
  139.  
  140.     procedure Activate (active: Boolean);
  141.     begin
  142.         ZDrawGrowBox(zoomWind);
  143.         if (active) then
  144.             DisableItem(editMenu, 0)
  145.         else
  146.             EnableItem(editMenu, 0);
  147.         DrawMenuBar;
  148.     end;
  149.  
  150.  
  151.     procedure Clobber;
  152.     begin
  153.         DisposeWindow(zoomWind);
  154.     end;
  155.  
  156.  
  157.     procedure Idle;
  158.         var
  159.             i: Integer;
  160.             pt1: Point;
  161.             pt2: Point;
  162.             dstRect: Rect;
  163.     begin
  164.         SetPt(pt1, Rand(sizeX), Rand(sizeY));
  165.         SetPt(pt2, Rand(sizeX), Rand(sizeY));
  166.         Pt2Rect(pt1, pt2, dstRect);
  167.         SetWindClip(zoomWind);
  168.         ZoomRect(zSrcRect, dstRect);
  169.         ResetWindClip;
  170.         zSrcRect := dstRect;
  171.     end;
  172.  
  173.  
  174.     procedure ZoomWindInit;
  175.         var
  176.             i: Integer;
  177.             ignore: Boolean;
  178.     begin
  179.         if (SkelQuery(skelQHasColorQD) <> 0) then
  180.             zoomWind := GetNewCWindow(zoomWindRes, nil, WindowPtr(-1))
  181.         else
  182.             zoomWind := GetNewWindow(zoomWindRes, nil, WindowPtr(-1));
  183.         if (zoomWind = nil) then
  184.             exit(ZoomWindInit);
  185.         ignore := SkelWindow(zoomWind, @Mouse, nil, @Update, @Activate, nil, @Clobber, @Idle, false);
  186.         SetZoomSize;
  187.         BackPat(qd.black);
  188.         PenMode(patXor);
  189.         SetRect(zSrcRect, 0, 0, 0, 0);
  190.         for i := 0 to maxZoomStep do
  191.             zRect[i] := zSrcRect;
  192.     end;
  193.  
  194. end.