Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/MyNewEditText.p

Text File | 1993-08-11 | 16.7 KB | 651 lines | [TEXT/PJMM]

unit MyNewEditText;

interface

    const
        paste_to_big = -20;

    type
        EditObject = object
                window: dialogPtr;
                view_item: integer;
                view_rect: rect;
                vcontrol, hcontrol: ControlHandle;
                te: TEHandle;
                has_grow: boolean; { hasgrow -> leave room for grow icon }
                readonly: boolean;
                undotext: handle;
                undostart, undoend, undoselstart, undoselend: integer;
                undoopen: boolean;
                modified: boolean;
                procedure Create (dlg: dialogPtr; item, width: integer; vscroll, hscroll, hasgrow, static: boolean);
                procedure Destroy;
                procedure Failed (oe: OSErr);
                procedure InsertText (h: handle);
                procedure Resize;
                procedure Draw;
                procedure DoItemWhere (er: eventRecord; item: integer);
                procedure DoIdle;
                procedure DoKey (modifiers: integer; ch: integer);
                procedure DoActivateDeactivate (activate: boolean);
                procedure Click (where: point; extend: boolean);
                procedure Adjust;
                procedure SetupActions;
                procedure Action (vertical: boolean; part: integer);
                function EditMenuEnabled: boolean;
                procedure SetEditMenuItem (item: integer);
                procedure DoEditMenu (item: integer);
            end;

