home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
4dos
/
4utils.zip
/
DISPLAYK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-31
|
12KB
|
402 lines
UNIT DisplayKeyboardAndCursor;
(* ----------------------------------------------------------------------
Part of 4DESC - A Simple 4DOS File Description Editor
David Frey, & Tom Bowden
Urdorferstrasse 30 1575 Canberra Drive
8952 Schlieren ZH Stone Mountain, GA 30088-3629
Switzerland USA
Code created using Turbo Pascal 7.0, (c) Borland International 1992
DISCLAIMER: This unit is freeware: you are allowed to use, copy
and change it free of charge, but you may not sell or hire
this part of 4DESC. The copyright remains in our hands.
If you make any (considerable) changes to the source code,
please let us know. (send a copy or a listing).
We would like to see what you have done.
We, David Frey and Tom Bowden, the authors, provide absolutely
no warranty of any kind. The user of this software takes the
entire risk of damages, failures, data losses or other
incidents.
This unit manages displaying messages, switching cursor modes etc.
----------------------------------------------------------------------- *)
INTERFACE USES Crt, Dos, Dmouse;
CONST Header = '4DESC 1.60 - (c) 1992, 1993 Copyright by David Frey & Tom Bowden';
(* Cursor *)
VAR OrigCursor : WORD;
(* Color constants for color screens: *)
CONST co_StatusFg = Blue;
co_StatusBg = Cyan;
co_DirFg = LightCyan;
co_SelectFg = Blue;
co_SelectBg = Cyan;
co_HighFg = LightRed;
co_NormFg = LightGray;
co_NormBg = Blue;
co_WarnFg = Yellow;
co_WarnBg = Cyan;
(* ...and for monochrome displays: *)
mo_StatusFg = Black;
mo_StatusBg = LightGray;
mo_DirFg = White;
mo_SelectFg = Black;
mo_SelectBg = LightGray;
mo_HighFg = LightGray;
mo_NormFg = LightGray;
mo_NormBg = Black;
mo_WarnFg = Black;
mo_WarnBg = White;
VAR ScreenSize : BYTE;
ScreenWidth: BYTE;
MaxLines : BYTE;
Monochrome : BOOLEAN;
VAR StatusFg : BYTE;
StatusBg : BYTE;
DirFg : BYTE;
SelectFg : BYTE;
SelectBg : BYTE;
HighFg : BYTE;
NormFg : BYTE;
NormBg : BYTE;
WarnFg : BYTE;
WarnBg : BYTE;
_4DOSVer : STRING[11];
ListCmd : PathStr;
NotLeftJust: BOOLEAN;
FullSize : BOOLEAN;
UseHidden : BOOLEAN;
PROCEDURE Abort(msg: STRING);
(* Min/Max *)
FUNCTION Min(a,b : INTEGER): INTEGER;
FUNCTION Max(a,b : INTEGER): INTEGER;
(* Cursor *)
PROCEDURE SetCursorShape(Cursor: WORD);
FUNCTION GetCursorShape: WORD;
PROCEDURE ResetCursor(Overwrite: BOOLEAN);
(* Screen *)
PROCEDURE Get4DOSVer;
PROCEDURE ChooseColors(Monochrome: BOOLEAN);
PROCEDURE ReportError(msg: STRING; FullClipBoard, Changed: BOOLEAN);
PROCEDURE DrawMainScreen(Index,NrOfFiles: WORD);
PROCEDURE DrawStatusLine(Redraw,FullClipboard, Changed: BOOLEAN);
PROCEDURE ShowHelpPage;
(* Keyboard *)
FUNCTION GetKey: WORD;
IMPLEMENTATION USES HandleINIFile, StringDateHandling;
VAR s : STRING;
line: STRING[132];
PROCEDURE Abort(msg: STRING);
(* Fatal error, abort the program and return an errorlevel of -1 *)
BEGIN
NormVideo;
ClrScr;
Write(msg);
HALT(255);
END;
(*------------------------------------------------------------- Min/Max *)
FUNCTION Min(a,b : INTEGER): INTEGER;
BEGIN
IF a < b THEN Min := a
ELSE Min := b;
END;
FUNCTION Max(a,b : INTEGER): INTEGER;
BEGIN
IF a > b THEN Max := a
ELSE Max := b;
END;
(* -------------------------------------------------------- Cursor *)
PROCEDURE SetCursorShape(Cursor: WORD); ASSEMBLER;
ASM
mov ah,01h
mov cx,Cursor
Int 10h
END;
FUNCTION GetCursorShape: WORD; ASSEMBLER;
ASM
mov ah,03h
mov bh,0
Int 10h
mov ax,cx
END;
PROCEDURE ResetCursor(Overwrite: BOOLEAN);
VAR Cursor : WORD;
BEGIN
IF Overwrite THEN Cursor := $0007
ELSE Cursor := $0607;
SetCursorShape(Cursor);
END; (* ResetCursor *)
(* -------------------------------------------------------- Screen *)
PROCEDURE Get4DOSVer;
VAR Regs : Registers;
_4dvmaj : STRING[1];
_4dvmin : STRING[2];
PROCEDURE DisplayVer;
BEGIN
Str(Regs.bl:1,_4dvmaj);
Str(Regs.bh:2,_4dvmin);
IF _4dvmin[1] = ' ' THEN _4dvmin[1] := '0';
_4DOSVer := ' 4DOS ' + _4dvmaj + '.' + _4dvmin + ' ';
END;
BEGIN
Regs.ax := $D44D;
Regs.bx := $0;
Intr($2F,Regs);
IF Regs.ax = $44DD THEN (* 4DOS is active *)
DisplayVer
ELSE
BEGIN
Regs.ax := $E44D;
Regs.bx := $0;
Intr($2F,Regs);
IF Regs.ax = $44EE THEN (* NDOS is active *)
BEGIN
DisplayVer;
_4DOSVer[2] := 'N';
END
ELSE
_4DOSVer := '───────────';
END
END; (* Get4DOSVer *)
Procedure CheckKeyOrMouse;
Var Key : Word;
Begin
Key := $0000;
Repeat
If KeyPressed Then Key := GetKey
Else
If MouseLoaded Then
Begin
ButtonReleased(Left);
If ReleaseCount > 0 Then Key := $FF;
ButtonReleased(Right);
If ReleaseCount > 0 Then Key := $FF;
End;
Until Key <> $0000;
End; (* CheckKeyOrMouse *)
PROCEDURE ReportError(msg: STRING; FullClipBoard, Changed: BOOLEAN);
VAR ch : WORD;
BEGIN
TextColor(WarnFg); TextBackGround(WarnBg);
GotoXY(1,MaxLines);
IF Length(msg) < ScreenWidth-1 THEN Write(Chars(' ',(ScreenWidth-Length(msg)) div 2));
Write(msg); ClrEol;
CheckKeyOrMouse;
DrawStatusLine(TRUE,FullClipBoard,Changed);
END; (* ReportError *)
PROCEDURE DrawStatusLine(Redraw,FullClipboard, Changed: BOOLEAN);
BEGIN
TextBackGround(NormBg);
IF Redraw THEN
BEGIN
TextColor(NormFg); ClrEol;
GotoXY(1,MaxLines); Write(line);
GotoXY(3,MaxLines); Write(_4DOSVer);
END;
GotoXY(76,MaxLines);
IF FullClipBoard THEN BEGIN TextColor(HighFg); Write('Cut'); END
ELSE BEGIN TextColor(NormFg); Write('───'); END;
GotoXY(70,MaxLines);
IF Changed THEN BEGIN TextColor(HighFg); Write('Edit'); END
ELSE BEGIN TextColor(NormFg); Write('────'); END;
END; (* DrawStatusLine *)
PROCEDURE DrawMainScreen(Index,NrOfFiles: WORD);
BEGIN
TextColor(NormFg); TextBackGround(NormBg);
ClrScr;
TextColor(StatusFg); TextBackGround(StatusBg);
GotoXY(1,1);
Write(' ESC exits │ ',Chr(24),' or ',Chr(25),' Selects │ F1 Help │',
' F2 or F10 Saves │ Line ',Index:5,' of ',NrOfFiles:5,' ');
DrawStatusLine(TRUE,FALSE,FALSE);
END; (* DrawMainScreen *)
PROCEDURE ShowHelpPage;
VAR ch, cursor : WORD;
BEGIN
TextBackGround(NormBg);
ClrScr;
TextColor(DirFg);
GotoXY((ScreenWidth-10) DIV 2, 1); Write('4DESC Help');
TextColor(NormFg);
GotoXY((ScreenWidth-41) DIV 2, 2); Write('USAGE: 4DESC [/help] [/mono] [d:][\path]');
GotoXY( 8, 4); Write('UpArr, DnArr, PgUp, PgDn: Move highlight bar');
GotoXY( 8, 5); Write('LtArr, RtArr, Home, End: Move cursor');
GotoXY( 8, 6); Write('Ctrl-PgUp, Ctrl-PgDn: Move to first or last line');
GotoXY( 8, 7); Write('Ctrl-Left, Ctrl-Right: Move to previous/next word');
GotoXY( 8, 9); Write('Backspace: Delete the character before the cursor');
GotoXY( 8,10); Write('DEL: Delete the character under the cursor');
GotoXY( 8,11); Write('Ctrl-End: Delete from cursor to end of line');
GotoXY( 8,12); Write('INS: Toggle from insert mode (default) to overwrite mode ');
GotoXY( 8,13); Write('Alt-D: Delete current description');
GotoXY( 8,14); Write('Alt-C: Copy current description to buffer');
GotoXY( 8,15); Write('Alt-M, Alt-T: Move current description to buffer');
GotoXY( 8,16); Write('Alt-P: Paste buffer to current description');
GotoXY( 8,17); Write('Alt-V, F3: View higlighted file');
GotoXY( 8,18); Write('Alt-S, Shift-F10: Shell to (4)DOS');
GotoXY( 8,19); Write('Alt-X, ESC: Exit program');
GotoXY( 8,20); Write('F4 or ENTER on dir : Change to highlighted directory');
GotoXY( 8,21); Write('F5 or ENTER on .. : Change to parent directory');
GotoXY( 8,22); Write('F6 or Alt-L : Change drive');
GotoXY((ScreenWidth-Length(Header)) div 2 ,24); Write(Header);
GotoXY((ScreenWidth-24) div 2,25); Write('Press any key to return.');
Cursor := $2000; SetCursorShape(Cursor); (* Hide cursor. *)
CheckKeyOrMouse;
END; (* ShowHelp *)
(* -------------------------------------------------------- Keyboard *)
FUNCTION GetKey: WORD;
VAR chlo, chhi : CHAR;
BEGIN
chlo := ReadKey;
IF chlo = #0 THEN chhi := ReadKey
ELSE chhi := #0;
GetKey := WORD(chhi) SHL 8 + BYTE(chlo);
END;
PROCEDURE ChooseColors(Monochrome: BOOLEAN);
BEGIN
IF Monochrome THEN
IF INIFileExists THEN
BEGIN
DirFg := ReadSettingsColor('monodisplay','dirfg' ,mo_DirFg);
StatusFg := ReadSettingsColor('monodisplay','statusfg',mo_StatusFg);
StatusBg := ReadSettingsColor('monodisplay','statusbg',mo_StatusBg);
SelectFg := ReadSettingsColor('monodisplay','selectfg',mo_SelectFg);
SelectBg := ReadSettingsColor('monodisplay','selectbg',mo_SelectBg);
HighFg := ReadSettingsColor('monodisplay','highfg' ,mo_HighFg);
NormFg := ReadSettingsColor('monodisplay','normfg' ,mo_NormFg);
NormBg := ReadSettingsColor('monodisplay','normbg' ,mo_NormBg);
WarnFg := ReadSettingsColor('monodisplay','warnfg' ,mo_WarnFg);
WarnBg := ReadSettingsColor('monodisplay','warnbg' ,mo_WarnBg);
END
ELSE
BEGIN
DirFg := mo_DirFg;
StatusFg := mo_StatusFg; StatusBg := mo_StatusBg;
SelectFg := mo_SelectFg; SelectBg := mo_SelectBg;
HighFg := mo_HighFg;
NormFg := mo_NormFg; NormBg := mo_NormBg;
WarnFg := mo_WarnFg; WarnBg := mo_WarnBg;
END
ELSE
IF INIFileExists THEN
BEGIN
DirFg := ReadSettingsColor('colordisplay','dirfg' ,co_DirFg);
StatusFg := ReadSettingsColor('colordisplay','statusfg',co_StatusFg);
StatusBg := ReadSettingsColor('colordisplay','statusbg',co_StatusBg);
SelectFg := ReadSettingsColor('colordisplay','selectfg',co_SelectFg);
SelectBg := ReadSettingsColor('colordisplay','selectbg',co_SelectBg);
HighFg := ReadSettingsColor('colordisplay','highfg' ,co_HighFg);
NormFg := ReadSettingsColor('colordisplay','normfg' ,co_NormFg);
NormBg := ReadSettingsColor('colordisplay','normbg' ,co_NormBg);
WarnFg := ReadSettingsColor('colordisplay','warnfg' ,co_WarnFg);
WarnBg := ReadSettingsColor('colordisplay','warnbg' ,co_WarnBg);
END
ELSE
BEGIN
DirFg := co_DirFg;
StatusFg := co_StatusFg; StatusBg := co_StatusBg;
SelectFg := co_SelectFg; SelectBg := co_SelectBg;
HighFg := co_HighFg;
NormFg := co_NormFg; NormBg := co_NormBg;
WarnFg := co_WarnFg; WarnBg := co_WarnBg;
END;
END;
BEGIN
Get4DOSVer;
OrigCursor := GetCursorShape;
MaxLines := Hi(WindMax)+1;
ScreenSize := MaxLines-4;
ScreenWidth:= Lo(WindMax)+1;
Monochrome := (LastMode = Mono);
line := Chars('─',ScreenWidth-1);
IF INIFileExists THEN
BEGIN
s := ReadSettingsString('generaldisplay','leftjust','n');
NotLeftJust := (s[1] = 'y');
s := ReadSettingsString('generaldisplay','fullsize','n');
FullSize := (s[1] = 'y');
s := ReadSettingsString('generaldisplay','hidden','n');
UseHidden:= (s[1] = 'y');
ListCmd := ReadSettingsString('generaldisplay','viewer','list')
END
ELSE
BEGIN
NotLeftJust:= FALSE;
FullSize := FALSE;
UseHidden := FALSE;
ListCmd := 'list';
END;
END.