Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyMovableModal.p

Text File | 1997-06-16 | 7.7 KB | 301 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);

{ Call DisableMenuBar after the modal dialog is shown }
{
    GetNewDialog
    set up dialog
    ShowWindow(dialog);
    DisableMenuBar
    while not finished
        MovableModalDialog
    end-while
    ReEnableMenuBar
    DisposeDialog
}

implementation

    uses
        Balloons, ToolUtils, Scrap, GestaltEqu, Memory, Menus, Dialogs, LowMem, Events, Windows, Menus, TextEdit, Quickdraw,
        MyTypes, MyDialogs, MyCursors, MySystemGlobals, MyMenus, MyUtils, MyEvents, MyMemory, MyAssertions;

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

{$PUSH}
{$ALIGN MAC68K}

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

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

{$ALIGN RESET}
{$POP}

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

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

    procedure SetEditMenu( theDialog: DialogPtr );
        var
            item, start, fin: integer;
    begin
        if theDialog <> nil then begin
            GetDialogTextSelection( theDialog, item, start, fin );
            if item > 0 then begin
                SetIDItemEnable( M_Edit, EMcut, start < fin );
                SetIDItemEnable( M_Edit, EMcopy, start < fin );
                SetIDItemEnable( M_Edit, EMpaste, true );
                SetIDItemEnable( M_Edit, EMclear, start < fin );
            end;
        end;
    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);

        junk := MNewPtr( saved_state, 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, EMcut) + BSL(1, EMcopy) + BSL(1, EMpaste);
                    end else begin
                        DisableItem(theMenu, 0);
                    end;
                end else begin { if this menu is enabled, disable it and set the corresponding bit  }
                    if (btst(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
        Assert( (saved_state <> nil) );
        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 (btst(state^.mbsBarEnable, i)) then begin
                    EnableItem(theMenu, 0);
                end;
                if (hasBalloons) then begin
                    err := HMSetMenuResID(menuID, -1);
                end;
            end;
        end;

        MDisposePtr( saved_state );
        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
{$unused(theEvent)}
        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;

            case menuitem of
                EMcut:  begin
                    DialogCut(theDialog);
                    junk := ZeroScrap;
                    junk := TEToScrap;
                end;
                EMcopy: begin
                    DialogCopy(theDialog);
                    junk := ZeroScrap;
                    junk := TEToScrap;
                end;
                EMpaste: begin
                    junk := TEFromScrap;
                    DialogPaste(theDialog);
                end;
                EMclear: begin
                    DialogDelete(theDialog);
                end;
                otherwise begin
                    { do nothing }
                end;
            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
            SetEditMenu( theDialog );
            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;
    begin
        itemHit := 0;
        dlg := FrontWindow;
        if (dlg <> nil) then begin
            SetPort(dlg);
            SetEditMenu( dlg );
            repeat
                dummy := WaitNextEvent(kMovableModalEventMask, er, 0, nil);
                SetPort(dlg);
                SetEditMenu( dlg );

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

                if er.what = kOSEvent then begin
                    if EventIsSuspendResume( er ) then begin
                        SetInForeground( EventHasResume( er ) );
                    end;
                end;

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

                if EventIsKeyDown( er ) & EventHasCommandKey( er ) then begin
                    SetEditMenu( dlg );
                    if DoMenuChoice(dlg, er, itemHit, MenuKey( EventChar( er ) ) ) then begin
                        Leave;
                    end;
                end;

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

    end;

end.