home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 June / MacFormat 25.iso / Shareware City / Developers / ICAppSourceKit1.0 / ICButtonWhat.p < prev    next >
Encoding:
Text File  |  1994-11-27  |  5.6 KB  |  234 lines  |  [TEXT/PJMM]
  1. unit ICButtonWhat;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ICWindowGlobals;
  7.  
  8.     function WhatOpenButton (wt: WindowType; item: integer): OSErr;
  9.     function WhatClickButton (wt: WindowType; item: integer; er: eventRecord): OSErr;
  10.  
  11. implementation
  12.  
  13.     uses
  14.         Traps, IconFamilies, ICStrH, OSSubs, 
  15.  
  16.         ICKeys, ICAPI, ICSubs, ICDialogs, ICMiscSubs, ICSubs, ICDocUtils, ICGlobals, ICWindowUtils;
  17.  
  18.     procedure HackDeviceLoop (drawingRgn: RgnHandle; drawingProc: DeviceLoopDrawingProcPtr; userData: LONGINT; flags: longint);
  19.     inline
  20.         $ABCA;
  21.  
  22.     procedure GetIconRect (dlg: DialogPtr; item: integer; var r: Rect);
  23.         var
  24.             width: integer;
  25.     begin
  26.         GetDItemRect(dlg, item, r);
  27.         width := r.right - r.left;
  28.         r.right := r.left + 32;
  29.         r.bottom := r.top + 32;
  30.         OffsetRect(r, (width - 32) div 2, 8);
  31.     end; (* GetIconRect *)
  32.  
  33.     var
  34.         button_highlighted: boolean;
  35.  
  36.     procedure ButtonDeviceLoopProc (depth: integer; deviceFlags: integer; targetDevice: GDHandle; item: longint);
  37.         var
  38.             dlg: DialogPtr;
  39.             r: Rect;
  40.             width: integer;
  41.             colour: RGBColor;
  42.             font_info: FontInfo;
  43.             boundary_rect: Rect;
  44.             icon_rect: Rect;
  45.     begin
  46.         GetPort(dlg);
  47.         PenNormal;
  48.         GetDItemRect(dlg, item, r);
  49.         if button_highlighted then begin
  50.             if depth = 1 then begin
  51.                 PaintRect(r);
  52.             end
  53.             else begin
  54.                 colour.red := lowrd(16000);     (* 8520 *)
  55.                 colour.green := lowrd(16000);
  56.                 colour.blue := lowrd(16000);
  57.                 RGBBackColor(colour);
  58.                 EraseRect(r);
  59.                 BackColor(whiteColor);
  60.             end; (* if *)
  61.         end
  62.         else begin
  63.             if depth = 1 then begin
  64.                 EraseRect(r);
  65.             end
  66.             else begin
  67.                 colour.red := lowrd(57015);
  68.                 colour.green := lowrd(57015);
  69.                 colour.blue := lowrd(57015);
  70.                 RGBBackColor(colour);
  71.                 EraseRect(r);
  72.                 BackColor(whiteColor);
  73.             end; (* if *)
  74.         end; (* if *)
  75.         FrameRect(r);
  76.         GetIconRect(dlg, item, icon_rect);
  77.         boundary_rect := icon_rect;
  78.         InsetRect(boundary_rect, -4, -4);
  79.         EraseRect(boundary_rect);
  80.         FrameRect(boundary_rect);
  81.         DrawIcon(200 + item, icon_rect, button_highlighted);
  82.         TextFont(applFont);
  83.         TextSize(9);
  84.         GetFontInfo(font_info);
  85.         width := StringWidth(GetAString(130, item));
  86.         MoveTo((r.left + (r.right - r.left) div 2) - (width div 2), r.bottom - 2 - font_info.descent);
  87.         if button_highlighted then begin
  88.             TextMode(srcBic);
  89.         end; (* if *)
  90.         DrawString(GetAString(130, item));
  91.         TextMode(srcOr);
  92.     end; (* ButtonDeviceLoopProc *)
  93.  
  94.     procedure DrawButton (dlg: DialogPtr; item: integer; highlighted: boolean);
  95.         var
  96.             r: Rect;
  97.             rgn: RgnHandle;
  98.     begin
  99.         button_highlighted := highlighted;
  100.         SetPort(dlg);
  101.         if TrapAvailable(_DeviceLoop) then begin
  102.             GetDItemRect(dlg, item, r);
  103.             rgn := NewRgn;
  104.             RectRgn(rgn, r);
  105.             HackDeviceLoop(rgn, @ButtonDeviceLoopProc, item, 0);
  106.             DisposeRgn(rgn);
  107.         end
  108.         else begin
  109.             ButtonDeviceLoopProc(1, 0, nil, item);
  110.         end; (* if *)
  111.     end; (* DrawButton *)
  112.  
  113.     procedure UserItemUpdate (dlg: DialogPtr; item: integer);
  114.     begin
  115.         DrawButton(dlg, item, false);
  116.     end; (* UserItemUpdate *)
  117.  
  118.     function WhatOpenButton (wt: WindowType; item: integer): OSErr;
  119.     begin
  120.         SetDItemHandle(windowinfo[wt].window, item, @UserItemUpdate);
  121.         WhatOpenButton := noErr;
  122.     end; (* WhatOpenButton *)
  123.  
  124.     function WhatClickButton (wt: WindowType; item: integer; er: eventRecord): OSErr;
  125.         var
  126.             dlg: DialogPtr;
  127.             highlighted: boolean;
  128.             junk: OSErr;
  129.             mouse_pos: Point;
  130.             r: Rect;
  131.  
  132.         procedure ToggleHighlight;
  133.         begin
  134.             highlighted := not highlighted;
  135.             DrawButton(dlg, item, highlighted);
  136.         end; (* ToggleHighlight *)
  137.  
  138.         var
  139.             err: OSErr;
  140.     begin
  141.         dlg := windowinfo[wt].window;
  142.         GetDItemRect(dlg, item, r);
  143.         highlighted := false;
  144.         repeat
  145.             GetMouse(mouse_pos);
  146.             if PtInRect(mouse_pos, r) <> highlighted then begin
  147.                 ToggleHighlight;
  148.             end; (* if *)
  149.         until not StillDown;
  150.         err := noErr;
  151.         if highlighted then begin
  152.             ToggleHighlight;
  153.             err := WindowsOpen(WindowType(ord(WT_Personal) + item - 1), 200 + item);
  154.         end; (* if *)
  155.         WhatClickButton := err;
  156.     end; (* WhatClickButton *)
  157.  
  158. end. (* ICButtonWhat *)
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165. function WhatClickButton (wt: WindowType; item: integer; er: eventRecord): OSErr;
  166.     const
  167.         HiliteMode = $938;
  168.     var
  169.         dlg: DialogPtr;
  170.         r: Rect;
  171.         highlighted: boolean;
  172.         suite: Handle;
  173.         junk: OSErr;
  174.         transfer: integer;
  175.         highlight_rgn: RgnHandle;
  176.         tmp_rgn: RgnHandle;
  177.         icon_rect: Rect;
  178.         mouse_pos: Point;
  179.  
  180.     procedure ToggleHighlight;
  181.     begin
  182.         highlighted := not highlighted;
  183.         if system7 then begin
  184.             if highlighted then begin
  185.                 transfer := ttSelected;
  186.             end
  187.             else begin
  188.                 transfer := ttNone;
  189.             end; (* if *)
  190.             junk := PlotIconSuite(icon_rect, atNone, transfer, suite);
  191.         end; (* if *)
  192.         if has_colorQD then begin
  193.             BitClr(Ptr(HiliteMode), pHiliteBit);
  194.         end; (* if *)
  195.         InvertRgn(highlight_rgn);
  196.     end; (* ToggleHighlight *)
  197.  
  198.     var
  199.         err: OSErr;
  200. begin
  201.     dlg := windowinfo[wt].window;
  202.     GetIconRect(dlg, item, icon_rect);
  203.     GetDItemRect(dlg, item, r);
  204.     suite := nil;
  205.     highlight_rgn := NewRgn;
  206.     InsetRect(r, 1, 1);
  207.     RectRgn(highlight_rgn, r);
  208.     if system7 then begin
  209.         junk := GetIconSuite(suite, 200 + item, svAllLargeData);
  210.         tmp_rgn := NewRgn;
  211.         junk := IconSuiteToRgn(tmp_rgn, icon_rect, atNone, suite);
  212.         XorRgn(tmp_rgn, highlight_rgn, highlight_rgn);
  213.         DisposeRgn(tmp_rgn);
  214.     end; (* if *)
  215.     highlighted := false;
  216.     while StillDown do begin
  217.         GetMouse(mouse_pos);
  218.         if PtInRect(mouse_pos, r) <> highlighted then begin
  219.             ToggleHighlight;
  220.         end; (* if *)
  221.     end; (* while *)
  222.     err := noErr;
  223.     if highlighted then begin
  224.         ToggleHighlight;
  225.         err := WindowsOpen(WindowType(ord(WT_Personal) + item - 1), 200 + item);
  226.     end; (* if *)
  227.     if suite <> nil then begin
  228.         junk := DisposeIconSuite(suite, false);
  229.     end; (* if *)
  230.     if highlight_rgn <> nil then begin
  231.         DisposeRgn(highlight_rgn);
  232.     end; (* if *)
  233.     WhatClickButton := err;
  234. end; (* WhatClickButton *)