ftp.mactech.com 2010/ftp.mactech.com.tar/ftp.mactech.com/macintosh-pascal/macintoshp-1.2-demos.sit.hqx/chap23pascal_demo/chap05pascal_demoPPC/Controls2PascalPPC.p

Text File | 1997-01-07 | 13KB | 550 lines

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// Controls2PascalPPC.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program:
//
// •    Opens a noGrowDocProc window with a horizontal scrollbar.
//
// •    Allows the user to horizontally scroll a picture within the window using the
//        scroll box, the scroll arrows and the gray area.
//
// The program utilises the following resources:
//
// •    An 'MBAR' resource, and 'MENU' resources for Apple, File and Edit (preload,
//        non-purgeable).
//
// •    A 'WIND' resource (purgeable) (initially visible).
//
// •    An 'CNTL' resource for the horizontal scroll bar (purgeable).
//
// •    A 'PICT' resource containing the picture to be scrolled (non-purgeable).
//
// •    A 'SIZE' resource with the acceptSuspendResumeEvents and
//        doesActivateOnFGSwitch flags set.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }

program Controls2Pascal(input, output);

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

uses

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

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

const

rMenubar = 128;
rNewWindow = 128;
rPicture = 128;

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

cHScrollbar = 128;

kMaxLong = $7FFFFFFF;

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

type

DocRec = record
    hScrollbarHdl : ControlHandle;
    end;

DocRecHandle = ^^DocRec;

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

var

gDone : boolean;
gInBackground : boolean;
gPictRect : Rect;
gPictureHdl : PicHandle;
menubarHdl : Handle;
menuHdl : MenuHandle;
myWindowPtr : WindowPtr;
docRecHdl : DocRecHandle;
eventRec : EventRecord;

actionProcedureRD : ControlActionUPP;                                      { For PowerPC }

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

procedure DoInitManagers;

    begin
    MaxApplZone;
    MoreMasters;

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

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMoveScrollBox }

procedure DoMoveScrollBox(controlHdl : ControlHandle; scrollDistance : integer);

    var
    oldControlValue, controlValue, controlMax : integer;

    begin
    oldControlValue := GetControlValue(controlHdl);
    controlMax := GetControlMaximum(controlHdl);

    controlValue := oldControlValue - scrollDistance;

    if (controlValue < 0)
        then    controlValue := 0
        else     if (controlValue > controlMax)
                    then controlValue := controlMax;

    SetControlValue(controlHdl, controlValue);
    end;
        {of procedure DoMoveScrollBox}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ ActionProcedure }

procedure ActionProcedure(controlHdl : ControlHandle; partCode : ControlPartCode);

    var
    myWindowPtr : WindowPtr;
    docRecHdl : DocRecHandle;
    scrollDistance : integer;
    controlValue : integer;
    updateRegion : RgnHandle;

    begin
    if (partCode > 0) then
        begin
        myWindowPtr := controlHdl^^.contrlOwner;
        docRecHdl := DocRecHandle(GetWRefCon(myWindowPtr));

        case (partCode) of

            kControlUpButtonPart, kControlDownButtonPart:
                begin
                scrollDistance := 2;
                end;

            kControlPageUpPart, kControlPageDownPart:
                begin
                scrollDistance := (myWindowPtr^.portRect.right
                                                    - myWindowPtr^.portRect.left) - 10;
                end;
            end;
                {of case statement}

        if ((partCode = kControlDownButtonPart) or (partCode = kControlPageDownPart))
            then scrollDistance := -scrollDistance;

        controlValue := GetControlValue(controlHdl);
        if (((controlValue = GetControlMaximum(controlHdl)) and (scrollDistance < 0)) or
             ((controlValue = GetControlMinimum(controlHdl)) and (scrollDistance > 0)))
                 then Exit(ActionProcedure);

        DoMoveScrollBox(controlHdl, scrollDistance);

        updateRegion := NewRgn;
        ScrollRect(gPictRect, scrollDistance, 0, updateRegion);
        InvalRgn(updateRegion);
        DisposeRgn(updateRegion);

        if((scrollDistance = 2) or (scrollDistance = -2)) then
            BeginUpdate(myWindowPtr);

        SetOrigin(GetControlValue(docRecHdl^^.hScrollbarHdl), 0);
        DrawPicture(gPictureHdl, gPictRect);
        SetOrigin(0, 0);

        if((scrollDistance = 2) or (scrollDistance = -2)) then
            EndUpdate(myWindowPtr);
        end;
    end;
        {of procedure ActionProcedure}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoScrollBars }

