[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]
Program DIRSEL;
Uses
Crt,Dos; { ** needed for DIRSELECT functions ** }
{ ** The following Type & Var declarations are for the main program only ** }
{ ** However, the string length of the returned parameter from DIRSELECT ** }
{ ** must be a least 12 characters. ** }
Type
strtype = String[12];
Var
spec,fname : strtype;
{ ************************************************************************** }
{ ** List of Procedures/Functions needed for DIRSELECT** }
{ ** Procedure CURSOR - turns cursor on or off** }
{ ** Procedure FRAME - draws single or double frame ** }
{ ** Function ISCOLOR - returns the current video mode** }
{ ** Procedure SAVESCR- saves current video screen** }
{ ** Procedure RESTORESCR - restores old video screen ** }
{ ** Procedure SCRGET - get character/attribute ** }
{ ** Procedure SCRPUT - put character/attribute ** }
{ ** Procedure FNAMEPOS - finds proper screen position ** }
{ ** Procedure HILITE - highlights proper name** }
{ ** Function DIRSELECT - directory selector** }
{ ************************************************************************** }
Procedure CURSOR( attrib : Boolean );
Var
regs : Registers;
Begin
If NOT attrib Then { turn cursor off }
Begin
regs.ah := 1;
regs.cl := 7;
regs.ch := 32;
Intr($10,regs)
End
Else { turn cursor on }
Begin
Intr($11,regs);
regs.cx := $0607;
If regs.al AND $10 <> 0 Then regs.cx := $0B0C;
regs.ah := 1;
Intr($10,regs)
End
End;
Procedure FRAME(t,l,b,r,ftype : Integer);
Var
i : Integer;
Begin
GoToXY(l,t);
If ftype = 2 Then
Write(Chr(201))
Else
Write(Chr(218));
GoToXY(r,t);
If ftype = 2 Then
Write(Chr(187))
Else
Write(Chr(191));
GoToXY(l+1,t);
For i := 1 To (r - (l + 1)) Do
If ftype = 2 Then
Write(Chr(205))
Else
Write(Chr(196));
GoToXY(l+1,b);
For i := 1 To (r - (l + 1)) Do
If ftype = 2 Then
Write(Chr(205))
Else
Write(Chr(196));
GoToXY(l,b);
If ftype = 2 Then
Write(Chr(200))
Else
Write(Chr(192));
GoToXY(r,b);
If ftype = 2 Then
Write(Chr(188))
Else
Write(Chr(217));
For i := (t+1) To (b-1) Do
Begin
GoToXY(l,i);
If ftype = 2 Then
Write(Chr(186))
Else
Write(Chr(179))
End;
For i := (t+1) To (b-1) Do
Begin
GoToXY(r,i);
If ftype = 2 Then
Write(Chr(186))
Else
Write(Chr(179))
End
End;
Function ISCOLOR : Boolean; { returns FALSE for MONO or TRUE for COLOR }
Var
regs : Registers;
video_mode : Integer;
equ_lo : Byte;
Begin
Intr($11,regs);
video_mode := regs.al and $30;
video_mode := video_mode shr 4;
Case video_mode of
1 : ISCOLOR := FALSE; { Monochrome }
2 : ISCOLOR := TRUE{ Color }
End
End;
Procedure SAVESCR( Var screen );
Var
vidc : Byte Absolute $B800:0000;
vidm : Byte Absolute $B000:0000;
Begin
If NOT ISCOLOR Then { if MONO }
Move(vidm,screen,4000)
Else { else COLOR }
Move(vidc,screen,4000)
End;
Procedure RESTORESCR( Var screen );
Var
vidc : Byte Absolute $B800:0000;
vidm : Byte Absolute $B000:0000;
Begin
If NOT ISCOLOR Then { if MONO }
Move(screen,vidm,4000)
Else { else COLOR }
Move(screen,vidc,4000)
End;
Procedure SCRGET( Var ch,attr : Byte );
Var
regs : Registers;
Begin
regs.bh := 0;
regs.ah := 8;
Intr($10,regs);
ch := regs.al;
attr := regs.ah
End;
Procedure SCRPUT( ch,attr : Byte );
Var
regs : Registers;
Begin
regs.al := ch;
regs.bl := attr;
regs.ch := 0;
regs.cl := 1;
regs.bh := 0;
regs.ah := 9;
Intr($10,regs);
End;
Procedure FNAMEPOS(Var arypos,x,y : Integer);
{ determine position on screen of filename }
Const
FPOS1 = 2;
FPOS2 = 15;
FPOS3 = 28;
FPOS4 = 41;
FPOS5 = 54;
FPOS6 = 67;
Begin
Case arypos of
1: Begin x := FPOS1; y := 2 End;
2: Begin x := FPOS2; y := 2 End;
3: Begin x := FPOS3; y := 2 End;
4: Begin x := FPOS4; y := 2 End;
5: Begin x := FPOS5; y := 2 End;
6: Begin x := FPOS6; y := 2 End;
7: Begin x := FPOS1; y := 3 End;
8: Begin x := FPOS2; y := 3 End;
9: Begin x := FPOS3; y := 3 End;
10: Begin x := FPOS4; y := 3 End;
11: Begin x := FPOS5; y := 3 End;
12: Begin x := FPOS6; y := 3 End;
13: Begin x := FPOS1; y := 4 End;
14: Begin x := FPOS2; y := 4 End;
15: Begin x := FPOS3; y := 4 End;
16: Begin x := FPOS4; y := 4 End;
17: Begin x := FPOS5; y := 4 End;
18: Begin x := FPOS6; y := 4 End;
19: Begin x := FPOS1; y := 5 End;
20: Begin x := FPOS2; y := 5 End;
21: Begin x := FPOS3; y := 5 End;
22: Begin x := FPOS4; y := 5 End;
23: Begin x := FPOS5; y := 5 End;
24: Begin x := FPOS6; y := 5 End;
25: Begin x := FPOS1; y := 6 End;
26: Begin x := FPOS2; y := 6 End;
27: Begin x := FPOS3; y := 6 End;
28: Begin x := FPOS4; y := 6 End;
29: Begin x := FPOS5; y := 6 End;
30: Begin x := FPOS6; y := 6 End;
31: Begin x := FPOS1; y := 7 End;
32: Begin x := FPOS2; y := 7 End;
33: Begin x := FPOS3; y := 7 End;
34: Begin x := FPOS4; y := 7 End;
35: Begin x := FPOS5; y := 7 End;
36: Begin x := FPOS6; y := 7 End;
37: Begin x := FPOS1; y := 8 End;
38: Begin x := FPOS2; y := 8 End;
39: Begin x := FPOS3; y := 8 End;
40: Begin x := FPOS4; y := 8 End;
41: Begin x := FPOS5; y := 8 End;
42: Begin x := FPOS6; y := 8 End;
43: Begin x := FPOS1; y := 9 End;
44: Begin x := FPOS2; y := 9 End;
45: Begin x := FPOS3; y := 9 End;
46: Begin x := FPOS4; y := 9 End;
47: Begin x := FPOS5; y := 9 End;
48: Begin x := FPOS6; y := 9 End;
49: Begin x := FPOS1; y := 10 End;
50: Begin x := FPOS2; y := 10 End;
51: Begin x := FPOS3; y := 10 End;
52: Begin x := FPOS4; y := 10 End;
53: Begin x := FPOS5; y := 10 End;
54: Begin x := FPOS6; y := 10 End;
55: Begin x := FPOS1; y := 11 End;
56: Begin x := FPOS2; y := 11 End;
57: Begin x := FPOS3; y := 11 End;
58: Begin x := FPOS4; y := 11 End;
59: Begin x := FPOS5; y := 11 End;
60: Begin x := FPOS6; y := 11 End;
61: Begin x := FPOS1; y := 12 End;
62: Begin x := FPOS2; y := 12 End;
63: Begin x := FPOS3; y := 12 End;
64: Begin x := FPOS4; y := 12 End;
65: Begin x := FPOS5; y := 12 End;
66: Begin x := FPOS6; y := 12 End;
67: Begin x := FPOS1; y := 13 End;
68: Begin x := FPOS2; y := 13 End;
69: Begin x := FPOS3; y := 13 End;
70: Begin x := FPOS4; y := 13 End;
71: Begin x := FPOS5; y := 13 End;
72: Begin x := FPOS6; y := 13 End;
73: Begin x := FPOS1; y := 14 End;
74: Begin x := FPOS2; y := 14 End;
75: Begin x := FPOS3; y := 14 End;
76: Begin x := FPOS4; y := 14 End;
77: Begin x := FPOS5; y := 14 End;
78: Begin x := FPOS6; y := 14 End;
79: Begin x := FPOS1; y := 15 End;
80: Begin x := FPOS2; y := 15 End;
81: Begin x := FPOS3; y := 15 End;
82: Begin x := FPOS4; y := 15 End;
83: Begin x := FPOS5; y := 15 End;
84: Begin x := FPOS6; y := 15 End;
85: Begin x := FPOS1; y := 16 End;
86: Begin x := FPOS2; y := 16 End;
87: Begin x := FPOS3; y := 16 End;
88: Begin x := FPOS4; y := 16 End;
89: Begin x := FPOS5; y := 16 End;
90: Begin x := FPOS6; y := 16 End;
91: Begin x := FPOS1; y := 17 End;
92: Begin x := FPOS2; y := 17 End;
93: Begin x := FPOS3; y := 17 End;
94: Begin x := FPOS4; y := 17 End;
95: Begin x := FPOS5; y := 17 End;
96: Begin x := FPOS6; y := 17 End;
97: Begin x := FPOS1; y := 18 End;
98: Begin x := FPOS2; y := 18 End;
99: Begin x := FPOS3; y := 18 End;
100: Begin x := FPOS4; y := 18 End;
101: Begin x := FPOS5; y := 18 End;
102: Begin x := FPOS6; y := 18 End;
103: Begin x := FPOS1; y := 19 End;
104: Begin x := FPOS2; y := 19 End;
105: Begin x := FPOS3; y := 19 End;
106: Begin x := FPOS4; y := 19 End;
107: Begin x := FPOS5; y := 19 End;
108: Begin x := FPOS6; y := 19 End;
109: Begin x := FPOS1; y := 20 End;
110: Begin x := FPOS2; y := 20 End;
111: Begin x := FPOS3; y := 20 End;
112: Begin x := FPOS4; y := 20 End;
113: Begin x := FPOS5; y := 20 End;
114: Begin x := FPOS6; y := 20 End;
115: Begin x := FPOS1; y := 21 End;
116: Begin x := FPOS2; y := 21 End;
117: Begin x := FPOS3; y := 21 End;
118: Begin x := FPOS4; y := 21 End;
119: Begin x := FPOS5; y := 21 End;
120: Begin x := FPOS6; y := 21 End
Else
Begin
x := 0;
y := 0;
End
End
End;
Procedure HILITE(old,new : Integer); { highlight a filename on the screen }
Var
i,oldx,oldy,newx,newy : Integer;
ccolor,locolor,hicolor,cchar : Byte;
Begin
FNAMEPOS(old,oldx,oldy); { get position in the array of the filename }
FNAMEPOS(new,newx,newy); { get position in the array of the filename }
For i := 0 To 11 Do
Begin
If old < 121 Then { if valid position, reverse video, old selection }
Begin
GoToXY((oldx + i),oldy);
SCRGET(cchar,ccolor);
locolor := ccolor AND $0F;
locolor := locolor shl 4;
hicolor := ccolor AND $F0;
hicolor := hicolor shr 4;
ccolor := locolor + hicolor;
SCRPUT(cchar,ccolor)
End;
GoToXY((newx + i),newy); { reverse video, new selection }
SCRGET(cchar,ccolor);
locolor := ccolor AND $0F;
locolor := locolor shl 4;
hicolor := ccolor AND $F0;
hicolor := hicolor shr 4;
ccolor := locolor + hicolor;
SCRPUT(cchar,ccolor)
End
End;
Function DIRSELECT(mask : strtype; attr : Integer) : strtype;
Const
OFF = FALSE;
ON= TRUE;
Var
i,oldcurx,oldcury,
newcurx,newcury,
oldpos,newpos,
scrrows,fncnt: Integer;
ch : Char;
dos_dir : Array[1..120] of String[12];
fileinfo : SearchRec;
screen : Array[1..4000] of Byte;
Begin
fncnt := 0;
FindFirst(mask,attr,fileinfo);
If DosError <> 0 Then { if not found, return NULL }
Begin
DIRSELECT := '';
Exit
End;
While (DosError = 0) AND (fncnt <> 120) Do { else, collect filenames }
Begin
Inc(fncnt);
dos_dir[fncnt] := fileinfo.Name;
FindNext(fileinfo)
End;
oldcurx := WhereX; { store old CURSOR position }
oldcury := WhereY;
SAVESCR(screen);
CURSOR(OFF);
scrrows := (fncnt DIV 6) + 3;
Window(1,1,80,scrrows + 1);
ClrScr;
GoToXY(1,1);
i := 1;
While (i <= fncnt) AND (i <= 120) Do { display all filenames }
Begin
FNAMEPOS(i,newcurx,newcury);
GoToXY(newcurx,newcury);
Write(dos_dir[i]);
Inc(i)
End;
FRAME(1,1,scrrows,80,1); { draw the frame }
HILITE(255,1);{ highlight the first filename }
oldpos := 1;
newpos := 1;
While TRUE Do { get keypress and do appropriate action }
Begin
ch := ReadKey;
Case ch of
#27: { Esc }
Begin
Window(1,1,80,25);
RESTORESCR(screen);
GoToXY(oldcurx,oldcury);
CURSOR(ON);
DIRSELECT := '';
Exit { return NULL }
End;
#71: { Home }{ goto first filename }
Begin
oldpos := newpos;
newpos := 1;
HILITE(oldpos,newpos)
End;
#79: { End }{ goto last filename }
Begin
oldpos := newpos;
newpos := fncnt;
HILITE(oldpos,newpos)
End;
#72: { Up }{ move up one filename }
Begin
i := newpos;
i := i - 6;
If i >= 1 Then
Begin
oldpos := newpos;
newpos := i;
HILITE(oldpos,newpos)
End
End;
#80: { Down }{ move down one filename }
Begin
i := newpos;
i := i + 6;
If i <= fncnt Then
Begin
oldpos := newpos;
newpos := i;
HILITE(oldpos,newpos)
End
End;
#75: { Left }{ move left one filename }
Begin
i := newpos;
Dec(i);
If i >= 1 Then
Begin
oldpos := newpos;
newpos := i;
HILITE(oldpos,newpos)
End
End;
#77: { Right } { move right one filename }
Begin
i := newpos;
Inc(i);
If i <= fncnt Then
Begin
oldpos := newpos;
newpos := i;
HILITE(oldpos,newpos)
End
End;
#13: { CR }
Begin
Window(1,1,80,25);
RESTORESCR(screen);
GoToXY(oldcurx,oldcury);{ return old CURSOR position }
CURSOR(ON);
DIRSELECT := dos_dir[newpos];
Exit{ return with filename }
End
End
End
End;
{ ************************************************************************** }
{ ** Main Program : NOTE that the following is a demo program only. ** }
{ **It is not needed to use the DIRSELECT function. ** }
{ ************************************************************************** }
Begin
While TRUE Do
Begin
Writeln;
Write('Enter a filespec => ');
Readln(spec);
fname := DIRSELECT(spec,0);
If Length(fname) = 0 Then
Begin
Writeln('Filespec not found.');
Halt
End;
Writeln('The file you have chosen is ',fname,'.')
End
End.
[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]