MacFormat 1995 June/MacFormat 25.iso/Shareware City/Developers/ICAppSourceKit1.0/ICText.p

Text File | 1994-11-11 | 11.6 KB | 460 lines | [TEXT/PJMM]

unit ICText;

interface

    function TextCreate (var data: univ ptr; window: DialogPtr; item: integer; font: integer; size: integer; locked: boolean): OSErr;
    procedure TextDestroy (var data: univ ptr);
    procedure TextDraw (data: univ ptr);
    procedure TextActivate (data: univ ptr; activate: boolean);
    procedure TextClick (data: univ ptr; er: eventRecord);
    procedure TextIdle (data: univ ptr);
    procedure TextKey (data: univ ptr; er: EventRecord);
    procedure TextSetSelect (data: univ ptr; selStart, selEnd: integer);
    procedure TextGetSelect (data: univ ptr; var selStart, selEnd: integer);
    procedure TextGetSize (data: univ ptr; var text_size: longint);
    procedure TextInsert (data: univ ptr; h: Handle);
    procedure TextGet (data: univ ptr; h: Handle);
    procedure TextMove (data: univ ptr; r: Rect);

    procedure TextCut (data: univ ptr);
    procedure TextCopy (data: univ ptr);
    procedure TextPaste (data: univ ptr);
    procedure TextClear (data: univ ptr);

    procedure NopCaretHook; { asm }

