ftp.mactech.com 2010/ftp.mactech.com.tar/ftp.mactech.com/macintosh-pascal/macintoshp-1.2-demos.sit.hqx/chap05pascal_demo/Controls1Pascal.p

Text File | 1999-04-05 | 14KB | 612 lines

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// Controls1Pascal.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program opens a zoomDocProc window containing:
//
// •    A pop-up menu.
//
// •    Three radio buttons.
//
// •    Two checkboxes.
//
// •    One button.
//
// •    Vertical and horizontal scroll bars.
//
// The pop-up menu, radio buttons, checkboxes, and button work correctly except that the
// control values are not used for any specific purpose.
//
// The scroll bars are moved and resized when the user resizes or zooms the window;
// however, no action is taken when the scroll box is moved or the scroll arrows or gray
// areas are clicked.
//
// The program utilizes the following resources:
//
// •    An 'MBAR' resource, and 'MENU' resources for Apple, File, Edit menus and a
//        pop-up menu (preload, non-purgeable).
//
// •    A 'WIND' resource (purgeable) (initially not visible).
//
// •    'CNTL' resources for the pop-up menu, radio buttons, checkboxes, button and
//            scroll bars (preload, purgeable) (initially visible).
//
// •    A 'SIZE' resource with the acceptSuspendResumeEvents and doesActivateOnFGSwitch
//            flags set.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }

program Controls1Pascal(input, output);

{ ………………………………………………………………………………………………………………… include the following Universal Interfaces }

uses

    Windows, Menus, Events, Types, Memory, Quickdraw, QuickdrawText, Fonts, Processes,
    TextUtils, Controls, OSUtils, TextEdit, Dialogs, ToolUtils, Devices, Segload, Sound;

{ ………………………………………………………………………………………………………………………………………………… define the following constants }

const

 rMenubar = 128;
 rNewWindow = 128;

 mApple = 128;
      iAbout = 1;
 mFile = 129;
      iQuit = 11;
 mEdit = 130;

 cTimeZone = 128;
      pSydney = 1;
      pNewYork = 2;
      pLondon = 3;
      pRome = 4;

 cRed = 129;
 cWhite = 130;
 cBlue = 131;
 cShowgrid = 132;
 cShowrulers = 133;
 cButton = 134;
 cVScrollbar = 135;
 cHScrollbar = 136;

 kMaxLong = $7FFFFFFF;

{ ………………………………………………………………………………………………………………………………………………………………………………… user-defined types }

type

DocRec = record
        popupControlHdl: ControlHandle;
        redHdl: ControlHandle;
        whiteHdl: ControlHandle;
        blueHdl: ControlHandle;
        showGridHdl: ControlHandle;
        showRulersHdl: ControlHandle;
        okButtonHdl: ControlHandle;
        vScrollbarHdl: ControlHandle;
        hScrollbarHdl: ControlHandle;
        end;

DocRecPointer = ^DocRec;
DocRecHandle = ^DocRecPointer;

{ ……………………………………………………………………………………………………………………………………………………………………………………… global variables }

var

gDone : boolean;
gInBackground : boolean;
menubarHdl : Handle;
menuHdl : MenuHandle;
myWindowPtr: WindowPtr;
docRecHdl : DocRecHandle;
eventRec : EventRecord;


{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitManagers }

procedure DoInitManagers;

    begin
    MaxApplZone;
    MoreMasters;

    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);

    InitCursor;
    FlushEvents(everyEvent, 0);
    end;
        {of procedure DoInitManagers}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMenuChoice }

procedure DoMenuChoice(menuChoice : longint);

    var
    menuID, menuItem : integer;
    itemName : string;
    daDriverRefNum : integer;

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

    if (menuID = 0) then
        Exit(DoMenuChoice);

    case (menuID) of

        mApple:
            begin
            if (menuItem = iAbout)
                then     SysBeep(10)
                else    begin
                        GetMenuItemText(GetMenuHandle(mApple), menuItem, itemName);
                        daDriverRefNum := OpenDeskAcc(itemName);
                        end;
            end;

        mFile:
            begin
            if (menuItem = iQuit) then
                gDone := true;
            end;

        end;
            {of case statement}

    HiliteMenu(0);
    end;
        {of procedure DoMenuChoice}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoPopupMenuChoice }

