home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / ATVSRC.RAR / DRIVERS.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  34KB  |  1,129 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {       Virtual Pascal v2.1                             }
  10. {       Copyright (C) 1996-2000 vpascal.com             }
  11. {                                                       }
  12. {*******************************************************}
  13.  
  14. unit Drivers;
  15.  
  16. {$X+,I-,S-,P-,Cdecl-,Delphi+,Use32+}
  17.  
  18. interface
  19.  
  20. uses Objects;
  21.  
  22. { ******** EVENT MANAGER ******** }
  23.  
  24. const
  25.  
  26. { Event codes }
  27.  
  28.   evMouseDown = $0001;
  29.   evMouseUp   = $0002;
  30.   evMouseMove = $0004;
  31.   evMouseAuto = $0008;
  32.   evKeyDown   = $0010;
  33.   evCommand   = $0100;
  34.   evBroadcast = $0200;
  35.  
  36. { Event masks }
  37.  
  38.   evNothing   = $0000;
  39.   evMouse     = $000F;
  40.   evKeyboard  = $0010;
  41.   evMessage   = $FF00;
  42.  
  43. { Extended key codes }
  44.  
  45.   kbEsc       = $011B;  kbAltSpace  = $0200;  kbCtrlIns   = $0400;
  46.   kbShiftIns  = $0500;  kbCtrlDel   = $0600;  kbShiftDel  = $0700;
  47.   kbBack      = $0E08;  kbCtrlBack  = $0E7F;  kbShiftTab  = $0F00;
  48.   kbTab       = $0F09;  kbAltQ      = $1000;  kbAltW      = $1100;
  49.   kbAltE      = $1200;  kbAltR      = $1300;  kbAltT      = $1400;
  50.   kbAltY      = $1500;  kbAltU      = $1600;  kbAltI      = $1700;
  51.   kbAltO      = $1800;  kbAltP      = $1900;  kbCtrlEnter = $1C0A;
  52.   kbEnter     = $1C0D;  kbAltA      = $1E00;  kbAltS      = $1F00;
  53.   kbAltD      = $2000;  kbAltF      = $2100;  kbAltG      = $2200;
  54.   kbAltH      = $2300;  kbAltJ      = $2400;  kbAltK      = $2500;
  55.   kbAltL      = $2600;  kbAltZ      = $2C00;  kbAltX      = $2D00;
  56.   kbAltC      = $2E00;  kbAltV      = $2F00;  kbAltB      = $3000;
  57.   kbAltN      = $3100;  kbAltM      = $3200;  kbF1        = $3B00;
  58.   kbF2        = $3C00;  kbF3        = $3D00;  kbF4        = $3E00;
  59.   kbF5        = $3F00;  kbF6        = $4000;  kbF7        = $4100;
  60.   kbF8        = $4200;  kbF9        = $4300;  kbF10       = $4400;
  61.   kbHome      = $4700;  kbUp        = $4800;  kbPgUp      = $4900;
  62.   kbGrayMinus = $4A2D;  kbLeft      = $4B00;  kbRight     = $4D00;
  63.   kbGrayPlus  = $4E2B;  kbEnd       = $4F00;  kbDown      = $5000;
  64.   kbPgDn      = $5100;  kbIns       = $5200;  kbDel       = $5300;
  65.   kbShiftF1   = $5400;  kbShiftF2   = $5500;  kbShiftF3   = $5600;
  66.   kbShiftF4   = $5700;  kbShiftF5   = $5800;  kbShiftF6   = $5900;
  67.   kbShiftF7   = $5A00;  kbShiftF8   = $5B00;  kbShiftF9   = $5C00;
  68.   kbShiftF10  = $5D00;  kbCtrlF1    = $5E00;  kbCtrlF2    = $5F00;
  69.   kbCtrlF3    = $6000;  kbCtrlF4    = $6100;  kbCtrlF5    = $6200;
  70.   kbCtrlF6    = $6300;  kbCtrlF7    = $6400;  kbCtrlF8    = $6500;
  71.   kbCtrlF9    = $6600;  kbCtrlF10   = $6700;  kbAltF1     = $6800;
  72.   kbAltF2     = $6900;  kbAltF3     = $6A00;  kbAltF4     = $6B00;
  73.   kbAltF5     = $6C00;  kbAltF6     = $6D00;  kbAltF7     = $6E00;
  74.   kbAltF8     = $6F00;  kbAltF9     = $7000;  kbAltF10    = $7100;
  75.   kbCtrlPrtSc = $7200;  kbCtrlLeft  = $7300;  kbCtrlRight = $7400;
  76.   kbCtrlEnd   = $7500;  kbCtrlPgDn  = $7600;  kbCtrlHome  = $7700;
  77.   kbAlt1      = $7800;  kbAlt2      = $7900;  kbAlt3      = $7A00;
  78.   kbAlt4      = $7B00;  kbAlt5      = $7C00;  kbAlt6      = $7D00;
  79.   kbAlt7      = $7E00;  kbAlt8      = $7F00;  kbAlt9      = $8000;
  80.   kbAlt0      = $8100;  kbAltMinus  = $8200;  kbAltEqual  = $8300;
  81.   kbCtrlPgUp  = $8400;  kbAltBack   = $0800;  kbNoKey     = $0000;
  82.  
  83. { Additional keyboard codes that Borland forgot to define }
  84.  
  85.  kbCtrlA      = $1E01;  kbCtrlB     = $3002;  kbCtrlC     = $2E03;
  86.  kbCtrlD      = $2004;  kbCtrlE     = $1205;  kbCtrlF     = $2106;
  87.  kbCtrlG      = $2207;  kbCtrlH     = $2308;  kbCtrlI     = $1709;
  88.  kbCtrlJ      = $240A;  kbCtrlK     = $250B;  kbCtrlL     = $260C;
  89.  kbCtrlM      = $320D;  kbCtrlN     = $310E;  kbCtrlO     = $180F;
  90.  kbCtrlP      = $1910;  kbCtrlQ     = $1011;  kbCtrlR     = $1312;
  91.  kbCtrlS      = $1F13;  kbCtrlT     = $1414;  kbCtrlU     = $1615;
  92.  kbCtrlV      = $2F16;  kbCtrlW     = $1117;  kbCtrlX     = $2D18;
  93.  kbCtrlY      = $1519;  kbCtrlZ     = $2C1A;
  94.  
  95. { 101-key AT keyboard }
  96.  
  97.  kbAltTab     = $A500; kbAltDel     = $A300;  kbAltIns    = $A200;
  98.  kbAltPgDn    = $A100; kbAltDown    = $A000;  kbAltEnd    = $9F00;
  99.  kbAltRight   = $9D00; kbAltLeft    = $9B00;  kbAltPgUp   = $9900;
  100.  kbAltUp      = $9800; kbAltHome    = $9700;  kbCtrlTab   = $9400;
  101.  kbCtrlGreyPlus=$9000; kbCtrlCenter = $8F00;  kbCtrlMinus = $8E00;
  102.  kbCtrlUp     = $8D00; kbAltF12     = $8C00;  kbAltF11    = $8B00;
  103.  kbCtrlF12    = $8A00; kbCtrlF11    = $8900;  kbShiftF12  = $8800;
  104.  kbShiftF11   = $8700; kbF12        = $8600;  kbF11       = $8500;
  105.  kbAltGrayPlus= $4E00; kbCenter     = $4C00;  kbAltGreyAst= $3700;
  106.  kbAltSlash   = $3500; kbAltPeriod  = $3400;  kbAltComma  = $3300;
  107.  kbAltBackSlash=$2B00; kbAltOpQuote = $2900;  kbAltQuote  = $2800;
  108.  kbAltSemicolon=$2700; kbAltRgtBrack= $1B00;  kbAltLftBrack=$1A00;
  109.  kbAltEsc     = $0100; kbCtrlDown   = $9100;
  110.  
  111. { Special keys }
  112.  
  113. kbAltShiftBack = $0900;
  114.  
  115. { Keyboard state and shift masks }
  116.  
  117.   kbRightShift  = $0001;
  118.   kbLeftShift   = $0002;
  119.   kbCtrlShift   = $0004;
  120.   kbAltShift    = $0008;
  121.   kbScrollState = $0010;
  122.   kbNumState    = $0020;
  123.   kbCapsState   = $0040;
  124.   kbInsState    = $0080;
  125.  
  126. { Mouse button state masks }
  127.  
  128.   mbLeftButton  = $01;
  129.   mbRightButton = $02;
  130.  
  131. type
  132.  
  133. { Event record }
  134.  
  135.   PEvent = ^TEvent;
  136.   TEvent = record
  137.     What: Word;
  138.     case Word of
  139.       evNothing: ();
  140.       evMouse: (
  141.         Buttons: Byte;
  142.         Double: Boolean;
  143.         Where: TPoint);
  144.       evKeyDown: (
  145.         case Integer of
  146.           0: (KeyCode: SmallWord;
  147.               ShiftState: Byte);
  148.           1: (CharCode: Char;
  149.               ScanCode: Byte));
  150.       evMessage: (
  151.         Command: Word;
  152.         case Word of
  153.           0: (InfoPtr: Pointer);
  154.           1: (InfoLong: Longint);
  155.           2: (InfoWord: Word);
  156.           3: (InfoInt: Integer);
  157.           4: (InfoByte: Byte);
  158.           5: (InfoChar: Char));
  159.   end;
  160.  
  161.   TShiftStateHandler = function(var ShiftState: Byte): Boolean;
  162.   TCtrlBreakAction = procedure;
  163.  
  164. const
  165.  
  166. { Initialized variables }
  167.  
  168.   ButtonCount: Byte = 0;
  169.   MouseEvents: Boolean = False;
  170.   MouseReverse: Boolean = False;
  171.   DoubleDelay: Word = 8;
  172.   RepeatDelay: Word = 8;
  173.   GetShiftStateHandler: TShiftStateHandler = nil;
  174.   CtrlBreakAction: TCtrlBreakAction = nil;
  175.   KeyDownMask: Word = evKeyDown;
  176.   NonStandardModes = True;
  177.  
  178. var
  179.   MouseButtons: Byte;
  180.   MouseWhere: TPoint;
  181.   MouseEventMask: SmallWord;
  182.   CodePage: SmallWord;
  183.  
  184. { Event manager routines }
  185.  
  186. procedure InitEvents;
  187. procedure DoneEvents;
  188. procedure ShowMouse;
  189. procedure HideMouse;
  190. procedure UpdateMouseWhere;
  191. procedure GetMouseEvent(var Event: TEvent);
  192. procedure GetKeyEvent(var Event: TEvent);
  193. function GetShiftState: Byte;
  194.  
  195. { ******** SCREEN MANAGER ******** }
  196.  
  197. const
  198.  
  199. { Screen modes }
  200.  
  201.   smBW80        = $0002;
  202.   smCO80        = $0003;
  203.   smMono        = $0007;
  204.   smNonStandard = $00FF;
  205.   smFont8x8     = $0100;
  206.  
  207. const
  208.  
  209. { Initialized variables }
  210.  
  211.   StartupMode: Word = $FFFF;
  212.   CheckSnow: Boolean = False;   { not used }
  213.  
  214. var
  215.  
  216. { Uninitialized variables }
  217.  
  218.   ScreenMode: Word;
  219.   ScreenWidth: Byte;
  220.   ScreenHeight: Byte;
  221.   HiResScreen: Boolean;
  222.   ScreenBuffer: Pointer;
  223.   CursorLines: SmallWord;
  224.   // ScreenMirror made larger to handle Win2000
  225.   ScreenMirror: array[0..65535] of Byte;
  226.  
  227. { Screen manager routines }
  228.  
  229. procedure InitVideo;
  230. procedure DoneVideo;
  231. procedure SetVideoMode(Mode: Word);
  232. procedure ClearScreen;
  233.  
  234. { Keyboard }
  235.  
  236. procedure InitKeyboard;
  237.  
  238. { Initialized variables }
  239.  
  240. const
  241.   CtrlBreakHit: Boolean = False;
  242.   SaveCtrlBreak: Boolean = False;       { not used }
  243.   SysErrActive: Boolean = False;
  244.   FailSysErrors: Boolean = False;       { not used }
  245.  
  246. { System error handler routines }
  247.  
  248. procedure InitSysError;
  249. procedure DoneSysError;
  250.  
  251. { ******** UTILITY ROUTINES ******** }
  252.  
  253. { Keyboard support routines }
  254.  
  255. function GetAltChar(KeyCode: Word): Char;
  256. function GetAltCode(Ch: Char): Word;
  257. function GetCtrlChar(KeyCode: Word): Char;
  258. function GetCtrlCode(Ch: Char): Word;
  259. function CtrlToArrow(KeyCode: Word): Word;
  260.  
  261. { String routines }
  262.  
  263. procedure FormatStr(var Result: String; const Format: String; var Params);
  264. procedure PrintStr(const S: String);
  265.  
  266. { Buffer move routines }
  267.  
  268. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word);
  269. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word);
  270. procedure MoveCStr(var Dest; const Str: String; Attrs: Word);
  271. procedure MoveStr(var Dest; const Str: String; Attr: Byte);
  272. function CStrLen(const S: String): Integer;
  273.  
  274. implementation
  275.  
  276. uses Dos, VpSysLow;
  277.  
  278. { ******** EVENT MANAGER ******** }
  279.  
  280. var
  281.  
  282. { Event manager variables }
  283.  
  284.   LastButtons: Byte;
  285.   DownButtons: Byte;
  286.   LastDouble: Boolean;
  287.   DownWhere: TPoint;
  288.   DownTicks: Word;
  289.   AutoTicks: Word;
  290.   AutoDelay: Word;
  291.   StrtCurY1: Integer;
  292.   StrtCurY2: Integer;
  293.   StrtCurVisible: Boolean;
  294.  
  295. // Detects mouse driver, moves mouse pointer to the top left corner
  296.  
  297. procedure DetectMouse;
  298. begin
  299.   ButtonCount := SysTVDetectMouse;
  300. end;
  301.  
  302. // Shows mouse pointer
  303.  
  304. procedure ShowMouse;
  305. begin
  306.   SysTVShowMouse;
  307. end;
  308.  
  309. // Hides mouse pointer
  310.  
  311. procedure HideMouse;
  312. begin
  313.   SysTVHideMouse;
  314. end;
  315.  
  316. // Initializes Turbo Vision's event manager by setting event mask and
  317. // showing the mouse. Called automatically by TApplication.Init.
  318.  
  319. procedure InitEvents;
  320. begin
  321.   if ButtonCount <> 0 then
  322.   begin
  323.     DownButtons := 0;
  324.     LastDouble := False;
  325.     LastButtons := 0;       // Assume that no button is pressed
  326.     SysTVInitMouse(MouseWhere.X, MouseWhere.Y);
  327.     MouseEvents := True;
  328.   end;
  329. end;
  330.  
  331. // Terminates Turbo Vision's event manager and hides the mouse. Called
  332. // automatically by TApplication.Done.
  333.  
  334. procedure DoneEvents;
  335. begin
  336.   if ButtonCount <> 0 then
  337.   begin
  338.     SysTVDoneMouse(False);
  339.     MouseEvents := False;
  340.   end;
  341. end;
  342.  
  343. // Checks whether a mouse event is available by polling the mouse event
  344. // queue maintained by OS/2. If a mouse event has occurred, Event.What
  345. // is set to evMouseDown, evMouseUp,evMouseMove, or evMouseAuto;
  346. // Event.Buttons is set to mbLeftButton or mbRightButton;
  347. // Event.Double is set to True or False;
  348. // Event.Where is set to the mouse position in global coordinates.
  349. // If no mouse events are available, Event.What is set to evNothing.
  350. // GetMouseEvent is called by TProgram.GetEvent.
  351.  
  352. procedure GetMouseEvent(var Event: TEvent);
  353. var
  354.   SysMouseEvent: TSysMouseEvent;
  355.   CurTicks: Word;
  356.   B: Byte;
  357.  
  358. procedure StoreEvent(MouWhat: Word);
  359. begin
  360.   LastButtons := MouseButtons;
  361.   MouseWhere.X := SysMouseEvent.smePos.X;
  362.   MouseWhere.Y := SysMouseEvent.smePos.Y;
  363.   with Event do
  364.   begin
  365.     What := MouWhat;
  366.     Buttons := MouseButtons;
  367.     Double  := LastDouble;
  368.     Where.X := SysMouseEvent.smePos.X;
  369.     Where.Y := SysMouseEvent.smePos.Y;
  370.   end;
  371. end;
  372.  
  373. // GetMouseEvent body
  374.  
  375. begin
  376.   if not MouseEvents then
  377.     Event.What := evNothing
  378.   else
  379.     begin
  380.       if not SysTVGetMouseEvent(SysMouseEvent) then
  381.         begin
  382.           MouseButtons := LastButtons;
  383.           SysMouseEvent.smeTime := SysSysMsCount;
  384.           SysMouseEvent.smePos.X := MouseWhere.X;
  385.           SysMouseEvent.smePos.Y := MouseWhere.Y;
  386.         end
  387.       else
  388.         begin
  389.           if MouseReverse then
  390.           begin
  391.             B := 0;
  392.             if (SysMouseEvent.smeButtons and $0001) <> 0 then
  393.               Inc(B, $0002);
  394.             if (SysMouseEvent.smeButtons and $0002) <> 0 then
  395.               Inc(B, $0001);
  396.             SysMouseEvent.smeButtons := B;
  397.           end;
  398.           MouseButtons := SysMouseEvent.smeButtons;
  399.         end;
  400.       // ms -> ticks: 1 DOS timer tick = 55ms
  401.       CurTicks  := SysMouseEvent.smeTime div 55;
  402.       // Process mouse event
  403.       if (LastButtons <> 0) and (MouseButtons = 0) then
  404.         StoreEvent(evMouseUp) // button is released
  405.       else
  406.         if LastButtons = MouseButtons then
  407.           begin
  408.             if (SysMouseEvent.smePos.Y <> MouseWhere.Y) or (SysMouseEvent.smePos.X <> MouseWhere.X) then
  409.               StoreEvent(evMouseMove)
  410.             else
  411.               if (MouseButtons <> 0) and ((CurTicks - AutoTicks) >= AutoDelay) then
  412.                 begin
  413.                   AutoTicks := CurTicks;
  414.                   AutoDelay := 1;
  415.                   StoreEvent(evMouseAuto);
  416.                 end
  417.               else
  418.                 StoreEvent(evNothing);
  419.           end
  420.         else // CurButton <> 0, LastButton = 0
  421.           begin
  422.             LastDouble := False;
  423.             if (MouseButtons = DownButtons) and (SysMouseEvent.smePos.Y = DownWhere.Y) and (SysMouseEvent.smePos.X = DownWhere.X)
  424.               and ((CurTicks - DownTicks) < DoubleDelay) then
  425.                 LastDouble := True;
  426.             DownButtons := MouseButtons;
  427.             DownWhere.Y := SysMouseEvent.smePos.Y;
  428.             DownWhere.X := SysMouseEvent.smePos.X;
  429.             DownTicks   := CurTicks;
  430.             AutoTicks   := CurTicks;
  431.             AutoDelay   := RepeatDelay;
  432.             StoreEvent(evMouseDown);
  433.           end;
  434.     end;
  435. end;
  436.  
  437. procedure InitKeyboard;
  438. begin
  439.   SysTVKbdInit;
  440. end;
  441.  
  442. procedure UpdateMouseWhere;
  443. begin
  444.   SysTVUpdateMouseWhere(MouseWhere.X, MouseWhere.Y);
  445. end;
  446.  
  447. // Checks whether a keyboard event is available. If a key has been
  448. // pressed, Event.What is set to evKeyDown and Event.KeyCode is set to
  449. // the scan code of the key. Otherwise, Event.What is set to evNothing.
  450. // GetKeyEvent is called by TProgram.GetEvent.
  451.  
  452. procedure GetKeyEvent(var Event: TEvent);
  453. var
  454.   I: Integer;
  455.   SysKeyEvent: TSysKeyEvent;
  456. // Keyboard scan codes
  457. const
  458.   scSpace    = $39;  scIns      = $52;  scDel      = $53;
  459.   scBack     = $0E;  scUp       = $48;  scDown     = $50;
  460.   scLeft     = $4B;  scRight    = $4D;  scHome     = $47;
  461.   scEnd      = $4F;  scPgUp     = $49;  scPgDn     = $51;
  462.   scCtrlIns  = $92;  scCtrlDel  = $93;  scCtrlUp   = $8D;
  463.   scCtrlDown = $91;  kbShift    = kbLeftShift + kbRightShift;
  464.  
  465. type
  466.   KeyTransEntry = record
  467.     Scan:  Byte;
  468.     Shift: Byte;
  469.     Code:  SmallWord;
  470.   end;
  471.  
  472. const
  473.   KeyTranslateTable : array [1..15] of KeyTransEntry =
  474.     (( Scan: scSpace   ; Shift: $08 ; Code: kbAltSpace    ), // Alt-Space
  475.      ( Scan: scIns     ; Shift: $04 ; Code: kbCtrlIns     ), // Ctrl-Ins
  476.      ( Scan: scCtrlIns ; Shift: $04 ; Code: kbCtrlIns     ), // Ctrl-Ins
  477.      ( Scan: scIns     ; Shift: $01 ; Code: kbShiftIns    ), // Shift-Ins
  478.      ( Scan: scIns     ; Shift: $02 ; Code: kbShiftIns    ), // Shift-Ins
  479.      ( Scan: scIns     ; Shift: $03 ; Code: kbShiftIns    ), // Shift-Ins
  480.      ( Scan: scDel     ; Shift: $04 ; Code: kbCtrlDel     ), // Ctrl-Del
  481.      ( Scan: scCtrlDel ; Shift: $04 ; Code: kbCtrlDel     ), // Ctrl-Del
  482.      ( Scan: scDel     ; Shift: $01 ; Code: kbShiftDel    ), // Shift-Del
  483.      ( Scan: scDel     ; Shift: $02 ; Code: kbShiftDel    ), // Shift-Del
  484.      ( Scan: scDel     ; Shift: $03 ; Code: kbShiftDel    ), // Shift-Del
  485.      ( Scan: scBack    ; Shift: $09 ; Code: kbAltShiftBack), // Alt-Shift-Backspace
  486.      ( Scan: scBack    ; Shift: $0A ; Code: kbAltShiftBack), // Alt-Shift-Backspace
  487.      ( Scan: scBack    ; Shift: $0B ; Code: kbAltShiftBack), // Alt-Shift-Backspace
  488.      ( Scan: scBack    ; Shift: $08 ; Code: kbAltBack    )); // Alt-Backspace
  489. begin
  490.   with Event do
  491.     if not SysTVGetKeyEvent(SysKeyEvent) then
  492.       What := evNothing
  493.     else
  494.       begin
  495.         What       := KeyDownMask;
  496.         KeyCode    := SysKeyEvent.skeKeyCode;
  497.         ShiftState := SysKeyEvent.skeShiftState;
  498.         for I := Low(KeyTranslateTable) to High(KeyTranslateTable) do
  499.           with KeyTranslateTable[I] do
  500.           begin
  501.             if (Scan = ScanCode) and ((Shift and ShiftState) = Shift) then
  502.             begin
  503.               KeyCode := Code;
  504.               Break;
  505.             end;
  506.           end;
  507.         if (CharCode = #$E0) and (ScanCode in
  508.           [scUp,scDown,scLeft,scRight,scIns,scDel,scHome,scEnd,scPgUp,scPgDn,
  509.           Hi(kbCtrlHome), Hi(kbCtrlEnd)  , Hi(kbCtrlPgUp), Hi(kbCtrlPgDn),
  510.           Hi(kbCtrlLeft), Hi(kbCtrlRight),    scCtrlUp,       scCtrlDown]) then
  511.             CharCode := #0;      // Grey Keys
  512.         if KeyCode = $E00D then  // Grey Enter
  513.           KeyCode := kbEnter;
  514.       end;
  515. end;
  516.  
  517. // Returns a byte containing the current Shift key state, as reported by
  518. // the system. The return value contains a combination of the kbXXXX constants
  519. // for shift states.
  520.  
  521. function GetShiftState: Byte;
  522. var
  523.   Handled: Boolean;
  524. begin
  525.   Handled := False;
  526.   if @GetShiftStateHandler <> nil then
  527.     Handled := GetShiftStateHandler(Result);
  528.   if not Handled then
  529.     Result := SysTVGetShiftState;
  530. end;
  531.  
  532. { ******** SCREEN MANAGER ******** }
  533.  
  534. // Fixes the CRT mode if required
  535.  
  536. function FixCrtMode(Mode: Word): Word;
  537. begin
  538.   case Lo(Mode) of
  539.     smMono,smCO80,smBW80:
  540.       FixCrtMode := Mode;
  541.     smNonStandard:
  542.       if NonStandardModes then
  543.         FixCrtMode := Mode
  544.       else
  545.         FixCrtMode := smCO80;
  546.     else FixCrtMode := smCO80;
  547.   end;
  548. end;
  549.  
  550. // Updates the CRT-related variables
  551.  
  552. procedure SetCrtData;
  553. var
  554.   BufSize: SmallWord;
  555.   Y1,Y2: Integer;
  556.   Visible: Boolean;
  557.   SrcSize: TSysPoint;
  558. begin
  559.   ScreenMode := SysTVGetScrMode(@SrcSize);
  560.   ScreenHeight := SrcSize.Y;
  561.   ScreenWidth := SrcSize.X;
  562.   ShowMouse;
  563.   HiResScreen := True;
  564.   ScreenBuffer := SysTVGetSrcBuf;
  565.   SysTVGetCurType(Y1, Y2, Visible);
  566.   WordRec(CursorLines).Hi := Y1;
  567.   WordRec(CursorLines).Lo := Y2;
  568.   SysTVSetCurType(Y1, Y2, False);   // Hide cursor
  569. end;
  570.  
  571. // Detects video modes
  572.  
  573. procedure DetectVideo;
  574. begin
  575.   ScreenMode := FixCrtMode(SysTVGetScrMode(nil));
  576. end;
  577.  
  578. // Initializes Turbo Vision's video manager. Saves the current screen
  579. // mode in StartupMode, and switches the screen to the mode indicated by
  580. // ScreenMode. The ScreenWidth, ScreenHeight, HiResScreen, ScreenBuffer,
  581. // and CursorLines variables are updated accordingly.InitVideo is called
  582. // automatically by TApplication.Init.
  583.  
  584. procedure InitVideo;
  585. begin
  586.   SysTVGetCurType(StrtCurY1, StrtCurY2, StrtCurVisible);
  587.   if StartupMode = $FFFF then
  588.      StartupMode := SysTVGetScrMode(nil);
  589.   if StartupMode <> ScreenMode then
  590.     SysTVSetScrMode(ScreenMode);
  591.   SetCrtData;
  592. end;
  593.  
  594. // Terminates Turbo Vision's video manager by restoring the initial
  595. // screen mode, clearing the screen, and restoring the cursor. Called
  596. // automatically by TApplication.Done.
  597.  
  598. procedure DoneVideo;
  599. begin
  600.   if (StartupMode <> $FFFF) and (StartupMode <> ScreenMode) then
  601.     SysTVSetScrMode(StartupMode);
  602.   ClearScreen;
  603.   SysTVSetCurType(StrtCurY1, StrtCurY2, StrtCurVisible);
  604.   FillChar(ScreenMirror, SizeOf(ScreenMirror), 0);
  605. end;
  606.  
  607. // Sets the video mode. Mode is one of the constants smCO80, smBW80, or smMono,
  608. // optionally with smFont8x8 added to select 43- or 50-line mode on an EGA or
  609. // VGA. SetVideoMode initializes the same variables as InitVideo (except for
  610. // the StartupMode variable, which isn't affected).
  611.  
  612. procedure SetVideoMode(Mode: Word);
  613. begin
  614.   SysTVSetScrMode(FixCrtMode(Mode));
  615.   SetCrtData;
  616. end;
  617.  
  618. // Clears the screen, moves cursor to the top left corner
  619.  
  620. procedure ClearScreen;
  621. begin
  622.   SysTVClrScr;
  623. end;
  624.  
  625. { ********************* SYSTEM ERROR HANDLER ************************** }
  626.  
  627. // Initializes Turbo Vision's system error handler. Called automatically
  628. // by TApplication.Init. Since no error handler is available,InitSysError
  629. // sets SysErrActive to True and does nothing.
  630.  
  631. procedure InitSysError;
  632. begin
  633.   SysErrActive := True;
  634. end;
  635.  
  636. // Terminates Turbo Vision's system error handler. Called automatically
  637. // by TApplication.Done. Since no error handler is available,DoneSysError
  638. // sets SysErrActive to False and does nothing.
  639.  
  640. procedure DoneSysError;
  641. begin
  642.   SysErrActive := False;
  643. end;
  644.  
  645. // Ctrl-Break handler
  646.  
  647. function TVCtrlBreak: Boolean;
  648. begin
  649.   CtrlBreakHit := True;
  650.   Result := True;
  651. end;
  652.  
  653. { ******** UTILITY ROUTINES ******** }
  654.  
  655. // Keyboard support routines
  656.  
  657. const
  658.  
  659.   AltCodes1: array[$10..$32] of Char =
  660.     'QWERTYUIOP'#0#0#0#0'ASDFGHJKL'#0#0#0#0#0'ZXCVBNM';
  661.  
  662.   AltCodes2: array[$78..$83] of Char =
  663.     '1234567890-=';
  664.  
  665. function GetAltChar(KeyCode: Word): Char;
  666. begin
  667.   GetAltChar := #0;
  668.   if Lo(KeyCode) = 0 then
  669.     case Hi(KeyCode) of
  670.       $02: GetAltChar := #240;
  671.       $10..$32: GetAltChar := AltCodes1[Hi(KeyCode)];
  672.       $78..$83: GetAltChar := AltCodes2[Hi(KeyCode)];
  673.     end;
  674. end;
  675.  
  676. function GetAltCode(Ch: Char): Word;
  677. var
  678.   I: Word;
  679. begin
  680.   GetAltCode := 0;
  681.   if Ch = #0 then Exit;
  682.   Ch := UpCase(Ch);
  683.   if Ch = #240 then
  684.   begin
  685.     GetAltCode := $0200;
  686.     Exit;
  687.   end;
  688.   for I := $10 to $32 do
  689.     if AltCodes1[I] = Ch then
  690.     begin
  691.       GetAltCode := I shl 8;
  692.       Exit;
  693.     end;
  694.   for I := $78 to $83 do
  695.     if AltCodes2[I] = Ch then
  696.     begin
  697.       GetAltCode := I shl 8;
  698.       Exit;
  699.     end;
  700. end;
  701.  
  702. function GetCtrlChar(KeyCode: Word): Char;
  703. begin
  704.   GetCtrlChar := #0;
  705.   if (Lo(KeyCode) <> 0) and (Lo(KeyCode) <= Byte('Z') - Byte('A') + 1) then
  706.     GetCtrlChar := Char(Lo(KeyCode) + Byte('A') - 1);
  707. end;
  708.  
  709. function GetCtrlCode(Ch: Char): Word;
  710. begin
  711.   GetCtrlCode := GetAltCode(Ch) or (Byte(UpCase(Ch)) - Byte('A') + 1);
  712. end;
  713.  
  714. function CtrlToArrow(KeyCode: Word): Word;
  715. const
  716.   NumCodes = 11;
  717.   CtrlCodes: array[0..NumCodes-1] of Char = ^S^D^E^X^A^F^G^V^R^C^H;
  718.   ArrowCodes: array[0..NumCodes-1] of Word =
  719.     (kbLeft, kbRight, kbUp, kbDown, kbHome, kbEnd, kbDel, kbIns,
  720.      kbPgUp, kbPgDn, kbBack);
  721. var
  722.   I: Integer;
  723. begin
  724.   CtrlToArrow := KeyCode;
  725.   for I := 0 to NumCodes - 1 do
  726.     if WordRec(KeyCode).Lo = Byte(CtrlCodes[I]) then
  727.     begin
  728.       CtrlToArrow := ArrowCodes[I];
  729.       Exit;
  730.     end;
  731. end;
  732.  
  733. // A generalized string formatting routine. Given a string in Format
  734. // that includes format specifiers and a list of parameters in Params,
  735. // FormatStr produces a formatted output string in Result.
  736. // Format specifiers are of the form %[-][nnn]X, where
  737. //   % indicates the beginning of a format specifier
  738. //  [-] is an optional minus sign (-) indicating the parameter is to be
  739. //      left-justified (by default, parameters are right-justified)
  740. // [nnn] is an optional, decimal-number width specifier in the range
  741. //      0..255 (0 indicates no width specified, and non-zero means to
  742. //      display in a field of nnn characters)
  743. //   X  is a format character:
  744. //   's' means the parameter is a pointer to a string.
  745. //   'd' means the parameter is a Longint to be displayed in decimal.
  746. //   'c' means the low byte of the parameter is a character.
  747. //   'x' means the parameter is a Longint to be displayed in hexadecimal.
  748. //   '#' sets the parameter index to nnn.
  749.  
  750. procedure FormatStr(var Result: String; const Format: String; var Params);
  751.   assembler; {&USES ebx,esi,edi} {&FRAME+}
  752. var
  753.   ParOfs: Longint;
  754.   Filler,Justify: Byte;
  755.   Buffer: array [1..12] of Byte;
  756. const
  757.   HexDigits: array [0..15] of Char = '0123456789ABCDEF';
  758.  
  759. // Convert next parameter to string
  760. // EXPECTS:     al    = Conversion character
  761. // RETURNS:     esi   = Pointer to string
  762. //              ecx   = String length
  763.  
  764. procedure Convert; {&USES None} {&FRAME-}
  765. asm
  766.                 mov     edx,eax
  767.                 mov     esi,Params
  768.                 lodsd
  769.                 mov     Params,esi
  770.                 xor     ecx,ecx
  771.                 lea     esi,Buffer[TYPE Buffer]
  772.                 and     dl,0DFh         // UpCase(ConversionChar)
  773.                 cmp     dl,'C'
  774.                 je      @@ConvertChar
  775.                 cmp     dl,'S'
  776.                 je      @@ConvertStr
  777.                 cmp     dl,'D'
  778.                 je      @@ConvertDec
  779.                 cmp     dl,'X'
  780.                 jne     @@Done
  781. // ConvertHex
  782.               @@1:
  783.                 mov     edx,eax
  784.                 and     edx,0Fh
  785.                 mov     dl,HexDigits.Byte[edx]
  786.                 dec     esi
  787.                 inc     ecx
  788.                 mov     [esi],dl
  789.                 shr     eax,4
  790.                 jnz     @@1
  791.                 jmp     @@Done
  792. @@ConvertDec:
  793.                 push    esi
  794.                 mov     ebx,eax
  795.                 mov     ecx,10
  796.                 test    eax,eax
  797.                 jns     @@2
  798.                 neg     eax
  799.               @@2:
  800.                 xor     edx,edx
  801.                 dec     esi
  802.                 div     ecx
  803.                 add     dl,'0'
  804.                 mov     [esi],dl
  805.                 test    eax,eax
  806.                 jnz     @@2
  807.                 pop     ecx
  808.                 sub     ecx,esi
  809.                 test    ebx,ebx
  810.                 jns     @@Done
  811.                 mov     al,'-'
  812. @@ConvertChar:
  813.                 inc     ecx
  814.                 dec     esi
  815.                 mov     [esi],al
  816.                 jmp     @@Done
  817. @@ConvertStr:
  818.                 test    eax,eax
  819.                 jz      @@Done
  820.                 mov     esi,eax
  821.                 lodsb
  822.                 mov     cl,al
  823.               @@Done:
  824. end;
  825.  
  826. // FormatStr body
  827.  
  828. asm
  829.                 mov     eax,Params
  830.                 mov     ParOfs,eax
  831.                 xor     eax,eax
  832.                 mov     esi,Format
  833.                 mov     edi,Result
  834.                 inc     edi
  835.                 cld
  836.                 lodsb
  837.                 mov     ecx,eax
  838.                 mov     ebx,255
  839.               @@1:
  840.                 dec     ecx
  841.                 js      @@End
  842.                 lodsb
  843.                 cmp     al,'%'
  844.                 je      @@3
  845.                 dec     ebx
  846.                 js      @@End
  847.               @@2:
  848.                 stosb
  849.                 jmp     @@1
  850.               @@3:
  851.                 dec     ecx
  852.                 js      @@End
  853.                 lodsb
  854.                 cmp     al,'%'
  855.                 je      @@2
  856.                 mov     Justify,0       // Justify (0:right, 1:left)
  857.                 mov     Filler,' '
  858.                 xor     edx,edx         // edx = Field width (0:no width)
  859.                 cmp     al,'0'
  860.                 jne     @@4
  861.                 mov     Filler,al
  862.               @@4:
  863.                 cmp     al,'-'
  864.                 jne     @@5
  865.                 inc     Justify
  866.                 dec     ecx
  867.                 js      @@End
  868.                 lodsb
  869.               @@5:
  870.                 cmp     al,'0'
  871.                 jb      @@6
  872.                 cmp     al,'9'
  873.                 ja      @@6
  874.                 sub     al,'0'
  875.                 xchg    eax,edx
  876.                 mov     ah,10
  877.                 mul     ah
  878.                 add     al,dl
  879.                 xchg    eax,edx
  880.                 dec     ecx
  881.                 js      @@End
  882.                 lodsb
  883.                 jmp     @@5
  884.               @@6:
  885.                 cmp     al,'#'
  886.                 jne     @@10
  887.                 shl     edx,2
  888.                 add     edx,ParOfs
  889.                 mov     Params,edx
  890.                 jmp     @@1
  891.               @@End:
  892.                 mov     eax,Result
  893.                 mov     ecx,edi
  894.                 sub     ecx,eax
  895.                 dec     ecx
  896.                 mov     [eax],cl
  897.                 jmp     @@Done
  898.               @@10:
  899.                 push    esi
  900.                 push    ecx
  901.                 push    edx
  902.                 push    ebx
  903.                 Call    Convert
  904.                 pop     ebx
  905.                 pop     edx
  906.                 test    edx,edx
  907.                 jz      @@12
  908.                 sub     edx,ecx
  909.                 jae     @@12
  910.                 cmp     Justify,0
  911.                 jnz     @@11
  912.                 sub     esi,edx
  913.               @@11:
  914.                 add     ecx,edx
  915.                 xor     edx,edx
  916.               @@12:
  917.                 cmp     Justify,0
  918.                 jz      @@14
  919.                 cmp     ecx,ebx
  920.                 jbe     @@13
  921.                 mov     ecx,ebx
  922.               @@13:
  923.                 sub     ebx,ecx
  924.                 rep     movsb           // Copy formated parm (left-justified)
  925.               @@14:
  926.                 xchg    ecx,edx
  927.                 mov     al,Filler
  928.                 cmp     ecx,ebx
  929.                 jbe     @@15
  930.                 mov     ecx,ebx
  931.               @@15:
  932.                 sub     ebx,ecx
  933.                 rep     stosb           // Fill unused space
  934.                 xchg    ecx,edx
  935.                 cmp     ecx,ebx
  936.                 jbe     @@16
  937.                 mov     ecx,ebx
  938.               @@16:
  939.                 sub     ebx,ecx
  940.                 rep     movsb           // Copy formated parm (right-justified)
  941.                 pop     ecx
  942.                 pop     esi
  943.                 jmp     @@1
  944.               @@Done:
  945. end;
  946.  
  947. // Prints the string on the screen
  948.  
  949. procedure PrintStr(const S: String);
  950. var
  951.   Count: Longint;
  952. begin
  953.   SysFileWrite(SysFileStdOut, S[1], Length(S), Count);
  954. end;
  955.  
  956. // Buffer move routines
  957.  
  958. // Moves text and video attributes into a buffer. Count bytes are moved
  959. // from Source into the low bytes of corresponding words in Dest. The
  960. // high bytes of the words in Dest are set to Attr, or remain unchanged
  961. // if Attr is zero.
  962.  
  963. procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word); {&USES esi,edi} {&FRAME-}
  964. asm
  965.                 mov     ecx,Count
  966.                 jecxz   @@4
  967.                 mov     edi,Dest
  968.                 mov     esi,Source
  969.                 mov     ah,Attr
  970.                 cld
  971.                 test    ah,ah
  972.                 jz      @@3
  973.               @@1:
  974.                 lodsb
  975.                 stosw
  976.                 loop    @@1
  977.                 jmp     @@4
  978.               @@2:
  979.                 inc     edi
  980.               @@3:
  981.                 movsb
  982.                 loop    @@2
  983.               @@4:
  984. end;
  985.  
  986. // Moves characters into a buffer. The low bytes of the first Count
  987. // words of Dest are set to C, or remain unchanged if C = #0. The high
  988. // bytes of the words are set to Attr, or remain unchanged if Attr is
  989. // zero.
  990.  
  991. procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word); {&USES edi} {&FRAME-}
  992. asm
  993.                 mov     ecx,Count
  994.                 jecxz   @@4
  995.                 mov     edi,Dest
  996.                 mov     al,C
  997.                 mov     ah,Attr
  998.                 cld
  999.                 test    al,al
  1000.                 jz      @@1
  1001.                 test    ah,ah
  1002.                 jz      @@3
  1003.                 mov     edx,eax
  1004.                 shl     eax,16
  1005.                 mov     ax,dx
  1006.                 shr     ecx,1
  1007.                 rep     stosd
  1008.                 adc     ecx,ecx
  1009.                 rep     stosw
  1010.                 jmp     @@4
  1011.               @@1:
  1012.                 mov     al,ah
  1013.               @@2:
  1014.                 inc     edi
  1015.               @@3:
  1016.                 stosb
  1017.                 loop    @@2
  1018.               @@4:
  1019. end;
  1020.  
  1021. // Moves a two-colored string into a buffer. The characters in Str are
  1022. // moved into the low bytes of corresponding words in Dest. The high
  1023. // bytes of the words are set to Lo(Attr) or Hi(Attr). Tilde characters
  1024. // (~) in the string toggle between the two attribute bytes passed in
  1025. // the Attr word.
  1026.  
  1027. procedure MoveCStr(var Dest; const Str: String; Attrs: Word); {&USES esi,edi} {&FRAME-}
  1028. asm
  1029.                 xor     ecx,ecx
  1030.                 mov     esi,Str
  1031.                 cld
  1032.                 lodsb
  1033.                 mov     cl,al
  1034.                 jecxz   @@3
  1035.                 mov     edi,Dest
  1036.                 mov     edx,Attrs
  1037.                 mov     ah,dl
  1038.               @@1:
  1039.                 lodsb
  1040.                 cmp     al,'~'
  1041.                 je      @@2
  1042.                 stosw
  1043.                 loop    @@1
  1044.                 jmp     @@3
  1045.               @@2:
  1046.                 xchg    ah,dh
  1047.                 loop    @@1
  1048.               @@3:
  1049. end;
  1050.  
  1051. // Moves a string into a buffer. The characters in Str are moved into
  1052. // the low bytes of corresponding words in Dest. The high bytes of the
  1053. // words are set to Attr, or remain unchanged if Attr is zero.
  1054.  
  1055. procedure MoveStr(var Dest; const Str: String; Attr: Byte); {&USES esi,edi} {&FRAME-}
  1056. asm
  1057.                 xor     ecx,ecx
  1058.                 mov     esi,Str
  1059.                 cld
  1060.                 lodsb
  1061.                 mov     cl,al
  1062.                 jecxz   @@4
  1063.                 mov     edi,Dest
  1064.                 mov     ah,Attr
  1065.                 test    ah,ah
  1066.                 jz      @@3
  1067.               @@1:
  1068.                 lodsb
  1069.                 stosw
  1070.                 loop    @@1
  1071.                 jmp     @@4
  1072.               @@2:
  1073.                 inc     edi
  1074.               @@3:
  1075.                 movsb
  1076.                 loop    @@2
  1077.               @@4:
  1078. end;
  1079.  
  1080. // Returns the length of string S, where S is a control string using
  1081. // tilde characters ('~') to designate shortcut characters. The tildes
  1082. // are excluded from the length of the string, as they will not appear
  1083. // on the screen.
  1084.  
  1085. function CStrLen(const S: String): Integer; {&USES edi} {&FRAME-}
  1086. asm
  1087.                 xor     ecx,ecx
  1088.                 mov     edi,S
  1089.                 mov     cl,[edi]
  1090.                 inc     edi
  1091.                 mov     edx,ecx
  1092.                 jecxz   @@2
  1093.                 mov     al,'~'
  1094.                 cld
  1095.               @@1:
  1096.                 repne   scasb
  1097.                 jne     @@2
  1098.                 dec     edx
  1099.                 test    esp,esp
  1100.                 jmp     @@1
  1101.               @@2:
  1102.                 mov     eax,edx
  1103. end;
  1104.  
  1105. // Drivers unit initialization and shutdown
  1106.  
  1107. var
  1108.   SaveExit: Pointer;
  1109.  
  1110. procedure ExitDrivers;
  1111. begin
  1112.   DoneSysError;
  1113.   DoneEvents;
  1114.   SysTVDoneMouse(True);
  1115.   ExitProc := SaveExit;
  1116. end;
  1117.  
  1118. begin
  1119.   CodePage := SysGetCodePage;
  1120.   SysTVInitCursor;
  1121.   InitKeyboard;
  1122.   DetectMouse;
  1123.   DetectVideo;
  1124.   SaveExit := ExitProc;
  1125.   ExitProc := @ExitDrivers;
  1126.   CtrlBreakHandler := TVCtrlBreak;
  1127.   SysCtrlSetCBreakHandler;
  1128. end.
  1129.