procedure DoScrollBars(partCode : ControlPartCode; myWindowPtr : WindowPtr;
                        controlHdl : ControlHandle; mouseXY : Point);

    var
    docRecHdl : DocRecHandle;
    oldControlValue : integer;
    scrollDistance : integer;
    updateRegion : RgnHandle;
    ignored : integer;

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


    case (partCode) of

        kControlIndicatorPart:
            begin
            oldControlValue := GetControlValue(controlHdl);
            if (TrackControl(controlHdl, mouseXY, nil) > 0) then
                begin
                scrollDistance := oldControlValue - GetControlValue(controlHdl);
                if (scrollDistance <> 0) then
                    begin
                    if (controlHdl = docRecHdl^^.hScrollbarHdl)
                        then    begin
                                updateRegion := NewRgn;
                                ScrollRect(gPictRect, scrollDistance, 0, updateRegion);
                                InvalRgn(updateRegion);
                                DisposeRgn(updateRegion);
                                end

                        else    begin
                                {Vertical scroll bar scroll box handling here.}
                                end;
                    end;
                end;
            end;

        kControlUpButtonPart, kControlDownButtonPart, kControlPageUpPart,
                kControlPageDownPart:

            begin
            if (controlHdl = docRecHdl^^.hScrollbarHdl)
                then ignored := TrackControl(controlHdl, mouseXY, actionProcedureRD)   { PowerPC }
                else    begin
                       {Vertical scroll via horizontal scrolling action procedure here.}
                        end;
            end;

        end;
            {of case statement}

    end;
        {of procedure DoScrollBars}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoIncontent }

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

    var
    mouseXY : Point;
    partCode : ControlPartCode;
    controlHdl : ControlHandle;

    begin
    partCode := 0;
    mouseXY := eventRec.where;
    GlobalToLocal(mouseXY);

    partCode := FindControl(mouseXY, myWindowPtr, controlHdl);
    if (partCode <> 0) then
        DoScrollBars(partCode, myWindowPtr, controlHdl, mouseXY);
    end;
        {of procedure DoInContent}

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

procedure  DoUpdate(eventRec : EventRecord);

    var
    myWindowPtr : WindowPtr;
    docRecHdl : DocRecHandle;

    begin
    myWindowPtr := WindowPtr(eventRec.message);
    docRecHdl := DocRecHandle(GetWRefCon(myWindowPtr));

    BeginUpdate(myWindowPtr);

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

        SetOrigin(GetControlValue(docRecHdl^^.hScrollbarHdl),0);
        DrawPicture(gPictureHdl, gPictRect);
        SetOrigin(0, 0);
        end;

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

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

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

    var
    docRecHdl : DocRecHandle;

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

    if (becomingActive)
        then    HiliteControl(docRecHdl^^.hScrollbarHdl, 0)
        else    HiliteControl(docRecHdl^^.hScrollbarHdl, 255);

    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
            gInBackground := boolean(BAnd(eventRec.message, resumeFlag));
            DoActivateWindow(FrontWindow, gInBackground);
            end;

        mouseMovedMessage:
            begin
            end;

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ 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}

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

procedure DoMouseDown(eventRec : EventRecord);

    var
    myWindowPtr : WindowPtr;
    partCode : integer;

    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;

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ 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}


{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoGetControl }

procedure DoGetControl(myWindowPtr : WindowPtr);

    var
    docRecHdl : DocRecHandle;

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

    docRecHdl^^.hScrollbarHdl := GetNewControl(cHScrollbar, myWindowPtr);
    end;
        {of procedure DoGetControl}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoGetPicture }

procedure  DoGetPicture;

    begin
    gPictureHdl := GetPicture(rPicture);

    gPictRect := gPictureHdl^^.picFrame;
    gPictRect.right :=  gPictRect.right - gPictRect.left;
    gPictRect.left := 0;
    gPictRect.bottom := gPictRect.bottom - gPictRect.top;
    gPictRect.top := 0;
    end;
        {of procedure DoGetPicture}

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

begin

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

    DoInitManagers;

    { …………………………………………………………………………………………………………………………………………………… create routine descriptor }

    actionProcedureRD := NewControlActionProc(ProcPtr(@ActionProcedure));  { For PowerPC }

    { …………………………………………………………………………………………………………………………………………………… 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)));
    SetWRefCon(myWindowPtr, longint(docRecHdl));

    { ……………………………………………………………………………………………………………………………………………………………………………………… get controls }

    DoGetControl(myWindowPtr);

    { ………………………………………………………………………………………………………………………………………………………………………………………… get picture }

    DoGetPicture;

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

    gDone := false;

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


end.

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