implementation

    uses
        Script, MyTypes, MyDialogs;

    const
        inHome = 9998;
        inEnd = 9999;

    function Pin (a, b, c: longInt): longInt;
    begin
        if b < a then
            Pin := a
        else if b > c then
            Pin := c
        else
            Pin := b;
    end;

    procedure EditObject.Failed (oe: OSErr);
    begin
        SysBeep(1);
    end;

    procedure EditObject.Create (dlg: dialogPtr; item, width: integer; vscroll, hscroll, hasgrow, static: boolean);
        var
            dr, vr: rect;
            k: integer;
            h: handle;
    begin
        SetPort(dlg);
        window := dlg;
        view_item := item;
        vcontrol := nil;
        has_grow := hasgrow;
        readonly := static;
        if vscroll then begin
            SetRect(dr, 0, 0, 16, 100);
            vcontrol := NewControl(window, dr, '', true, 0, 0, 0, scrollBarProc, 1);
        end;
        hcontrol := nil;
        if hscroll then begin
            SetRect(dr, 0, 0, 100, 16);
            hcontrol := NewControl(window, dr, '', true, 0, 0, 0, scrollBarProc, 0);
        end;
        GetDItemRect(dlg, view_item, dr);
        view_rect := dr;
        vr := dr;
        dr.right := dr.left + width;
        EraseRect(view_rect);
        te := TENew(dr, vr);
        TEAutoView(true, te);
        undotext := NewHandle(0);
        undostart := -1;
        undoopen := false;
        modified := false;
        Resize;
    end;

    procedure EditObject.Destroy;
    begin
        TEDispose(te);
        if vcontrol <> nil then
            DisposeControl(vcontrol);
        if hcontrol <> nil then
            DisposeControl(hcontrol);
        DisposHandle(undotext);
        dispose(self);
    end;

    procedure EditObject.InsertText (h: handle);
        var
            state: SignedByte;
    begin
        state := HGetState(h);
        HLock(h);
        TEInsert(h^, GetHandleSize(h), te);
        Adjust;
        HSetState(h, state);
    end;

    procedure AdjustTE (te: TEHandle; hc, vc: integer);
{Scroll the TERec around to match up to the potentially updated scrollbar}
{values. This is really useful when the window resizes such that the}
{scrollbars become inactive and the TERec had been previously scrolled.}
        var
            value: INTEGER;
    begin
        with te^^ do
            TEScroll((viewRect.left - destRect.left) - hc, (viewRect.top - destRect.top) - (vc * lineHeight), te);
    end; {AdjustTE}

    function AdjustHV (isVert: BOOLEAN; control: ControlHandle; te: TEHandle; canRedraw: BOOLEAN): integer;
{Calculate the new control maximum value and current value, whether it is the horizontal or}
{vertical scrollbar. The vertical max is calculated by comparing the number of lines to the}
{vertical size of the viewRect. The horizontal max is calculated by comparing the maximum document}
{width to the width of the viewRect. The current values are set by comparing the offset between}
{the view and destination rects. If necessary and we canRedraw, have the control be re-drawn by}
{calling ShowControl.}
        var
            value, lines, max: INTEGER;
            oldValue, oldMax: INTEGER;
            cliprgn: RgnHandle;
            r: rect;
    begin
        if control = nil then begin
            value := 0;
        end
        else begin
            oldValue := GetCtlValue(control);
            oldMax := GetCtlMax(control);
            with te^^ do begin
                if isVert then begin
                    lines := nLines;
        {since nLines isn’t right if the last character is a return, check for that case}
                    if (teLength > 0) & (Ptr(ORD(hText^) + teLength - 1)^ = 13) then
                        lines := lines + 1;
                    max := lines - ((viewRect.bottom - viewRect.top) div lineHeight);
                    if max < 0 then
                        max := 0;            {check for negative values}
                    value := (viewRect.top - destRect.top) div lineHeight
                end
                else begin
                    max := destRect.right - destRect.left - (viewRect.right - viewRect.left);
                    if max < 0 then
                        max := 0;            {check for negative values}
                    value := viewRect.left - destRect.left;
                end;
                value := Pin(0, value, max);
            end;
            SetCtlMax(control, max);
            SetCtlValue(control, value);
            if canRedraw and ((max <> oldMax) or (value <> oldValue)) then
                ShowControl(control);            {check to see if the control can be re-drawn}
        end;
        AdjustHV := value;
    end; {AdjustHV}

    procedure EditObject.Adjust;
        var
            hc, vc: integer;
    begin
        vc := AdjustHV(true, vcontrol, te, false);
        hc := AdjustHV(false, hcontrol, te, false);
        AdjustTE(te, hc, vc);
    end; {AdjustScrollValues}

    procedure EditObject.Resize;
        const
            invis = 0;
            vis = 255;
            inset = 3;
        var
            dr, vr: rect;
            pt: point;
            k: integer;
            h: handle;
            wd, ht: integer;
            hc, vc: integer;
    begin
        SetPort(window);
        EraseRect(view_rect);
        GetDItemRect(window, view_item, vr);
        view_rect := vr;
        InvalRect(vr);
        InsetRect(vr, inset, inset);
        if hcontrol <> nil then
            vr.bottom := vr.bottom - 15;
        if vcontrol <> nil then
            vr.right := vr.right - 15;
        vr.bottom := vr.top + (vr.bottom - vr.top) div te^^.lineHeight * te^^.lineHeight;

        pt := vr.topleft;
        SubPt(te^^.viewRect.topleft, pt);
        OffsetRect(te^^.destRect, pt.h, pt.v);

        te^^.viewRect := vr;

        if vcontrol <> nil then begin
            vcontrol^^.contrlVis := invis;
            MoveControl(vcontrol, view_rect.right - 16, view_rect.top);
            ht := view_rect.bottom - view_rect.top;
            if has_grow then
                ht := ht - 15;
            SizeControl(vcontrol, 16, ht);
            vc := AdjustHV(true, vcontrol, te, false);
            vcontrol^^.contrlVis := vis;
        end;
        if hcontrol <> nil then begin
            hcontrol^^.contrlVis := invis;
            MoveControl(hcontrol, view_rect.left, view_rect.bottom - 16);
            ht := view_rect.right - view_rect.left;
            if has_grow or (vcontrol <> nil) then
                ht := ht - 15;
            SizeControl(hcontrol, ht, 16);
            hc := AdjustHV(false, hcontrol, te, false);
            hcontrol^^.contrlVis := vis;
        end;
        AdjustTE(te, hc, vc);
    end;

    procedure EditObject.Draw;
        var
            r: rect;
            pt: point;
            k: integer;
            h: handle;
    begin
        GetDItemRect(window, view_item, r);
        EraseRect(r);
        if vcontrol <> nil then begin
            Draw1Control(vcontrol);
        end;
        if hcontrol <> nil then begin
            Draw1Control(hcontrol);
        end;
        EraseRect(te^^.viewRect);
        TEUpdate(te^^.viewRect, te);
    end;

    var
        actionTE: TEHandle;
        action_vcontrol, action_hcontrol: ControlHandle;