implementation

    uses
        ICDialogs;

    type
        ItemData = record
                window: DialogPtr;
                item: integer;
                te: TEHandle;
                fi: FontInfo;
                lineheight: integer;
                active: boolean;
            end;
        ItemDataPtr = ^ItemData;

    function TextCreate (var data: univ ptr; window: DialogPtr; item: integer; font: integer; size: integer; locked: boolean): OSErr;
        var
            err: OSErr;
            idp: ItemDataPtr;
            view, dest: rect;
            saved: SavedWindowInfo;
    begin
        data := NewPtr(SizeOf(ItemData));
        err := MemError;
        if err = noErr then begin
            idp := ItemDataPtr(data);
            idp^.window := window;
            idp^.item := item;
            idp^.te := nil;
            idp^.active := true;
            EnterWindow(window, font, size, [], saved);
            with idp^ do begin
                GetDItemRect(window, item, dest);
                view := dest;
                GetFontInfo(fi);
                lineheight := fi.leading + fi.ascent + fi.descent;
                dest.bottom := dest.top + (dest.bottom - dest.top) div lineheight * lineheight;
                te := TENew(dest, view);
                if locked then begin
                    te^^.caretHook := @NopCaretHook; { Disable the caret }
                end;
                TEAutoView(true, te);
            end;
            ExitWindow(saved);
            if err <> nOErr then begin
                TextDestroy(data);
            end;
        end;
        TextCreate := err;
    end;

    procedure TextDestroy (var data: univ ptr);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        if data <> nil then begin
            if idp^.te <> nil then begin
                TEDispose(idp^.te);
            end;
            DisposePtr(data);
            data := nil;
        end;
    end;

    procedure TextDraw (data: univ ptr);
        var
            idp: ItemDataPtr;
            r: rect;
    begin
        idp := ItemDataPtr(data);
        GetDItemRect(idp^.window, idp^.item, r);
        EraseRect(r);
        TEUpdate(idp^.te^^.viewRect, idp^.te);
    end;

    procedure TextActivate (data: univ ptr; activate: boolean);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        idp^.active := activate;
        if idp^.active then begin
            TEActivate(idp^.te);
        end
        else begin
            TEDeactivate(idp^.te);
        end;
    end;

    procedure TextClick (data: univ ptr; er: EventRecord);
        var
            idp: ItemDataPtr;
            control: controlHandle;
            value, part: integer;
    begin
        idp := ItemDataPtr(data);
        with idp^ do begin
            SetPort(window);
            GlobalToLocal(er.where);
            part := FindControl(er.where, window, control);
            if part = 0 then begin
                if PtInRect(er.where, te^^.viewRect) then begin
                    TEClick(er.where, BAND(er.modifiers, shiftKey) <> 0, te);
                end;
            end
            else begin
            end;
        end;
    end;

    procedure TextIdle (data: univ ptr);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        TEIdle(idp^.te);
    end;

    procedure TextKey (data: univ ptr; er: EventRecord);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        if BAND(er.modifiers, cmdKey) = 0 then begin
            TEKey(chr(BAND(er.message, $FF)), idp^.te);
        end;
{    Adjust;}
    end;

    procedure TextSetSelect (data: univ ptr; selStart, selEnd: integer);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        TESetSelect(selStart, selEnd, idp^.te);
    end; (* TextSetSelect *)

    procedure TextGetSelect (data: univ ptr; var selStart, selEnd: integer);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        selStart := idp^.te^^.selStart;
        selEnd := idp^.te^^.selEnd;
    end;

    procedure TextGetSize (data: univ ptr; var text_size: longint);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        text_size := GetHandleSize(idp^.te^^.hText);
    end;

    procedure TextInsert (data: univ ptr; h: Handle);
        var
            idp: ItemDataPtr;
            s: signedByte;
    begin
        idp := ItemDataPtr(data);
        s := HGetState(h);
        HLock(h);
        TEInsert(h^, GetHandleSize(h), idp^.te);
        HSetState(h, s);
    end; (* TextInsert *)

    procedure TextGet (data: univ ptr; h: Handle);
        var
            idp: ItemDataPtr;
            source_size: longint;
            source: Handle;
    begin
        idp := ItemDataPtr(data);
        source := Handle(TEGetText(idp^.te));
        source_size := GetHandleSize(source);
        SetHandleSize(h, source_size);
        if MemError = noErr then begin
            BlockMove(source^, h^, source_size);
        end
        else begin
            SetHandleSize(h, 0);
        end; (* if *)
    end; (* TextGet *)

    procedure TextMove (data: univ ptr; r: Rect);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        idp^.te^^.viewRect := r;
        idp^.te^^.destRect := r;
        TECalText(idp^.te);
    end;

    procedure TextCut (data: univ ptr);
        var
            idp: ItemDataPtr;
            junk: longint;
    begin
        idp := ItemDataPtr(data);
        TECut(idp^.te);
        junk := ZeroScrap;
        junk := TEToScrap;
    end;

    procedure TextCopy (data: univ ptr);
        var
            idp: ItemDataPtr;
            junk: longint;
    begin
        idp := ItemDataPtr(data);
        TECopy(idp^.te);
        junk := ZeroScrap;
        junk := TEToScrap;
    end;

    procedure TextPaste (data: univ ptr);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        if TEFromScrap = noErr then begin
            TEPaste(idp^.te);
        end; (* if *)
    end;

    procedure TextClear (data: univ ptr);
        var
            idp: ItemDataPtr;
    begin
        idp := ItemDataPtr(data);
        TEDelete(idp^.te);
    end;

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
    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);
        end
        else
            max := destRect.right - destRect.left - (viewRect.right - viewRect.left);
        if max < 0 then
            max := 0;            {check for negative values}
        if isVert then
            value := (viewRect.top - destRect.top) div lineHeight
        else
            value := viewRect.left - destRect.left;
        if value < 0 then
            value := 0
        else if value > max then
            value := max;                    {pin the value to within range}
    end;
    SetPort(te^^.inPort);
    clipRgn := NewRgn;
    GetClip(clipRgn);
    SetRect(r, 0, 0, 0, 0);
    ClipRect(r);
    SetCtlMax(control, max);
    SetClip(clipRgn);
    DisposeRgn(clipRgn);
    SetCtlValue(control, value);
    if canRedraw and ((max <> oldMax) or (value <> oldValue)) then
        ShowControl(control);            {check to see if the control can be re-drawn}
    AdjustHV := value;
end; {AdjustHV}

procedure TEStaticObject.Adjust;
    var
        hc, vc: integer;