procedure DoPopupMenuChoice(controlValue : integer);

    begin
    case (controlValue) of

        pSydney:
            begin
            { Action as appropriate.}
            end;

        pNewYork:
            begin
            { Action as appropriate.}
            end;

        pLondon:
            begin
            { Action as appropriate.}
            end;

        pRome:
            begin
            { Action as appropriate.}
            end;
        end;
            {of case statement}

    SysBeep(10);
    end;
        {of procedure DoPopupMenuChoice}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoControls }

procedure DoControls(controlHdl : ControlHandle; docRecHdl : DocRecHandle);

    begin
    if ((controlHdl = docRecHdl^^.redHdl) or (controlHdl = docRecHdl^^.whiteHdl) or
             (controlHdl = docRecHdl^^.blueHdl))

        then    begin
            SetControlValue(docRecHdl^^.redHdl, 0);
            SetControlValue(docRecHdl^^.whiteHdl, 0);
            SetControlValue(docRecHdl^^.blueHdl, 0);
            SetControlValue(controlHdl, 1);
            end

    else    if((controlHdl = docRecHdl^^.showGridHdl) or
                    (controlHdl = docRecHdl^^.showRulersHdl))

        then    begin
            if (GetControlValue(controlHdl) = 1)
                then SetControlValue(controlHdl, 0)
            else SetControlValue(controlHdl, 1);
            end

    else     if ((controlHdl = docRecHdl^^.vScrollbarHdl) or
                        (controlHdl = docRecHdl^^.hScrollbarHdl))
        then    {Do scroll bars handling.}

    else    {Must be button.  Do button handling.};

    SysBeep(10);
    end;
        {of procedure DoControls}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInContent }

procedure DoInContent(eventRec : EventRecord; myWindowPtr : WindowPtr);

    var
    controlHdl : ControlHandle;
    controlValue : integer;
    docRecHdl : DocRecHandle;
    ignored : integer;

    begin
    GlobalToLocal(eventRec.where);

    if (FindControl(eventRec.where, myWindowPtr, controlHdl) <> 0) then
        begin
        docRecHdl := DocRecHandle(GetWRefCon(myWindowPtr));
        if (controlHdl = docRecHdl^^.popupControlHdl)
            then    begin
                ignored := TrackControl(controlHdl, eventRec.where, ControlActionUPP(-1));
                controlValue := GetControlValue(controlHdl);
                DoPopupMenuChoice(controlValue);
                end

            else    if (TrackControl(controlHdl, eventRec.where, nil) <> 0) then
                        DoControls(controlHdl, docRecHdl);
        end;
    end;
        {of procedure DoInContent}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAdjustScrollBars }

procedure DoAdjustScrollBars(myWindowPtr : WindowPtr);

    var
    winRect : Rect;
    docRecHdl : DocRecHandle;

    begin
    docRecHdl := DocRecHandle(GetWRefCon(myWindowPtr));

    winRect := myWindowPtr^.portRect;

    HideControl(docRecHdl^^.vScrollbarHdl);
    HideControl(docRecHdl^^.hScrollbarHdl);

    MoveControl(docRecHdl^^.vScrollbarHdl, winRect.right - 15, winRect.top - 1);
    MoveControl(docRecHdl^^.hScrollbarHdl, winRect.left -1, winRect.bottom -15);

    SizeControl(docRecHdl^^.vScrollbarHdl, 16, winRect.bottom - 13);
    SizeControl(docRecHdl^^.hScrollbarHdl, winRect.right - 13, 16);

    ShowControl(docRecHdl^^.vScrollbarHdl);
    ShowControl(docRecHdl^^.hScrollbarHdl);

    DrawGrowIcon(myWindowPtr);
    end;
        {of procedure DoAdjustScrollBars}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoEraseGrowIcon }

