home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / System / DX Clock 1.31 / DX Clockƒ / Tools.p < prev   
Encoding:
Text File  |  1994-01-05  |  7.1 KB  |  344 lines  |  [TEXT/PJMM]
  1. unit Tools;
  2.  
  3. interface
  4.  
  5.     const
  6.         HiliteMode = $938;
  7.         GMDTrapNum = $AA2A;
  8.  
  9.     type
  10.         QDGlobalsPtr = ^QDGlobalsRec;
  11.         QDGlobalsRec = record
  12.                 randSeed: LongInt;
  13.                 screenBits: BitMap;
  14.                 arrow: Cursor;
  15.                 dkGray: Pattern;
  16.                 ltGray: Pattern;
  17.                 gray: Pattern;
  18.                 black: Pattern;
  19.                 white: Pattern;
  20.                 ThePort: GrafPtr;
  21.             end;
  22.  
  23.     function QDGlobals: QDGlobalsPtr;
  24.     function Strip2Size (theStr: Str255; theSize: Integer): Str255;
  25.     function TrapAvailable (theTrap: Integer): Boolean;
  26.     function BitPerPixel: Integer;
  27.     procedure BlinkBtn (theDialog: DialogPtr; btnNum: Integer);
  28.     function GetItemRect (theDialog: DialogPtr; theItem: Integer): Rect;
  29.     procedure FrameItemRect (theDialog: DialogPtr; itemNo: Integer);
  30.     procedure doBold (theDialog: DialogPtr; itemNo: Integer);
  31.     function aStr2Num (NumStr: Str255): LongInt;
  32.     function CenterHDialog (dlogID: Integer): Integer;
  33.     procedure CenterToWindow (theWindow: WindowPtr);
  34.     procedure SetCheck (theDialog: DialogPtr; checkNum: Integer; status: Boolean);
  35.  
  36. implementation
  37.  
  38. {----------------------------------------------}
  39.  
  40.     function QDGlobals: QDGlobalsPtr;
  41.  
  42.         const
  43.             CurrentA5 = $904;
  44.  
  45.         var
  46.             myPtr, myPtr2: ^LongInt;
  47.  
  48.     begin
  49.         myPtr := Pointer(CurrentA5);
  50.         myPtr2 := Pointer(myPtr^);
  51.         QDGlobals := QDGlobalsPtr(myPtr2^ - 130 + 4);
  52.     end;
  53.  
  54. {---------------------------------------------------------}
  55.  
  56.     function Strip2Size (theStr: Str255; theSize: Integer): Str255;
  57.  
  58.         var
  59.             ellipsisWid, newWid, newLen, wid: Integer;
  60.  
  61.     begin
  62.  
  63.         newWid := StringWidth(theStr);
  64.         if (theSize > 0) and (length(theStr) > 0) then
  65.             begin
  66.                 if newWid > theSize then
  67.                     begin
  68.                         ellipsisWid := CharWidth('…');
  69.                         wid := theSize;
  70.                         newLen := length(theStr);
  71.                         wid := wid - ellipsisWid;
  72.  
  73.                         repeat
  74.                             newWid := newWid - CharWidth(theStr[newLen]);
  75.                             newLen := newLen - 1;
  76.                         until (newWid <= wid) or (length(theStr) = 0);
  77.  
  78.                         newLen := newLen + 1;
  79.                         theStr[newLen] := '…';
  80. {$PUSH}
  81. {$R-}
  82.                         theStr[0] := chr(newLen);
  83. {$R+}
  84.                     end;
  85.             end;
  86.  
  87.         Strip2Size := theStr;
  88.  
  89.     end; { Strip2Size }
  90.  
  91. {---------------------------------------------------------------------}
  92.  
  93.     function BitPerPixel: Integer;
  94.  
  95.     begin
  96.  
  97.         if TrapAvailable(GMDTrapNum) then
  98.             BitPerPixel := GetMainDevice^^.gdPMap^^.pixelSize
  99.         else
  100.             BitPerPixel := 1;
  101.  
  102.     end; { BitPerPixel }
  103.  
  104. {--------------------------------------------------------}
  105.  
  106.     function NumToolboxTraps: Integer;
  107.  
  108.         const
  109.             _InitGraf = $A86E;
  110.  
  111.     begin
  112.  
  113.         if NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) then
  114.             NumToolboxTraps := $200
  115.         else
  116.             NumToolboxTraps := $400;
  117.  
  118.     end; { NumToolboxTraps }
  119.  
  120. {--------------------------------------------------------}
  121.  
  122.     function GetTrapType (theTrap: Integer): TrapType;
  123.  
  124.         const
  125.             trapMask = $0800;
  126.  
  127.     begin
  128.  
  129.         if BAND(theTrap, $07FF) > 0 then
  130.             GetTrapType := ToolTrap
  131.         else
  132.             GetTrapType := OSTrap;
  133.  
  134.     end; { GetTrapType }
  135.  
  136. {--------------------------------------------------------}
  137.  
  138.     function TrapAvailable (theTrap: Integer): Boolean;
  139.  
  140.         const
  141.             _Unimplemented = $A89F;
  142.  
  143.         var
  144.             tType: TrapType;
  145.  
  146.     begin
  147.  
  148.         tType := GetTrapType(theTrap);
  149.         if tType = ToolTrap then
  150.             begin
  151.                 theTrap := BAND(theTrap, $07FF);
  152.                 if theTrap >= NumToolboxTraps then
  153.                     theTrap := _Unimplemented;
  154.             end;
  155.         TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap);
  156.  
  157.     end; { TrapAvailable }
  158.  
  159. {------------------------------------------------}
  160.  
  161.     procedure BlinkBtn (theDialog: DialogPtr; btnNum: Integer);
  162.  
  163.         var
  164.             item: Handle;
  165.             box: Rect;
  166.             kind: Integer;
  167.             endTime: LongInt;
  168.  
  169.     begin
  170.  
  171.         GetDItem(theDialog, btnNum, kind, item, box);
  172.         HiliteControl(ControlHandle(item), 1);
  173.         Delay(10, endTime);
  174.         HiliteControl(ControlHandle(item), 0);
  175.  
  176.     end; { BlinkBtn }
  177.  
  178. {------------------------------------------------}
  179.  
  180.     function GetItemRect (theDialog: DialogPtr; theItem: Integer): Rect;
  181.  
  182.         var
  183.             item: Handle;
  184.             box: Rect;
  185.             kind: Integer;
  186.  
  187.     begin
  188.  
  189.         GetDItem(theDialog, theItem, kind, item, box);
  190.         GetItemRect := box;
  191.  
  192.     end; { GetItemRect }
  193.  
  194. {---------------------------------------------------------------}
  195.  
  196.     procedure FrameItemRect (theDialog: DialogPtr; itemNo: Integer);
  197.  
  198. { draw a rect around an item }
  199.  
  200.         var
  201.             item: Handle;
  202.             box: Rect;
  203.             kind: Integer;
  204.  
  205.     begin
  206.  
  207.         GetDItem(theDialog, itemNo, kind, item, box);
  208.         if kind = 16 then            { dont known why I have to do this … }
  209.             InsetRect(box, -3, -3);
  210.         FrameRect(box);
  211.  
  212.     end; { FrameItemRect }
  213.  
  214. {---------------------------------------------------------------}
  215.  
  216.     procedure doBold (theDialog: DialogPtr; itemNo: Integer);
  217.  
  218.         var
  219.             item: Handle;
  220.             box: Rect;
  221.             kind: Integer;
  222.             thePenState: PenState;
  223.  
  224.     begin
  225.  
  226.         GetPenState(thePenState);
  227.         GetDItem(theDialog, itemNo, kind, item, box);
  228.         InsetRect(box, -4, -4);
  229.         PenSize(3, 3);
  230.         if (ControlHandle(item)^^.contrlHilite = 0) then
  231.             PenPat(QDGlobals^.black)
  232.         else
  233.             PenPat(QDGlobals^.gray);
  234.         FrameRoundRect(box, 16, 16);
  235.         SetPenState(thePenState);
  236.  
  237.     end; { DoBold }
  238.  
  239. {--------------------------------------------------------}
  240.  
  241.     function aStr2Num (NumStr: Str255): LongInt;
  242.  
  243.         var
  244.             aNum: LongInt;
  245.  
  246.     begin
  247.  
  248.         StringToNum(NumStr, aNum);
  249.         aStr2Num := aNum
  250.  
  251.     end; { aStr2Num }
  252.  
  253. {---------------------------------------------------------------------}
  254.  
  255.     function CenterHDialog (dlogID: Integer): Integer;
  256.  
  257.         type
  258.             RectPtr = ^Rect;
  259.             RectHandle = ^RectPtr;
  260.  
  261.         var
  262.             theDlog: DialogPtr;
  263.             temp: Integer;
  264.             theHandle: Handle;
  265.  
  266.     begin
  267.  
  268.         temp := 0;
  269.         theHandle := GetResource('DLOG', dlogID);
  270.         if (theHandle <> nil) and (ResError = NoErr) then
  271.             begin
  272. {•    theDlog := GetNewDialog(dlogID, nil, Pointer(-1));•}
  273. {•    with theDlog^.portRect do•}
  274. {•     temp := right - left;•}
  275.                 with RectHandle(theHandle)^^ do
  276.                     temp := right - left;
  277.                 ReleaseResource(theHandle);
  278.                 with QDGlobals^.screenBits.bounds do
  279.                     temp := (right - left - temp) div 2;
  280. {DisposDialog(theDlog);}
  281.             end;
  282.         CenterHDialog := temp;
  283.  
  284.     end; { CenterHDialog }
  285.  
  286. {---------------------------------------------------------------------}
  287.  
  288.     procedure CenterToWindow (theWindow: WindowPtr);
  289.  
  290.         type
  291.             IntPtr = ^Integer;
  292.  
  293.         var
  294.             where, org: Point;
  295.             savePort: GrafPtr;
  296.             prevWindow: WindowPtr;
  297.             minV: Integer;
  298.  
  299.     begin
  300.  
  301.         GetPort(savePort);
  302.         prevWindow := WindowPtr(WindowPeek(FrontWindow)^.nextWindow);
  303.         prevWindow := FrontWindow;
  304.         org := prevWindow^.portRect.topLeft;
  305.         SetPort(prevWindow);
  306.         LocalToGlobal(org);
  307.         SetPort(theWindow);
  308.         where.v := theWindow^.portRect.bottom - theWindow^.portRect.top;
  309.         where.h := theWindow^.portRect.right - theWindow^.portRect.left;
  310.         with prevWindow^.portRect do
  311.             begin
  312.                 where.h := ((right - left) - where.h) div 2;
  313.                 where.v := ((bottom - top) - where.v) div 2;
  314.             end;
  315.         org.h := org.h + where.h;
  316.         org.v := org.v + where.v;
  317.         if org.h < 0 then
  318.             org.h := 10;
  319.         minv := 20 + IntPtr($BAA)^;
  320.         if org.v < minv then
  321.             org.v := minv;
  322.  
  323.         MoveWindow(theWindow, org.h, org.v, false);
  324.         SetPort(savePort);
  325.  
  326.     end; { CenterToWindow }
  327.  
  328. {------------------------------------------------}
  329.  
  330.     procedure SetCheck (theDialog: DialogPtr; checkNum: Integer; status: Boolean);
  331.  
  332.         var
  333.             item: Handle;
  334.             box: Rect;
  335.             itemType: Integer;
  336.  
  337.     begin
  338.  
  339.         GetDItem(theDialog, checkNum, itemType, item, box);
  340.         SetCtlValue(ControlHandle(item), Integer(status));
  341.  
  342.     end; { SetCheck}
  343.  
  344. end.