begin
    vc := AdjustHV(true, vcontrol, te, false);
    hc := AdjustHV(false, hcontrol, te, false);
    AdjustTE(te, hc, vc);
end; {AdjustScrollValues}
{ Common algorithm for pinning the value of a control. It returns the actual amount }
{ the value of the control changed. }
procedure CommonAction (control: ControlHandle; var amount: integer);
    var
        value, max: integer;
begin
    value := GetCtlValue(control);
    max := GetCtlMax(control);
    amount := value - amount;
    if (amount <= 0) then
        amount := 0
    else if (amount >= max) then
        amount := max;
    SetCtlValue(control, amount);
    amount := value - amount;   { calculate true change }
end; { CommonAction  }

var
    actionTE: TEHandle;

{ Determines how much to change the value of the vertical scrollbar by and how }
{ much to scroll the TE record.}
procedure VActionProc (control: ControlHandle; part: integer);
    var
        amount: integer;
        window: WindowPtr;
begin
    if (part <> 0) then begin
        window := control^^.contrlOwner;
        case part of
            inUpButton, inDownButton:        { one line  }
                amount := 1;
            inPageUp, inPageDown:            { one page  }
                with actionTE^^, viewRect do
                    amount := (bottom - top) div lineHeight;
        end;
        if ((part = inDownButton) or (part = inPageDown)) then
            amount := -amount;        { reverse direction for a downer  }
        CommonAction(control, amount);
        if (amount <> 0) then
            TEScroll(0, amount * actionTE^^.lineHeight, actionTE);
    end;
end; { VActionProc }

{ Determines how much to change the value of the horizontal scrollbar by and how }
{ much to scroll the TE record. }
procedure HActionProc (control: ControlHandle; part: integer);
    var
        amount: integer;
        window: WindowPtr;
begin
    if (part <> 0) then begin
        window := control^^.contrlOwner;
        case part of
            inUpButton, inDownButton:        { a few pixels }
                amount := 8;
            inPageUp, inPageDown:            { a page width }
                with actionTE^^.viewRect do
                    amount := (right - left);
        end;
        if ((part = inDownButton) or (part = inPageDown)) then
            amount := -amount;        { reverse direction }
        CommonAction(control, amount);
        if (amount <> 0) then
            TEScroll(amount, 0, actionTE);
    end;
end; { HActionProc }
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
            if control = vcontrol then
                TEScroll(0, value * te^^.lineHeight, te)
            else
                TEScroll(value, 0, te);
    end;
end
else begin
    actionTE := te;
    if control = vcontrol then
        value := TrackControl(control, er.where, @VActionProc)
    else
        value := TrackControl(control, er.where, @HActionProc);
end;
function TEStaticObject.EditMenuEnabled: boolean;
    var
        i: integer;
begin
    for i := EMundo to EMselectall do
        if i <> EMundo + 1 then
            SetEditMenuItem(i);
    EditMenuEnabled := (te^^.selStart < te^^.selEnd) or (te^^.teLength > 0);
end;

procedure TEStaticObject.SetEditMenuItem (item: integer);
begin
    case item of
        EMundo, EMcut, EMpaste, EMclear:  { Can't undo, cut, copy, paste in a static edit thingy }
            SetIDItemEnable(M_Edit, item, false);
        EMcopy:
            SetIDItemEnable(M_Edit, item, te^^.selStart < te^^.selEnd);  { Can copy iff there is a selection }
        EMselectall:
            SetIDItemEnable(M_Edit, item, te^^.teLength > 0);  { Can select all iff there is something to select }
        otherwise
    end;
end;

procedure TEStaticObject.DoEditMenu (item: integer);
    var
        oe: OSErr;
        loe: longInt;
begin
    case item of
        EMcopy:  begin
            TECopy(te);
            loe := ZeroScrap;
            oe := TEToScrap;
        end;
        EMselectall:  begin
            SetPort(window);
            TESetSelect(0, maxLongInt, te);
        end;
        otherwise
    end;
end;