{ Common algorithm for pinning the value of a control. It returns the actual amount }
{ the value of the control changed. }
    procedure ActionScroll (vertical: boolean; amount: integer);
        var
            value, newvalue, max: integer;
            control: ControlHandle;
    begin
        if vertical then
            control := action_vcontrol
        else
            control := action_hcontrol;
        if control <> nil then begin
            value := GetCtlValue(control);
            max := GetCtlMax(control);
            newvalue := Pin(0, longInt(value) - amount, max);
            SetCtlValue(control, newvalue);
            amount := value - newvalue;   { calculate true change }
            if (amount <> 0) then begin
                if vertical then begin
                    TEScroll(0, amount * actionTE^^.lineHeight, actionTE);
                end
                else begin
                    TEScroll(amount, 0, actionTE);
                end;
            end;
        end;
    end; { CommonAction  }

{$PUSH}
{$D-}
    function MyClickLoop: boolean;
        var
            where: point;
            old_clip: RgnHandle;
    begin
        SetPort(actionTE^^.inPort);
        GetMouse(where);
        old_clip := NewRgn;
        GetClip(old_clip);
        ClipRect(actionTE^^.inPort^.portRect); { need to be able to update the controls }
        if where.v < actionTE^^.viewrect.top then begin
            ActionScroll(true, (actionTE^^.viewrect.top - where.v) div actionTE^^.lineheight + 1);
        end;
        if where.v > actionTE^^.viewrect.bottom then begin
            ActionScroll(true, -((where.v - actionTE^^.viewrect.bottom) div actionTE^^.lineheight + 1));
        end;
        if where.h < actionTE^^.viewrect.left then begin
            ActionScroll(false, actionTE^^.viewrect.left - where.h);
        end;
        if where.h > actionTE^^.viewrect.right then begin
            ActionScroll(false, -actionTE^^.viewrect.right - where.h);
        end;
        SetClip(old_clip);
        DisposeRgn(old_clip);
        MyClickLoop := true;
    end;
{$POP}

    procedure EditObject.SetupActions;
    begin
        actionTE := te;
        action_vcontrol := vcontrol;
        action_hcontrol := hcontrol;
    end;

    procedure EditObject.Click (where: point; extend: boolean);
    begin
        SetupActions;
        SetPort(window);
        SetClikLoop(@MyClickLoop, te);
        TEClick(where, extend, te);
        if readonly and (te^^.selStart = te^^.selEnd) then begin  { kludge to make the carret go away }
            TEDeactivate(te);
            TEActivate(te);
        end;
    end;

