home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / macintosh-pascal / macintoshp-1.2-demos.sit.hqx / chap23pascal_demo / chap19pascal_demoPPC / CDEFsPascalPPC / CDEF1PascalPPC.p next >
Text File  |  1997-01-21  |  10KB  |  364 lines
  1. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
  2. // CDEF1PascalPPC.p           Custom control definition function for radio button control
  3. // ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
  4. //
  5. // This CDEF displays:
  6. //
  7. // •    3D coloured radio buttons on colour displays set to pixel depths greater than 2.
  8. //
  9. // •    Black-and-white buttons on colour displays set to pixel depths less than 4.
  10. //
  11. // •    Black-and-white radio buttons if Color QuickDraw is not present.
  12. //
  13. // This CDEF utilises six 'cicn' resources (purgeable).  The bitmap component, as opposed
  14. // to the pixel map component, of each of these resources is automatically utilised if 
  15. // the icon is being displayed on a colour device for which the pixel depth has been set
  16. // to 1 or 2.  The appearance of the coloured radio buttons conforms to the specification
  17. // for radio button controls contained in the document Apple Grayscale Appearance for
  18. // System 7.5 published by Apple Computer Inc.
  19. //
  20. // ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }
  21.  
  22. unit CDEF1Pascal;
  23.  
  24.  
  25.  
  26. { ……………………………………………………………………………………………………………………………………………………………………… unit interface section }
  27.  
  28. interface
  29.  
  30. { ………………………………………………………………………………………………………………… include the following Universal Interfaces }
  31.  
  32. uses
  33.  
  34.     Controls, Fonts, Menus, Quickdraw, QuickdrawText, Processes, Types, Icons,
  35.     Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, QDOffscreen, SegLoad, Retrace, 
  36.     Traps, GestaltEqu, LowMem;
  37.  
  38. { ………………………………………………………………………………………………………………………………………………… define the following constants }
  39.  
  40. const
  41.  
  42. rActiveDeselect = 128;
  43. rActiveSelect = 129;
  44. rInactiveDeselect = 130;
  45. rInactiveSelect = 131;
  46. rFeedbackDeselect = 132;
  47. rFeedbackSelect = 133;
  48. partCode = 1;
  49.  
  50. { ………………………………………………………………………………………………………………………………………… procedure and function interfaces }
  51.  
  52.     {$MAIN}
  53.     function main(varCode : integer; controlHdl : ControlHandle; message : integer; 
  54.             param : longint) : longint;
  55.  
  56.  
  57.  
  58. { ………………………………………………………………………………………………………………………………………………………… unit implementation section }
  59.  
  60. implementation
  61.  
  62. { ……………………………………………………………………………………………………………………………………………………………………………………… global variables }
  63.  
  64. var
  65.  
  66. gTheQDGlobalsPtr : QDGlobalsPtr;
  67. gColorQuickDrawPresent : boolean;
  68. gColorDisplay : boolean;
  69. gActiveDeselectHdl : CIconHandle;
  70. gActiveSelectHdl : CIconHandle;
  71. gInactiveDeselectHdl : CIconHandle;
  72. gInactiveSelectHdl : CIconHandle;
  73. gFeedbackDeselectHdl : CIconHandle;
  74. gFeedbackSelectHdl : CIconHandle;
  75.  
  76. { ………………………………………………………………………………………………………………………………………… procedure and function interfaces }
  77.  
  78.     procedure DoInitMessage; forward;
  79.     procedure DoDrawMessage(controlHdl : ControlHandle); forward;
  80.     procedure DrawColour(controlHdl : ControlHandle; controlValue : integer; 
  81.                 controlRect : Rect); forward;
  82.     procedure DrawMono(controlHdl : ControlHandle; controlValue : integer;
  83.                 controlRect : Rect); forward;
  84.     function  DoTestMessage(controlHdl : ControlHandle; 
  85.                 param : longint) : longint; forward;
  86.  
  87. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ main }
  88.  
  89. function main(varCode : integer; controlHdl : ControlHandle; message : integer; 
  90.                                                             param : longint) : longint;
  91.  
  92.     var
  93.     returnValue : longint;
  94.     {$IFC GENERATING68k}                                                     { For PowerPC }
  95.     oldA4, ignored : longint;
  96.     {$ENDC}                                                                  { For PowerPC }
  97.  
  98.     begin
  99.     {$IFC GENERATING68K }                                                    { For PowerPC }
  100.     oldA4 := SetCurrentA4;
  101.     {$ENDC}                                                                  { For PowerPC }
  102.     
  103.     case (message) of
  104.  
  105.         initCntl: begin
  106.             DoInitMessage;
  107.             end;
  108.  
  109.         drawCntl: begin
  110.             if (controlHdl^^.contrlVis <> 0) then
  111.                 DoDrawMessage(controlHdl);
  112.             returnValue := 0;
  113.             end;
  114.  
  115.         testCntl: begin
  116.             returnValue := DoTestMessage(controlHdl, param);
  117.             end;
  118.             
  119.         otherwise begin
  120.             returnValue := 0;
  121.             end;
  122.         end;
  123.             {of case statement}
  124.  
  125.     main := returnValue;
  126.     {$IFC GENERATING68K }                                                    { For PowerPC }
  127.     ignored := SetA4(oldA4);
  128.     {$ENDC}                                                                  { For PowerPC }
  129.     end;
  130.         {of main procedure}
  131.  
  132. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitMessage }
  133.  
  134. procedure DoInitMessage;
  135.  
  136.     var
  137.     theErr : OSErr;
  138.     response : longint;
  139.     
  140.     begin
  141.     
  142.     gTheQDGlobalsPtr := 
  143.         QDGlobalsPtr(longint(Ptr(SetCurrentA5)) - (sizeof(QDGlobals) - sizeof(GrafPtr)));
  144.         
  145.     theErr := Gestalt(gestaltQuickdrawVersion, response);
  146.     
  147.     if (response >= gestalt8BitQD) then
  148.         gColorQuickDrawPresent := true
  149.     else
  150.         gColorQuickDrawPresent := false;
  151.  
  152.     gColorDisplay := false;
  153.     gActiveDeselectHdl := nil;
  154.     gActiveSelectHdl := nil;
  155.     gInactiveDeselectHdl := nil;
  156.     gInactiveSelectHdl := nil;
  157.     gFeedbackDeselectHdl := nil;
  158.     gFeedbackSelectHdl := nil;
  159.     end;
  160.         {of procedure DoInitMessage}
  161.  
  162. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawMessage }
  163.  
  164. procedure DoDrawMessage(controlHdl : ControlHandle);
  165.  
  166.     var
  167.     theWindowPtr : WindowPtr;
  168.     oldPort : GrafPtr;
  169.     oldFont, oldSize, oldTextMode, controlValue, fontNum : integer;
  170.     oldPenState : PenState;
  171.     controlRect : Rect;
  172.     mainDeviceHdl : GDHandle;
  173.     bitsPerPixel : integer;
  174.         
  175.     begin
  176.     theWindowPtr := WindowPtr(controlHdl^^.contrlOwner);
  177.     
  178.     GetPort(oldPort);
  179.     oldFont := theWindowPtr^.txFont;
  180.     oldSize := theWindowPtr^.txSize;
  181.     oldTextMode := theWindowPtr^.txMode;
  182.     GetPenState(oldPenState);
  183.     
  184.     SetPort(theWindowPtr);
  185.  
  186.     controlValue := GetControlValue(controlHdl);
  187.  
  188.     controlRect := controlHdl^^.contrlRect;
  189.     controlRect.right := controlRect.left + 12;
  190.     controlRect.bottom := controlRect.top + 12;
  191.  
  192.     GetFNum('Chicago', fontNum);
  193.     TextFont(fontNum);
  194.     TextSize(12);
  195.  
  196.     if (gColorQuickDrawPresent) then
  197.         begin
  198.         if (gActiveDeselectHdl = nil) then
  199.             gActiveDeselectHdl := GetCIcon(rActiveDeselect);
  200.         if (gActiveSelectHdl = nil) then
  201.             gActiveSelectHdl := GetCIcon(rActiveSelect);
  202.         if (gInactiveDeselectHdl = nil) then
  203.             gInactiveDeselectHdl := GetCIcon(rInactiveDeselect);
  204.         if (gInactiveSelectHdl = nil) then
  205.             gInactiveSelectHdl := GetCIcon(rInactiveSelect);
  206.         if (gFeedbackDeselectHdl = nil) then
  207.             gFeedbackDeselectHdl := GetCIcon(rFeedbackDeselect);
  208.         if (gFeedbackSelectHdl = nil) then
  209.             gFeedbackSelectHdl := GetCIcon(rFeedbackSelect);
  210.         end;
  211.     
  212.     mainDeviceHdl := LMGetMainDevice;
  213.     bitsPerPixel := mainDeviceHdl^^.gdPMap^^.pixelSize;
  214.     if (bitsPerPixel > 1) then
  215.         gColorDisplay := true
  216.     else
  217.         gColorDisplay := false;
  218.     
  219.     if (gColorQuickDrawPresent and gColorDisplay) then
  220.         DrawColour(controlHdl, controlValue, controlRect)
  221.     else
  222.         DrawMono(controlHdl, controlValue, controlRect);
  223.  
  224.     SetPenState(oldPenState);
  225.     TextMode(oldTextMode);
  226.     TextFont(oldFont);
  227.     TextSize(oldSize);
  228.     SetPort(oldPort);
  229.     end;
  230.         {of procedure DoDrawMessage}
  231.  
  232. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawColour }
  233.  
  234. procedure DrawColour(controlHdl : ControlHandle; controlValue : integer; 
  235.                                                     controlRect : Rect);
  236.  
  237.     var
  238.     oldForeColour : RGBColor;
  239.     blackColour : RGBColor;
  240.     gray8 : RGBColor;
  241.         
  242.     begin
  243.     blackColour.red := $0000;
  244.     blackColour.green := $0000;
  245.     blackColour.blue := $0000;
  246.     gray8.red := $7777;    
  247.     gray8.green := $7777;    
  248.     gray8.blue := $7777;
  249.     
  250.     GetForeColor(oldForeColour);
  251.     
  252.     if (controlHdl^^.contrlHilite = 255) then
  253.         begin
  254.         if (gColorDisplay) then
  255.             RGBForeColor(gray8)
  256.         else
  257.             TextMode(grayishTextOr);
  258.  
  259.         if (controlValue = 1) then
  260.             PlotCIcon(controlRect, gInactiveSelectHdl)
  261.         else
  262.             PlotCIcon(controlRect, gInactiveDeselectHdl);
  263.         end
  264.     else if (controlHdl^^.contrlHilite = 0) then
  265.         begin
  266.         RGBForeColor(blackColour);
  267.         TextMode(srcOr);
  268.         
  269.         if (controlValue = 1) then
  270.             PlotCIcon(controlRect, gActiveSelectHdl)
  271.         else
  272.             PlotCIcon(controlRect, gActiveDeselectHdl);
  273.         end
  274.     else if (controlHdl^^.contrlHilite = partCode) then
  275.         begin
  276.         if (controlValue = 1) then
  277.             PlotCIcon(controlRect, gFeedbackSelectHdl)
  278.         else
  279.             PlotCIcon(controlRect, gFeedbackDeselectHdl);
  280.         end;
  281.  
  282.     MoveTo(controlRect.left + 17, controlRect.top + 10);
  283.     DrawString(controlHdl^^.contrlTitle);
  284.  
  285.     RGBForeColor(oldForeColour);
  286.     end;
  287.         {of procedure DrawColour}
  288.  
  289. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawMono }
  290.  
  291. procedure DrawMono(controlHdl : ControlHandle; controlValue : integer; controlRect : Rect);
  292.  
  293.     begin
  294.     ForeColor(blackColor);
  295.     BackColor(whiteColor);
  296.     
  297.     PenNormal;
  298.                 
  299.     if ((controlHdl^^.contrlHilite = 255) or (controlHdl^^.contrlHilite = 0)) then
  300.         begin
  301.         if (controlHdl^^.contrlHilite = 255) then
  302.             begin
  303.             PenPat(gTheQDGlobalsPtr^.gray);
  304.             TextMode(grayishTextOr);
  305.             end
  306.         else begin
  307.             PenPat(gTheQDGlobalsPtr^.black);
  308.             TextMode(srcOr);
  309.             end;
  310.  
  311.         FrameOval(controlRect);
  312.  
  313.         InsetRect(controlRect, 1, 1);
  314.         FillOval(controlRect, gTheQDGlobalsPtr^.white);
  315.         InsetRect(controlRect, -1, -1);
  316.  
  317.         if (controlValue = 1) then
  318.             begin
  319.             InsetRect(controlRect, 3, 3);
  320.             if (controlHdl^^.contrlHilite = 255) then
  321.                 FillOval(controlRect, gTheQDGlobalsPtr^.gray)
  322.             else
  323.                 FillOval(controlRect, gTheQDGlobalsPtr^.black);
  324.             InsetRect(controlRect, -3, -3);
  325.             end;
  326.         end        
  327.     else if (controlHdl^^.contrlHilite = partCode) then
  328.         begin
  329.         InsetRect(controlRect, 1, 1);
  330.         FrameOval(controlRect);
  331.         InsetRect(controlRect, -1, -1);
  332.         end;
  333.  
  334.     MoveTo(controlRect.left + 17, controlRect.top + 10);
  335.     DrawString(controlHdl^^.contrlTitle);
  336.     end;
  337.         {of procedure DrawMono}
  338.  
  339. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoTestMessage }
  340.  
  341. function DoTestMessage(controlHdl : ControlHandle; param : longint) : longint;
  342.  
  343.     var
  344.     controlRect : Rect;
  345.     mouseXY : Point;
  346.  
  347.     begin
  348.     controlRect := controlHdl^^.contrlRect;
  349.  
  350.     mouseXY.v := HiWord(param);
  351.     mouseXY.h := LoWord(param);
  352.     
  353.     if (PtInRect(mouseXY, controlRect)) then
  354.         DoTestMessage := partCode
  355.     else
  356.         DoTestMessage := 0;
  357.     
  358.     end;
  359.         {of function DoTestMessage}
  360.  
  361. end.
  362.     {of unit CDEF1Pascal}    
  363.     
  364. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }