< -->
Program LevelEditor;
{$G+,N+,E-,D+}
{$M 32768, 0, 655360}
Uses Graph, CRT, DOS;
{$L C:\PROGRA~2\BP70\BIN\EGAVGA.OBJ}
Procedure EGAVGA; External;
const
Arrow : array[0..31] of Word = ($0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0,
$0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0);
const
OldInt1Ch : Pointer = NIL;
flag : Word = 0;
MouseTimer : Word = 0;
MouseForm : Word = 0; {0 - Arrow, 1 - Cursor, 2 - SandGlass, 3 - finger}
Command : Word = 0;
ConfFile : PathStr = 'LVOBEDIT.CFG';
HS: array [0..15] of Char = '0123456789ABCDEF';
EP : Boolean = False;
const
eFont : String[4] = '.fnt';
eObject : String[4] = '.obc';
eScript : String[4] = '.sct';
eLevel : String[4] = '.lvp';
eMap : String[4] = '.mpp';
var
Ps : array [0..10] of Pointer;
Pmem : Pointer;
AdrMem : Longint absolute Pmem;
PImg : Pointer;
MemSize : Longint;
GrMemSize : Longint;
GrMem : Word;
Pages : Byte;
P : Pointer;
D, R, e, IOR : Integer;
CurFileNm : String;
i, j : Word;
MouseMask : Pointer;
FSrch : SearchRec;
Pth : PathStr;
DirName : DirStr;
NameName : NameStr;
ExtName : ExtStr;
FileName : String;
FileMask : String;
CurDir : String;
const watchData : array [0..31] of word =
($E007,$C003,$8001,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$8001,$C003,$E007,
$0,$1FF8,$318C,$6186,$4012,$4022,$4042,$718C,$718C,$4062,$4032,
$4002,$6186,$318C,$1FF8,$0);
const arrowData : array [0..31] of word =
($FFFF,$8FFF,$8FFF,$87FF,$83FF,$81FF,$80FF,$807F,$803F,$801F,$800F,
$801F,$807F,$887F,$DC3F,$FC3F,
$0,$0,$2000,$3000,$3800,$3C00,$3E00,$3F00,$3F80,$3FC0,
$3FE0,$3E00,$3300,$2300,$0180,$0180);
const UpArrowCursor : array [0..31] of word =
($f9ff,$f0ff,$e07f,$e07f,$c03f,$c03f,$801f,$801f,
$f,$f,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,
$0,$600,$f00,$f00,$1f80,$1f80,$3fc0,$3fc0,
$7fe0,$600, $600, $600, $600, $600, $600, $600);
const LeftArrowCursor : array [0..31] of word
= ($fe1f,$f01f,$0, $0, $0, $f01f,$fe1f,$ffff,
$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
$0, $c0, $7c0, $7ffe,$7c0, $c0, $0, $0,
$0, $0, $0, $0, $0, $0, $0, $0);
const CheckMarkCursor : array [0..31] of word
= ($fff0,$ffe0,$ffc0,$ff81,$ff03,$607, $f, $1f,
$c03f,$f07f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
$0, $6, $c, $18, $30, $60, $70c0,$1d80,
$700, $0, $0, $0, $0, $0, $0, $0);
const PointingHandCursor : array [0..31] of word
= ($e1ff,$e1ff,$e1ff,$e1ff,$e1ff,$e000,$e000,$e000,
$0, $0, $0, $0, $0, $0, $0, $0,
$1e00,$1200,$1200,$1200,$1200,$13ff,$1249,$1249,
$f249,$9001,$9001,$9001,$8001,$8001,$8001,$ffff);
const DiagonalcrossCursor : array [0..31] of word
= ($7e0, $180, $0, $c003,$f00f,$c003,$0, $180,
$7e0, $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
$0, $700e,$1c38,$660, $3c0, $660, $1c38,$700e,
$0, $0, $0, $0, $0, $0, $0, $0);
const
RectangularCrossCursor : array [0..31] of word
= ($fc3f,$fc3f,$fc3f,$0,$0, $0, $fc3f,$fc3f,
$fc3f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
$0, $180, $180, $180, $7ffe,$180, $180, $180,
$0, $0, $0, $0, $0, $0, $0, $0);
const
HourglassCursor : array [0..31] of word
= ($0, $0, $0, $0, $8001,$c003,$e007,$f00f,
$e007,$c003,$8001,$0, $0, $0, $0, $ffff,
$0, $7ffe,$6006,$300c,$1818,$c30, $660, $3c0,
$660, $c30, $1998,$33cc,$67e6,$7ffe,$0, $0);
const
newWatchCursor : array [0..31] of word
= ( $ffff, $c003, $8001, $0, $0, $0, $0, $0, $0,
$0, $0, $0, $0, $8001, $c003, $ffff, $0, $0,
$1ff8, $2004, $4992, $4022, $4042, $518a, $4782,
$4002, $4992, $4002, $2004, $1ff8, $0, $0 );
Procedure MCrsr; Assembler;
asm
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 1111111111111111b
dw 0000001111000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000001111000000b
end;
Procedure MSandGlass; Assembler;
asm
dw 1111111111111111b
dw 1000000000000001b
dw 1010101011010101b
dw 1000000000000001b
dw 1100110111110011b
dw 1111001101001111b
dw 1111110110111111b
dw 1111111001111111b
dw 1111111001111111b
dw 1111110110111111b
dw 1111001101001111b
dw 1100110111110011b
dw 1000000000000001b
dw 1001010110101001b
dw 1000000000000001b
dw 1111111111111111b
dw 0000000000000000b
dw 0111111111111110b
dw 0101010100101010b
dw 0111111111111110b
dw 0011001000001100b
dw 0000110010110000b
dw 0000001001000000b
dw 0000000110000000b
dw 0000000110000000b
dw 0000001001000000b
dw 0000110010110000b
dw 0011001000001100b
dw 0111111111111110b
dw 0110101001010110b
dw 0111111111111110b
dw 0000000000000000b
end;
Procedure MFing; Assembler;
asm
dw 1001111111111111b
dw 0010111111111111b
dw 0100111111111111b
dw 0110111111111111b
dw 1011010011111111b
dw 1011001101000111b
dw 1011011101011001b
dw 0101101110111010b
dw 0101110111011010b
dw 0110111111111110b
dw 0111111111111110b
dw 0111111111111110b
dw 1011111111111101b
dw 1100000000000001b
dw 1010101010101010b
dw 1111111111111111b
dw 0110000000000000b
dw 1101000000000000b
dw 1011000000000000b
dw 1001000000000000b
dw 0100101100000000b
dw 0100110010111000b
dw 0100100010100110b
dw 1010010001000101b
dw 1010001000100101b
dw 1001000000000001b
dw 1000000000000001b
dw 1000000000000001b
dw 0100000000000010b
dw 0011111111111110b
dw 0101010101010101b
dw 0000000000000000b
end;
Procedure WaitRetrace;Assembler;
asm
mov dx, 03DAh
@VRTL1:
in al, dx
test al, 8
jnz @VRTL1
@VRTL2:
in al, dx
test al, 8
jz @VRTL2
ret
end;
Procedure InitMouse; Assembler;
asm
mov ax, 0
int 33h
end;
Procedure ShowMouse; Assembler;
asm
mov ax, 1
int 33h
end;
Procedure HideMouse; Assembler;
asm
mov ax, 2
int 33h
end;
Function MouseButt : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, bx
end;
Function MouseX : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, cx
end;
Function MouseY : Word; Assembler;
asm
mov ax, 3
int 33h
mov ax, dx
end;
Procedure MouseGotoXY(X, Y : Integer); Assembler;
asm
mov ax, 4
mov cx, word ptr X
mov dx, word ptr Y
int 33h
end;
Procedure MouseGraphCursor(X,Y: Byte); Assembler;
{Задает вид графического указателя}
asm
mov ax, 2
int 33h
push es
les dx, MouseMask
mov ax, 09h
mov bx, word ptr X
mov cx, word ptr Y
int 033h
pop es
mov ax, 1
int 33h
end; {MouseGraphCursor}
Function MouseIn(X1,Y1,X2,Y2: Integer): Boolean;
begin
MouseIn := (MouseX>X1) and (MouseXY1) and (MouseY=X1) and (MouseX<=X2) and (MouseY>=Y1) and (MouseY<=Y2)
end; {MouseIn}
Procedure SetInt1Ch; Assembler;
asm
push es
mov ax, 351Ch
int 21h
mov word ptr OldInt1Ch, bx
mov word ptr OldInt1Ch+2, es
mov word ptr @OI1Ch, bx
mov word ptr @OI1Ch+2, es
pop es
mov ax, 251Ch
push ds
mov dx, seg @int1Ch
mov ds, dx
mov dx, offset @int1Ch
int 21h
pop ds
ret
@int1Ch:
pushf
push ds
push ax
mov ax, seg flag
mov ds, ax
inc word ptr flag
inc word ptr MouseTimer
pop ax
pop ds
popf
db 02Eh, 0EAh {cs:jmp 00000000}
@OI1Ch :
dd 0
{ iret}
end;
Procedure RestoreInt1Ch; Assembler;
asm
push ds
lds dx, OldInt1Ch
mov ax, 251Ch
int 21h
pop ds
end;
Function HexW(X: Word; Bl : Boolean): String;
var
S: String;
k: Byte;
begin
S := '';
for k := 3 downto 0 do
S := S+HS[(X shr (k*4)) and 15];
if not Bl then
While (S[1] = '0') and (Length(S)<>0) do
Delete(S, 1, 1);
HexW := S
end; {HexW}
Procedure WaitFlag; Assembler;
asm
@bgn:
mov ax, word ptr flag
cmp ax, 5
jne @bgn
xor ax, ax
mov word ptr flag, ax
end;
Procedure BarL(x1, y1, x2, y2 : Word);
begin
MoveTo(x1, y1);
LineTo(x2, y1);
LineTo(x2, y2);
LineTo(x1, y2);
LineTo(x1, y1);
end;
Function EditS(x, y, x1, y1, C, BC, CC : Word; var S : String) : String;
var
Flg : Byte;
Ch : Char;
CVis, Marked : Boolean;
Xc, Yc : Word;
l : Word;
S1 : String;
Procedure Mkl;
var
k : Byte;
begin
SetColor(9);
for k := 0 to 7 do
Line(x, y+k, x+l, y+k);
end;
Procedure ViewStr;
begin
HideMouse;
SetColor(C);
SetFillStyle(1, BC);
Bar(x, y-2, x1, y1);
OutTextXY(x, y, S1);
if CVis then
begin
SetColor(CC);
Line(Xc, Yc-2, Xc, Yc+8);
end;
ShowMouse;
end;
begin
S := FileName;
MouseForm := 3;
MouseMask := @MFing;
MouseGraphCursor(0, 0);
CVis := False;
Marked := True;
S1 := S;
Flg := 0;
l := Length(S1)*8;
Xc := x + l;
Yc := y;
HideMouse;
SetColor(C);
SetFillStyle(1, BC);
OutTextXY(x, y, S1);
SetWriteMode(XORput);
Mkl;
ShowMouse;
While MouseButt <> 0 do;
Repeat
if Flag and 8 = 0 then
begin
if CVis then
begin
SetColor(CC);
HideMouse;
Line(Xc, Yc-2, Xc, Yc+8);
ShowMouse;
CVis := not CVis;
end;
end else
if not CVis then
begin
SetColor(CC);
HideMouse;
Line(Xc, Yc-2, Xc, Yc+8);
ShowMouse;
CVis := not CVis;
end;
if KeyPressed then
begin
Ch := ReadKey;
case Ch of
#0:case ReadKey of
#75:{Left Arrow}
begin
HideMouse;
if Marked then Mkl;
Marked := False;
if Xc>x then
begin
dec(Xc, 8);
if CVis then
begin
SetColor(CC);
Line(Xc+8, Yc-2, Xc+8, Yc+8);
Line(Xc, Yc-2, Xc, Yc+8);
end;
end;
ShowMouse;
end;
#77:{Right Arrow}
begin
HideMouse;
if Marked then Mkl;
Marked := False;
if Xc0) and (Xc>=x) and (Xc0) and (Xc>x) then
begin
Delete(S1, (Xc-x) div 8, 1);
ViewStr;
dec(l, 8);
dec(Xc, 8);
if CVis then
begin
SetColor(CC);
Line(Xc+8, Yc-2, Xc+8, Yc+8);
Line(Xc, Yc-2, Xc, Yc+8);
end;
end;
end;
#13:{Enter}
begin
S := S1;
if CVis then
begin
SetColor(CC);
Line(Xc, Yc-2, Xc, Yc+8);
end;
if Marked then
begin
Marked := False;
Mkl;
end;
Flg := 255;
end;
#27:{Esc}
begin
if CVis then
begin
SetColor(CC);
Line(Xc, Yc-2, Xc, Yc+8);
end;
if Marked then
begin
Marked := False;
Mkl;
end;
Flg := 255;
end;{Esc}
end;{case ReadKey of...}
end;{if KeyPressed}
if MouseButt=1 then
begin
if MouseIn(x, y, x1, y1) then
begin
if not Marked then
begin
l := Length(S1)*8;
Xc := x+l;
HideMouse;
if CVis then
begin
SetColor(CC);
Line(Xc, Yc-2, Xc, Yc+8);
end;
Marked := True;
Mkl;
ShowMouse;
end{if not Marked}
else
begin
end;
end {if MouseIn...}
else
begin
HideMouse;
if CVis then
begin
SetColor(CC);
Line(Xc, Yc-2, Xc, Yc+8);
end;
if Marked then
begin
Marked := False;
Mkl;
end;
Flg := 255;
ShowMouse;
end;{else}
While MouseButt<>0 do;
end;{if MouseButt<>0...}
Until Flg=255;
SetWriteMode(NormalPut);
EditS := S;
end;
const
FSSz = (440-90) div 8;
DSSz = (320-90) div 8;
FSelSz = FSSz*8;
DSelSz = DSSz*8;
SF_WndName : String = '';
Pth_ : String[5] = 'Путь:';
FL_ : String[14] = 'Список файлов:';
Dr_ : String[11] = 'Директория:';
Dsk_ : String[5] = 'Диск:';
tmpFDir : String[12] = 'loe_dlst.tmp';
tmpFNm : String[12] = 'loe_flst.tmp';
ActWnd : Byte = 0;
Done : ShortInt = 0;
CurVisibleA : Boolean = False;
CurVisibleB : Boolean = False;
Function SelectFile : String;
var
nDirs, nFiles : Longint;
CurND, CurNF : Longint;
FNbg, FNend, DNbg, DNend : Longint;
i, j, Nd, k : Word;
S, tmpS, S1 : String;
fDir, fFNm : Text;
mX, mY : Word;
Label Scock;
Procedure WrFileList;
var
i : Longint;
begin
SetFillStyle(1, DarkGray);
SetColor(LightGray);
Bar(30, 90, 310, 440);{FL}
BarL(29, 89, 311, 441);{FL}
Line(171, 90, 171, 440);
Line(169, 90, 169, 440);
SetColor(Yellow);
Reset(fFNm);
for i := 1 to FNbg-1 do
ReadLn(fFNm, tmpS);
for i := 1 to (FNend-FNbg+1) do
begin
ReadLn(fFNm, tmpS);
OutTextXY(32+142*((i-1) div FSSz), 85+i*8-FSelSz*((i-1) div FSSz), tmpS);
end;
Close(fFNm);
end;
Procedure WrDirList;
var
i : Longint;
begin
SetFillStyle(1, DarkGray);
SetColor(LightGray);
Bar(330, 90, 610, 320);{Dr}
BarL(329, 89, 611, 321);{Dr}
Line(471, 90, 471, 320);
Line(469, 90, 469, 320);
SetColor(Yellow);
Reset(fDir);
for i := 1 to DNbg-1 do
ReadLn(fDir, tmpS);
for i := 1 to (DNend-DNbg+1) do
begin
ReadLn(fDir, tmpS);
OutTextXY(332+142*((i-1) div DSSz), 85+i*8-DSelSz*((i-1) div DSSz), tmpS);
end;
Close(fDir);
end;
Procedure Mklx(x, y, l : Word; xCl : Byte);
var
k : Byte;
begin
SetWriteMode(XORPut);
SetColor(xCl); {4, 5}
for k := 0 to 7 do
Line(x, y+k, x+l, y+k);
SetWriteMode(NormalPut);
end;
Procedure SetCurPos;
begin
case ActWnd of
1 :
begin
i := CurNF-FNbg;
Mklx(32+142*(i div FSSz), 85+(i+1)*8-FSelSz*(i div FSSz), 135, 1);
end;
2 :
begin
i := CurND-DNbg;
Mklx(332+142*(i div DSSz), 85+(i+1)*8-DSelSz*(i div DSSz), 135, 1);
end;
3 :
begin
SetLineStyle(2, 1, NormWidth);
SetWriteMode(XorPut);
BarL(330, 365, 400, 380);
SetLineStyle(0, 1, NormWidth);
SetWriteMode(NormalPut);
end;
4 :
begin
SetLineStyle(2, 1, NormWidth);
SetWriteMode(XorPut);
BarL(330, 390, 400, 405);
SetLineStyle(0, 1, NormWidth);
SetWriteMode(NormalPut);
end;
end;
end;
begin
Done := 0;
S1 := FileName;
FileName := FExpand(FileMask);
FSplit(filename, DirName, NameName, extname);
filename := NameName;
Pth := DirName;
ChDir(Pth);
S := Pth;
ActWnd := 0;
Scock:
CurVisibleA := False;
CurVisibleB := False;
if ExtName='' then ExtName := '.*';
FileMask := '*'+ ExtName;
CurND := 0;
CurNF := 0;
nDirs := 0;
nFiles := 0;
Assign(fFNm, CurDir+tmpFNm);
ReWrite(fFNm);
FindFirst(Pth+FileMask, $2F, FSrch);{AnyFile without Directory}
While DosError = 0 do
begin
if (FSrch.Attr and VolumeID)=0 then
begin
WriteLn(fFNm, FSrch.Name);
inc(nFiles);
end;
FindNext(FSrch);
end;
Close(fFNm);
Assign(fDir, CurDir+tmpFDir);
ReWrite(fDir);
FindFirst(Pth+'*.*', AnyFile, FSrch);
While DosError = 0 do
begin
if (FSrch.Attr and Directory)<>0 then
begin
WriteLn(fDir, FSrch.Name);
inc(nDirs);
end;
FindNext(FSrch);
end;
Close(fDir);
if nFiles<>0 then
begin
FNbg := 1;
CurNF := 1;
if nFiles>=FSSz*2 then FNend := FSSz*2
else FNend := nFiles;
end else
begin
FNbg := 0;
FNend := 0;
end;
if nDirs<>0 then
begin
DNbg := 1;
CurND := 1;
if nDirs>=DSSz*2 then DNend := DSSz*2
else DNend := nDirs;
end else
begin
DNbg := 0;
DNend := 0;
end;
Nd := 1;
for i := 3 to 26 do
if DiskFree(i)<>-1 then inc(Nd);
HideMouse;
SetColor(LightGray);
SetFillStyle(1, DarkGray);
Bar(15, 30, 625, 465);
SetFillStyle(1, Blue);
Bar(15, 15, 625, 30);
MoveTo(15, 15); LineTo(625, 15); LineTo(625, 465);
LineTo(15, 465); LineTo(15, 15); Line(15, 30, 625, 30);
SetColor(LightMagenta);
OutTextXY(320-4*Length(SF_WndName), 19, SF_WndName);
SetColor(White);
OutTextXY(28, 47, Pth_);
OutTextXY(40, 75, FL_);
OutTextXY(340, 75, Dr_);
OutTextXY(400, 334, Dsk_);
SetFillStyle(1, DarkGray);
Bar(70, 43, 610, 58);{Pth}
Bar(461, 327, 610, 345);{Dsk}
SetColor(LightGray);
BarL(69, 42, 611, 59);{Pth}
BarL(459, 331, 611, 346);{Dsk}
SetFillStyle(1, LightBlue);
Bar(445, 330, 458, 345);
SetColor(Yellow);
OutTextXY(448, 335, #$19);
FindFirst(Pth[1]+':\*.*', VolumeID, FSrch);
OutTextXY(461, 335, FExpand(Pth[1]+':\')+' ['+FSrch.Name+']');
OutTextXY(75, 47, Pth+filename+ExtName);
SetColor(LightGreen);
OutTextXY(30, 450, Pth+filemask);
FindFirst(FileMask, AnyFile, FSrch);
SetColor(14);
WrFileList;
WrDirList;
SetColor(Red);
SetFillStyle(1, Red);
Bar(314, 90, 316, 440);
Bar(614, 90, 616, 320);
SetFillStyle(1, LightGray);
Bar(330, 365, 400, 380);
Bar(330, 390, 400, 405);
SetColor(Black);
OutTextXY(333, 369, 'Согласен');
OutTextXY(333, 394, 'Отменить');
SetCurPos;
ShowMouse;
Repeat
if MouseIn(70, 43, 610, 58) then
begin
if MouseForm<>1 then
begin
MouseForm := 1;
MouseMask := @MCrsr;
MouseGraphCursor(8, 8);
end;
end else
if MouseIn(30, 90, 310, 440) or MouseIn(330, 90, 610, 320) or
MouseIn(445, 330, 610, 345) or MouseIn(330, 365, 400, 380) or MouseIn(330, 390, 400, 405) then
begin
if MouseForm<>3 then
begin
MouseForm := 3;
MouseMask := @MFing;
MouseGraphCursor(0, 0);
end;
end else
if MouseForm<>0 then
begin
MouseForm := 0;
MouseMask := @Arrow;
MouseGraphCursor(0, 0);
end;
if MouseButt=1 then
begin
MouseTimer := 0;
if MouseIn(445, 330, 610, 345) then {Диски}
begin
ActWnd := 0;
HideMouse;
Nd := 1;
for i := 3 to 26 do
if DiskFree(i)<>-1 then inc(Nd);
SetFillStyle(1, Cyan);
SetColor(LightRed);
Bar(445, 346, 610, 346+Nd*8);
OutTextXY(460, 347, 'A:\');
i := 1;
for j := 3 to 26 do
if DiskFree(j)<>-1 then
begin
FindFirst(Char(j+$40)+':\*.*', VolumeID, FSrch);
OutTextXY(460, 347+i*8, FExpand(Char(j+$40)+':\')+' ['+FSrch.Name+']');
inc(i);
end;
ShowMouse;
SetColor(10); {2, 10}
SetWriteMode(XORput);
i := 0;
While MouseButt<>0 do
if MouseIn(445, 346, 610, 346+Nd*8) then
begin
j := (MouseY-346) and $FFF8 + 346;
if i <> j then
begin
HideMouse;
if i <> 0 then
for k := 0 to 7 do
Line(445, i+k, 610, i+k);
for k := 0 to 7 do
Line(445, j+k, 610, j+k);
i := j;
ShowMouse;
end;
end;
SetLineStyle(SolidLn, 1, 1);
SetWriteMode(NormalPut);
if MouseIn(445, 346, 610, 346+Nd*8) then
begin
j := (MouseY-346) div 8 + 2;
i := 2;
k := 2;
if j<>i then
Repeat
inc(i);
if DiskFree(i)<>-1 then inc(k);
Until k=j;
S:= Char(i+$40)+':\';
end;
Pth := S;
ChDir(S);
FindFirst(S[1]+':\*.*', VolumeID, FSrch);
HideMouse;
SetFillStyle(1, DarkGray);
Bar(445, 346, 610, 346+Nd*8);
ShowMouse;
Goto Scock;
end;
if MouseIn(70, 43, 610, 58) then {Строка ввода имени файла}
begin
ActWnd := 0;
FileName := Pth+FileName+ExtName;
FileName := EditS(75, 47, 610, 58, Yellow, DarkGray, 6, S);
FileName := FExpand(FileName);
FSplit(filename, DirName, NameName, extname);
{$I-}
ChDir(Pth);
{$I+}
if IOResult=0 then
begin
filename := NameName;
Pth := DirName;
S := FileName;
end;
Goto Scock;
end;
if MouseIn(330, 365, 400, 380) then
begin
While MouseButt<>0 do;
While MouseButt=1 do;
While MouseButt<>0 do;
if MouseTimer<2 then
Done := 1;
end;
if MouseIn(330, 390, 400, 405) then
begin
While MouseButt<>0 do;
While MouseButt=1 do;
While MouseButt<>0 do;
if MouseTimer<2 then
Done := -1;
end;
if MouseIn(30, 90, 310, 440) then {Выбор файлов}
begin
ActWnd := 1;
mX := MouseX - 31;
mY := MouseY - 91;
While MouseButt<>0 do;
mX := mX div 140;
mY := mY div 8 + 1 + FNbg;
if (mY+mX*FSSz-1<=FNend) then
begin
While (MouseButt=1) and (MouseTimer<1) do;
While MouseButt<>0 do;
HideMouse;
if CurVisibleA then
SetCurPos;
CurVisibleA := True;
if CurVisibleB=True then
begin
ActWnd := 2;
SetCurPos;
ActWnd := 1;
CurVisibleB := False;
end;
CurNF := mY+mX*FSSz-1;
SetCurPos;
ShowMouse;
if MouseTimer<2 then
begin
Reset(fFNm);
for i := 0 to mY+mX*FSSz-2 do
ReadLn(fFNm, tmpS);
Close(fFNm);
FileName := FExpand(tmpS);
FSplit(filename, DirName, NameName, extname);
filename := NameName;
Pth := DirName;
S := FileName;
Goto Scock;
end;
end;
end;
if MouseIn(330, 90, 610, 320) then {Выбор Папок}
begin
ActWnd := 2;
mX := MouseX - 331;
mY := MouseY - 91;
While MouseButt<>0 do;
mX := mX div 140;
mY := mY div 8 + 1 + DNbg;
if (mY+mX*DSSz-1<=DNend) then
begin
While (MouseButt=1) and (MouseTimer<1) do;
While MouseButt<>0 do;
HideMouse;
if CurVisibleB then
SetCurPos;
CurVisibleB := True;
if CurVisibleA=True then
begin
ActWnd := 1;
SetCurPos;
ActWnd := 2;
CurVisibleA := False;
end;
CurND := mY+mX*DSSz-1;
SetCurPos;
ShowMouse;
if MouseTimer<2 then
begin
Reset(fDir);
for i := 0 to mY+mX*DSSz-2 do
ReadLn(fDir, tmpS);
Close(fDir);
Pth := FExpand(tmpS+'\');
ChDir(Pth);
S := FileName;
Goto Scock;
end;
end;
end;
end;{if MouseButt=1}
if KeyPressed then
case ReadKey of
#0: begin
HideMouse;
SetCurPos;
ShowMouse;
if ActWnd=1 then
begin
CurVisibleB := True;
CurVisibleA := False;
end;
if ActWnd=2 then
begin
CurVisibleB := True;
CurVisibleA := False;
end;
case ReadKey of
#15:{Shift+Tab}
begin
if ActWnd = 0 then ActWnd := 4;
if ActWnd <> 1 then dec(ActWnd) else ActWnd := 4;
HideMouse;
SetCurPos;
ShowMouse;
case ActWnd of
1 :
begin
CurVisibleA := True;
CurVisibleB := False;
end;
2 :
begin
CurVisibleB := True;
CurVisibleA := False;
end;
else
begin
CurVisibleB := False;
CurVisibleA := False;
end;
end;
HideMouse;
SetCurPos;
ShowMouse;
end;
#72:{Up Arrow}
begin
if ActWnd=1 then
begin
if (CurNF>FNbg) then dec(CurNF);
end;
if ActWnd=2 then
begin
if (CurND>DNbg) then dec(CurND);
end;
end;
#75:{Left Arrow}
begin
if ActWnd=1 then
begin
end;
if ActWnd=2 then
begin
end;
end;
#77:{Right Arrow}
begin
if ActWnd=1 then
begin
if CurNF+FSSz4 then ActWnd := 1;
if ActWnd=0 then ActWnd := 1;
case ActWnd of
1 :
begin
CurVisibleA := True;
CurVisibleB := False;
end;
2 :
begin
CurVisibleB := True;
CurVisibleA := False;
end;
else
begin
CurVisibleB := False;
CurVisibleA := False;
end;
end;
HideMouse;
SetCurPos;
ShowMouse;
end;
#13: case ActWnd of
1 :
begin
Reset(fFNm);
for i := 0 to CurNF-1 do
ReadLn(fFNm, tmpS);
Close(fFNm);
FileName := FExpand(tmpS);
FSplit(filename, DirName, NameName, extname);
filename := NameName;
Pth := DirName;
S := FileName;
Goto Scock;
end;
2 :
begin
Reset(fDir);
for i := 0 to CurND-1 do
ReadLn(fDir, tmpS);
Close(fDir);
Pth := FExpand(tmpS+'\');
ChDir(Pth);
S := FileName;
Goto Scock;
end;
3 : Done := 1;
4 : Done := -1;
end;
#27: Done := -1;
end;{case}
Until Done<>0;
Erase(fDir);
Erase(fFNm);
if Done = 1 then
SelectFile := Pth+FileName+ExtName
else SelectFile := S1;
end;
Procedure DefaultConfig;
begin
end;
Procedure ConfigureSystem;
begin
end;
Procedure StoreConfig;
begin
end;
const
MIcnt = 2;
MenuItems : array[1..MIcnt] of String =
('Файл', ' Конфигурация');
var
LineSize : Word;
Procedure DrawMenu;
var
i : Word;
LCnt : Word;
begin
LineSize := ImageSize(0, 0, 639, 12);
LCnt := 2;
SetFillStyle(1, DarkGray);
SetColor(LightGray);
HideMouse;
Bar(0, 0, 639, 12);
BarL(0, 0, 639, 12);
for i := 1 to MIcnt do
begin
SetColor(Green);
OutTextXY(LCnt, 2, MenuItems[i]);
LCnt := LCnt + Length(MenuItems[i])*8;
SetColor(LightGray);
Line(LCnt, 0, LCnt, 12);
end;
ShowMouse;
end;
Procedure DoEditProcess;
begin
DrawMenu;
MouseForm := 0;
for i := 0 to Pages do GetMem(Ps[i], 65535);
GrMemSize := MaxAvail;
GetMem(PImg, GrMemSize);
Repeat
if MouseInF(0, 0, 639, 12) then
begin
if MouseForm<>3 then
begin
MouseForm := 3;
MouseMask := @MFing;
MouseGraphCursor(0, 0);
end;
end
else
if MouseForm<>0 then
begin
MouseForm := 0;
MouseMask := @Arrow;
MouseGraphCursor(0, 0);
end;
if KeyPressed then
case ReadKey of
#27: EP := True;
end;
if MouseButt<>0 then EP := True;
While MouseButt<>0 do;
Until EP;
FreeMem(PImg, GrMemSize);
for i := Pages downto 0 do FreeMem(Ps[i], 65535);
end;
begin
MemSize := MemAvail;
WriteLn('Всего свободно памяти: ', MemSize);
WriteLn('Размер максимально доступной части: ', MaxAvail);
Pages := MemSize div 65536 - 1;
WriteLn('Число страниц: ', Pages+1);
CurDir := FExpand('/');
P := @EGAVGA;
D := Detect;
FileMask := '*.*';
if RegisterBGIdriver(P) < 0 then
begin
Writeln('Ошибка регистрации драйвера: ',
GraphErrorMsg(GraphResult));
Halt(1);
end;
InitGraph(D, R, '');
e := GraphResult;
if e <> grOk then
begin
WriteLn('Произошла ошибка графики!!!');
WriteLn(GraphErrorMsg(e));
Halt;
end;
InitMouse;
MouseGotoXY(0, 0);
ShowMouse;
{ watchData arrowData UpArrowCursor LeftArrowCursor CheckMarkCursor PointingHandCursor
DiagonalcrossCursor RectangularCrossCursor HourglassCursor newWatchCursor }
for i := 0 to 15 do
begin
for j := 0 to 15 do
Arrow[i+15] := Arrow[i+15] or (GetPixel(j, i) and 1) shl (15-j);
Arrow[i] := not Arrow[i+15];
end;
SetInt1Ch;
FileName := '';
Pth := FSearch(ConfFile, '');
if Pth='' then DefaultConfig else ConfigureSystem;
DoEditProcess;
{ if FileName='' then
begin
FileMask := '*'+eLevel;
SF_WndName := 'Выберите файл для редактирования:';
FileName := SelectFile;
end;}
HideMouse;
StoreConfig;
ChDir(CurDir);
RestoreInt1Ch;
CloseGraph;
end.
Назад