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

Text File | 1997-01-17 | 4.4 KB | 194 lines | [TEXT/CWIE]

unit MyCursors;

interface

    uses
        Types, Lists, Dialogs, StandardFile, QuickDraw;

    procedure StartupCursors;
    procedure CursorSet (c: Cursor);
    procedure CursorSetArrow;
    procedure CursorSetIBeam;
    procedure CursorSetCross;
    procedure CursorSetPlus;
    procedure CursorSetWatch;
    procedure CursorSetProcessing (processing: boolean);
    procedure CursorStandardGetFile(fileFilter:FileFilterUPP;numTypes:integer;typeList:SFTypeList;var reply:StandardFileReply);
    procedure CursorStandardPutFile(prompt:Str255;defaultName:Str255;var reply:StandardFileReply);
    procedure SetEnableCursorTask( enable: boolean );

implementation

    uses
        Processes, GestaltEqu, ToolUtils, LowMem, Events,
        MyTypes, MyTimeManager, MySystemGlobals, MyStartup;

    const
        watch_delay_time = 1800; { ms }
        cursor_task_time = 200; { ms }

{$ifc do_debug}
    var
        startup_check: integer;
{$endc}

    var
        state: (S_Leave, S_Waiting, S_Watch);
        ibeam, cross, plus, watch: Cursor;
        current_cursor: Cursor;
        xtm: XTMTask;
        gCursorTaskProc:UniversalProcPtr;
        watch_time:longint;
        last_processing:Boolean;
        cursor_enabled: boolean;

    procedure UpdateCursor;
    begin
        if in_foreground then begin
            if state = S_Watch then begin
                SetCursor(watch);
            end else begin
                SetCursor(current_cursor);
            end;
        end;
    end;

    procedure CursorTask (xtm: XTMTaskPtr);
    begin
        AssertDidStartup( startup_check );
        if (state = S_Waiting) & (LMGetTicks > watch_time) then begin
            state := S_Watch;
            UpdateCursor;
        end;
        XPrimeTime(xtm, gCursorTaskProc, cursor_task_time);
    end;

    procedure CursorSet (c: Cursor);
    begin
        current_cursor := c;
        UpdateCursor;
    end;

    procedure CursorSetArrow;
    begin
        CursorSet(GetQDGlobals^.arrow);
    end;

    procedure CursorSetIBeam;
    begin
        CursorSet(ibeam);
    end;

    procedure CursorSetCross;
    begin
        CursorSet(cross);
    end;

    procedure CursorSetPlus;
    begin
        CursorSet(plus);
    end;

    procedure CursorSetWatch;
    begin
        CursorSet(watch);
    end;

    procedure CursorSetProcessing (processing: boolean);
    begin
        if processing <> last_processing then begin
            if processing then begin
                watch_time := TickCount + watch_delay_time;
                state := S_Waiting;
            end else begin
                state := S_Leave;
            end;
            last_processing := processing;
        end;
        UpdateCursor;
    end;

    function CursorAlert (alertID: integer; filterProc: ModalFilterUPP): integer;
    begin
        CursorSetArrow;
        CursorSetProcessing(false);
        CursorAlert := Alert(alertID, filterProc);
    end;

    function CursorCautionAlert (alertID: integer; filterProc: ModalFilterUPP): integer;
    begin
        CursorSetArrow;
        CursorSetProcessing(false);
        CursorCautionAlert := CautionAlert(alertID, filterProc);
    end;

    function CursorNoteAlert (alertID: integer; filterProc: ModalFilterUPP): integer;
    begin
        CursorSetArrow;
        CursorSetProcessing(false);
        CursorNoteAlert := NoteAlert(alertID, filterProc);
    end;

    function CursorStopAlert (alertID: integer; filterProc: ModalFilterUPP): integer;
    begin
        CursorSetArrow;
        CursorSetProcessing(false);
        CursorStopAlert := StopAlert(alertID, filterProc);
    end;

    procedure CursorStandardGetFile(fileFilter:FileFilterUPP;numTypes:integer;typeList:SFTypeList;var reply:StandardFileReply);
    begin
        CursorSetArrow;
        CursorSetProcessing(false);
        StandardGetFile(fileFilter,numTypes,@typeList,reply);
    end;

    procedure CursorStandardPutFile(prompt:Str255;defaultName:Str255;var reply:StandardFileReply);
    begin
        CursorSetArrow;
        CursorSetProcessing(false);
        StandardPutFile(prompt,defaultName,reply);
    end;

    procedure SetEnableCursorTask( enable: boolean );
    begin
        if cursor_enabled <> enable then begin
            cursor_enabled := enable;
            if enable then begin
                XInsertTime(@xtm);
                XPrimeTime(@xtm, gCursorTaskProc, cursor_task_time);
            end else begin
                XRemoveTime(@xtm);
            end;
        end;
    end;

    function InitCursors(var msg: integer): OSStatus;
    begin
{$unused(msg)}
        DidStartup( startup_check );
        gCursorTaskProc:=NewXTimerProc(@CursorTask);
        state := S_Leave;
        ibeam := GetCursor(iBeamCursor)^^;
        cross := GetCursor(crossCursor)^^;
        plus := GetCursor(plusCursor)^^;
        watch := GetCursor(watchCursor)^^;
        current_cursor := GetQDGlobals^.arrow;
        last_processing := false;
        cursor_enabled := false;
        SetEnableCursorTask( true );
        InitCursors := noErr;
    end;

    procedure FinishCursors;
    begin
        SetEnableCursorTask( false );
    end;

    procedure StartupCursors;
    begin
        StartupTimeManager;
        SetStartup(InitCursors, nil, 0, FinishCursors);
    end;

end.