Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPPAN.ZIP/PICK.PAS

Pascal/Delphi Source File | 1990-05-10 | 5.7 KB | 221 lines

{

    pick.pas
    5-10-90

    Copyright 1990
    John W. Small
    All rights reserved

    PSW / Power SoftWare
    P.O. Box 10072
    McLean, Virginia 22102 8072

}

unit pick;

interface

    uses crt, panscrol, crtplus, flex;

    type

        PickAttrs = (PICK_TITLE_ATTR, PICK_BORDER_ATTR,
                    PICK_SCROLL_ATTR, PICK_NORMAL_ATTR,
                    PICK_SELECT_ATTR, PICK_HILITE_ATTR);
        PickAttrsArray = array[PickAttrs] of byte;
        PickAttrsA = ^PickAttrsArray;

    const

        PickColorAttrs : PickAttrsArray = (
            BLACK + LIGHTGRAY * 16,
            BLACK + LIGHTGRAY * 16,
            RED   + LIGHTGRAY * 16,
            BLACK + LIGHTGRAY * 16,
            WHITE + BLACK     * 16,
            RED   + LIGHTGRAY * 16);

        PickMonoAttrs : PickAttrsArray = (
            BLACK + LIGHTGRAY * 16,
            BLACK + LIGHTGRAY * 16,
            WHITE + LIGHTGRAY * 16,
            BLACK + LIGHTGRAY * 16,
            WHITE + BLACK     * 16,
            WHITE + LIGHTGRAY * 16);

    type

        PickList = object(FlexList)
            color, mono, attrs : PickAttrsA;
            ps : PanScroller;
            finished : boolean;
            title : string;
            constructor init(PickFlexDataSize,
                PickRows, PickColumns : word;
                PickX, PickY, PickColumnWidth : byte;
                PickTitle : string);
            procedure   showItem; virtual;
            function    doItem : boolean; virtual;
            procedure   query;
            destructor  done; virtual;
            end;

implementation


    constructor PickList.init(PickFlexDataSize,
                PickRows, PickColumns : word;
                PickX, PickY, PickColumnWidth : byte;
                PickTitle : string);
        begin
            FlexList.init(PickFlexDataSize);
            color := @PickColorAttrs;
            mono := @PickMonoAttrs;
            if TxtScr.ColorAttrs then
                attrs := color
            else
                attrs := mono;
            ps.init(0,PickColumns,PickRows,PickColumns);
            ps.ScreenStartColumn := PickX;
            ps.ScreenStartRow := PickY;
            ps.ScreenColumnWidth := PickColumnWidth;
            title := PickTitle
        end;

    procedure   PickList.showItem;
        begin
        end;

    function    PickList.doItem : boolean;
        begin
        end;

    procedure   PickList.query;
        var lp,wrow,wcols,scol : word;
            p : pointer;
            w : FramedTextWindow;
        begin
            if nodes = 0 then exit;
            if TxtScr.ColorAttrs then
                attrs := color
            else
                attrs := mono;
            w.window(ps.ScreenStartColumn,
                ps.ScreenStartRow,
                ps.ScreenStartColumn +
                    ps.WindowColumns *
                    (ps.ScreenColumnWidth + 3),
                ps.ScreenStartRow + ps.WindowRows + 1);
            cursor.Off;
            w.frame(attrs^[PICK_BORDER_ATTR],svsh);
            w.titleFooter(true,attrs^[PICK_TITLE_ATTR],title);
            ps.ResizeImage(
                (nodes-1) div ps.ImageColumns + 1,
                ps.ImageColumns);
            ps.CursorRC(1,1);
            ps.UpdateWindow := true;
            finished := false;
            while not finished  do begin
                if ps.UpdateWindow or ps.UpdateCursor then begin
                    if ps.UpdateWindow then begin
                        crt.textAttr := attrs^[PICK_NORMAL_ATTR];
                        clrscr;
                        lp := word(ps.WindowStartLinearPosition);
                        mkcur(lp);
                        for wrow := 1 to ps.WindowRows do begin
                            scol := 2;
                            wcols := ps.WindowColumns;
                            while ok and (wcols > 0) do begin
                                gotoxy(scol,wrow);
                                showItem;
                                if nextD(p) then;
                                dec(wcols);
                                inc(scol,ps.ScreenColumnWidth);
                                inc(scol,3);
                                end;
                            inc(lp,ps.ImageColumns);
                            mkcur(lp);
                            end;
                        ps.UpdateWindow := false
                        end
                    else begin    { Erase last hilite bar }
                        TxtScr.windLightBar(
                            ps.LastCursorWindowColumn,
                            ps.LastCursorWindowRow,
                            ps.ScreenColumnWidth+2,
                            attrs^[PICK_NORMAL_ATTR]);
                        gotoxy(ps.LastCursorWindowColumn+1,
                            ps.LastCursorWindowRow);
                        showItem
                        end;
                    mkcur(word(ps.CursorLinearPosition));
                    ps.LastCursorWindowRow :=
                        ps.CursorWindowRow;
                    ps.LastCursorWindowColumn :=
                        (ps.CursorWindowColumn-1) *
                        (ps.ScreenColumnWidth+3)+1;
                    TxtScr.windLightBar(
                        ps.LastCursorWindowColumn,
                        ps.LastCursorWindowRow,
                        ps.ScreenColumnWidth+2,
                        attrs^[PICK_SELECT_ATTR]);
                    w.scrollBar(true,attrs^[PICK_BORDER_ATTR],svsh,
                        attrs^[PICK_SCROLL_ATTR],
                        ps.CursorImageRow,
                        (nodes-1) div ps.ImageColumns + 1);
                    ps.UpdateCursor := false;
                    end;    { if update }
                case crtplus.readkey of
                    #0: begin
                        case char(hi(crtplus.asciiScan)) of
                            DnArr: ps.CursorDown;
                            UpArr: ps.CursorUp;
                            RArr: ps.CursorRight;
                            LArr: ps.CursorLeft;
                            PgUp: ps.CursorPgUp;
                            PgDn: ps.CursorPgDown;
                            Home: ps.CursorRC(1,1);
                            EndKey: ps.CursorRC(ps.ImageRows,1);
                        end; { case hi(asciiScan) }
                        end; { #0: }
                    ESC: begin
                        w.done;
                        finished := true
                        end;
                    CR: if ps.CursorLinearPosition <= nodes
                        then begin
                        if doItem then
                           finished := true
                        else if nodes = 0 then
                             finished := true
                        else begin
                            ps.ResizeImage(
                                (nodes-1) div ps.ImageColumns + 1,
                                ps.ImageColumns);
                            ps.CursorRC(1,1);
                            ps.UpdateWindow := true;
                            w.frame(attrs^[PICK_BORDER_ATTR],svsh);
                            w.titleFooter(true,attrs^[PICK_TITLE_ATTR],title)
                            end;
                        if finished then
                           w.done;
                        end;
                end { case crtplus.readkey }
                end { while not finished }
        end;

    destructor  PickList.done;
        begin
            FlexList.done
        end;

    begin

    end.