Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

KURSOV~1 / FFIND

.PAS
Скачиваний:
3
Добавлен:
16.12.2013
Размер:
4.25 Кб
Скачать

unit ffind;

interface
uses dos,crt;
{$I-,S-,V-}


Type S_type = String[13];
Function Select_File(Path : S_type;
BorderColor,WinColor,
TopX,TopY,Deep,Shadow : Byte ) : S_type;

implementation
Type
Stack_Ptr = String[13];
Var
HeapTop : ^Integer;
PtrArray : Array[1..256] of ^Stack_Ptr;
NuOfFiles,
BotY,RecNum,Ypos : Byte;
Function Select_File(Path : S_type;
BorderColor,WinColor,
TopX,TopY,Deep,Shadow : Byte ) : S_type;

Procedure Draw_Frame;
begin
If NuOfFiles > (Deep-TopY) then
BotY := Deep
else BotY := (TopY + 1) + NuOfFiles;
If Shadow = 1 then
Begin
Window(TopX+1,TopY+1,TopX+13,BotY + 1);
TextAttr := $07;
ClrScr;
end;
TextAttr := BorderColor;
Window(TopX,TopY,TopX+11,BotY+1);
Inc(TopY); dec(BotY);
Write('ЪДДДДДДДДДДї');
For Ypos := TopY to BotY do
Write('і і');
Write('АДДДДДДДДДДЩ');
Inc(TopX);
Deep := BotY - TopY;
GotoXY(6,Deep+3);
If NuOfFiles > Deep+1 then
Write(' more ');
end;

Function Get_Files : Boolean;
Var
DirInfo : SearchRec;

begin
NuOfFiles := 0;
FindFirst(Path,$20, DirInfo);
Get_Files := True;
If DosError = 0 then
While DosError = 0 do
begin
inc(NuOfFiles);
New(PtrArray[NuOfFiles]);
PtrArray[NuOfFiles]^ := DirInfo.Name;
FindNext(DirInfo);
end
else Get_Files := False;
end;


Function ParsedFile( FileToParse : S_Type) : S_Type;
Var
X : byte;
begin
X := Pos('.',FileToParse);
If x > 0 then
FileToParse[0] := Char(x-1);
ParsedFile := FileToParse;
end;

Procedure Draw_Files;
begin
Window(TopX,TopY,TopX+9,BotY);
TextAttr := WinColor;
ClrScr;
For RecNum := 1 to deep+1 do
begin
GotoXY(2,RecNum);
Write(ParsedFile(PtrArray[RecNum]^));
end;
Window(1,1,80,25);
end;

Procedure Scroll(Direction : Char;
X,Y,Width,Deep,Lines,Attr : Byte);
Var
Reg : Registers;
begin
dec(X);
dec(Y);
inc(Deep,Y);
inc(Width,X);
If Direction = 'D' then
Reg.ah := 7
else Reg.ah := 6;
Reg.al := Lines;
Reg.bh := Attr;
Reg.ch := Y;
reg.cl := X;
reg.dh := Deep;
Reg.dl := Width ;
Intr(16,Reg);
end;

Procedure Pick_File;
Var CH : Char;
filename : String[10];
begin
Ypos := TopY;
RecNum := 1;
repeat
GotoXY(TopX,Ypos);
TextAttr := $70;
textbackground(10);
FileName := ' ';
Insert(ParsedFile(PtrArray[RecNum]^),FileName,2);
Write(FileName);
CH := ReadKey;
If CH = #0 then
CH := ReadKey;
GotoXY(TopX,Ypos);
TextAttr := WinColor;
Write(FileName);
Case CH of
#80 : begin
inc(Ypos);
inc(RecNum);
end;
#72 : Begin
dec(Ypos);
dec(RecNum);
end;
#27 : PtrArray[RecNum]^ := '';
end;
If Ypos > BotY then
begin
dec(Ypos);
If RecNum <= NuOfFiles then
Scroll('U',TopX,TopY,9,deep,1,WinColor)
else RecNum := NuOfFiles;
end;
If Ypos < TopY then
begin
inc(Ypos);
If RecNum > 0 then
Scroll('D',TopX,TopY,9,Deep,1,WinColor)
Else RecNum := 1;
end;
until (CH = #13) or (CH = #27);
end;

begin
Mark(HeapTop);
If Get_Files then
begin
Draw_Frame;
Draw_Files;
Pick_File;
Select_File := PtrArray[RecNum]^;
end
else Select_File := '?';
Release(HeapTop);
end;

Begin
End.
Соседние файлы в папке KURSOV~1