Power-Programmierung/CD1.mdf/pascal/library/dos/crtplus/crtplus.int

Text File | 1990-01-05 | 14.2 KB | 547 lines

{

    CrtPlus.pas
    1-5-90

    Keyboard, cursor, and window enhancements to
    Turbo Pascal 5.5's Crt unit.

    Copyright 1990
    John W. Small
    All rights reserved

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

    If you acquired the CrtPlus ToolBox through 'shareware'
    and find it useful, a registration fee of $20 would
    be appreciated.  Upon registion you will be sent source
    code, manual on disk, the latest example programs, and
    notices of updates.


    Works consulted:

    Norton, Peter. "Program's Guide to the IBM PC."
            Bellevue, Washington: Microsoft Press, 1985.

    Duncan, Ray. "Advanced MS DOS.", Bellevue Washington:
            Microsoft Press, 1986.

    Wilton, Richard. "Programmer's Guide to PC & PS/2
            Video Systems.", Bellevue Washington:
            Microsoft Press, 1987.

}

unit CrtPlus;

interface

    uses dos, crt;

    const

        {
            Ascii codes returned by CrtPlus.ReadKey, and
            Crt.ReadKey (first call).
        }

        ESC         =   #27;
        CR          =   #13;
        Tab         =    #9;
        BackSp      =    #8;
        Space       =   #32;
        DelCh       =  #127;

        CtrlA       =    #1;
        CtrlB       =    #2;
        CtrlC       =    #3;
        CtrlD       =    #4;
        CtrlE       =    #5;
        CtrlF       =    #6;
        CtrlG       =    #7;
        CtrlH       =    #8;
        CtrlI       =    #9;
        CtrlJ       =   #10;
        CtrlK       =   #11;
        CtrlL       =   #12;
        CtrlM       =   #13;
        CtrlN       =   #14;
        CtrlO       =   #15;
        CtrlP       =   #16;
        CtrlQ       =   #17;
        CtrlR       =   #18;
        CtrlS       =   #19;
        CtrlT       =   #20;
        CtrlU       =   #21;
        CtrlV       =   #22;
        CtrlW       =   #23;
        CtrlX       =   #24;
        CtrlY       =   #25;
        CtrlZ       =   #26;


        {
            Scan codes returned when (CrtPlus.ReadKey = #0)
            via the global variable, CrtPlus.scan,
            or by Crt.ReadKey (second call). Please note
            that CrtPlus.ReadKey requires only one call
            since the extended character set characters are
            returned in CrtPlus.scan.  CrtPlus.ReadKey is
            faster than Crt.ReadKey since it is inline code
            which also explains why I couldn't make the
            keyboard into an object.
        }

        AltA        =    #30;
        AltB        =    #48;
        AltC        =    #46;
        AltD        =    #32;
        AltE        =    #18;
        AltF        =    #33;
        AltG        =    #34;
        AltH        =    #35;
        AltI        =    #23;
        AltJ        =    #36;
        AltK        =    #37;
        AltL        =    #38;
        AltM        =    #50;
        AltN        =    #49;
        AltO        =    #24;
        AltP        =    #25;
        AltQ        =    #16;
        AltR        =    #19;
        AltS        =    #31;
        AltT        =    #20;
        AltU        =    #22;
        AltV        =    #47;
        AltW        =    #17;
        AltX        =    #45;
        AltY        =    #21;
        AltZ        =    #44;

        Home        =    #71;
        UpArr       =    #72;
        PgUp        =    #73;
        LArr        =    #75;
        RArr        =    #77;
        EndKey      =    #79;
        DnArr       =    #80;
        PgDn        =    #81;
        InsKey      =    #82;
        DelKey      =    #83;

        CtrlHome    =    #119;
        CtrlPgUp    =    #132;
        CtrlLArr    =    #115;
        CtrlRArr    =    #116;
        CtrlEnd     =    #117;
        CtrlPgDn    =    #118;


        Alt1        =    #120;
        Alt2        =    #121;
        Alt3        =    #122;
        Alt4        =    #123;
        Alt5        =    #124;
        Alt6        =    #125;
        Alt7        =    #126;
        Alt8        =    #127;
        Alt9        =    #128;
        Alt0        =    #129;

        AltHyphen   =    #130;
        AltEquals   =    #131;
        CtrlPrtSc   =    #114;
        ShiftTab    =     #15;


        F1          =     #59;
        ShiftF1     =     #84;
        CtrlF1      =     #94;
        AltF1       =    #104;

        F2          =     #60;
        ShiftF2     =     #85;
        CtrlF2      =     #95;
        AltF2       =    #105;

        F3          =     #61;
        ShiftF3     =     #86;
        CtrlF3      =     #96;
        AltF3       =    #106;


        F4          =     #62;
        ShiftF4     =     #87;
        CtrlF4      =     #97;
        AltF4       =    #107;

        F5          =     #63;
        ShiftF5     =     #88;
        CtrlF5      =     #98;
        AltF5       =    #108;

        F6          =     #64;
        ShiftF6     =     #89;
        CtrlF6      =     #99;
        AltF6       =    #109;

        F7          =     #65;
        ShiftF7     =     #90;
        CtrlF7      =    #100;
        AltF7       =    #110;

        F8          =     #66;
        ShiftF8     =     #91;
        CtrlF8      =    #101;
        AltF8       =    #111;

        F9          =     #67;
        ShiftF9     =     #92;
        CtrlF9      =    #102;
        AltF9       =    #112;

        F10         =     #68;
        ShiftF10    =     #93;
        CtrlF10     =    #103;
        AltF10      =    #113;

        {  some BIOS' don't return these  }

        F11         =    #133;
        ShiftF11    =    #135;
        CtrlF11     =    #137;
        AltF11      =    #139;

        F12         =    #134;
        ShiftF12    =    #136;
        CtrlF12     =    #138;
        AltF12      =    #140;


        {
            BIOS keyboard shift constants used to mask value
            returned by CrtPlus.ReadShift, e.g.

                if CapsLock and ReadShift then ...
        }

        InsertState         =   128;
        CapsLock            =    64;
        NumLock             =    32;
        ScrollLock          =    16;
        AltPressed          =     8;
        CtrlPressed         =     4;
        LeftShiftPressed    =     2;
        RightShiftPressed   =     1;
        ShiftPressed        =     3;

    type

        {
            TextFrameChars are the IBM extended character
            set characters used to draw line boxes.  Imagine
            a box with a cross inside, then the characters
            needed to draw this are typified by the corners
            of the box, the four points the cross touches
            the outside box, and the center of the cross.

            Indices into textFrameChars are thus:

                rt = top-right corner of the box,
                mm = middle-middle or center of cross,
                mb = middle-bottom where cross touches
                        the bottom of the box
                etc.
        }

        textFrameChars = (v,h,lt,rt,rb,lb,ml,mt,mr,mb,mm);

        textFrame = array[textFrameChars] of char;

    const

        {
            Text Box Drawing Characters:

                svsh = single vert., single horizonal lines
                dvdh = double vert., double horizonal lines
                etc.
        }

        svsh : textFrame =
            #179#196#218#191#217#192#195#194#180#193#197;
        svdh : textFrame =
            #179#205#213#184#190#212#198#209#181#207#216;
        dvsh : textFrame =
            #186#196#214#183#189#211#199#210#182#208#215;
        dvdh : textFrame =
            #186#205#201#187#188#200#204#203#185#202#206;

    type


        { Cursor object for turning on/off cursor, etc. }

        CursorShape = object                { CURSORSHAPE }
            OrigShape, prevShape : word;
            procedure init;     { Do not call! }
            function  getShape : word;
            procedure putShape (shape : word);
            function  defaultShape : word;
            procedure off;
            procedure on;
            procedure block;
            procedure normal;
            procedure restore;
            procedure done;
        end;



        { Object for storing text screen images. }

        TextImage = object                    { TEXTIMAGE }
            ImageMin, ImageMax : word;
            image : ^word;
            procedure init (x1, y1, x2, y2 : byte);
            procedure done
        end;



        {
            Turbo Pascal's text-screen state, i.e. current
            window, text attribute, cursor position, and
            cursor shape.
        }

        TurboWindow = object                { TURBOWINDOW }
            WindMin, WindMax : word;
            textAttr, wherex, wherey : byte;
            curshape : word;
            procedure save;
            procedure restore;
        end;



        {
            TextWindow is a direct replacement for Turbo
            Pascal's window procedure.  It sets the current
            window, like Turbo Pascal does, but it also
            saves the shadow beneath the window and the
            screen state before the window was called.  When
            done is called the window is removed and the
            screen returned to its previous state.  Call
            TxtScr.TextMode() instead of Crt.TextMode()
            when changing video modes to insure proper
            operation!
        }

        TextWindow = object                    { TEXTWINDOW }
            shadow : TextImage;
            prevWind  : TurboWindow;
            procedure window (x1, y1, x2, y2 : byte);
            procedure done
        end;



        {
            The TextScreen object provides enhancements to
            Turbo Pascal's Crt unit's treatment of the text
            screen.  The TextScreen object works in all the
            text modes supported by Turbo Pascal including
            43/50 line modes!  It also respects the setting
            of Crt.CheckSnow and Crt.DirectVideo!  The only
            restriction is that your call TxtScr.TextMode()
            instead of Crt.TextMode() when changing video
            modes.
        }

        TextScreen = object                    { TEXTSCREEN }

            OrigMode, dim, vseg, vport : word;
            prevTextAttr : byte;
            state : TextWindow;    { used by save and restore }
            CheckSnow, DirectVideo : boolean;
            vmode : integer;

            procedure init;     { Do not call! }


            { Use to save screen during exec calls. }

            procedure save;
            procedure restore;


            { Use instead of Crt.TextMode(). }

            procedure TextMode  (mode : integer);
            function  VideoMode : integer;
            function  IsTextMode : boolean;
            function  IsColorMode : boolean;


            { Use to extend Low/Norm/High video. }

            procedure ReverseVideo;
            procedure SetVideo  (fgrd, bgrd : byte);
            procedure BlinkVideo;
            procedure UnblinkVideo;
            procedure RestoreVideo;


            { Use to construct TextAttr bytes. }

            function  rvideo (attr : byte) : byte;
            function  svideo (fgrd, bgrd : byte) : byte;
            function  bvideo (attr : byte) : byte;
            function  ubvideo (attr : byte) : byte;
            function  lvideo (attr : byte) : byte;
            function  hvideo (attr : byte) : byte;


            { Use to save and restore screen images. }

            procedure getText   (var ti : TextImage);
            procedure putText   (var ti : TextImage);


            {
                Use instead of WhereX and WhereY for
                screen coordinates.
            }

            function  scrX : byte;
            function  scrY : byte;


            { Use to write to screen without scroll/wrap. }

            procedure scrWrite  (
                x, y, maxLen, attr : byte;
                var str : string);
            procedure scrFill   (
                x, y, len, attr : byte; ch : char);
                { Note: if ch = #0 then fill attr only }
            procedure scrHorzLn (
                left, row, right, attr: byte; ch: char);
            procedure scrVertLn (
                col, top, bottom, attr: byte; ch: char);
            procedure scrBox    (
                x1, y1, x2, y2, attr: byte;
                var tf : textFrame);


            {
                Use to write to current crt.window without
                scroll/wrap
            }

            procedure windWrite (var str : string);
            procedure windLightBar (x, y, len, attr : byte);
            procedure windColor (fgrd, bgrd : byte);


            {  Call to restore original crt mode. }

            procedure done
        end;



        {
            FramedTextWindow is a popup window object drived
            from the TextWindow object.  This window has an
            optional border, title and/or footer, and scroll
            bar(s).  This object provides an example of how
            the TextWindow object is extensible and can be
            used as a base class object to construct any
            type of text window!  Call TxtScr.TextMode()
            instead of Crt.TextMode() when changing video
            modes to insure proper operation!
        }

                                    { FRAMEDTEXTWINDOW }

        FramedTextWindow = object(TextWindow)
            procedure window (x1, y1, x2, y2 : byte);
            procedure frame  (
                attr : byte; var f : textFrame);
            procedure titleFooter (
                title : boolean; attr : byte; str : string);
            procedure scrollBar (
                vert : boolean; attr : byte;
                var f : textFrame; p, maxp : integer);
            { Uses procedure TextWindow.done; }
        end;



        {
            ShadowTextWindow is yet another popup window
            object drived from the TextWindow object.  This
            window has an title bar and shadow beneath the
            window.  This object is yet another extension to
            the TextWindow object.  Call TxtScr.TextMode()
            instead of Crt.TextMode() when changing video
            modes to insure proper operation!
        }

                                    { SHADOWWINDOW }

        ShadowTextWindow = object(TextWindow)
            procedure window(x1, y1, x2, y2 : byte);
            procedure title(attr : byte; str : string);
            { Uses procedure TextWindow.done; }
        end;


    var

        cursor : CursorShape;    { TEXT CURSOR OBJECT }

        TxtScr : TextScreen;    { TEXT SCREEN OBJECT }

        scan : char;    { KEYBOARD SCAN CODE }
                        { set by CrtPlus.ReadKey }


    { READ CHARACTER FROM KEYBOARD }

    function  ReadKey : char;
                inline($30/$E4/             { xor ah,ah }
                    $CD/$16/                { int $16   }
                    $88/$26/CrtPlus.scan/   { mov scan,ah }
                    $30/$E4);               { xor ah,ah }


    { IS CHARACTER WAITING? }

    function  KeyPressed : boolean;
                inline($B4/$01/         { mov ah,1  }
                    $CD/$16/            { int $16   }
                    $9C/                { pushf     }
                    $58/                { pop ax    }
                    $25/>$01);          { and ax,1  }


    { FLUSH KEYBOARD BUFFER }

    procedure ClrKey;


    { READ KEYBOARD SHIFT STATE }

    function  ReadShift : byte;
                inline($B4/$02/         { mov ah,2  }
                    $CD/$16/            { int $16   }
                    $30/$E4);           { xor ah,ah }