procedure DoEraseGrowIcon(myWindowPtr : WindowPtr);

    var
    growBoxRect : Rect;

    begin
    SetPort(myWindowPtr);

    growBoxRect := myWindowPtr^.portRect;
    growBoxRect.left := growBoxRect.right - 15;
    growBoxRect.top := growBoxRect.bottom - 15;
    EraseRect(growBoxRect);
    end;
        {of procedure DoEraseGrowIcon}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMouseDown }

procedure DoMouseDown(eventRec : EventRecord);

    var
    myWindowPtr : WindowPtr;
    partCode : integer;
    growRect : Rect;
    newSize : longint;

    begin
    partCode := FindWindow(eventRec.where, myWindowPtr);

    case (partCode) of

        inMenuBar:
            begin
            DoMenuChoice(MenuSelect(eventRec.where));
            end;

        inSysWindow:
            begin
            SystemClick(eventRec, myWindowPtr);
            end;

        inContent:
            begin
            if (myWindowPtr <> FrontWindow)
                then    SelectWindow(myWindowPtr)
                else    DoInContent(eventRec, myWindowPtr);
            end;

        inDrag:
            begin
            DragWindow(myWindowPtr, eventRec.where, qd.screenBits.bounds);
            end;

        inGoAway:
            begin
            if (TrackGoAway(myWindowPtr,eventRec.where)) then
                gDone := true;
            end;

        inGrow:
            begin
            growRect := qd.screenBits.bounds;
            growRect.top := 200;
            growRect.left := 275;
            newSize := GrowWindow(myWindowPtr, eventRec.where, growRect);
            if (newSize <> 0) then
                begin
                DoEraseGrowIcon(myWindowPtr);
                SizeWindow(myWindowPtr, LoWord(newSize), HiWord(newSize), true);
                DoAdjustScrollBars(myWindowPtr);
                end;
            end;

        inZoomIn, inZoomOut:
            begin
            if (TrackBox(myWindowPtr, eventRec.where, partCode)) then
                begin
                SetPort(myWindowPtr);
                EraseRect(myWindowPtr^.portRect);
                ZoomWindow(myWindowPtr, partCode, false);
                InvalRect(myWindowPtr^.portRect);
                DoAdjustScrollBars(myWindowPtr);
                end;
            end;
        end;
            {of case statement}
    end;
        {of procedure DoMouseDown}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoUpdate }

procedure DoUpdate(eventRec : EventRecord);

    var
    myWindowPtr : WindowPtr;

    begin
    myWindowPtr := WindowPtr(eventRec.message);

    BeginUpdate(myWindowPtr);

    if not (EmptyRgn(myWindowPtr^.visRgn)) then
        begin
        SetPort(myWindowPtr);
        UpdateControls(myWindowPtr, myWindowPtr^.visRgn);
        DrawGrowIcon(myWindowPtr);
        end;

    EndUpdate(myWindowPtr);
    end;
        {of procedure DoUpdate}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivateWindow }

procedure DoActivateWindow(myWindowPtr : WindowPtr; becomingActive : boolean);

    var
    docRecHdl : DocRecHandle;
    hiliteState : integer;

    begin
    docRecHdl := DocRecHandle(GetWRefCon(myWindowPtr));

    if (becomingActive)
        then hiliteState := 0
        else hiliteState := 255;

    HiliteControl(docRecHdl^^.popupControlHdl, hiliteState);
    HiliteControl(docRecHdl^^.redHdl,    hiliteState);
    HiliteControl(docRecHdl^^.whiteHdl, hiliteState);
    HiliteControl(docRecHdl^^.blueHdl, hiliteState);
    HiliteControl(docRecHdl^^.showGridHdl, hiliteState);
    HiliteControl(docRecHdl^^.showRulersHdl, hiliteState);
    HiliteControl(docRecHdl^^.okButtonHdl, hiliteState);
    HiliteControl(docRecHdl^^.vScrollbarHdl, hiliteState);
    HiliteControl(docRecHdl^^.hScrollbarHdl, hiliteState);
    end;
        {of procedure DoActivateWindow}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivate }

