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

Text File | 1997-01-05 | 5KB | 248 lines

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// UMain.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }

unit UMain;



interface

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

uses

    Windows, Fonts, Menus, TextEdit, Dialogs, SegLoad, ToolUtils, Devices, GestaltEqu,
    Resources, Sound, Notification, Icons, Processes, ColorPicker, Traps, LowMem,

{ ……………………………………………………………………………………………………………………… include the following user-defined units }

    UDemos;

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

const

mApple = 128;
 iAbout = 1;
mFile = 129;
 iQuit = 11;
mDemonstration = 131;
 iCommandPeriod = 1;
 iNotification = 2;
 iColourPicker = 3;
 iTrapAvailable = 4;
 iMultiMonitors = 5;

rMenubar = 128;
rWindow = 128;
rAlert = 128;
rDialog = 129;
 iUserItem = 1;
rIconFamily = 128;
rBarkSound = 8192;
rString = 128;

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

var

gColorQuickDraw : boolean;
gDone : boolean;
gWindowPtr : WindowPtr;
gProcessSerNum : ProcessSerialNumber;
gMultiMonitorsDrawDemo : boolean;

    procedure DoInitManagers;
    procedure DoEvents(theEvent : EventRecord);
    procedure DoMouseDown(theEvent : EventRecord);
    procedure  DoMenuChoice(menuChoice : longint);
    procedure UnloadSegments;



implementation

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

procedure DoInitManagers;

    begin
    MaxApplZone;
    MoreMasters;

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

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

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

procedure DoEvents(theEvent : EventRecord);

    var
    theWindowPtr : WindowPtr;
    userData : longint;

    begin
    case (theEvent.what) of

        mouseDown: begin
            DoMouseDown(theEvent);
            end;

        updateEvt: begin
            theWindowPtr := WindowPtr(theEvent.message);

            BeginUpdate(theWindowPtr);
            if (gMultiMonitorsDrawDemo = true) then
                begin
                userData := longint(theWindowPtr);
                DeviceLoop(theWindowPtr^.visRgn, DeviceLoopDrawingUPP(@DoDeviceLoopDraw),
                            userData, 0);
                end;
            EndUpdate(theWindowPtr);
            end;

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

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

procedure DoMouseDown(theEvent : EventRecord);

    var
    partCode : integer;
    theWindowPtr : WindowPtr;

    begin
    partCode := FindWindow(theEvent.where, theWindowPtr);

    case (partCode) of

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

        inSysWindow: begin
            SystemClick(theEvent, theWindowPtr);
            end;

        inContent: begin
            if (theWindowPtr <> FrontWindow) then
                SelectWindow(theWindowPtr);
            end;

        inDrag: begin
            DragWindow(theWindowPtr, theEvent.where, qd.screenBits.bounds);
            end;

        inZoomIn, inZoomOut: begin
            if (TrackBox(theWindowPtr, theEvent.where, partCode)) then
                DoZoomWindowMultiMonitors(theWindowPtr, partCode);
            end;
        end;
            {of case statement}
    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;

        mDemonstration: begin
            gMultiMonitorsDrawDemo := false;
            case (menuItem) of

                iCommandPeriod: begin
                    DoCommandPeriodAndStatusBar;
                    end;

                iNotification: begin
                    EraseRect(gWindowPtr^.portRect);
                    DoSetUpNotification;
                    end;

                iColourPicker: begin
                    DoColourPicker;
                    end;

                iTrapAvailable: begin
                    EraseRect(gWindowPtr^.portRect);
                    MoveTo(150, 110);
                    if (DoCheckSlotVInstallAvailable) then
                        DrawString('Trap is available')
                    else
                        DrawString('Trap is not available');
                    end;

                iMultiMonitors: begin
                    EraseRect(gWindowPtr^.portRect);
                    gMultiMonitorsDrawDemo := true;
                    InvalRect(gWindowPtr^.portRect);
                    end;
                end;
                    {of case statement}
            end;
        end;
            {of case statement}

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ UnloadSegments }

procedure UnloadSegments;

    begin
    UnloadSeg(@DemosSegment);
    end;
        {of procedure UnloadSegments}

end.
    {of unit UMain}

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