home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / dos_util / 4utils76.zip / DISPLAYK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-31  |  12KB  |  402 lines
  1. UNIT DisplayKeyboardAndCursor;
  2. (* ----------------------------------------------------------------------
  3.    Part of 4DESC - A Simple 4DOS File Description Editor
  4.  
  5.        David Frey,         & Tom Bowden
  6.        Urdorferstrasse 30    1575 Canberra Drive
  7.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  8.        Switzerland           USA
  9.  
  10.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.    This unit manages displaying messages, switching cursor modes etc.
  26.  
  27.    ----------------------------------------------------------------------- *)
  28.  
  29. INTERFACE USES Crt, Dos, Dmouse;
  30.  
  31. CONST Header = '4DESC 1.60 - (c) 1992, 1993 Copyright by David Frey & Tom Bowden';
  32.  
  33. (* Cursor *)
  34.  
  35. VAR OrigCursor : WORD;
  36.  
  37. (* Color constants for color screens: *)
  38.  
  39. CONST co_StatusFg = Blue;
  40.       co_StatusBg = Cyan;
  41.       co_DirFg    = LightCyan;
  42.       co_SelectFg = Blue;
  43.       co_SelectBg = Cyan;
  44.       co_HighFg   = LightRed;
  45.       co_NormFg   = LightGray;
  46.       co_NormBg   = Blue;
  47.       co_WarnFg   = Yellow;
  48.       co_WarnBg   = Cyan;
  49.  
  50.       (* ...and for monochrome displays: *)
  51.  
  52.       mo_StatusFg = Black;
  53.       mo_StatusBg = LightGray;
  54.       mo_DirFg    = White;
  55.       mo_SelectFg = Black;
  56.       mo_SelectBg = LightGray;
  57.       mo_HighFg   = LightGray;
  58.       mo_NormFg   = LightGray;
  59.       mo_NormBg   = Black;
  60.       mo_WarnFg   = Black;
  61.       mo_WarnBg   = White;
  62.  
  63. VAR   ScreenSize : BYTE;
  64.       ScreenWidth: BYTE;
  65.       MaxLines   : BYTE;
  66.       Monochrome : BOOLEAN;
  67.  
  68. VAR   StatusFg   : BYTE;
  69.       StatusBg   : BYTE;
  70.       DirFg      : BYTE;
  71.       SelectFg   : BYTE;
  72.       SelectBg   : BYTE;
  73.       HighFg     : BYTE;
  74.       NormFg     : BYTE;
  75.       NormBg     : BYTE;
  76.       WarnFg     : BYTE;
  77.       WarnBg     : BYTE;
  78.       _4DOSVer   : STRING[11];
  79.  
  80.       ListCmd    : PathStr;
  81.       NotLeftJust: BOOLEAN;
  82.       FullSize   : BOOLEAN;
  83.       UseHidden  : BOOLEAN;
  84.  
  85. PROCEDURE Abort(msg: STRING);
  86.  
  87. (* Min/Max *)
  88. FUNCTION Min(a,b : INTEGER): INTEGER;
  89. FUNCTION Max(a,b : INTEGER): INTEGER;
  90.  
  91. (* Cursor *)
  92. PROCEDURE SetCursorShape(Cursor: WORD);
  93. FUNCTION  GetCursorShape: WORD;
  94. PROCEDURE ResetCursor(Overwrite: BOOLEAN);
  95.  
  96. (* Screen *)
  97. PROCEDURE Get4DOSVer;
  98. PROCEDURE ChooseColors(Monochrome: BOOLEAN);
  99.  
  100. PROCEDURE ReportError(msg: STRING; FullClipBoard, Changed: BOOLEAN);
  101. PROCEDURE DrawMainScreen(Index,NrOfFiles: WORD);
  102. PROCEDURE DrawStatusLine(Redraw,FullClipboard, Changed: BOOLEAN);
  103. PROCEDURE ShowHelpPage;
  104.  
  105. (* Keyboard *)
  106.  
  107. FUNCTION GetKey: WORD;
  108.  
  109.  
  110. IMPLEMENTATION USES HandleINIFile, StringDateHandling;
  111.  
  112. VAR s   : STRING;
  113.     line: STRING[132];
  114.  
  115. PROCEDURE Abort(msg: STRING);
  116. (* Fatal error, abort the program and return an errorlevel of -1 *)
  117.  
  118. BEGIN
  119.  NormVideo;
  120.  ClrScr;
  121.  Write(msg);
  122.  HALT(255);
  123. END;
  124.  
  125. (*------------------------------------------------------------- Min/Max *)
  126. FUNCTION Min(a,b : INTEGER): INTEGER;
  127.  
  128. BEGIN
  129.  IF a < b THEN Min := a
  130.           ELSE Min := b;
  131. END;
  132.  
  133. FUNCTION Max(a,b : INTEGER): INTEGER;
  134.  
  135. BEGIN
  136.  IF a > b THEN Max := a
  137.           ELSE Max := b;
  138. END;
  139.  
  140.  
  141. (* -------------------------------------------------------- Cursor *)
  142.  
  143. PROCEDURE SetCursorShape(Cursor: WORD); ASSEMBLER;
  144.  
  145. ASM
  146.  mov ah,01h
  147.  mov cx,Cursor
  148.  Int 10h
  149. END;
  150.  
  151. FUNCTION  GetCursorShape: WORD; ASSEMBLER;
  152.  
  153. ASM
  154.  mov ah,03h
  155.  mov bh,0
  156.  Int 10h
  157.  mov ax,cx
  158. END;
  159.  
  160. PROCEDURE ResetCursor(Overwrite: BOOLEAN);
  161.  
  162. VAR Cursor : WORD;
  163.  
  164. BEGIN
  165.  IF Overwrite THEN Cursor := $0007
  166.               ELSE Cursor := $0607;
  167.  SetCursorShape(Cursor);
  168. END; (* ResetCursor *)
  169.  
  170.  
  171. (* -------------------------------------------------------- Screen *)
  172. PROCEDURE Get4DOSVer;
  173.  
  174. VAR Regs    : Registers;
  175.     _4dvmaj : STRING[1];
  176.     _4dvmin : STRING[2];
  177.  
  178.  PROCEDURE DisplayVer;
  179.   BEGIN
  180.    Str(Regs.bl:1,_4dvmaj);
  181.    Str(Regs.bh:2,_4dvmin);
  182.    IF _4dvmin[1] = ' ' THEN _4dvmin[1] := '0';
  183.    _4DOSVer := ' 4DOS ' + _4dvmaj + '.' + _4dvmin + ' ';
  184.   END;
  185.  
  186. BEGIN
  187.  Regs.ax := $D44D;
  188.  Regs.bx := $0;
  189.  Intr($2F,Regs);
  190.  IF Regs.ax = $44DD THEN    (* 4DOS is active *)
  191.   DisplayVer
  192.  ELSE
  193.   BEGIN
  194.    Regs.ax := $E44D;
  195.    Regs.bx := $0;
  196.    Intr($2F,Regs);
  197.    IF Regs.ax = $44EE THEN    (* NDOS is active *)
  198.     BEGIN
  199.      DisplayVer;
  200.      _4DOSVer[2] := 'N';
  201.     END
  202.    ELSE
  203.     _4DOSVer := '───────────';
  204.   END
  205. END;  (* Get4DOSVer *)
  206.  
  207. Procedure CheckKeyOrMouse;
  208.  
  209. Var Key : Word;
  210.  
  211. Begin
  212.   Key := $0000;
  213.   Repeat
  214.     If KeyPressed Then Key := GetKey
  215.     Else
  216.       If MouseLoaded Then
  217.          Begin
  218.            ButtonReleased(Left);
  219.            If ReleaseCount > 0 Then Key := $FF;
  220.            ButtonReleased(Right);
  221.            If ReleaseCount > 0 Then Key := $FF;
  222.          End;
  223.   Until Key <> $0000;
  224. End;  (* CheckKeyOrMouse *)
  225.  
  226. PROCEDURE ReportError(msg: STRING; FullClipBoard, Changed: BOOLEAN);
  227.  
  228. VAR ch : WORD;
  229.  
  230. BEGIN
  231.  TextColor(WarnFg); TextBackGround(WarnBg);
  232.  GotoXY(1,MaxLines);
  233.  IF Length(msg) < ScreenWidth-1 THEN Write(Chars(' ',(ScreenWidth-Length(msg)) div 2));
  234.  Write(msg); ClrEol;
  235.  CheckKeyOrMouse;
  236.  DrawStatusLine(TRUE,FullClipBoard,Changed);
  237. END; (* ReportError *)
  238.  
  239. PROCEDURE DrawStatusLine(Redraw,FullClipboard, Changed: BOOLEAN);
  240.  
  241. BEGIN
  242.  TextBackGround(NormBg);
  243.  IF Redraw THEN
  244.   BEGIN
  245.    TextColor(NormFg); ClrEol;
  246.    GotoXY(1,MaxLines); Write(line);
  247.    GotoXY(3,MaxLines); Write(_4DOSVer);
  248.   END;
  249.  
  250.  GotoXY(76,MaxLines);
  251.  IF FullClipBoard THEN BEGIN TextColor(HighFg); Write('Cut'); END
  252.                   ELSE BEGIN TextColor(NormFg); Write('───'); END;
  253.  
  254.  GotoXY(70,MaxLines);
  255.  IF Changed THEN BEGIN TextColor(HighFg); Write('Edit'); END
  256.             ELSE BEGIN TextColor(NormFg); Write('────'); END;
  257. END; (* DrawStatusLine *)
  258.  
  259. PROCEDURE DrawMainScreen(Index,NrOfFiles: WORD);
  260.  
  261. BEGIN
  262.  TextColor(NormFg); TextBackGround(NormBg);
  263.  ClrScr;
  264.  TextColor(StatusFg); TextBackGround(StatusBg);
  265.  GotoXY(1,1);
  266.  Write(' ESC exits │ ',Chr(24),' or ',Chr(25),' Selects │ F1 Help │',
  267.        ' F2 or F10 Saves │   Line ',Index:5,' of ',NrOfFiles:5,' ');
  268.  DrawStatusLine(TRUE,FALSE,FALSE);
  269. END; (* DrawMainScreen *)
  270.  
  271. PROCEDURE ShowHelpPage;
  272.  
  273. VAR ch, cursor : WORD;
  274.  
  275. BEGIN
  276.  TextBackGround(NormBg);
  277.  ClrScr;
  278.  TextColor(DirFg);
  279.  GotoXY((ScreenWidth-10) DIV 2, 1); Write('4DESC Help');
  280.  TextColor(NormFg);
  281.  GotoXY((ScreenWidth-41) DIV 2, 2); Write('USAGE:  4DESC [/help] [/mono] [d:][\path]');
  282.  
  283.  GotoXY( 8, 4); Write('UpArr, DnArr, PgUp, PgDn:  Move highlight bar');
  284.  GotoXY( 8, 5); Write('LtArr, RtArr, Home, End:   Move cursor');
  285.  GotoXY( 8, 6); Write('Ctrl-PgUp, Ctrl-PgDn:      Move to first or last line');
  286.  GotoXY( 8, 7); Write('Ctrl-Left, Ctrl-Right:     Move to previous/next word');
  287.  GotoXY( 8, 9); Write('Backspace:        Delete the character before the cursor');
  288.  GotoXY( 8,10); Write('DEL:              Delete the character under  the cursor');
  289.  GotoXY( 8,11); Write('Ctrl-End:         Delete from cursor to end of line');
  290.  GotoXY( 8,12); Write('INS:              Toggle from insert mode (default) to overwrite mode ');
  291.  GotoXY( 8,13); Write('Alt-D:            Delete current description');
  292.  GotoXY( 8,14); Write('Alt-C:            Copy current description to buffer');
  293.  GotoXY( 8,15); Write('Alt-M, Alt-T:     Move current description to buffer');
  294.  GotoXY( 8,16); Write('Alt-P:            Paste buffer to current description');
  295.  GotoXY( 8,17); Write('Alt-V, F3:        View higlighted file');
  296.  GotoXY( 8,18); Write('Alt-S, Shift-F10: Shell to (4)DOS');
  297.  GotoXY( 8,19); Write('Alt-X, ESC:       Exit program');
  298.  GotoXY( 8,20); Write('F4 or ENTER on dir :  Change to highlighted directory');
  299.  GotoXY( 8,21); Write('F5 or ENTER on ..  :  Change to parent directory');
  300.  GotoXY( 8,22); Write('F6 or Alt-L        :  Change drive');
  301.  
  302.  GotoXY((ScreenWidth-Length(Header)) div 2 ,24); Write(Header);
  303.  GotoXY((ScreenWidth-24) div 2,25); Write('Press any key to return.');
  304.  
  305.  Cursor := $2000; SetCursorShape(Cursor);   (* Hide cursor. *)
  306.  CheckKeyOrMouse;
  307. END; (* ShowHelp *)
  308.  
  309.  
  310. (* -------------------------------------------------------- Keyboard *)
  311.  
  312. FUNCTION GetKey: WORD;
  313.  
  314. VAR chlo, chhi : CHAR;
  315.  
  316. BEGIN
  317.  chlo := ReadKey;
  318.  IF chlo = #0 THEN chhi := ReadKey
  319.               ELSE chhi := #0;
  320.  GetKey := WORD(chhi) SHL 8 + BYTE(chlo);
  321. END;
  322.  
  323.  
  324. PROCEDURE ChooseColors(Monochrome: BOOLEAN);
  325.  
  326. BEGIN
  327.  IF Monochrome THEN
  328.   IF INIFileExists THEN
  329.    BEGIN
  330.     DirFg    := ReadSettingsColor('monodisplay','dirfg'   ,mo_DirFg);
  331.     StatusFg := ReadSettingsColor('monodisplay','statusfg',mo_StatusFg);
  332.     StatusBg := ReadSettingsColor('monodisplay','statusbg',mo_StatusBg);
  333.     SelectFg := ReadSettingsColor('monodisplay','selectfg',mo_SelectFg);
  334.     SelectBg := ReadSettingsColor('monodisplay','selectbg',mo_SelectBg);
  335.     HighFg   := ReadSettingsColor('monodisplay','highfg'  ,mo_HighFg);
  336.     NormFg   := ReadSettingsColor('monodisplay','normfg'  ,mo_NormFg);
  337.     NormBg   := ReadSettingsColor('monodisplay','normbg'  ,mo_NormBg);
  338.     WarnFg   := ReadSettingsColor('monodisplay','warnfg'  ,mo_WarnFg);
  339.     WarnBg   := ReadSettingsColor('monodisplay','warnbg'  ,mo_WarnBg);
  340.    END
  341.   ELSE
  342.    BEGIN
  343.     DirFg    := mo_DirFg;
  344.     StatusFg := mo_StatusFg; StatusBg := mo_StatusBg;
  345.     SelectFg := mo_SelectFg; SelectBg := mo_SelectBg;
  346.     HighFg   := mo_HighFg;
  347.     NormFg   := mo_NormFg;   NormBg   := mo_NormBg;
  348.     WarnFg   := mo_WarnFg;   WarnBg   := mo_WarnBg;
  349.    END
  350.  ELSE
  351.   IF INIFileExists THEN
  352.    BEGIN
  353.     DirFg    := ReadSettingsColor('colordisplay','dirfg'   ,co_DirFg);
  354.     StatusFg := ReadSettingsColor('colordisplay','statusfg',co_StatusFg);
  355.     StatusBg := ReadSettingsColor('colordisplay','statusbg',co_StatusBg);
  356.     SelectFg := ReadSettingsColor('colordisplay','selectfg',co_SelectFg);
  357.     SelectBg := ReadSettingsColor('colordisplay','selectbg',co_SelectBg);
  358.     HighFg   := ReadSettingsColor('colordisplay','highfg'  ,co_HighFg);
  359.     NormFg   := ReadSettingsColor('colordisplay','normfg'  ,co_NormFg);
  360.     NormBg   := ReadSettingsColor('colordisplay','normbg'  ,co_NormBg);
  361.     WarnFg   := ReadSettingsColor('colordisplay','warnfg'  ,co_WarnFg);
  362.     WarnBg   := ReadSettingsColor('colordisplay','warnbg'  ,co_WarnBg);
  363.    END
  364.   ELSE
  365.    BEGIN
  366.     DirFg    := co_DirFg;
  367.     StatusFg := co_StatusFg; StatusBg := co_StatusBg;
  368.     SelectFg := co_SelectFg; SelectBg := co_SelectBg;
  369.     HighFg   := co_HighFg;
  370.     NormFg   := co_NormFg;   NormBg   := co_NormBg;
  371.     WarnFg   := co_WarnFg;   WarnBg   := co_WarnBg;
  372.    END;
  373. END;
  374.  
  375. BEGIN
  376.  Get4DOSVer;
  377.  OrigCursor := GetCursorShape;
  378.  MaxLines   := Hi(WindMax)+1;
  379.  ScreenSize := MaxLines-4;
  380.  ScreenWidth:= Lo(WindMax)+1;
  381.  Monochrome := (LastMode = Mono);
  382.  line       := Chars('─',ScreenWidth-1);
  383.  
  384.  IF INIFileExists THEN
  385.   BEGIN
  386.    s := ReadSettingsString('generaldisplay','leftjust','n');
  387.    NotLeftJust := (s[1] = 'y');
  388.    s := ReadSettingsString('generaldisplay','fullsize','n');
  389.    FullSize := (s[1] = 'y');
  390.    s := ReadSettingsString('generaldisplay','hidden','n');
  391.    UseHidden:= (s[1] = 'y');
  392.    ListCmd := ReadSettingsString('generaldisplay','viewer','list')
  393.   END
  394.  ELSE
  395.   BEGIN
  396.    NotLeftJust:= FALSE;
  397.    FullSize   := FALSE;
  398.    UseHidden  := FALSE;
  399.    ListCmd    := 'list';
  400.   END;
  401. END.
  402.