Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyMovableModal.p

Text File | 1995-09-26 | 6.9 KB | 265 lines | [TEXT/CWIE]

unit MyMovableModal;

{ This unit implements a MovableModalDialog routine similar to }
{ the Toolbox routine ModalDialog, to be used for movable modal dialogs }

{ Based on code by Marco Piovanelli <[e-mail]> }

interface

    uses
        Types;

    procedure DisableMenuBar (var saved_state: univ Ptr; hmnuID: Integer);
    procedure ReEnableMenuBar (var saved_state: univ Ptr);
    procedure MovableModalDialog (filterProc: ProcPtr; var itemHit: Integer);

implementation

    uses
        Balloons, ToolUtils, Scrap, GestaltEqu, Memory, Menus, Dialogs, LowMem,
        MyTypes, MyDialogs, MyCursors, MySystemGlobals;

    const
        kSystemMenuThreshold = -16000;        { menu IDs <= than this are used by the system }
        kMovableModalEventMask = mDownMask + mUpMask + keyDownMask + keyUpMask + autoKeyMask + updateMask + activMask + osMask;

    const
        EM_Cut = 3;
        EM_Copy = 4;
        EM_Paste = 5;

    type
        MenuEntry = record
                hMenu: MenuHandle;
                leftEdge: Integer;
            end;

        MenuList = record
                offsetToLastMenu: Integer;
                rightmostEdge: Integer;
                unused: Integer;
                theMenus: array[0..0] of MenuEntry;
            end;
        MenuListPtr = ^MenuList;
        MenuListHandle = ^MenuListPtr;

        MenuBarState = record
                mbsBarEnable: LongInt;
                mbsEditEnable: LongInt;
            end;
        MenuBarStatePtr = ^MenuBarState;

    function HasHelpManager: Boolean;
        var
            response: LongInt;
    begin
        HasHelpManager := (Gestalt(gestaltHelpMgrAttr, response) = noErr) & TPbtst(response, gestaltHelpMgrPresent);
    end;

    procedure DisableMenuBar (var saved_state: univ Ptr; hmnuID: Integer);
        var
            menuList: MenuListHandle;
            i, nMenus: Integer;
            theMenu: MenuHandle;
            menuID: Integer;
            theDialog: DialogPtr;
            hasBalloons, needEditMenu: Boolean;
            junk: OSErr;
            state: MenuBarStatePtr;
    begin
        hasBalloons := HasHelpManager;

        theDialog := FrontWindow;
        needEditMenu := (theDialog <> nil) & (SelectedTextItem(theDialog) > 0);

        menuList := MenuListHandle(LMGetMenuList);
        nMenus := menuList^^.offsetToLastMenu div SizeOf(MenuEntry);

        saved_state := NewPtr(SizeOf(MenuBarState));
        state := MenuBarStatePtr(saved_state);

        state^.mbsBarEnable := 0;
        for i := 0 to nMenus - 1 do begin
            theMenu := menuList^^.theMenus[i].hMenu;
            menuID := theMenu^^.menuID;

            if (menuID > kSystemMenuThreshold) then begin { do nothing if this is a system menu }

                if (menuID = M_Edit) then begin
                    state^.mbsEditEnable := theMenu^^.enableFlags;
                    if needEditMenu then begin
                        theMenu^^.enableFlags := 1 + BSL(1, EM_Cut) + BSL(1, EM_Copy) + BSL(1, EM_Paste);
                    end
                    else begin
                        DisableItem(theMenu, 0);
                    end;
                end
                else begin { if this menu is enabled, disable it and set the corresponding bit  }
                    if (TPbtst(theMenu^^.enableFlags, 0)) then begin
                        BSET(state^.mbsBarEnable, i);
                        DisableItem(theMenu, 0);
                    end;

                    if (hasBalloons) then begin { remap the help strings for this menu }
                        junk := HMSetMenuResID(menuID, hmnuID);
                    end;
                end;
            end;
        end;

        HiliteMenu(0);
        DrawMenuBar;
        CursorSetProcessing(false);
        CursorSetArrow;
    end;

    procedure ReEnableMenuBar (var saved_state: univ Ptr);
        var
            menuList: MenuListHandle;
            i, nMenus: Integer;
            theMenu: MenuHandle;
            menuID: Integer;
            hasBalloons: Boolean;
            err: OSErr;
            state: MenuBarStatePtr;
    begin
        state := MenuBarStatePtr(saved_state);

        hasBalloons := HasHelpManager;

        menuList := MenuListHandle(LMGetMenuList);
        nMenus := menuList^^.offsetToLastMenu div SizeOf(MenuEntry);

        for i := 0 to nMenus - 1 do begin
            theMenu := menuList^^.theMenus[i].hMenu;
            menuID := theMenu^^.menuID;

            if (menuID > kSystemMenuThreshold) then begin
                if (menuID = M_Edit) then begin
                    theMenu^^.enableFlags := state^.mbsEditEnable;
                end
                else if (TPbtst(state^.mbsBarEnable, i)) then begin
                    EnableItem(theMenu, 0);
                end;
                if (hasBalloons) then begin
                    err := HMSetMenuResID(menuID, -1);
                end;
            end;
        end;

        DisposePtr(saved_state);
        saved_state := nil;
        DrawMenuBar;
    end;

    function DoMenuChoice (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: Integer; menuChoice: LongInt): Boolean;
        var
            menuID, menuItem: Integer;
            currentEditField, itemType: Integer;
            junk: OSErr;
    begin
        theEvent:=theEvent; { UNUSED! }
        DoMenuChoice := false;

        menuID := HiWord(menuChoice);
        menuItem := LoWord(menuChoice);

        if (menuID = M_Edit) then begin
            currentEditField := SelectedTextItem(theDialog);
            GetDItemKind(theDialog, currentEditField, itemType);

            if (BAND(itemType, itemDisable) = 0) then begin { if the current edit field is an enabled item, exit from MovableModalDialog loop }
                DoMenuChoice := true;
                itemHit := currentEditField;
            end;

            if (menuItem = EM_Cut) then begin
                DialogCut(theDialog);
                junk := ZeroScrap;
                junk := TEToScrap;
            end
            else if (menuItem = EM_Copy) then begin
                DialogCopy(theDialog);
                junk := ZeroScrap;
                junk := TEToScrap;
            end
            else if (menuItem = EM_Paste) then begin
                junk := TEFromScrap;
                DialogPaste(theDialog);
            end;
        end;

        HiliteMenu(0);
    end;

    function HandleMouseDown (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: Integer): Boolean;
        var
            partCode: Integer;
            wind: WindowPtr;
            beeper: ProcPtr;
            dragRect: Rect;
    begin
        HandleMouseDown := false;

        partCode := FindWindow(theEvent.where, wind);

        if (partCode = inMenuBar) then begin
            HandleMouseDown := DoMenuChoice(theDialog, theEvent, itemHit, MenuSelect(theEvent.where));
        end
        else if (not PtInRgn(theEvent.where, WindowPeek(theDialog)^.strucRgn)) then begin
            beeper := LMGetDABeeper;
            if (beeper <> nil) then begin
                CallSoundProc(1, beeper);
            end;
        end
        else if (partCode = inDrag) & (theDialog = wind) then begin { now, we have to handle the only thing DialogSelect doesn't do for us: dragging }
            dragRect := GetGrayRgn^^.rgnBBox;
            DragWindow(wind, theEvent.where, dragRect);
            theEvent.what := nullEvent;
        end;
    end;

    procedure MovableModalDialog (filterProc: ProcPtr; var itemHit: Integer);
        var
            dlg, junk_dialog: DialogPtr;
            er: EventRecord;
            dummy: Boolean;
            resume:Boolean;
    begin
        itemHit := 0;
        dlg := FrontWindow;
        if (dlg <> nil) then begin
            SetPort(dlg);
            repeat
                dummy := WaitNextEvent(kMovableModalEventMask, er, 0, nil);
                SetPort(dlg);

                if (filterProc <> nil) & CallModalFilterProc(dlg, er, itemHit, filterProc) then begin
                    Leave;
                end;

                if er.what = kOSEvent then begin
                    if BAND(BROTL(er.message, 8), $FF) = kSuspendResumeMessage then begin
                        resume := (BAnd(er.message, kResumeMask) <> 0);
                        SetInForeground(resume);
                    end;
                end;

                if (er.what = mouseDown) & HandleMouseDown(dlg, er, itemHit) then begin
                    Leave;
                end;

                if (er.what = keyDown) & (BAND(er.modifiers, cmdKey) <> 0) & DoMenuChoice(dlg, er, itemHit, MenuKey(CHR(BAND(er.message, charCodeMask)))) then begin
                    Leave;
                end;

                if IsDialogEvent(er) & DialogSelect(er, junk_dialog, itemHit) then begin
                    Leave;
                end;
            until false;
        end;

    end;

end.