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 / CDEF2PascalPPC.p < prev    next >
Text File  |  1997-01-21  |  24KB  |  770 lines
  1. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
  2. // CDEF2PascalPPC.p                 Custom control definition function for slider control
  3. // ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
  4. //
  5. // This CDEF displays:
  6. //
  7. // •   A 3D coloured slider control on colour displays set to pixel depths greater than 1.
  8. //
  9. // •   A black-and-white slider control on colour displays set to pixel depths less than
  10. //       2.
  11. //
  12. // •   A black-and-white slider control if Color QuickDraw is not present.
  13. //
  14. // The CDEF utilises two 'PICT' resources (purgeable).  One resource contains the colour
  15. // version of the slider control components.  The other comprises the black and white 
  16. // version.  The appearance of the coloured slider conforms to the specification for
  17. // slider controls contained in the document Apple Greyscale Appearance for System 7.5
  18. // published by Apple Computer Inc.  
  19. //
  20. // ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }
  21.  
  22. unit CDEF2Pascal;
  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, Processes, Types, 
  35.     Memory, Events, ToolUtils, OSUtils, Devices, QDOffscreen, SegLoad, Retrace, 
  36.     Traps, GestaltEqu, LowMem;
  37.  
  38. { ………………………………………………………………………………………………………………………………………… procedure and function interfaces }
  39.  
  40.     {$MAIN}
  41.     function main(varCode : integer; theControl : ControlHandle; message : integer;
  42.                 param : longint) : longint;
  43.  
  44.  
  45.  
  46. { ………………………………………………………………………………………………………………………………………………………… unit implementation section }
  47.  
  48. implementation
  49.  
  50. { ………………………………………………………………………………………………………………………………………………… define the following constants }
  51.  
  52. const
  53.  
  54. kInactive = 255;
  55. kIndicatorHeight = 16;
  56. rTrackPict = 128;
  57.  
  58. { ………………………………………………………………………………………………………………………………………………………………………………… user-defined types }
  59.  
  60. type
  61.  
  62. VBLRec = record
  63.     vblTaskRec : VBLTask;
  64.     inVBlankPeriod : boolean;
  65.     thisApplicationsA5 : longint;
  66.     end;
  67. VBLRecPtr = ^VBLRec;
  68.  
  69. SliderDataRec = record
  70.     offScreenPort : GWorldPtr;
  71.     offScreenPortRect : Rect;
  72.     trackActiveRect : Rect;
  73.     trackInactiveRect : Rect;
  74.     indicatorActiveRect : Rect;
  75.     indicatorPressedRect : Rect;
  76.     indicatorInactiveRect : Rect;
  77.     compositeRect : Rect;
  78.     currentPort : GWorldPtr;
  79.     currentDevice : GDHandle;
  80.     ColorQuickDrawPresent : boolean;
  81.     mainSlotNumber : integer;
  82.     slotVInstallPresent : boolean;
  83.     dragMessageFlag : boolean;
  84.     VBLInstallFail : boolean;
  85.     end;
  86. SliderDataPtr = ^SliderDataRec;
  87. SliderDataHdl = ^SliderDataPtr;
  88.  
  89. { ……………………………………………………………………………………………………………………………………………………………………………………… global variables }
  90.  
  91. var
  92.  
  93. theVBLTaskRD : VBLUPP;                                                     { For PowerPC }
  94. gVBLRec : VBLRec;                                                          { For PowerPC }
  95.  
  96. { …………………………………………………………………………………………………………………………………………………………… in-line glue for GetVBLRec }
  97.  
  98. {$IFC GENERATING68k}                                                       { For PowerPC }
  99. function GetVBLRec : longint;
  100.     {$IFC NOT GENERATINGCFM}
  101.     inline $2E88;
  102.     {$ENDC}
  103. {$ENDC}                                                                    { For PowerPC }
  104.  
  105. { ………………………………………………………………………………………………………………………………………… procedure and function interfaces }
  106.  
  107.     procedure DoInitMessage(theControl : ControlHandle); forward;
  108.     procedure DoDrawMessage(theControl : ControlHandle); forward;
  109.     function  DoTestMessage(theControl : ControlHandle; 
  110.                 param : longint) : longint; forward;
  111.     function  DoDragMessage(theControl : ControlHandle) : longint; forward;
  112.     procedure DoDisposeMessage(theControl : ControlHandle); forward;
  113.     procedure CreateOffScreenGWorld(theControl : ControlHandle); forward;
  114.     procedure PixelDepthCheck(theControl : ControlHandle); forward;
  115.     procedure DrawControlActive(theControl : ControlHandle); forward;
  116.     procedure DrawControlInactive(theControl : ControlHandle); forward;
  117.     function  CalcIndicatorRect(theControl : ControlHandle) : Rect; forward;
  118.     function  InstallVBLTask(theControl : ControlHandle) : OSErr; forward;
  119.     procedure RemoveVBLTask(theControl : ControlHandle); forward;
  120.     procedure TheVBLTask; forward;
  121.     function  CheckSlotVInstallAvailable : boolean; forward;
  122.     function  CheckTrapAvailable(theTrap : integer) : boolean; forward;
  123.  
  124. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ main }
  125.  
  126. function main(varCode : integer; theControl : ControlHandle; message : integer;
  127.                                                             param : longint) : longint;
  128.  
  129.     var
  130.     oldPenState : PenState;
  131.     returnValue : longint;
  132.     {$IFC GENERATING68k}                                                   { For PowerPC }
  133.     oldA4, ignored : longint;
  134.     {$ENDC}                                                                { For PowerPC }
  135.     
  136.     begin
  137.  
  138.     {$IFC GENERATING68k}                                                   { For PowerPC }
  139.     oldA4 := SetCurrentA4;
  140.     {$ENDC}                                                                { For PowerPC }
  141.     
  142.     GetPenState(oldPenState);
  143.  
  144.     case (message) of
  145.  
  146.         initCntl: begin
  147.             DoInitMessage(theControl);
  148.             returnValue := 0;
  149.             end;
  150.  
  151.         drawCntl: begin
  152.             if (theControl^^.contrlVis <> 0) then
  153.                 DoDrawMessage(theControl);
  154.             returnValue := 0;
  155.             end;
  156.  
  157.         testCntl: begin
  158.             returnValue := DoTestMessage(theControl, param);
  159.             end;
  160.  
  161.         dragCntl: begin
  162.             returnValue := DoDragMessage(theControl);
  163.             end;
  164.  
  165.         dispCntl: begin
  166.             DoDisposeMessage(theControl);
  167.             returnValue := 0;
  168.             end;
  169.  
  170.         otherwise begin
  171.             returnValue := 0;
  172.             end;
  173.         end;
  174.             {of case statement}
  175.  
  176.     SetPenState(oldPenState);
  177.  
  178.     main := returnValue;
  179.     {$IFC GENERATING68k}                                                   { For PowerPC }
  180.     ignored := SetA4(oldA4);
  181.     {$ENDC}                                                                { For PowerPC }
  182.     end;
  183.         {of main procedure}
  184.  
  185. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitMessage }
  186.  
  187. procedure DoInitMessage(theControl : ControlHandle);
  188.  
  189.     var
  190.     theErr : OSErr;
  191.     response : longint;
  192.     mainDeviceHdl : GDHandle;
  193.     mainDeviceRefNum : integer;
  194.     deviceCtlEntryHdl : DCtlHandle;
  195.     theSliderDataHdl : SliderDataHdl;
  196.     
  197.     begin
  198.     theVBLTaskRD := NewVBLProc(ProcPtr(@TheVBLTask));                      { For PowerPC }
  199.  
  200.     theControl^^.contrlData := NewHandleClear(sizeof(SliderDataRec));
  201.     
  202.     if (theControl^^.contrlData <> nil) then
  203.         begin
  204.         theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  205.         theSliderDataHdl^^.ColorQuickDrawPresent := true;
  206.         theSliderDataHdl^^.dragMessageFlag := false;
  207.         theSliderDataHdl^^.VBLInstallFail := true;
  208.     
  209.         theErr := Gestalt(gestaltQuickdrawVersion, response);
  210.         if (response < gestalt8BitQD) then
  211.             theSliderDataHdl^^.ColorQuickDrawPresent := false;
  212.         
  213.         HLock(Handle(theControl));
  214.         
  215.         CreateOffScreenGWorld(theControl);
  216.  
  217.         HUnlock(Handle(theControl));
  218.     
  219.         theSliderDataHdl^^.slotVInstallPresent := CheckSlotVInstallAvailable;
  220.         if (theSliderDataHdl^^.slotVInstallPresent) then
  221.             begin
  222.             mainDeviceHdl := LMGetMainDevice;
  223.             mainDeviceRefNum := mainDeviceHdl^^.gdRefNum;
  224.             deviceCtlEntryHdl := GetDCtlEntry(mainDeviceRefNum);
  225.             theSliderDataHdl^^.mainSlotNumber := 
  226.                         integer(AuxDCEHandle(deviceCtlEntryHdl)^^.dCtlSlot);
  227.             end;
  228.         end;
  229.     end;
  230.         {of procedure DoInitMessage}
  231.  
  232. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawMessage }
  233.  
  234. procedure DoDrawMessage(theControl : ControlHandle);
  235.  
  236.     begin
  237.     if (SliderDataHdl(theControl^^.contrlData)^^.ColorQuickDrawPresent) then
  238.         PixelDepthCheck(theControl);
  239.  
  240.     if (theControl^^.contrlHilite = kInactive) then
  241.         DrawControlInactive(theControl)
  242.     else
  243.         DrawControlActive(theControl);
  244.     end;
  245.         {of procedure DoInitMessage}
  246.  
  247. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoTestMessage }
  248.  
  249. function DoTestMessage(theControl : ControlHandle; param : longint) : longint;
  250.  
  251.     var
  252.     indicatorRect : Rect;
  253.     mouseXY : Point;
  254.     theSliderDataHdl : SliderDataHdl;
  255.  
  256.     begin
  257.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  258.     indicatorRect := CalcIndicatorRect(theControl);
  259.  
  260.     mouseXY.v := HiWord(param);
  261.     mouseXY.h := LoWord(param);
  262.     
  263.     if (PtInRect(mouseXY, indicatorRect)) then
  264.         begin
  265.         theSliderDataHdl^^.dragMessageFlag := true;
  266.         DrawControlActive(theControl);
  267.         theSliderDataHdl^^.dragMessageFlag := false;
  268.         DoTestMessage := kControlIndicatorPart;
  269.         end
  270.     else DoTestMessage := 0;
  271.     
  272.     end;
  273.         {of procedure DoInitMessage}
  274.  
  275. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDragMessage }
  276.  
  277. function DoDragMessage(theControl : ControlHandle) : longint;
  278.  
  279.     var
  280.     indicatorRect, slopRect, trackRect : Rect;
  281.     indicatorHeight, indicatorHalfHeight, indicatorCentre, trackHeight : integer;
  282.     startMouseXY, currentMouseXY : Point;
  283.     controlValueRange, differenceMouseY : integer;
  284.     ratio : longreal;
  285.     myWindowPtr : WindowPtr;
  286.     theErr : OSErr;
  287.     theSliderDataHdl : SliderDataHdl;
  288.  
  289.     begin
  290.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  291.     theSliderDataHdl^^.dragMessageFlag := true;
  292.  
  293.     HLock(Handle(theControl));
  294.  
  295.     indicatorHeight := kIndicatorHeight;
  296.     indicatorHalfHeight := indicatorHeight div 2;
  297.  
  298.     trackRect := theControl^^.contrlRect;
  299.     InsetRect(trackRect, 0, indicatorHalfHeight + 4);
  300.     trackRect.bottom := trackRect.bottom + 1;
  301.     trackHeight := trackRect.bottom - trackRect.top;
  302.  
  303.     controlValueRange := theControl^^.contrlMax - theControl^^.contrlMin;
  304.     ratio := longreal(controlValueRange / trackHeight);
  305.  
  306.     myWindowPtr := theControl^^.contrlOwner;
  307.     slopRect := myWindowPtr^.portRect;
  308.  
  309.     theErr := InstallVBLTask(theControl);
  310.     if (theErr = noErr) then
  311.         theSliderDataHdl^^.VBLInstallFail := false
  312.     else
  313.         theSliderDataHdl^^.VBLInstallFail := true;
  314.     
  315.     indicatorRect := CalcIndicatorRect(theControl);
  316.  
  317.     GetMouse(startMouseXY);
  318.  
  319.     while (StillDown) do
  320.         begin
  321.         GetMouse(currentMouseXY);
  322.         differenceMouseY := startMouseXY.v - currentMouseXY.v;
  323.  
  324.         if ((differenceMouseY <> 0) and (PtInRect(currentMouseXY, slopRect))) then
  325.             begin
  326.             indicatorRect.top := indicatorRect.top - differenceMouseY;
  327.             indicatorRect.bottom := indicatorRect.bottom - differenceMouseY;
  328.  
  329.             indicatorCentre := indicatorRect.top + indicatorHalfHeight;
  330.  
  331.             theControl^^.contrlValue := longint(trunc((trackRect.bottom 
  332.                                                     - indicatorCentre) * ratio));
  333.  
  334.             if (theControl^^.contrlValue > theControl^^.contrlMax) then
  335.                 theControl^^.contrlValue := theControl^^.contrlMax;
  336.             if (theControl^^.contrlValue < theControl^^.contrlMin) then
  337.                 theControl^^.contrlValue := theControl^^.contrlMin;
  338.  
  339.             DrawControlActive(theControl);
  340.  
  341.             startMouseXY := currentMouseXY;
  342.             end;
  343.         end;
  344.     
  345.     if not (theSliderDataHdl^^.VBLInstallFail) then
  346.         RemoveVBLTask(theControl);
  347.  
  348.     theSliderDataHdl^^.dragMessageFlag := false;
  349.     DrawControlActive(theControl);
  350.  
  351.     HUnlock(Handle(theControl));
  352.  
  353.     DoDragMessage := 1;
  354.     end;
  355.         {of procedure DoInitMessage}
  356.  
  357. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDisposeMessage }
  358.  
  359. procedure DoDisposeMessage(theControl : ControlHandle);
  360.  
  361.     var
  362.     theRect : Rect;
  363.     theSliderDataHdl : SliderDataHdl;
  364.  
  365.     begin
  366.     DisposeRoutineDescriptor(theVBLTaskRD);                                { For PowerPC }
  367.  
  368.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  369.     theRect := theControl^^.contrlRect;
  370.     theRect.right := theRect.right + (theRect.right - theRect.left);
  371.     EraseRect(theRect);
  372.  
  373.     if (theSliderDataHdl^^.offScreenPort <> nil) then
  374.         DisposeGWorld(theSliderDataHdl^^.offScreenPort);
  375.  
  376.     if (theControl^^.contrlData <> nil) then
  377.         DisposeHandle(theControl^^.contrlData);
  378.     end;
  379.         {of procedure DoDisposeMessage}
  380.  
  381. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ CreateOffScreenGWorld }
  382.  
  383. procedure CreateOffScreenGWorld(theControl : ControlHandle);
  384.  
  385.     var
  386.     theSliderDataHdl : SliderDataHdl;
  387.     resourceOffset : integer;
  388.     pixMapHdl : PixMapHandle;    
  389.     pictureHdl : PicHandle;
  390.     currentPortDepth : integer;
  391.     ignored : QDErr;
  392.     ignoredBool : boolean;
  393.  
  394.     begin
  395.     resourceOffset := 0;
  396.     currentPortDepth := 1;
  397.     
  398.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);    
  399.  
  400.     theSliderDataHdl^^.compositeRect := theControl^^.contrlRect;
  401.     OffsetRect(theSliderDataHdl^^.compositeRect, - theSliderDataHdl^^.compositeRect.left, 
  402.                          - theSliderDataHdl^^.compositeRect.top);
  403.     SetRect(theSliderDataHdl^^.trackActiveRect, 50, 0, 100, 139);
  404.     SetRect(theSliderDataHdl^^.trackInactiveRect, 100, 0, 150, 139);
  405.     SetRect(theSliderDataHdl^^.indicatorActiveRect, 0, 139, 16, 154);
  406.     SetRect(theSliderDataHdl^^.indicatorPressedRect, 16, 139, 32, 154);
  407.     SetRect(theSliderDataHdl^^.indicatorInactiveRect, 32, 139, 48, 154);
  408.     SetRect(theSliderDataHdl^^.offScreenPortRect, 0, 0, 150, 154);
  409.     
  410.     GetGWorld(theSliderDataHdl^^.currentPort, theSliderDataHdl^^.currentDevice);
  411.  
  412.     HLock(Handle(theSliderDataHdl));
  413.  
  414.     ignored := NewGWorld(theSliderDataHdl^^.offScreenPort, 0, 
  415.                             theSliderDataHdl^^.offScreenPortRect, nil, nil, 0);
  416.  
  417.     pixMapHdl := GetGWorldPixMap(theSliderDataHdl^^.offScreenPort);
  418.     ignoredBool := LockPixels(pixMapHdl);
  419.  
  420.     SetGWorld(theSliderDataHdl^^.offScreenPort, nil);
  421.  
  422.     EraseRect(theSliderDataHdl^^.offScreenPortRect);
  423.     
  424.     if (theSliderDataHdl^^.ColorQuickDrawPresent) then
  425.         begin
  426.         pixMapHdl := GetGWorldPixMap(theSliderDataHdl^^.currentPort);
  427.         currentPortDepth := pixMapHdl^^.pixelSize;
  428.         end;
  429.  
  430.     if (not (theSliderDataHdl^^.ColorQuickDrawPresent) or (currentPortDepth < 2)) then
  431.         resourceOffset := 1;
  432.  
  433.     pictureHdl := GetPicture(rTrackPict + resourceOffset);
  434.     if (pictureHdl <> nil) then
  435.         begin
  436.         HNoPurge(Handle(pictureHdl));
  437.         DrawPicture(pictureHdl, theSliderDataHdl^^.offScreenPortRect);    
  438.         HPurge(Handle(pictureHdl));
  439.         end;
  440.     
  441.     SetGWorld(theSliderDataHdl^^.currentPort, theSliderDataHdl^^.currentDevice);
  442.     UnlockPixels(pixMapHdl);
  443.     HUnlock(Handle(theSliderDataHdl));
  444.     
  445.     end;
  446.         {of procedure CreateOffScreenGWorld}
  447.  
  448. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ PixelDepthCheck }
  449.  
  450. procedure PixelDepthCheck(theControl : ControlHandle);
  451.  
  452.     var
  453.     theSliderDataHdl : SliderDataHdl;
  454.     pixMapHdl : PixMapHandle;
  455.     currentPortDepth, gworldPortDepth : integer;
  456.  
  457.     begin
  458.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);    
  459.  
  460.     pixMapHdl := GetGWorldPixMap(theSliderDataHdl^^.currentPort);
  461.     currentPortDepth := pixMapHdl^^.pixelSize;
  462.     pixMapHdl := GetGWorldPixMap(theSliderDataHdl^^.offScreenPort);
  463.     gworldPortDepth := pixMapHdl^^.pixelSize;
  464.  
  465.     if (currentPortDepth <> gworldPortDepth) then
  466.         begin
  467.         DisposeGWorld(theSliderDataHdl^^.offScreenPort);
  468.         CreateOffScreenGWorld(theControl);
  469.         end;
  470.     
  471.     end;
  472.         {of procedure CreateOffScreenGWorld}
  473.  
  474. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawControlActive }
  475.  
  476. procedure DrawControlActive(theControl : ControlHandle);
  477.  
  478.     var
  479.     oldForeColour, oldBackColour : RGBColor;
  480.     theSliderDataHdl : SliderDataHdl;
  481.     myWindowPtr : WindowPtr;    
  482.     pixMapHdl : PixMapHandle;
  483.     indicatorRect : Rect;
  484.     ignoredBool : boolean;
  485.  
  486.     begin    
  487.     GetForeColor(oldForeColour);
  488.     GetBackColor(oldBackColour);
  489.  
  490.     HLock(Handle(theControl));
  491.  
  492.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  493.     HLock(Handle(theSliderDataHdl));
  494.  
  495.     myWindowPtr := WindowPtr(theControl^^.contrlOwner);
  496.     SetPort(myWindowPtr);
  497.  
  498.     pixMapHdl := GetGWorldPixMap(theSliderDataHdl^^.offScreenPort);
  499.     ignoredBool := LockPixels(pixMapHdl);
  500.  
  501.     ForeColor(blackColor);
  502.     BackColor(whiteColor);
  503.      
  504.     CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  505.                      GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  506.                      theSliderDataHdl^^.trackActiveRect, theSliderDataHdl^^.compositeRect, 
  507.                      srcCopy, nil);
  508.  
  509.     indicatorRect := CalcIndicatorRect(theControl);
  510.     OffsetRect(indicatorRect, -theControl^^.contrlRect.left, 
  511.                     -theControl^^.contrlRect.top);
  512.  
  513.     if (theSliderDataHdl^^.dragMessageFlag) then
  514.         begin
  515.         CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  516.                     GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  517.                     theSliderDataHdl^^.indicatorPressedRect, indicatorRect, srcCopy, nil);
  518.         end
  519.     else begin
  520.         CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  521.                     GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  522.                     theSliderDataHdl^^.indicatorActiveRect, indicatorRect, srcCopy, nil);
  523.         end;
  524.  
  525.     if ((theSliderDataHdl^^.dragMessageFlag) and 
  526.                 not (theSliderDataHdl^^.VBLInstallFail)) then
  527.         begin  
  528.         if (gVBLRec.inVBlankPeriod) then
  529.             begin
  530.             gVBLRec.inVBlankPeriod := false;
  531.  
  532.             CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  533.                      GrafPtr(myWindowPtr)^.portBits, theSliderDataHdl^^.compositeRect, 
  534.                     theControl^^.contrlRect, srcCopy, nil);
  535.             end;
  536.         end
  537.     else begin
  538.         CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  539.                      GrafPtr(myWindowPtr)^.portBits, theSliderDataHdl^^.compositeRect, 
  540.                      theControl^^.contrlRect, srcCopy, nil);
  541.         end;
  542.  
  543.     UnlockPixels(pixMapHdl);
  544.     HUnlock(Handle(theSliderDataHdl));
  545.     HUnlock(Handle(theControl));
  546.  
  547.     RGBForeColor(oldForeColour);
  548.     RGBBackColor(oldBackColour);
  549.     end;
  550.         {of procedure CreateOffScreenGWorld}
  551.  
  552. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawControlInactive }
  553.  
  554. procedure DrawControlInactive(theControl : ControlHandle);
  555.  
  556.     var
  557.     oldForeColour, oldBackColour : RGBColor;
  558.     theSliderDataHdl : SliderDataHdl;
  559.     myWindowPtr : WindowPtr;    
  560.     pixMapHdl : PixMapHandle;
  561.     indicatorRect : Rect;
  562.     ignoredBool : boolean;
  563.  
  564.     begin
  565.     GetForeColor(oldForeColour);
  566.     GetBackColor(oldBackColour);
  567.  
  568.     HLock(Handle(theControl));
  569.  
  570.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  571.     HLock(Handle(theSliderDataHdl));
  572.  
  573.     myWindowPtr := WindowPtr(theControl^^.contrlOwner);
  574.     SetPort(myWindowPtr);
  575.  
  576.     pixMapHdl := GetGWorldPixMap(theSliderDataHdl^^.offScreenPort);
  577.     ignoredBool := LockPixels(pixMapHdl);
  578.  
  579.     ForeColor(blackColor);
  580.     BackColor(whiteColor);
  581.  
  582.     CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  583.                  GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  584.                  theSliderDataHdl^^.trackInactiveRect, theSliderDataHdl^^.compositeRect, 
  585.                  srcCopy, nil);
  586.  
  587.     indicatorRect := CalcIndicatorRect(theControl);
  588.     OffsetRect(indicatorRect, -theControl^^.contrlRect.left, 
  589.                          -theControl^^.contrlRect.top);
  590.  
  591.     CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  592.                      GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  593.                      theSliderDataHdl^^.indicatorInactiveRect, indicatorRect, srcCopy, nil);
  594.             
  595.     CopyBits(GrafPtr(theSliderDataHdl^^.offScreenPort)^.portBits, 
  596.                      GrafPtr(myWindowPtr)^.portBits, theSliderDataHdl^^.compositeRect, 
  597.                      theControl^^.contrlRect, srcCopy, nil);
  598.  
  599.     UnlockPixels(pixMapHdl);
  600.     HUnlock(Handle(theSliderDataHdl));
  601.     HUnlock(Handle(theControl));
  602.  
  603.     RGBForeColor(oldForeColour);
  604.     RGBBackColor(oldBackColour);
  605.     end;
  606.         {of procedure DrawControlInactive}
  607.  
  608. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ CalcIndicatorRect }
  609.  
  610. function CalcIndicatorRect(theControl : ControlHandle) : Rect;
  611.  
  612.     var
  613.     indicatorHeight, indicatorHalfHeight : integer;
  614.     trackRect, indicatorRect : Rect;
  615.     trackHeight, controlValue, controlMax, controlMin, indicatorCentre : integer;
  616.     ratio : longreal;
  617.  
  618.     begin
  619.     indicatorHeight := kIndicatorHeight;
  620.     indicatorHalfHeight := indicatorHeight div 2;
  621.  
  622.     trackRect := theControl^^.contrlRect;
  623.     InsetRect(trackRect, 0, indicatorHalfHeight + 4);
  624.     trackRect.bottom := trackRect.bottom + 1;
  625.     trackHeight := trackRect.bottom - trackRect.top;
  626.  
  627.     controlValue := theControl^^.contrlValue;
  628.     controlMax := theControl^^.contrlMax;
  629.     controlMin := theControl^^.contrlMin;
  630.  
  631.     ratio := longreal((controlValue) / (controlMax - controlMin));
  632.     indicatorCentre := trackRect.bottom - integer(trunc(ratio * trackHeight));
  633.  
  634.     SetRect(indicatorRect, trackRect.left, indicatorCentre - indicatorHalfHeight, 
  635.                     trackRect.left + 16, indicatorCentre + indicatorHalfHeight - 1);
  636.  
  637.     CalcIndicatorRect := indicatorRect;
  638.     end;
  639.         {of function CalcIndicatorRect}
  640.  
  641. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ InstallVBLTask }
  642.  
  643. function InstallVBLTask(theControl : ControlHandle) : OSErr;
  644.  
  645.     var
  646.     theErr : OSErr;
  647.     theSliderDataHdl : SliderDataHdl;
  648.  
  649.     begin
  650.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  651.     gVBLRec.inVBlankPeriod := false;
  652.  
  653.     gVBLRec.vblTaskRec.qType := vType;
  654.     gVBLRec.vblTaskRec.vblAddr := theVBLTaskRD;                            { For PowerPC }
  655.     gVBLRec.vblTaskRec.vblCount := 1;
  656.     gVBLRec.vblTaskRec.vblPhase := 0;
  657.  
  658.     {$IFC GENERATING68K}                                                   { For PowerPC }
  659.     gVBLRec.thisApplicationsA5 := SetCurrentA5;
  660.     {$ENDC}                                                                { For PowerPC }
  661.  
  662.     if (theSliderDataHdl^^.slotVInstallPresent) then
  663.         theErr := SlotVInstall(QElemPtr(@gVBLRec.vblTaskRec), 
  664.                                 theSliderDataHdl^^.mainSlotNumber)
  665.     else
  666.         theErr := VInstall(QElemPtr(@gVBLRec.vblTaskRec));
  667.  
  668.     InstallVBLTask := theErr;
  669.     end;
  670.         {of function InstallVBLTask}
  671.  
  672. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ RemoveVBLTask }
  673.  
  674. procedure RemoveVBLTask(theControl : ControlHandle);
  675.  
  676.     var
  677.     ignoredErr : OSErr;
  678.     theSliderDataHdl : SliderDataHdl;
  679.  
  680.     begin
  681.     theSliderDataHdl := SliderDataHdl(theControl^^.contrlData);
  682.     
  683.     if (theSliderDataHdl^^.slotVInstallPresent) then
  684.         ignoredErr := SlotVRemove(QElemPtr(@gVBLRec.vblTaskRec), 
  685.                         theSliderDataHdl^^.mainSlotNumber)
  686.     else
  687.         ignoredErr := VRemove(QElemPtr(@gVBLRec.vblTaskRec));
  688.         
  689.     end;
  690.         {of function RemoveVBLTask}
  691.  
  692. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ TheVBLTask }
  693.  
  694. procedure TheVBLTask;
  695.  
  696.     {$IFC GENERATING68K}                                                   { For PowerPC }
  697.     var
  698.     theVBLRecPtr : VBLRecPtr;
  699.     currentA5 : longint;
  700.     ignoredLong : longint;
  701.     {$ENDC}                                                                { For PowerPC }
  702.  
  703.     begin
  704.     {$IFC GENERATING68K}                                                   { For PowerPC }
  705.     theVBLRecPtr := VBLRecPtr(GetVBLRec);
  706.     currentA5 := SetA5(theVBLRecPtr^.thisApplicationsA5);
  707.     {$ENDC}                                                                { For PowerPC }
  708.  
  709.     {$IFC GENERATING68K}                                                   { For PowerPC }
  710.     theVBLRecPtr^.inVBlankPeriod := true;
  711.     theVBLRecPtr^.vblTaskRec.vblCount := 1;
  712.     {$ELSEC}                                                               { For PowerPC }
  713.     gVBLRec.inVBlankPeriod := true;                                        { For PowerPC }
  714.     gVBLRec.vblTaskRec.vblCount := 1;                                      { For PowerPC }
  715.     {$ENDC}                                                                { For PowerPC }
  716.  
  717.     {$IFC GENERATING68K}                                                   { For PowerPC }
  718.     ignoredLong := SetA5(currentA5);
  719.     {$ENDC}                                                                { For PowerPC }
  720.     end;
  721.         {of function TheVBLTask}
  722.  
  723. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ CheckSlotVInstallAvailable }
  724.  
  725. function CheckSlotVInstallAvailable : boolean;
  726.  
  727.     begin
  728.     CheckSlotVInstallAvailable := CheckTrapAvailable(_SlotVInstall);
  729.     end;
  730.         {of function CheckSlotVInstallAvailable}
  731.  
  732. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ CheckTrapAvailable }
  733.  
  734. function CheckTrapAvailable(theTrap : integer) : boolean;
  735.  
  736.     var
  737.     theTrapType : TrapType;
  738.     trapMask : integer;
  739.     numToolboxTraps : integer;
  740.  
  741.     begin
  742.     trapMask := $0800;
  743.     
  744.     if (BAnd(theTrap, trapMask) > 0) then
  745.         theTrapType := ToolTrap
  746.     else
  747.         theTrapType := OSTrap;
  748.  
  749.     if (theTrapType = ToolTrap) then
  750.         theTrap := BAnd(theTrap, $07FF);
  751.  
  752.     if (NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap)) then
  753.         numToolboxTraps := $0200
  754.     else
  755.         numToolboxTraps := $0400;
  756.  
  757.     if (theTrap >= numToolboxTraps) then
  758.         theTrap := _Unimplemented;
  759.  
  760.     CheckTrapAvailable :=
  761.         (NGetTrapAddress(theTrap, theTrapType) <> NGetTrapAddress(_Unimplemented, ToolTrap));
  762.     
  763.     end;
  764.         {of function CheckTrapAvailable}
  765.         
  766. end.
  767.     {of unit CDEF2Pascal}    
  768.  
  769. { ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }
  770.