procedure DoActivate(eventRec : EventRecord);

    var
    myWindowPtr : WindowPtr;
    becomingActive : boolean;

    begin
    myWindowPtr := WindowPtr(eventRec.message);

    becomingActive := (BAnd(eventRec.modifiers, activeFlag) <> 0);

    DoActivateWindow(myWindowPtr, becomingActive);
    end;
        {of procedure DoActivate}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoOSEvent }

procedure DoOSEvent(eventRec : EventRecord);

    begin
    case BAnd(BSR(eventRec.message, 24), $000000FF) of

        suspendResumeMessage:
            begin
            DrawGrowIcon(FrontWindow);
            gInBackground := boolean(BAnd(eventRec.message, resumeFlag));
            DoActivateWindow(FrontWindow, gInBackground);
            end;

        mouseMovedMessage:
            begin
            end;

        end;
            {of case statement}
    end;
        {of procedure DoOSEvent}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoEvents }

procedure DoEvents(eventRec : EventRecord);

    begin
    case (eventRec.what) of
        mouseDown:
            begin
            DoMouseDown(eventRec);
            end;

        updateEvt:
            begin
            DoUpdate(eventRec);
            end;

        activateEvt:
            begin
            DoActivate(eventRec);
            end;

        osEvt:
            begin
            DoOSEvent(eventRec);
            HiliteMenu(0);
            end;
        end;
            {of case statement}
    end;
        {of procedure DoEvents}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoGetControls }

procedure DoGetControls(myWindowPtr : WindowPtr);

    var
    docRecHdl : DocRecHandle;

    begin
    docRecHdl := DocRecHandle(GetWRefCon(myWindowPtr));

    with docRecHdl^^ do
        begin
        popupControlHdl := GetNewControl(cTimeZone, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        redHdl := GetNewControl(cRed, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        whiteHdl := GetNewControl(cWhite, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        blueHdl := GetNewControl(cBlue, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        showGridHdl := GetNewControl(cShowgrid, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        showRulersHdl := GetNewControl(cShowrulers, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        okButtonHdl := GetNewControl(cButton, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        vScrollbarHdl := GetNewControl(cVScrollbar, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;

        hScrollbarHdl := GetNewControl(cHScrollbar, myWindowPtr);
        if (popupControlHdl = nil) then
            ExitToShell;
        end;
            {of with statement}

    end;
        {of procedure DoGetControls}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ start of main program }

begin

    { …………………………………………………………………………………………………………………………………………………………………… initialize managers }

    DoInitManagers;

    { …………………………………………………………………………………………………………………………………………………… set up menu bar and menus }

    menubarHdl := GetNewMBar(rMenubar);
    if (menubarHdl = nil) then
        ExitToShell;
    SetMenuBar(menubarHdl);
    DrawMenuBar;

    menuHdl := GetMenuHandle(mApple);
    if (menuHdl = nil)
        then ExitToShell
        else AppendResMenu(menuHdl,'DRVR');

    { …………………………………………………………………………………………………………………………………………………………………………………… open a window }

    myWindowPtr := GetNewWindow(rNewWindow, nil, WindowPtr(-1));
    if (myWindowPtr = nil) then
        ExitToShell;
    SetPort(myWindowPtr);

    { ………………… get block for document record, assign handle to window record refCon field }

    docRecHdl := DocRecHandle(NewHandle(sizeof(DocRec)));
    if (docRecHdl = nil) then
        ExitToShell;

    SetWRefCon(myWindowPtr, longint(docRecHdl));

    { …………………………………………………………………………………………………………………………………………… get controls and show window }

    DoGetControls(myWindowPtr);
    DoAdjustScrollBars(myWindowPtr);
    ShowWindow(myWindowPtr);

    { ……………………………………………………………………………………………………………………………………………………………………………… enter eventLoop }

    gDone := false;

    while not (gDone) do
        if (WaitNextEvent(everyEvent, eventRec, kMaxLong, nil)) then
            DoEvents(eventRec);

end.

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }