home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / Marquee Pascal 1.0 / Marquee.p < prev    next >
Encoding:
Text File  |  1996-07-05  |  11.6 KB  |  371 lines  |  [TEXT/PJMM]
  1. {This program is based on Finder Marquee by Jordan Zimmerman.}
  2. {}
  3. {Using the techniques in the original C program, this program is }
  4. {done in Pascal.  It uses a linked lists for objects instead of}
  5. {an array, and a new function was added for adding objects (AddSquare).}
  6. {Some of the other data structures were also changed.}
  7. {}
  8. {This code implements a "rubber band" marquee select rect}
  9. {with very smooth drawing in a manner similar to the Mac Finder.}
  10. {    }
  11. {Project includes:}
  12. {}
  13. {Marquee.p  - Pascal source code}
  14. {Marquee.µ  - Codewarrior Pascal project file.}
  15. {    }
  16. {8/13/95 - Bill Catambay, catambay@aol.com}
  17.  
  18. {This version is modified by Ingemar R.}
  19. {- The program no longer messes with the font and size of the Window Mgr port.}
  20. {- Works with Think Pascal; added Marquee.π, the Think Pascal project file.}
  21. {- Changed routine names and some variable names to get closer to the standard.}
  22. {- The routine AddSquare disposed the memory it allocated, which could cause some}
  23. {rather violent crashes under Think Pascal. (I don't know why it worked with MWP -}
  24. {probably due to some differences in the way New is implemented.)}
  25.  
  26. program Marquee;
  27.  
  28. {$IFC UNDEFINED THINK_PASCAL}
  29.     uses
  30.         Types, Windows, Events, Fonts, Dialogs, TextUtils;
  31. {$ENDC}
  32.  
  33.     type
  34.         FinderMarqueeRec = record
  35.                 marquee_r: Rect;    { current marquee_r }
  36.                 pin_pt: Point;        { mouse down point }
  37.                 current_pt: Point;    { current mouse location }
  38.             end;
  39.         MarqueePtrType = ^FinderMarqueeRec;
  40.         HighlightPtr = ^HighlightRec;
  41.         HighlightRec = record
  42.                 bounds_r: Rect;
  43.                 selected_flag: boolean;
  44.                 next_rec: HighlightPtr;
  45.             end;
  46.  
  47.     var
  48.         bounds_r: Rect;
  49.         mainw: WindowPtr;
  50.         statusw: WindowPtr;
  51.         is_done: Boolean;
  52.         the_event: EventRecord;
  53.         menu: MenuHandle; {menuRef;}
  54.         font_num: Integer;
  55.         tab_ptr: HighlightPtr;
  56.  
  57.     function SelectionsProc (marquee_ptr: MarqueePtrType): boolean;
  58.         var
  59.             i, qty: Integer;
  60.             sect_r: Rect;
  61.             tmp: HighlightPtr;
  62.     begin
  63.         tmp := tab_ptr;
  64.         while tmp <> nil do
  65.             begin
  66.                 if SectRect(marquee_ptr^.marquee_r, tmp^.bounds_r, sect_r) <> tmp^.selected_flag then
  67.                     begin
  68.                         SelectionsProc := TRUE;
  69.                         exit(SelectionsProc);
  70.                     end;
  71.                 tmp := tmp^.next_rec;
  72.             end;
  73.         SelectionsProc := false;
  74.     end; {SelectionsProc}
  75.  
  76. { invert any of the highlight rects that intersect the current marquee rect }
  77.     procedure ChangeSelectionProc (marquee_ptr: MarqueePtrType; old_marquee_r: Rect);
  78.         var
  79.             i, qty: Integer;
  80.             tmp: HighlightPtr;
  81.             sect_r: Rect;
  82.     begin
  83.         tmp := tab_ptr;
  84.         while tmp <> nil do
  85.             begin
  86.                 if SectRect(marquee_ptr^.marquee_r, tmp^.bounds_r, sect_r) <> tmp^.selected_flag then
  87.                     begin
  88.                         tmp^.selected_flag := not tmp^.selected_flag;
  89.                         InvertRect(tmp^.bounds_r);
  90.                     end;
  91.                 tmp := tmp^.next_rec;
  92.             end;
  93.     end; {ChangeSelectionProc}
  94.  
  95.     function Num2Str (num: integer): string;
  96.         var
  97.             str: str255;
  98.     begin
  99.         NumToString(num, str);
  100.         Num2Str := str;
  101.     end; { of Num2Str }
  102.  
  103. { outline the marquee rect in Xor gray }
  104.     procedure DrawMarqueeR (marquee_ptr: MarqueePtrType);
  105.         var
  106.             pen_state: PenState;
  107.     begin
  108.         GetPenState(pen_state);
  109.         PenMode(patXor);
  110. {$IFC UNDEFINED THINK_PASCAL}
  111.         PenPat(qd.gray);
  112. {$ELSEC}
  113.         PenPat(gray);
  114. {$ENDC}
  115.         FrameRect(marquee_ptr^.marquee_r);
  116.         SetPenState(pen_state);
  117.     end; {DrawMarqueeR}
  118.  
  119. { calculating the marquee rect isn't as simple as Pt2Rect.  Using Pt2Rect }
  120. { causes the pin point to shift around.  This function will calculate a }
  121. { correct marquee rect that keeps the pin point in place  }
  122.     procedure CalculateMarqueeR (marquee_ptr: MarqueePtrType);
  123.     begin
  124.         if (marquee_ptr^.current_pt.h >= marquee_ptr^.pin_pt.h) & (marquee_ptr^.current_pt.v >= marquee_ptr^.pin_pt.v) then    { Quadrant IV }
  125.             SetRect(marquee_ptr^.marquee_r, marquee_ptr^.pin_pt.h, marquee_ptr^.pin_pt.v, marquee_ptr^.current_pt.h + 1, marquee_ptr^.current_pt.v + 1)
  126.         else if (marquee_ptr^.current_pt.h <= marquee_ptr^.pin_pt.h) & (marquee_ptr^.current_pt.v <= marquee_ptr^.pin_pt.v) then    { Quadrant I }
  127.             SetRect(marquee_ptr^.marquee_r, marquee_ptr^.current_pt.h, marquee_ptr^.current_pt.v, marquee_ptr^.pin_pt.h + 1, marquee_ptr^.pin_pt.v + 1)
  128.         else if (marquee_ptr^.current_pt.h >= marquee_ptr^.pin_pt.h) & (marquee_ptr^.current_pt.v <= marquee_ptr^.pin_pt.v) then    { Quadrant II }
  129.             SetRect(marquee_ptr^.marquee_r, marquee_ptr^.pin_pt.h, marquee_ptr^.current_pt.v, marquee_ptr^.current_pt.h + 1, marquee_ptr^.pin_pt.v + 1)
  130.         else { Quadrant III }
  131.             SetRect(marquee_ptr^.marquee_r, marquee_ptr^.current_pt.h, marquee_ptr^.pin_pt.v, marquee_ptr^.pin_pt.h + 1, marquee_ptr^.current_pt.v + 1);
  132.     end; {CalculateMarqueeR}
  133.  
  134.     procedure FinderMarqueeBegin (marquee_ptr: MarqueePtrType; mouse_down_pt: Point);
  135.         var
  136.             old_marquee_r: rect;
  137.     begin
  138.         marquee_ptr^.pin_pt := mouse_down_pt;
  139.         marquee_ptr^.current_pt := mouse_down_pt;
  140.         CalculateMarqueeR(marquee_ptr);
  141.         ChangeSelectionProc(marquee_ptr, marquee_ptr^.marquee_r);
  142.         DrawMarqueeR(marquee_ptr);
  143.     end; {FinderMarqueeBegin}
  144.  
  145. { utility to make a 1 pixel thick region of the frame outline of a rect }
  146.     procedure MakeFrameRegion (target_rgn_h: RgnHandle; frame_r: Rect; work_rgn_h: RgnHandle);
  147.     begin
  148.         RectRgn(target_rgn_h, frame_r);
  149.         CopyRgn(target_rgn_h, work_rgn_h);
  150.         InsetRgn(work_rgn_h, 1, 1);
  151.         DiffRgn(target_rgn_h, work_rgn_h, target_rgn_h);
  152.     end; {MakeFrameRegion}
  153.  
  154.     procedure FinderMarqueeContinue (marquee_ptr: MarqueePtrType; new_pt: Point);
  155.         var
  156.             pen_state: PenState;
  157.             old_marquee_r: Rect;
  158.             old_rgn_h: RgnHandle;
  159.             work_rgn_h: RgnHandle;
  160.             new_rgn_h: RgnHandle;
  161.             clip_rgn_h: RgnHandle;
  162.             success_flag: boolean;
  163.     begin
  164.         old_rgn_h := nil;
  165.         work_rgn_h := nil;
  166.         new_rgn_h := nil;
  167.         clip_rgn_h := nil;
  168.         success_flag := false;
  169.     { avoid flashing step 1 - do nothing if the mouse hasn't moved }
  170.         if EqualPt(new_pt, marquee_ptr^.current_pt) then
  171.             exit(FinderMarqueeContinue);
  172.         clip_rgn_h := NewRgn;
  173.         if clip_rgn_h = nil then
  174.             exit(FinderMarqueeContinue);    { can't find 10 bytes!  We're probably already in big trouble }
  175.     { we'll be messing with the clip, so save it for later restoration }
  176.         GetClip(clip_rgn_h);
  177.         GetPenState(pen_state);
  178.         PenMode(patXor);
  179. {$IFC UNDEFINED THINK_PASCAL}
  180.         PenPat(qd.gray);
  181. {$ELSEC}
  182.         PenPat(gray);
  183. {$ENDC}
  184.     { save the old marquee_r and setup the new one }
  185.         old_marquee_r := marquee_ptr^.marquee_r;
  186.         marquee_ptr^.current_pt := new_pt;
  187.         CalculateMarqueeR(marquee_ptr);
  188.         repeat
  189.             old_rgn_h := NewRgn;
  190.             if old_rgn_h = nil then
  191.                 Leave;
  192.             work_rgn_h := NewRgn;
  193.             if work_rgn_h = nil then
  194.                 Leave;
  195.             new_rgn_h := NewRgn;
  196.             if new_rgn_h = nil then
  197.                 Leave;
  198.         { generate 1 pixel thick outline regions of the old and new marquee_r }
  199.             MakeFrameRegion(old_rgn_h, old_marquee_r, work_rgn_h);
  200.             MakeFrameRegion(new_rgn_h, marquee_ptr^.marquee_r, work_rgn_h);
  201.         { get the area in common between the old and the new }
  202.             SectRgn(old_rgn_h, new_rgn_h, work_rgn_h);
  203.         { set the clip to the old clip minus the common area of the old and new marquee rect }
  204.             DiffRgn(clip_rgn_h, work_rgn_h, work_rgn_h);
  205.             SetClip(work_rgn_h);
  206.             if SelectionsProc(marquee_ptr) then
  207.                 begin
  208.             { If there is a selection, the old marquee must be erased, the selections must be drawn, }
  209.             { and then the new marquee can be drawn. }
  210.                     FrameRect(old_marquee_r);
  211.                     ChangeSelectionProc(marquee_ptr, old_marquee_r);
  212.                     FrameRect(marquee_ptr^.marquee_r);
  213.                 end
  214.             else
  215.                 begin
  216.             { If there's no selection change, the marquee can be drawn in one step }
  217.             { that will erase the old and draw the new. }
  218.                     UnionRgn(new_rgn_h, old_rgn_h, work_rgn_h);
  219.                     PaintRgn(work_rgn_h);
  220.                 end;
  221.             success_flag := true;
  222.         until success_flag;    { i.e. do once, set success_flag on exit }
  223.         if not success_flag then
  224.             begin
  225.         { memory is evidently very tight, we'll have to live with flashing }
  226.                 FrameRect(old_marquee_r);
  227.                 ChangeSelectionProc(marquee_ptr, old_marquee_r);
  228.                 FrameRect(marquee_ptr^.marquee_r);
  229.             end;
  230.         SetClip(clip_rgn_h);
  231.         SetPenState(pen_state);
  232.         if old_rgn_h <> nil then
  233.             DisposeRgn(old_rgn_h);
  234.         if work_rgn_h <> nil then
  235.             DisposeRgn(work_rgn_h);
  236.         if new_rgn_h <> nil then
  237.             DisposeRgn(new_rgn_h);
  238.         if clip_rgn_h <> nil then
  239.             DisposeRgn(clip_rgn_h);
  240.         SetPort(statusw);
  241.         EraseRect(statusw^.portRect);
  242.         with statusw^.portRect do
  243.             MoveTo(left + 5, top + 10);
  244.         TextSize(9);
  245.         TextFont(font_num);
  246.         with marquee_ptr^.marquee_r do
  247.             DrawString(concat('Size: ', Num2Str(bottom - top), ', ', Num2Str(right - left)));
  248.         with statusw^.portRect do
  249.             MoveTo(left + 5, top + 24);
  250.         DrawString(concat('Mouse: ', Num2Str(new_pt.h), ', ', Num2Str(new_pt.v)));
  251.         SetPort(mainw);
  252.     end; {FinderMarqueeContinue}
  253.  
  254. { here's the meat of the program }
  255. { while this example does it all in one function, }
  256. { you could just as easily separate the various calls and do it in the background }
  257.     procedure DoMarquee (local_pt: Point);
  258.         var
  259.             marquee: FinderMarqueeRec;
  260.             new_pt: Point;
  261.     begin
  262.         FinderMarqueeBegin(@marquee, local_pt);
  263.         while StillDown do
  264.             with marquee.marquee_r do
  265.                 begin
  266.                     GetMouse(new_pt);
  267.                     FinderMarqueeContinue(@marquee, new_pt);
  268.                 end;
  269.         DrawMarqueeR(@marquee);
  270.     end; {DoMarquee}
  271.  
  272. { walk through our highlight rects and see if any of the selections will change. }
  273. { the marquee drawing must work slightly differently if there's going to be }
  274. { a selection change. }
  275. { If there's no selection change, the marquee can be drawn in one step (PaintRgn) }
  276. { that will erase the old and draw the new.  If there is a selection, though, the }
  277. { old marquee must be erased, the selections must be drawn, and then the new marquee }
  278. { can be drawn. }
  279. { draw in response to an update event }
  280.     procedure DrawHighlights;
  281.         var
  282.             i, qty: integer;
  283.             tmp: HighlightPtr;
  284.     begin
  285.         EraseRect(mainw^.portRect);
  286.         tmp := tab_ptr;
  287.         while tmp <> nil do
  288.             begin
  289.                 FrameRect(tmp^.bounds_r);
  290.                 if tmp^.selected_flag then
  291.                     InvertRect(tmp^.bounds_r);
  292.                 tmp := tmp^.next_rec;
  293.             end;
  294.     end; {DrawHighlights}
  295.  
  296.     procedure AddSquare (left, top, right, bottom: integer);
  297.         var
  298.             tmp: HighlightPtr;
  299.     begin
  300. {new(tmp); <- Questionable - you shouldn't mix "New" and "DisposePtr", right?}
  301.         tmp := HighlightPtr(NewPtr(SizeOf(HighlightRec)));
  302.         SetRect(tmp^.bounds_r, left, top, right, bottom);
  303.         tmp^.selected_flag := false;
  304.         tmp^.next_rec := tab_ptr;
  305.         tab_ptr := tmp;
  306. {DisposePtr(pointer(tmp)); <- serious bug in old version}
  307.     end; {AddSquare}
  308.  
  309. (* Standard inits *)
  310.     procedure InitToolbox;
  311.     begin
  312. {$IFC UNDEFINED THINK_PASCAL}
  313.         MaxApplZone;
  314.         InitGraf(@qd.thePort);
  315.         InitFonts;
  316.         FlushEvents(everyEvent, 0);
  317.         InitWindows;
  318.         InitMenus;
  319.         TEInit;
  320.         InitDialogs(nil);
  321. {$ENDC}
  322.         InitCursor;
  323.     end; {InitToolbox}
  324.  
  325.  
  326. begin
  327.     InitToolbox;
  328.     is_done := false;
  329.  
  330. {In the previous version, the program did the following to set font}
  331. {and size. NEVER mess with the window mgr port like this! You just}
  332. {mess up the menus and window titles in all programs, forcing the}
  333. {user to reboot to get back to normal.}
  334. {textsize(9);}
  335.     GetFNum('Monaco', font_num);
  336. {textfont(font_num);}
  337.  
  338.     tab_ptr := nil;
  339.     AddSquare(10, 10, 42, 42);
  340.     AddSquare(50, 75, 82, 107);
  341.     AddSquare(100, 10, 132, 42);
  342.     AddSquare(110, 200, 142, 232);
  343.     AddSquare(308, 308, 340, 340);
  344.     menu := NewMenu(1, 'Finder Marquee');
  345.     InsertMenu(menu, 0);
  346.     DrawMenuBar;
  347.     SetRect(bounds_r, 50, 50, 400, 400);
  348.     mainw := NewCWindow(nil, bounds_r, 'Press Any Key To Quit', true, noGrowDocProc, WindowPtr(-1), false, 0);
  349.     SetRect(bounds_r, 100, 410, 200, 450);
  350.     statusw := NewCWindow(nil, bounds_r, '', true, plaindbox, nil, false, 0);
  351.     SetPort(mainw);
  352.     while not is_done do
  353.         if WaitNextEvent(everyEvent, the_event, GetDblTime, nil) then
  354.             case the_event.what of
  355.                 keyDown, autoKey: 
  356.                     is_done := true;
  357.                 updateEvt: 
  358.                     begin
  359.                         BeginUpdate(mainw);
  360.                         DrawHighlights;
  361.                         EndUpdate(mainw);
  362.                     end;
  363.                 mouseDown: 
  364.                     begin
  365.                         GlobalToLocal(the_event.where);
  366.                         DoMarquee(the_event.where);
  367.                     end;
  368.         {CASE}
  369.             end;
  370. end.
  371.