Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/DBL Pascal Library/DefProcs/PopUp/PopUpCDEF.p

Text File | 1993-03-30 | 29.6 KB | 896 lines | [TEXT/PJMM]

unit PopUpCDEF;

{David B. Lamkins, June 1991}
{}
{This is a CDEF for a pop-up menu that provides the following features:}
{    • Displays styled items and hierarchical menus (limited to one level of submenus).}
{    • Pop-up is in same font as menu.}
{    • Limits drawn size to width of control rect, trims item text to fit…}
{    • Recognizes both HiliteControl and HiliteMenu to enable/disable menu.}
{    • Can pop-up even if the control is not visible, by calling TrackControl.}
{    • Is (or should be… hasn't been tested) 32-bit clean.}
{    • Handles “iconOnly” variant (CDEF ID*16+1) to support mixed pop-up/TE arrangement.}
{    • Handles “useCTitle” variant (CDEF ID*16+2) to take title from control rather than menu.}
{    • Handles “noShrink” variant (CDEF ID*16+4) to force menu not to shrink narrower than control rect.}
{    • Handles “useWFont” variant (CDEF ID*16+8) to display menu using window font.}
{}
{Revision History:}
{    DBL, 1 July 1991:    Now correctly handles 1- and 2-item editable pop-ups.}
{                            No longer reduces control value after selecting a submenu.}
{    DBL, 2 July 1991:    Doesn't draw if owner is not visible.}
{                            Force contrlMax and contrlMin.}
{                            Editable pop-up doesn't grab insertion point.}
{    DBL, 3 July 1991:    Dim and disable TE fields with disabled editable pop-up.}
{    DBL, 17 July 1991:    Don't wipe out TE contents if menu is initially empty.}
{    DBL, 21 October 1991:    Use TE contents during initialization.}
{    DBL, 5 June 1992:    Arrange menu handle and ID in private data to match Apple's CDEF.}
{    DBL, 30 March 1993:    Case- and diacritical-insensitive match of TE to menu.}
{                            Change dimming of TE so thin glyphs are readable on 1-bit displays.}
{                            Finally fixed initialization of TE from menu.}
{}
{Bugs:}
{    When high byte of control value is <> 0, doesn't pin control value or check for valid submenu before drawing.}
{}
{Use:}
{    CNTL proc ID = 80, 81, 82, 84, 86, 88, 89, 90, 92 or 94 (since this is CDEF 5).}
{    CNTL min initializes MENU ID — menu must be installed in “hierarchical” menu list.}
{    CNTL max initializes item number of associated TE field for +1 and +9 variants.}
{    CNTL title is menu title for +2, +4, +6, +10 and +14 variants.}
{    CNTL refcon is unused.}
{    CNTL value in template may be chosen to initially show some menu item other than first.}
{    contrlValue is adjusted according to menu selection; high byte contains menu ID if selection}
{      was from a submenu, otherwise zero. A menu may not have more than 255 items.}
{    contrlMin is set to 1 and contrlMax is set to 255.}
{    Calling SetCtlValue changes the displayed item. Can only be used to select main menu.}
{    SetCtlMin and SetCtlMax do not affect the range of items displayed or selectable.}
{    DITL rect must be at least as large as CNTL rect, otherwise Dialog Mgr won't detect hit in control.}
{    A few characters of the item will be drawn, no matter how small you make the CNTL rect.}
{    If menu is changed using Menu Mgr calls, use Draw1Control to update appearance of menu.}
{    The TE field associated with an editable pop-up is changed to a disabled static text field}
{      when the pop-up control is disabled.}
{    If you want to pop up a hidden menu under the mouse: call MoveControl(…) with local mouse point,}
{      followed by TrackControl ( …, POINTER(-1))}
{    Don't use with item icons or command key equivalents.}
{    You're responsible for installing and removing menus used by the control.}
{    If the dialog contains TE fields, “useWFont” requires special handling. The following is}
{      derived from Apple's Q&A Stack:}
{            theDialog := GetNewDialog(…);}
{            SetPort(theDialog);}
{            TextFont(…);}
{            TextSize(…);}
{            ShowWindow(theDialog);}
{            for i := 1 to 3 do}
{                if EventAvail(everyEvent, evt) then}
{                    ;}
{            with DialogPeek(theDialog)^.textH^^ do}
{                begin}
{                    txFont := theDialog^.txFont;}
{                    txSize := theDialog^.txSize;}
{                end;}
{            InitCursor;}
{            repeat}
{                ModalDialog(…);}
{                …}
{            until …;}
{            DisposDialog(theDialog);}
{}
{Notes:}
{    This could be rewritten to be a lot smaller by inlining nearly all of the routines. However,}
{    I found it very difficult to keep track of what was going when I rewrote this as a monolith.}
{    I figured that the clarity was worth the 700 or so bytes it cost.}

interface

    function main (varCode: Integer; theControl: ControlHandle; message: Integer; param: Longint): Longint;

implementation

{$SETC Debugging=False}

    function main (varCode: Integer; theControl: ControlHandle; message: Integer; param: Longint): Longint;
        const
            minChars = 3;            {show at least this many chars from the menu item}
            iconOnly = 1;            {our variant codes}
            useCTitle = 2;
            noShrink = 4;
            partCode = 1;            {our part code}

        type
            PrivateData = record
                    menuH: MenuHandle;    {handle to our menu}
                    menuID: Integer;    {resource ID of menu — by convention, the first item}
                    lastMenuID: Integer;    {resource ID of last menu selected}
                    teItem: Integer;    {item list number of associated TE item}
                    boundsRect: Rect;    {control's bounding rect - size of control plus drop shadow}
                    menuRect: Rect;    {bounds of pop-up portion of control}
                    shadowRect: Rect;    {bounds of pop-up portion, plus the drop shadow}
                    menuEnabled: Boolean;    {true if menu and control are both enabled}
                    colorQD: Boolean;    {set at init time if Color QD exists}
                    useSysFont: Boolean;    {set at init time if not useWFont variant}
                    teUnInited: Boolean;    {initialization flag}
                    patGrey: Pattern;    {our own grey pattern - can't use globals}
                    downIcon: BitMap;    {the infamous downward-pointing arrow}
                    downIconBits: array[1..16] of Integer;    {the arrow’s bitmap}
                end;
            DataPtr = ^PrivateData;
            DataHandle = ^DataPtr;

    {Recursive function finds maximum width of menu. Limits depth of submenus.}
        function MeasureItemsWidth (menuH: MenuHandle; menuWidth, depthRemaining: Integer): Integer;
            var
                item: Integer;
                cmdChar: Char;
                markChar: Char;
                tempMenuH: MenuHandle;
                itemStyle: Style;
                itemText: Str255;
                itemWidth: Integer;
        begin
            if depthRemaining >= 0 then    {haven't reached depth cutoff}
                for item := 1 to CountMItems(menuH) do    {measure each item…}
                    begin
                        GetItemCmd(menuH, item, cmdChar);
                        if cmdChar = CHR($1B) then
                            begin
                                GetItemMark(menuH, item, markChar);
                                tempMenuH := GetMenu(ORD(markChar));
                                if tempMenuH <> nil then
                                    menuWidth := MeasureItemsWidth(tempMenuH, menuWidth, depthRemaining - 1);
                            end
                        else
                            begin
                                GetItemStyle(menuH, item, itemStyle);
                                GetItem(menuH, item, itemText);
                                TextFace(itemStyle);
                                itemWidth := TextWidth(@itemText[1], 0, length(itemText));
                                if itemWidth > menuWidth then    {…and remember the widest one}
                                    menuWidth := itemWidth;
                            end;
                    end;
            MeasureItemsWidth := menuWidth;
        end;

        const
            CalcMenuSizeTrapNum = $148;    {ToolTrap}
            patchCode = '0000000000004E712F2F000441FA000A2F08207AFFEC4ED0205F225F2251303AFFE4B06900026F04334000024ED0';

{ The following code puts a "tail patch" on CalcMenuSize. The patch forces menuWidth}
{ to be at least as wide as we want. We use this to keep the menu from shrinking horizontally}
{ during PopUpMenuSelect.}
{ 00000                                  proc}
{ 00000                       addr    ds.l        1                    ;the address of the real _CalcMenuSize}
{ 00004                       wid    ds.w        1                    ;our minimum width}
{ 00006   4E71            entry    nop                                ;enter the patch here}
{ 00008   2F2F 0004                move.l        4(sp),-(sp)        ;copy the MenuHandle}
{ 0000C   41FA 000A            lea.l        cont(pc),a0        ;make _CalcMenuSize return to the patch}
{ 00010   2F08                    move.l        a0,-(sp)}
{ 00012   207A FFEC                movea.l    addr(pc),a0        ;do the real _CalcMenuSize}
{ 00016   4ED0                    jmp        (a0)}
{ 00018   205F            cont    movea.l    (sp)+,a0            ;return here, and save return address}
{ 0001A   225F                    movea.l    (sp)+,a1            ;get the MenuHandle}
{ 0001C   2251                    movea.l    (a1),a1}
{ 0001E   303A FFE4                move.w    wid(pc),d0        ;get minimum width}
{ 00022   B069 0002            cmp.w        2(a1),d0            ;compare to MenuHandle.menuWidth}
{ 00026   6F04                    ble.s        return                ;at least as wide as the minimum?}
{ 00028   3340 0002            move.w    d0,2(a1)            ;no, force it}
{ 0002C   4ED0            return    jmp        (a0)                ;return from patched _CalcMenuSize}
{ 0002E                            end}

        type
            PatchParams = record    {Overlays the patch code to fill in runtime variables}
                    realTrap: Longint;
                    ourWidth: Integer;
                end;
            PatchParamsPtr = ^PatchParams;

        var
            oldTrapAddress: Longint;
            thePatch: Ptr;

        procedure PatchCalcMenuSize (minimumWidth: Integer);
        begin
            oldTrapAddress := NGetTrapAddress(CalcMenuSizeTrapNum, ToolTrap);
            thePatch := NewPtr(length(patchCode) div 2);
            if thePatch <> nil then
                begin
                    StuffHex(thePatch, patchCode);
                    with PatchParamsPtr(thePatch)^ do
                        begin
                            realTrap := oldTrapAddress;
                            ourWidth := minimumWidth;
                        end;
                    NSetTrapAddress(ORD(thePatch) + SIZEOF(Integer) + SIZEOF(Longint), CalcMenuSizeTrapNum, ToolTrap);
                end;
        end;

        procedure UnpatchCalcMenuSize;
        begin
            if thePatch <> nil then
                begin
                    NSetTrapAddress(oldTrapAddress, CalcMenuSizeTrapNum, ToolTrap);
                    DisposPtr(thePatch);
                end;
        end;

    {Prepare to do PopUpMenuSelect. If control is visible, erase the menu and position the}
    {pop-up relative to the menu rect. If the control is invisible, position the pop-up relative}
    {to the control rect.}
        function PreparePopUp: Point;
            var
                pt: Point;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    if contrlVis = 0 then    {…figure out where to place the pop-up and…}
                        begin
                            pt := contrlRect.topLeft;
                            AddPt(Point($FFF70002), pt);
                        end
                    else
                        begin
                            EraseRect(shadowRect);    {wipe out the menu, then…}
                            pt := menuRect.topLeft;
                            AddPt(Point($00010001), pt);
                        end;
                    LocalToGlobal(pt);    {…track the popup selection}
                end;
            PreparePopUp := pt;
        end;

    {Draw string in the current font. If wider than specified, trailing chars are trimmed}
    {until minChars of original string remain. Note that string trimmed to minChars may}
    {still exceed width.}
        procedure DrawClippedString (theString: Str255; width, minChars: Integer);
            const
                ellipsis = '…';
            var
                thisLength, ellipsisLength: Integer;
        begin
            ellipsisLength := CharWidth(ellipsis);
            thisLength := length(theString);
            if TextWidth(@theString[1], 0, thisLength) > width then
                begin
                    repeat
                        thisLength := thisLength - 1
                    until (TextWidth(@theString[1], 0, thisLength) + ellipsisLength <= width) or (thisLength <= minChars);
                    thisLength := thisLength + 1;
                    theString[thisLength] := ellipsis;
{$PUSH}
{$R-}
                    theString[0] := CHR(thisLength);
{$POP}
                end;
            DrawString(theString);
        end;

        const
            iconSize = 16;    {don't change this unless you change the bitmap allocation and initialization}
            halfIconSize = iconSize div 2;
            optionVCheckMark = '√';    {real check-mark exists only in system font}

        var
            savePort: GrafPtr;
            saveFont: Integer;
            saveSize: Integer;
            saveFace: Style;
            info: FontInfo;
            titleRect: Rect;
            iconRect: Rect;
            adjustedControlRect: Rect;
            textBaseline: Integer;
            titleLeft: Integer;
            itemLeft: Integer;
            itemWidth: Integer;
            altTitle: Boolean;
            noText: Boolean;
            useTE: Boolean;

        procedure PrepareToDraw;
            const
                titleInset = 6;
                titleGap = 1;
                itemInset = 5;        {plus width of checkmark}
                itemTail = 3;            {plus width of icon}
                minWidth = 21;
                iconOffset = 2;
            var
                itemKind: Integer;
                itemHandle: Handle;
                itemRect: Rect;
                textKind: Integer;
                newRight: Integer;
                centerLine: Integer;
                titleWidth: Integer;
                menuWidth: Integer;
                itemText: Str255;
                checkMarkWidth: Integer;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    with contrlOwner^ do
                        begin    {remember the original font}
                            saveFont := txFont;
                            saveSize := txSize;
                            saveFace := txFace;
                        end;
                    if useSysFont then        {if we need system font, set it}
                        begin
                            TextSize(0);
                            TextFont(0);
                        end;
                    noText := BAND(varCode, iconOnly) <> 0;    {is this an icon-only pop-up?}
                    menuEnabled := BTST(menuH^^.enableFlags, 0) and (contrlHilite <> 255);    {is our menu enabled?}
                    useTE := noText and (teItem > 0);    {do we have an associated TE?}
                    GetDItem(contrlOwner, teItem, itemKind, itemHandle, itemRect);
                    textKind := BAND(itemKind, BNOT(itemDisable));
                    useTE := useTE and ((textKind = statText) or (textKind = editText));    {is the TE item really a TE?}
                    altTitle := BAND(varCode, useCTitle) <> 0;    {do we use title from CNTL?}
                    TextFace([]);    {make sure our face is clean}
                    GetFontInfo(info);    {we'll need to know about the font, soon}
                    if noText then
                        menuWidth := minWidth    {icon-only pop-up has fixed width}
                    else
                        begin    {normal pop-up width has to be figured using current font and style}
                            if useSysFont then
                                checkMarkWidth := CharWidth(CHR(checkMark))
                            else
                                checkMarkWidth := CharWidth(optionVCheckMark);
                            menuWidth := MeasureItemsWidth(menuH, 0, 1) + itemInset + checkMarkWidth + itemTail + iconSize;
                            TextFace([]);    {blank face again}
                        end;
                    if altTitle then    {pick up the title from the right place…}
                        itemText := contrlTitle
                    else
                        itemText := menuH^^.menuData;
                    titleWidth := TextWidth(@itemText[1], 0, length(itemText));    {…and measure its width}
                    with info, contrlRect do
                        if noText then    {icon-only popup is fixed size}
                            SetRect(adjustedControlRect, left, top, left + minWidth, top + iconSize)
                        else    {normal pop-up size depends on font used}
                            begin
                                adjustedControlRect := contrlRect;
                                newRight := left + titleInset + titleWidth + titleGap + menuWidth;
                                if (BAND(varCode, noShrink) = 0) and (newRight < right) then
                                    adjustedControlRect.right := newRight;
                                adjustedControlRect.bottom := top + ascent + descent + leading + 2;
                                textBaseline := adjustedControlRect.bottom - descent - leading - 1;
                                with adjustedControlRect do
                                    if (textBaseline - top - ascent) > (bottom - textBaseline - descent) then
                                        bottom := bottom + 1;    {equalize top/bottom spacing}
                            end;
                    titleRect := adjustedControlRect;    {size title portion of control separately}
                    with titleRect do
                        begin
                            top := top + 1;
                            if titleWidth > 0 then
                                right := left + titleInset + titleWidth + titleGap
                            else
                                right := left;    {empty if no title}
                            if right > contrlRect.right then    {Don't overflow the CNTL's rect}
                                right := contrlRect.right;
                            titleLeft := left + titleInset;
                        end;
                    menuRect := adjustedControlRect;    {size pop-up portion separately}
                    if not noText then
                        menuRect.left := titleRect.right;    {menu starts where its title ends}
                    with menuRect do
                        begin
                            itemWidth := right - left - itemInset - checkMarkWidth - itemTail - iconSize;
                            itemLeft := left + itemInset + checkMarkWidth;
                            centerLine := (bottom + top) div 2;
                            SetRect(iconRect, right - iconSize - iconOffset, centerLine - halfIconSize, right - iconOffset, centerLine + halfIconSize);
                        end;
                    with menuRect do    {shadow extends beyond pop-up…}
                        SetRect(shadowRect, left, top, right + 1, bottom + 1);
                    with adjustedControlRect do    {…and beyond overall control}
                        SetRect(boundsRect, left, top, right + 1, bottom + 1);
                end;
        end;

        procedure RestoreAfterDrawing;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    TextFont(saveFont);    {put everything back the way it was}
                    TextSize(saveSize);
                    TextFace(saveFace);
                end;
        end;

        var
            teSaveID: Integer;
            teSaveSelStart: Integer;
            teSaveSelEnd: Integer;

        function SaveTE: Integer;
        begin
            with theControl^^, DialogPeek(contrlOwner)^ do
                begin
                    if useTE then
                        teSaveID := editField + 1
                    else
                        teSaveID := 0;
                    if teSaveID > 0 then
                        with textH^^ do
                            begin
                                teSaveSelStart := selStart;
                                teSaveSelEnd := selEnd;
                            end;
                end;
            SaveTE := teSaveID;
        end;

        procedure RestoreTE;
        begin
            if teSaveID > 0 then
                SelIText(theControl^^.contrlOwner, teSaveID, teSaveSelStart, teSaveSelEnd);
        end;

        procedure DrawTitle;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin    {draw the title}
                    EraseRect(titleRect);
                    MoveTo(titleLeft, textBaseline);
                    if altTitle then
                        DrawString(contrlTitle)
                    else
                        DrawString(menuH^^.menudata);
                    if contrlHilite = partCode then    {hilite the title}
                        InvertRect(titleRect);
                end;
        end;

        procedure DrawMenu;
            var
                clip: RgnHandle;
                item: Integer;
                itemStyle: Style;
                itemText: Str255;
                tempMenuH: MenuHandle;
                itemKind: Integer;
                itemHandle: Handle;
                itemRect: Rect;
                saveClip: RgnHandle;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    if not noText then
                        begin
                            EraseRect(menuRect);    {draw the item text}
                            MoveTo(itemLeft, textBaseline);
                            tempMenuH := GetMHandle(lastMenuID);
                            if tempMenuH = nil then
                                tempMenuH := menuH;
                            item := BAND(contrlValue, $FF);
                            GetItem(tempMenuH, item, itemText);
                            GetItemStyle(tempMenuH, item, itemStyle);
                            TextFace(itemStyle);
                            DrawClippedString(itemText, itemWidth, minChars);
                        end;
                    clip := NewRgn;        {draw the downarrow icon}
                    if clip <> nil then
                        RectRgn(clip, menuRect);
                    downIcon.baseAddr := @downIconBits;    {remember, the bit map is in a handle that may have moved!}
                    CopyBits(downIcon, contrlOwner^.portBits, downIcon.bounds, iconRect, srcOr, clip);
                    if clip <> nil then
                        DisposeRgn(clip);
                    if not menuEnabled then
                        begin    {grey out disabled menu}
                            if useTE then
                                begin    {change associated TE to static text…}
                                    GetDItem(contrlOwner, teItem, itemKind, itemHandle, itemRect);
                                    SetDItem(contrlOwner, teItem, statText + itemDisable, itemHandle, itemRect);
                                    with DialogPeek(contrlOwner)^ do
                                        if editField + 1 = teItem then
                                            begin
                                                SelIText(contrlOwner, teItem, 0, 0);    {remove any hilite}
                                                editField := -1;
                                            end;
                                    PenNormal;    {draw fake frame around our static text}
                                    InsetRect(itemRect, -3, -3);
                                    FrameRect(itemRect);
                                    InsetRect(itemRect, 1, 1);    {inset a grey frame.}
                                    PenSize(2, 2);
                                    PenPat(patGrey);
                                    FrameRect(itemRect);
                                end;
                            PenPat(patGrey);
                            PenMode(patBic);
                            PaintRect(adjustedControlRect);    {grey out the interior of the pop-up}
                        end;
                    PenNormal;    {frame is never greyed out}
                    FrameRect(menuRect);        {draw the frame…}
                    with menuRect do
                        begin
                            MoveTo(left + 2, bottom);        {…and the shadow}
                            LineTo(right, bottom);
                            LineTo(right, top + 2);
                        end;
                end;
        end;

        const
            SysFontFam = $BA6;    {address of system global}

        type
            IntPtr = ^Integer;

        var
            colorPort: CGrafPtr;
            monoPort: GrafPtr;

    {Because the standard MDEF always draws in the system font, we have to temporarily}
    {override the system font in order to draw the pop-up in the window’s font.}
        procedure SetPopUpFont;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    IntPtr(SysFontFam)^ := contrlOwner^.txFont;
                    if colorQD then
                        begin
                            GetCWMgrPort(colorPort);
                            SetPort(GrafPtr(colorPort));
                        end
                    else
                        begin
                            GetWMgrPort(monoPort);
                            SetPort(monoPort);
                        end;
                    TextFont(contrlOwner^.txFont);
                    TextSize(contrlOwner^.txSize);
                end;
        end;

        procedure RestorePopUpFont;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    IntPtr(SysFontFam)^ := SystemFont;
                    TextFont(SystemFont);
                    TextSize(0);
                    SetPort(contrlOwner);
                end;
        end;

        procedure CoupleMenuToTE;
            var
                oldTE: Integer;
                item: Integer;
                itemCount: Integer;
                itemKind: Integer;
                itemHandle: Handle;
                itemRect: Rect;
                menuText: Str255;
                startItem: Integer;
                foundItem: Integer;
                inMenu: Boolean;
                itemText: Str255;
                reFrame: Boolean;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    oldTE := SaveTE;
                    if (contrlHilite >= partCode) or teUnInited then    {we're about to pop up or disable the menu, or are initing}
                        begin
                            GetDItem(contrlOwner, teItem, itemKind, itemHandle, itemRect);
                            GetIText(itemHandle, itemText);    {what's in the TE?}
                            if length(itemText) > 0 then
                                begin
                                    itemCount := CountMItems(menuH);    {how many menu items?}
                                    startItem := 1;
                                    if itemCount > 1 then
                                        begin    {what's the first “permanent” item in the menu?}
                                            GetItem(menuH, 2, menuText);
                                            if menuText[1] = '-' then
                                                startItem := 3;
                                        end;
                                    inMenu := False;    {haven't found TE contents in menu, yet}
                                    for item := startItem to itemCount do
                                        begin
                                            GetItem(menuH, item, menuText);    {look in the menu}
                                            if EqualString(menuText, itemText, False, False) then
                                                begin
                                                    inMenu := True;    {menu item matched TE…}
                                                    foundItem := item;    {…so remember where}
                                                    Leave;
                                                end;
                                        end;
                                    if inMenu then
                                        begin    {TE text matches a permanent item in the menu}
                                            if startItem > 1 then {remove first two items}
                                                begin
                                                    DelMenuItem(menuH, 1);
                                                    DelMenuItem(menuH, 1);
                                                    contrlValue := foundItem - 2;
                                                end
                                            else
                                                contrlValue := foundItem;
                                        end
                                    else {TE text is not in menu}
                                        begin
                                            if startItem > 1 then    {alter existing temporary item}
                                                SetItem(menuH, 1, itemText)
                                            else
                                                begin    {create new temporary item and divider}
                                                    InsMenuItem(menuH, '-', 0);
                                                    InsMenuItem(menuH, itemText, 0);
                                                end;
                                            contrlValue := 1;
                                        end;
                                end
                            else {length(itemText) = 0)}
                                if teUninited then
                                    begin
                                        GetItem(menuH, contrlValue, menuText);    {look in the menu…}
                                        SetIText(itemHandle, menuText);    {…and stuff it into the TE}
                                    end;
                            teUnInited := False;
                        end
                    else    {we're not about to pop up the menu, but we are drawing it…}
                        begin    {…so update its associated TE field}
                            GetItem(menuH, contrlValue, itemText);
                            if length(itemText) > 0 then
                                begin
                                    GetDItem(contrlOwner, teItem, itemKind, itemHandle, itemRect);
                                    reFrame := menuEnabled and (itemKind = statText + itemDisable);
                                    if reFrame then
                                        begin
                                            SetDItem(contrlOwner, teItem, editText, itemHandle, itemRect);
                                            InsetRect(itemRect, -2, -2);
                                            PenNormal;
                                            PenSize(2, 2);
                                            PenMode(patBic);
                                            FrameRect(itemRect);
                                        end;
                                    if not useSysFont then
                                        SetPopUpFont;
                                    SelIText(contrlOwner, teItem, 0, 0);
                                    SetIText(itemHandle, itemText);
                                    if reFrame then
                                        begin
                                            InsetRect(itemRect, -1, -1);
                                            PenNormal;
                                            FrameRect(itemRect);
                                        end;
                                    if not useSysFont then
                                        RestorePopUpFont;
                                end;
                        end;
                    if oldTE = teItem then        {hilite our TE if the insertion point…}
                        SelIText(contrlOwner, teItem, 0, MAXINT)    {…was in our TE before, otherwise…}
                    else
                        RestoreTE;    {…put the insertion point back where it was}
                end;
        end;

        function NonHierValue: Boolean;
        begin
            NonHierValue := BAND(theControl^^.contrlValue, $FF00) = 0;
        end;

        procedure PinControlValue;
            var
                itemCount: Integer;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
                    itemCount := CountMItems(menuH);    {pin control value}
                    if NonHierValue then    {don't pin hierarchical!}
                        begin
                            if contrlValue < 1 then
                                contrlValue := 1;
                            if contrlValue > itemCount then
                                contrlValue := itemCount;
                        end;
                end;
        end;

        procedure DoInitControl;
            var
                macWorld: SysEnvRec;
        begin
            with theControl^^ do
                begin
{$IFC Debugging}
                    DebugStr('initCntl');
{$ENDC}
                    contrlData := NewHandleClear(SIZEOF(PrivateData));    {allocate private storage}
                    if contrlData <> nil then
                        begin
                            HLock(contrlData);
                            with DataHandle(contrlData)^^ do
                                begin    {create our local bitmap data}
                                    StuffHex(@patGrey, 'AA55AA55AA55AA55');
                                    StuffHex(@downIconBits[6], '3FF81FF00FE007C003800100');
                                    with downIcon do
                                        begin
                        {Set baseAddr later, when we use this - bitmap is in a handle that may move…}
                                            rowBytes := 2;
                                            SetRect(bounds, 0, 0, iconSize, iconSize);
                                        end;
                                    teItem := contrlMax;        {remember which TE we use}
                                    menuID := contrlMin;        {remember our menu's ID}
                                    lastMenuID := menuID;
                                    contrlMin := 1;                {init min and max values}
                                    contrlMax := 255;
                                    contrlAction := POINTER(-1);    {use our own action proc}
                                    if SysEnvirons(1, macWorld) = noErr then    {is this a color machine?}
                                        colorQD := macWorld.hasColorQD
                                    else
                                        colorQD := False;
                                    useSysFont := BAND(varCode, useWFont) = 0;
                                    teUnInited := True;        {Grrr… need this for one-time initialization in another part of code}
                                end;
                            HUnLock(contrlData);
                        end;
                end;
        end;

        procedure DoDisposeControl;
        begin
            with theControl^^ do
                begin
{$IFC Debugging}
                    DebugStr('dispCntl');
{$ENDC}
                    if contrlData <> nil then
                        DisposHandle(contrlData);    {don't need this any more}
                end
        end;

        function DoTestControl: Integer;
        begin
            with DataHandle(theControl^^.contrlData)^^ do
                begin
{$IFC Debugging}
                    DebugStr('testCntl');
{$ENDC}
                    if menuEnabled and PtInRect(Point(param), menuRect) then
                        DoTestControl := partCode    {hit our control}
                    else
                        DoTestControl := 0;
                end;
        end;

        procedure DoCalcControlRegions;
        begin
            with DataHandle(theControl^^.contrlData)^^ do
                begin
{$IFC Debugging}
                    DebugStr('calcCRgns, calcCntlRgn, calcThumbRgn');
{$ENDC}
                    if (message <> calcCRgns) or not BTST(param, 31) then
                        RectRgn(RgnHandle(Param), boundsRect);    {return control region}
                end;
        end;

        procedure DoDrawControl;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
{$IFC Debugging}
                    DebugStr('drawCntl');
{$ENDC}
                    if (contrlVis <> 0) and (WindowPeek(contrlOwner)^.visible) then
            {draw only if control is visible and owner window is visible}
                        begin
                            GetPort(savePort);    {make sure we have right port}
                            SetPort(contrlOwner);
                            menuH := GetMHandle(menuID);    {get our main menu}
                            if menuH <> nil then    {if menu exists…}
                                begin
                                    PrepareToDraw;
                                    begin    {…then we have to draw it, now}
                                        PinControlValue;
                                        if useTE then    {this is an “editable” pop-up…}
                                            CoupleMenuToTE;    {…so we may have to adjust its menu…}
                                        if not noText then
                                            DrawTitle;
                                        DrawMenu;
                                    end;    {if contrlVis <> 0 then …}
                                    RestoreAfterDrawing;
                                end
                            else
                                FillRect(contrlRect, patGrey);    {no menu? draw a blank…}
                            SetPort(savePort);    {put the port back to wherever it was}
                        end;
                end;
        end;

        procedure DoTrackControl;
            var
                oldTE: Integer;
                item: Integer;
                pt: Point;
                selected: Longint;
        begin
            with theControl^^, DataHandle(contrlData)^^ do
                begin
{$IFC Debugging}
                    DebugStr('autoTrack');
{$ENDC}
                    GetPort(savePort);    {make sure we have right port}
                    SetPort(contrlOwner);
                    menuH := GetMHandle(menuID);    {get our main menu}
                    if menuH <> nil then
                        if CountMItems(menuH) > 0 then
                            begin
                                oldTE := SaveTE;    {so we can put insertion point back later}
                                pt := PreparePopUp;
                                if useSysFont then
                                    begin    {easy for system font}
                                        if NonHierValue then
                                            CheckItem(menuH, contrlValue, True)
                                    end
                                else
                                    begin    {must hack around to make popup appear in window font}
                                        if NonHierValue then
                                            SetItemMark(menuH, contrlValue, optionVCheckMark);
                                        SetPopUpFont;
                                    end;
                                if useTE then
                                    SelIText(contrlOwner, teItem, 0, MAXINT);    {hilite the TE}
                                with menuRect do
                                    PatchCalcMenuSize(right - left - 2);
                                CalcMenuSize(menuH);    {size the actual pop-up; something may have changed}
                                selected := PopUpMenuSelect(menuH, pt.v, pt.h, contrlValue);    {track it!}
                                UnpatchCalcMenuSize;
                                RestoreTE;
                                if not useSysFont then
                                    RestorePopUpFont;    {if we messed with the system font, it was only temporary!}
                                if NonHierValue then
                                    CheckItem(menuH, contrlValue, False);    {clear old check mark}
                                item := LoWord(selected);
                                if item > 0 then    {if a menu item was selected…}
                                    begin    {…update the control value}
                                        lastMenuID := HiWord(selected);
                                        if lastMenuID = menuID then
                                            contrlValue := item
                                        else
                                            contrlValue := BSL(lastMenuID, 8) + item;
                                    end;
                            end;
                    SetPort(savePort);    {put the port back to wherever it was}
                end;
        end;

        const
            calcCntlRgn = 10;        {messages for “clean” control region inquiries}
            calcThumbRgn = 11;

    begin {Main — Pop–Up Menu CDEF}
        main := 0;    {normally we return a zero}
        HLock(Handle(theControl));    {lock down the usual control data for the duration}
        with theControl^^ do
            begin
                if message = initCntl then
                    DoInitControl

                else if message = dispCntl then
                    DoDisposeControl

                else if contrlData <> nil then
                    begin
                        HLock(contrlData);    {lock down control's private data}
                        with DataHandle(contrlData)^^ do
                            case message of
                                drawCntl:
                                    DoDrawControl;
                                testCntl:
                                    main := DoTestControl;
                                calcCRgns, calcCntlRgn:
                                    DoCalcControlRegions;
                                autoTrack:
                                    DoTrackControl;

                                otherwise
                                    ;    {don't handle other messages}
                            end;
                        HUnLock(contrlData);
                    end;
            end;
        HUnLock(Handle(theControl));
    end;

end.