{ Determines how much to change the value of the vertical scrollbar by and how }
{ much to scroll the TE record.}
    procedure ActionProc (control: ControlHandle; part: integer);
        var
            amount: integer;
            vertical: boolean;
    begin
        if control <> nil then begin
            if (part <> 0) then begin
                vertical := GetCRefCon(control) <> 0;
                if vertical then begin
                    case part of
                        inUpButton, inDownButton:        { one line  }
                            amount := 1;
                        inPageUp, inPageDown:            { one page  }
                            with actionTE^^, viewRect do
                                amount := (bottom - top) div lineHeight;
                        inHome, inEnd:
                            amount := GetCtlMax(control);
                    end;
                end
                else begin
                    case part of
                        inUpButton, inDownButton:        { a few pixels }
                            amount := 8;
                        inPageUp, inPageDown:            { a page width }
                            with actionTE^^.viewRect do
                                amount := (right - left);
                        inHome, inEnd:
                            amount := GetCtlMax(control);
                    end;
                end;
                if ((part = inDownButton) or (part = inPageDown) or (part = inEnd)) then
                    amount := -amount;        { reverse direction for a downer  }
                ActionScroll(vertical, amount);
            end;
        end;
    end; { ActionProc }

    procedure EditObject.Action (vertical: boolean; part: integer);
    begin
        SetupActions;
        if vertical then begin
            ActionProc(vcontrol, part);
        end
        else begin
            ActionProc(hcontrol, part);
        end;
    end;

    procedure EditObject.DoItemWhere (er: eventRecord; item: integer);
        var
            control: controlHandle;
            value, part: integer;
            uss, use: integer;
    begin
        uss := te^^.selStart;
        use := te^^.selEnd;
        SetPort(window);
        GlobalToLocal(er.where);
        part := FindControl(er.where, window, control);
        if part = 0 then begin
            if PtInRect(er.where, te^^.viewRect) then
                Click(er.where, BAND(er.modifiers, shiftKey) <> 0)
        end
        else begin
            if part = inThumb then begin
                value := GetCtlValue(control);
                part := TrackControl(control, er.where, nil);
                if part <> 0 then begin
                    value := value - GetCtlValue(control);
                    if value <> 0 then begin
                        if control = vcontrol then begin
                            TEScroll(0, value * te^^.lineHeight, te);
                        end
                        else begin
                            TEScroll(value, 0, te);
                        end;
                    end;
                end;
            end
            else begin
                SetupActions;
                value := TrackControl(control, er.where, @ActionProc);
            end;
        end;
        if (uss <> te^^.selStart) or (use <> te^^.selEnd) then
            undoopen := false;
    end;

    function EditObject.EditMenuEnabled: boolean;
        var
            i: integer;
            offset: longInt;
    begin
        for i := EMundo to EMselectall do
            if i <> EMundo + 1 then
                SetEditMenuItem(i);
        EditMenuEnabled := false;
        if (te^^.selStart < te^^.selEnd) or (te^^.teLength > 0) then { Select All, Copy }
            EditMenuEnabled := true;
        if not readonly and ((undostart >= 0) or (GetScrap(nil, 'TEXT', offset) > 0)) then { Undo, Paste }
            EditMenuEnabled := true;
    end;

    procedure EditObject.SetEditMenuItem (item: integer);
        procedure SetEnable (on: boolean);
        begin
            if on then
                EnableItem(GetMHandle(M_Edit), item)
            else
                DisableItem(GetMHandle(M_Edit), item);
        end;
        var
            offset: longInt;
    begin
        case item of
            EMundo:
                SetEnable(undostart >= 0);
            EMcut, EMclear:
                SetEnable(not readonly and (te^^.selStart < te^^.selEnd));  { Can cut,clear iff there is a selection and its not readonly}
            EMcopy:
                SetEnable(te^^.selStart < te^^.selEnd);  { Can copy iff there is a selection }
            EMpaste:
                SetEnable(not readonly and (GetScrap(nil, 'TEXT', offset) > 0));        {Paste is enabled for app. windows}
            EMselectall:
                SetEnable(te^^.teLength > 0);  { Can select all iff there is something to select }
            otherwise
        end;
    end;

    procedure CopyUndoSelection (h: handle; te: TEHandle);
    begin
        SetHandleSize(h, te^^.selEnd - te^^.selStart);
        BlockMove(ptr(longInt(te^^.hText^) + te^^.selStart), h^, te^^.selEnd - te^^.selStart);
    end;

    procedure EditObject.DoEditMenu (item: integer);
        var
            oe: OSErr;
            loe: longInt;
            th: handle;
            uss, use: integer;
    begin
        undoopen := false;
        case item of
            EMcopy:  begin
                TECopy(te);
                loe := ZeroScrap;
                oe := TEToScrap;
            end;
            EMselectall:  begin
                SetPort(window);
                TESetSelect(0, maxLongInt, te);
            end;
            EMcut:  begin
                CopyUndoSelection(undotext, te);
                undoselstart := te^^.selStart;
                undoselend := te^^.selEnd;
                undostart := te^^.selStart;
                undoend := undostart;
                TECut(te);
                loe := ZeroScrap;
                oe := TEToScrap;
                modified := true;
            end;
            EMclear:  begin
                CopyUndoSelection(undotext, te);
                undoselstart := te^^.selStart;
                undoselend := te^^.selEnd;
                undostart := te^^.selStart;
                undoend := undostart;
                TEDelete(te);
                modified := true;
            end;
            EMpaste:  begin
                oe := TEFromScrap;
                if TEGetScrapLen + (te^^.teLength - (te^^.selEnd - te^^.selStart)) > 32000 then begin
                    Failed(paste_to_big);
                end
                else begin
                    CopyUndoSelection(undotext, te);
                    undoselstart := te^^.selStart;
                    undoselend := te^^.selEnd;
                    undostart := te^^.selStart;
                    TEPaste(te);
                    undoend := te^^.selEnd;
                    modified := true;
                end;
            end;
            EMundo:  begin
                uss := undoselstart;
                use := undoselend;
                undoselstart := te^^.selStart;
                undoselend := te^^.selEnd;
                th := NewHandle(undoend - undostart);
                BlockMove(ptr(longInt(te^^.hText^) + undostart), th^, undoend - undostart); { save undo for redo }
                TESetSelect(undostart, undoend, te);
                TEDelete(te);
                HLock(undotext);
                TEInsert(undotext^, GetHandleSize(undotext), te);
                DisposHandle(undotext);
                undotext := th;
                undoend := te^^.selEnd;
                TESetSelect(uss, use, te);
            end;
            otherwise
        end;
    end;

    procedure EditObject.DoIdle;
    begin
        if not readonly then
            TEIdle(te);
    end;

    procedure EditObject.DoKey (modifiers: integer; ch: integer);
        procedure Doit;
        begin
            TEKey(chr(ch), te);
            Adjust;
        end;
        var
            dk: boolean;
            cmd, opt, shift: boolean;
            start, finish, length: longInt;
    begin
        cmd := BAND(modifiers, cmdKey) <> 0;
        opt := BAND(modifiers, optionKey) <> 0;
        shift := BAND(modifiers, shiftKey) <> 0;
        case ch of
            homeChar:
                Action(true, inHome);
            endChar:
                Action(true, inEnd);
            pageUpChar:
                Action(true, inPageUp);
            pageDownChar:
                Action(true, inPageDown);
            rightArrowChar, leftArrowChar, upArrowChar, downArrowChar:  begin
                finish := te^^.selEnd;
                start := te^^.selStart;
                if cmd & opt & (ch = upArrowChar) then begin
                    start := 0;
                    if not shift then
                        finish := 0;
                    TESetSelect(start, finish, te);
                end
                else if cmd & opt & (ch = downArrowChar) then begin
                    if not shift then
                        start := maxLongInt;
                    finish := maxLongInt;
                    TESetSelect(start, finish, te);
                end
                else begin
                    if shift and (ch = downArrowChar) then
                        TESetSelect(finish, finish, te);
                    TEKey(chr(ch), te);
                    if shift then begin
                        if te^^.selEnd > finish then
                            finish := te^^.selEnd;
                        if te^^.selStart < start then
                            start := te^^.selStart;
                        TESetSelect(start, finish, te);
                    end;
                end;
                Adjust;
            end;
            helpChar:
                Doit;
            otherwise begin
                begin
                    if not readonly then begin
                        modified := true;
                        if not undoopen then begin
                            CopyUndoSelection(undotext, te);
                            undoselstart := te^^.selStart;
                            undoselend := te^^.selEnd;
                            undostart := te^^.selStart;
                        end;
                        Doit;
                        undoend := te^^.selEnd;
                        undoopen := true;
                    end
                    else begin
                        SysBeep(1);
                    end; { if }
                end; { begin }
            end; { otherwise }
        end; { case }
    end; { DoKey }

    procedure EditObject.DoActivateDeactivate (activate: boolean);
    begin
        if activate then begin
            TEActivate(te);
        end
        else begin
            TEDeactivate(te);
        end;
    end;

end.
SetPort(te^^.inPort);
clipRgn := NewRgn;
GetClip(clipRgn);
SetRect(r, 0, 0, 0, 0);
ClipRect(r);
SetCtlMax(control, max);
SetClip(clipRgn);
DisposeRgn(clipRgn);