(********************************)
(* Computer Project *)
(********************************)
(* Video Enquiry System *)
(********************************)
(* Chau Pok Man (5) *)
(* Cheung Chi Hang (6) *)
(* Cheung Hoi Kwan (7) *)
(********************************)
Program VideoEnquirySystem;
uses crt;
procedure MainMenu; forward;
procedure SearchMenu; forward;
procedure ModifyDB; forward;
procedure Login; forward;
const
Left = 1; (*window frame*)
Top = 6;(*window frame*)
Right = 23;(*window frame*)
Bottom = 21;(*window frame*)
QLeft = 25;(*question box frame*)
QTop = 8; (*question box frame*)
QRight = 54;(*question box frame*)
QBottom = 17;(*question box frame*)
var
MMTColor : array[1..7] of integer;
MMBGColor : array[1..7] of integer;
(*Data Base*)
NameList : array[1..300] of string[30];
ProducerList : array[1..300] of string[20];
SubjectList : array[1..300] of string[15];
CodeList : array[1..300] of string[50];
(*Password*)
Password : string[10];(*password is limited to ten characters*)
StrPW : string[10];
StrStar : string[10];
Str3 : string[10];
(*Data stored in USER.txt*)
UserData : text;
UserPW : string[10];
UserColor : integer;
UserCode : string[4];
(*User define part*)
Ucolor : integer;(*user defined main text color*)
(*cch*)
data : text;
search_name : string[30];
search_producer : string[20];
search_subject : string[15];
search_code : string[4];
(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
(*** Draw Window Frame ***)
procedure DrawWindow(Left, Right, Top, Bottom : integer);
var
i : integer;
begin
textcolor(8);
gotoxy(Left, Top);
write(#201);(*Left Top*)
for i := Left+1 to Right-1 do
write(#205);
write(#187);(*Right Top*)
gotoxy(Left, Bottom);
write(#200);(*Left Bottom*)
for i := Left+1 to Right-1 do
write(#205);
write(#188);(*Right Bottom*)
gotoxy(Left, Top+1);
for i := Top+1 to Bottom-1 do
begin
write(#186);
gotoxy(Left, i+1);
end;
gotoxy(Right, Top+1);
for i := Top+1 to Bottom-1 do
begin
write(#186);
gotoxy(Right, i+1);
end;
textcolor(15);
end;
(*** Draw Window Frame ***)
(*** Draw Question Box ***)
procedure DrawQB;
begin
DrawWindow(Left+19, Right+39, Top+3, Bottom-8);
end;
(*** Draw All Window Frames ***)
procedure DrawAll;
begin
clrscr;
DrawWindow(left, Right+57, Top-4, Bottom-16);
DrawWindow(left, Right, Top, Bottom);
DrawWindow(left+24, Right+57, Top, Bottom);
DrawWindow(left, Right+57, Top+16, Bottom+3);
end;
(*** Draw All Window Frames ***)
(*** Draw Three Window Frames ***)
procedure DrawThree;
begin
clrscr;
DrawWindow(left, Right+57, Top-4, Bottom-16);
DrawWindow(left, Right+57, Top, Bottom);
DrawWindow(left, Right+57, Top+16, Bottom+3);
end;
(*** Draw Three Window Frames ***)
(*** Draw Main Menu ***)
procedure DrawMM;
var
i : integer;
begin
DrawAll;
textcolor(12);
gotoxy(26,3);
write(#31,' 567 VIDEO ENQUIRY SYSTEM ',#31);
gotoxy(15,4);
textcolor(Ucolor);
write('Please select one option (Press the ',#24,'and',#25,' keys to move)');
gotoxy(3,Bottom+2);
write('Find specific clip');
textcolor(MMTColor[1]);
textbackground(MMBGColor[1]);
gotoxy(3,7);
write('1. Search Clips');
textcolor(MMTColor[2]);
textbackground(MMBGColor[2]);
gotoxy(3,9);
write('2. Modify Data Base');
textcolor(MMTColor[3]);
textbackground(MMBGColor[3]);
gotoxy(3,11);
write('3. View Entry');
textcolor(MMTColor[4]);
textbackground(MMBGColor[4]);
gotoxy(3,13);
write('4. Options');
textcolor(MMTColor[5]);
textbackground(MMBGColor[5]);
gotoxy(3,15);
write('5. Readme');
textcolor(MMTColor[6]);
textbackground(MMBGColor[6]);
gotoxy(3,17);
write('6. Back Up');
textcolor(MMTColor[7]);
textbackground(MMBGColor[7]);
gotoxy(3,19);
write('7. Exit');
for i := 1 to 7 do
begin
MMTColor[i] := 15;
MMBGColor[i] := 0;
end;
end;
(*** Draw Main Menu ***)
(*** Count Database Code ***)
procedure Countcode;
var
err, num : integer;
begin
val(UserCode, num, err);
num := num + 1;
str(num:4, UserCode);
assign(UserData, 'a:/USER.txt');
rewrite(UserData);
writeln(UserData, Password);
writeln(UserData, Ucolor);
writeln(UserData, UserCode);
close(UserData);
end;
(*** Count Database Code ***)
(*** Erase Line ***)
procedure Eraseln;
var
i : integer;
begin
gotoxy(3,Bottom+2);
for i := 1 to 76 do
write(chr(0));
end;
(*** Erase Line ***)
(*** Back to Menu ***)
procedure BtoMenu;
var
ch : char;
Bool : boolean;
begin
Bool := true;
while Bool = true do
begin
ch := readkey;
if (ch = 'Q') or (ch = 'q')
then Bool := false
end;
MainMenu;
end;
(*** Back to Menu ***)
(*** View Entry ***)
procedure ViewEntry;
var
field : string;
view_Field : string[50];
data : text;
a, remainder, No_page, i, j : integer;
Bool : boolean;
ch : char;
begin
DrawThree;
Bool := true;
assign(data, 'A:\database.txt');
reset(data);
a := 0;
j := 0;
while not eof(data) do
begin
readln(data, FIELD);
a := a + 1;
end;
reset(data);
No_Page := a div 10;
remainder := a mod 10;
IF REMAINDER <> 0
then No_page := No_page+1;
while (Bool = true) and (j <> No_page) do
begin
for j:= 1 to No_page do
begin
DrawThree;
textcolor(12);
gotoxy(30,3);
write(#31,' VIEW ENTRY ',#31);
textcolor(7);
gotoxy(1,4);
writeln(' Name Of the Video Producer ');
textcolor(15);
For i := 1 to 10 do
begin
readln(data, view_field);
if i mod 2 = 0
then textcolor(Ucolor)
else textcolor(15);
if i <10
then begin
gotoxy(3,6+i);
write( i, ' . ')
end
else begin
gotoxy(3,6+i);
write(i , '. ');
end;
gotoxy(6,6+i);
writeln(view_Field);
end;
Eraseln;
textcolor(12);
gotoxy(3,Bottom+2);
writeln('Press any keys for next page, Q or q to exit');
textcolor(15);
ch := readkey;
if (ch = 'Q') or (ch = 'q')
then MainMenu;
end;
end;
MainMenu
end;
(*** View Entry ***)
(*** [Option] Move bar ***)
procedure MovecursorOp(index : integer; ch : char);
begin
if ch = #72
then begin
case index of (*bar up*)
2 : begin
gotoxy(27,9);
write('2. Purple');
gotoxy(27,7);
textbackground(3);
textcolor(10);
write('1. Blue')
end;
3 : begin
gotoxy(27,11);
write('3. Yellow');
gotoxy(27,9);
textbackground(3);
textcolor(10);
write('2. Purple')
end;
end;
end
else begin
case index of (*bar down*)
1 : begin
gotoxy(27,7);
write('1. Blue');
gotoxy(27,9);
textbackground(3);
textcolor(10);
write('2. Purple')
end;
2 : begin
gotoxy(27,9);
write('2. Purple');
gotoxy(27,11);
textbackground(3);
textcolor(10);
write('3. Yellow')
end;
end;
end;
textbackground(0);
textcolor(Ucolor);
end;
(*** [Option] Move bar ***)
(*** [Option] Selection ***)
procedure SelectionOp;
var
ch, Key1, Key2 : char;
Current : integer;
Bool : boolean;
begin
MMTColor[4] := 10;
MMBGColor[4] := 3;
DrawMM;
Current := 1;
textcolor(10);
textbackground(3);
gotoxy(27,7);
write('1. Blue');
textbackground(0);
textcolor(Ucolor);
gotoxy(27,9);
write('2. Purple');
gotoxy(27,11);
write('3. Yellow');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Please choose the color you like.');
textcolor(Ucolor);
Bool := true;
while Bool do
begin
Key1 := readkey;
if Key1 = #0
then begin
Key2 := readkey;
case Key2 of
#72 : if Current <> 1
then begin
MovecursorOp(Current, Key2);
Current := Current - 1
end;
#80 : if Current <> 3
then begin
MovecursorOp(Current, Key2);
Current := Current + 1
end;
end;
end
else if Key1 = #13
then begin
case Current of
1 : Ucolor := 9;
2 : Ucolor := 13;
3 : Ucolor := 14;
end;
assign(UserData, 'a:/USER.txt');
rewrite(UserData);
writeln(UserData, UserPW);
writeln(UserData, Ucolor);
writeln(UserData, UserCode);
close(UserData);
MainMenu;
end;
end;
end;
(*** [Option] Selection ***)
(*** Back Up Menu ***)
procedure BackupMenu;
var
backuplist : array[1..300] of string [69];
Backup, data : text;
ch : char;
counter, i : integer;
Bool : boolean;
begin
MMTColor[6] := 10;
MMBGColor[6] := 3;
DrawMM;
Bool := true;
assign(data, 'a:\database.txt');
reset(data);
counter := 1;
while not eof(data) do
begin
readln(data, backuplist[counter]);
counter := Counter + 1;
end;
close (data);
textcolor(12);
gotoxy(27,7);
writeln('Please note that the backup file named "BACKUP" will');
gotoxy(27,8);
writeln('be generated in A:/ drive');
EraseLn;
gotoxy(3, Bottom+2);
textcolor(12);
writeln('Press G or g to start back up, other keys to return');
while Bool = true do
begin
ch := readkey;
if (ch = 'G') or (ch = 'g')
then begin
textcolor(12);
gotoxy(27,Bottom-1);
write('Copying');
assign(Backup, 'a:\backup.txt');
rewrite(Backup);
for i:= 1 to Counter do
writeln(Backup, BackupList[i]);
close(Backup);
for i:= 1 to 20 do
begin
Delay(10);
write('.');
end;
Delay(50);
textcolor(Ucolor);
gotoxy(27,Bottom-1);
writeln('Finished Backup ');
EraseLn;
textcolor(Ucolor);
gotoxy(3, Bottom+2);
writeln('Press Q or q to return');
BtoMenu;
end
else MainMenu;
end;
end;
(*** Back Up Menu ***)
(*** Readme ***)
procedure ReadMe;
begin
DrawMM;
textcolor(Ucolor);
gotoxy(27,7);
write(#16,' Welcome to [567 Video Enquiry System].');
gotoxy(27,9);
write(#16,' This is the most epic invention in DBS. It enables');
gotoxy(27,11);
write(' us to search the clips we wanted meticulously.');
gotoxy(27,13);
write(#16,' You can search for any clips you wanted, change ');
gotoxy(27,15);
write(' the colour to personalize the screen colour. ');
gotoxy(27,17);
write(#16,' This program, which is repleted with modern');
gotoxy(27,19);
write(' convenience, is specially designed for the needs. ');
gotoxy(3,Bottom+2);
textcolor(Ucolor);
writeln('Press Q or q to return');
textcolor(15);
BtoMenu;
end;
(*** Readme ***)
(*** End Programe ***)
procedure EndP;
var
ch : char;
Bool : boolean;
begin
Eraseln;
textcolor(12);
gotoxy(21,Bottom+2);
write(#16);
textcolor(Ucolor);
gotoxy(22, Bottom+2);
write('Are you sure you want to quit? ( / )');
textcolor(4 + 128);
gotoxy(54, Bottom+2);
write('Y');
gotoxy(56, Bottom+2);
write('N');
gotoxy(58, Bottom+2);
textcolor(12);
write(#17);
textcolor(15);
Bool := true;
while Bool = true do
begin
ch := readkey;
if (ch = 'Y') or (ch = 'y')
then begin
clrscr;
textcolor(Ucolor);
gotoxy(16,13);
writeln('Thank you for using [567 Video Enquiry System]');
delay(250);
halt;
end
else if (ch = 'N') or (ch = 'n')
then MainMenu;
end;
end;
(*** End Programe ***)
(*** [Search] by name ***)
Procedure SearchByName;
var
name: String[30];
field : string;
Line : integer;
tlength, i, j, No : integer;
ch1 : char;
Bool : boolean;
begin
repeat
DrawAll;
search_name := '';
textcolor(12);
gotoxy(35,3);
write('Search Menu');
textcolor(10);
textbackground(3);
gotoxy(3,7);
write('1. By Clip Name');
textbackground(0);
textcolor(15);
gotoxy(3,9);
write('2. By Producer');
gotoxy(3,11);
write('3. By Subject');
gotoxy(3,13);
write('4. By Code Number');
gotoxy(27,7);
writeln('Enter the name for searching:');
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Please use CAPITAL leters(press the CAPS LOCK) Press ESC key to exit');
textcolor(15);
repeat
gotoxy(27,9);
ch1 := readkey;
if ch1 = #0
then ch1 := readkey
else begin
if (ord(ch1) >= 32) and (ord(ch1) <= 126) and (length(search_name) < 30)
then begin
search_name := search_name + ch1;
gotoxy(27,9);
write(search_name);
end
else begin
if ch1 = #27
then SearchMenu;
if ch1 = #8
then begin
delete(search_name, length(search_name), 1);
for i := 1 to 30 do
begin
gotoxy(26+i,9);
write(chr(0));
end;
gotoxy(27,9);
write(search_name);
end;
end;
end;
until ch1 = #13;
until (search_name <> '');
tlength := length(search_name);
assign(data, 'a:\database.txt');
reset(data);
j := 0;
No := 0;
Line := 1;
DrawThree;
gotoxy(3,4);
writeln(' Name Of the Video Producer Subject Code No');
while not eof(data) do
begin
readln(data, field);
name := field;
i := 1; ;
while (i < (30 - tlength)) and ((30-tlength)<30) and (copy(name,i, tlength) <> search_name) do
i := i+1 ;
if copy(name, i, tlength) = search_name
then begin
No:= No+1;
gotoxy(2,Line + 6);
write(no,'. ', field);
j := j+1;
Line := Line + 1;
end;
if Line mod 11 = 0
then begin
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Press any keys for next page, Q or q to exit');
textcolor(15);
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then MainMenu;
Line := 1;
end;
end;
if j = 0
then begin
textcolor(12 + 128);
gotoxy(3,Line + 7);
writeln('Not Found.');
Line := Line + 1;
end;
for no := Line to 11 do
begin
gotoxy(2,no + 6);
for i := 1 to 78 do
write(chr(0));
end;
textcolor(12);
gotoxy(3,Bottom - 1);
writeln('There are totally ',j,' record(s) of ','"',search_name,'" .' );
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then Bool := false
end;
SearchMenu;
close(data)
end;
(*** [Search] by name ***)
(*** [Search] by producer ***)
Procedure SearchByProducer;
var
producer: string [20];
field : string;
tlength, i, j, No : integer;
Line : integer;
ch1 : char;
Bool : boolean;
begin
repeat
DrawAll;
search_producer := '';
textcolor(12);
gotoxy(35,3);
write('Search Menu');
textcolor(15);
gotoxy(3,7);
write('1. By Clip Name');
gotoxy(3,9);
textcolor(10);
textbackground(3);
write('2. By Producer');
textbackground(0);
textcolor(15);
gotoxy(3,11);
write('3. By Subject');
gotoxy(3,13);
write('4. By Code Number');
gotoxy(27,7);
writeln('Enter the name of producer for searching:');
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Please use CAPITAL leters(press the CAPS LOCK) Press ESC key to exit');
textcolor(15);
repeat
gotoxy(27,9);
ch1 := readkey;
if ch1 = #0
then ch1 := readkey
else begin
if (ord(ch1) >= 32) and (ord(ch1) <= 126) and (length(search_producer) < 20)
then begin
search_producer := search_producer + ch1;
gotoxy(27,9);
write(search_producer);
end
else begin
if ch1 = #27
then SearchMenu;
if ch1 = #8
then begin
delete(search_producer, length(search_producer), 1);
for i := 1 to 30 do
begin
gotoxy(26+i,9);
write(chr(0));
end;
gotoxy(27,9);
write(search_producer);
end;
end;
end;
until ch1 = #13;
until (search_producer <> '');
tlength := length(search_producer);
assign(data, 'a:\database.txt');
reset(data);
j := 0;
No := 0;
Line := 1;
DrawThree;
gotoxy(3,4);
writeln(' Name Of the Video Producer Subject Code No');
while not eof(data) do
begin
readln(data, field);
producer := copy(field, 31, 20);
i := 1;
while (i < (20 - tlength)) and ((20-tlength)<20) and (copy(producer,i, tlength) <> search_producer) do
i := i+1 ;
if copy(producer, i, tlength) = search_producer
then begin
No:= No+1;
gotoxy(2,Line + 6);
writeln(no,'. ', field);
j := j+1;
Line := Line + 1;
end;
if Line mod 11 = 0
then begin
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Press any keys for next page, Q or q to exit');
textcolor(15);
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then MainMenu;
Line := 1;
end;
end;
if j = 0
then begin
textcolor(12 + 128);
gotoxy(3,Line + 7);
writeln('Not Found.');
Line := Line + 1;
end;
for no := Line to 11 do
begin
gotoxy(2,no + 6);
for i := 1 to 78 do
write(chr(0));
end;
textcolor(12);
gotoxy(3,Bottom - 1);
writeln('There are totally ',j,' record(s) of ','"',search_producer,'" .' );
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then Bool := false
end;
SearchMenu;
close(data)
end;
(*** [Search] by producer ***)
(*** [Search] by subject ***)
Procedure SearchBySubject;
var
subject : string [15];
field : string;
tlength, i, j, No : integer;
Line : integer;
ch1 : char;
Bool : boolean;
begin
repeat
DrawAll;
search_subject := '';
textcolor(12);
gotoxy(35,3);
write('Search Menu');
textcolor(15);
gotoxy(3,7);
write('1. By Clip Name');
gotoxy(3,9);
write('2. By Producer');
gotoxy(3,11);
textcolor(10);
textbackground(3);
write('3. By Subject');
textbackground(0);
textcolor(15);
gotoxy(3,13);
write('4. By Code Number');
gotoxy(27,7);
writeln('Enter a Subject for searching:');
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Please use CAPITAL letters(press the CAPS LOCK) Press ESC key to exit');
textcolor(15);
repeat
gotoxy(27,9);
ch1 := readkey;
if ch1 = #0
then ch1 := readkey
else begin
if (ord(ch1) >= 32) and (ord(ch1) <= 126) and (length(search_subject) < 15)
then begin
search_subject := search_subject + ch1;
gotoxy(27,9);
write(search_subject);
end
else begin
if ch1 = #27
then SearchMenu;
if ch1 = #8
then begin
delete(search_subject, length(search_subject), 1);
for i := 1 to 30 do
begin
gotoxy(26+i,9);
write(chr(0));
end;
gotoxy(27,9);
write(search_subject);
end;
end;
end;
until ch1 = #13;
until (search_subject <> '');
tlength := length(search_subject);
assign(data, 'a:\database.txt');
reset(data);
j := 0;
No := 0;
Line := 1;
DrawThree;
gotoxy(3,4);
writeln(' Name Of the Video Producer Subject Code No');
while not eof(data) do
begin
readln(data, field);
subject := copy(field, 51, 15);
i := 1;
while (i < (15 - tlength)) and ((15-tlength)<15) and (copy(subject,i, tlength) <> search_subject) do
i := i+1 ;
if copy(subject, i, tlength) = search_subject
then begin
No:= No+1;
gotoxy(2,Line + 6);
write(no,'. ', field);
j := j+1;
Line := Line + 1;
end;
if Line mod 11 = 0
then begin
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Press any keys for next page, Q or q to exit');
textcolor(15);
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then MainMenu;
Line := 1;
end;
end;
if j = 0
then begin
textcolor(12 + 128);
gotoxy(3,Line + 7);
writeln('Not Found.');
Line := Line + 1;
end;
for no := Line to 11 do
begin
gotoxy(2,no + 6);
for i := 1 to 78 do
write(chr(0));
end;
textcolor(12);
gotoxy(3,Bottom - 1);
writeln('There are totally ',j,' record(s) of ','"',search_subject,'" .' );
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then Bool := false
end;
SearchMenu;
close(data)
end;
(*** [Search] by subject ***)
(*** [Search] by Code Number ***)
procedure SearchByCodeNo;
var
field : string;
tlength, i, j, No : integer;
Line : integer;
ch1 : char;
Bool : boolean;
code : string[4];
begin
repeat
DrawAll;
search_code := '';
textcolor(12);
gotoxy(35,3);
write('Search Menu');
textcolor(15);
gotoxy(3,7);
write('1. By Clip Name');
gotoxy(3,9);
write('2. By Producer');
gotoxy(3,11);
write('3. By Subject');
textcolor(10);
textbackground(3);
gotoxy(3,13);
write('4. By Code Number');
textbackground(0);
textcolor(15);
gotoxy(27,7);
writeln('Enter the code for searching:');
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Please use CAPITAL leters(press the CAPS LOCK) Press ESC key to exit');
textcolor(15);
repeat
gotoxy(27,9);
ch1 := readkey;
if (ord(ch1) >= 48) and (ord(ch1) <= 57) and (length(search_code) < 4)
then begin
search_code := search_code + ch1;
gotoxy(27,9);
write(search_code);
end
else begin
if ch1 = #27
then SearchMenu;
if ch1 = #8
then begin
delete(search_code, length(search_code), 1);
for i := 1 to 30 do
begin
gotoxy(26+i,9);
write(chr(0));
end;
gotoxy(27,9);
write(search_code);
end;
end;
until ch1 = #13;
until (search_code <> '');
tlength := length(search_code);
assign(data, 'a:\database.txt');
reset(data);
j := 0;
No := 0;
Line := 1;
DrawThree;
gotoxy(3,4);
writeln(' Name Of the Video Producer Subject Code No');
while not eof(data) do
begin
readln(data, field);
code := copy(field, 66, 4);
i := 1; ;
while (i < (4 - tlength)) and ((4-tlength)<4) and (copy(code,i, tlength) <> search_code) do
i := i+1 ;
if copy(code, i, tlength) = search_code
then begin
No:= No+1;
gotoxy(2,Line + 6);
write(no,'. ', field);
j := j+1;
Line := Line + 1;
end;
if Line mod 11 = 0
then begin
Eraseln;
textcolor(Ucolor);
gotoxy(3,Bottom+2);
writeln('Press any keys for next page, Q or q to exit');
textcolor(15);
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then MainMenu;
Line := 1;
end;
end;
if j = 0
then begin
textcolor(12 + 128);
gotoxy(3,Line + 7);
writeln('Not Found.');
Line := Line + 1;
end;
for no := Line to 11 do
begin
gotoxy(2,no + 6);
for i := 1 to 78 do
write(chr(0));
end;
textcolor(12);
gotoxy(3,Bottom - 1);
writeln('There are totally ',j,' record(s) of ','"',search_code,'" .' );
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch1 := readkey;
if (ch1 = 'Q') or (ch1 = 'q')
then Bool := false
end;
SearchMenu;
close(data)
end;
(*** [Search] by Code Number ***)
(*** [Search] Move bar ***)
procedure SearchMovecursor(index : integer; ch : char);
begin
if ch = #72
then begin
case index of (*bar up*)
2 : begin
gotoxy(3,9);
write('2. By Producer');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Begin search with a known clip NAME');
gotoxy(3,7);
textbackground(3);
textcolor(10);
write('1. By Clip Name')
end;
3 : begin
gotoxy(3,11);
write('3. By Subject');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Begin search with a known clip PRODUCER');
gotoxy(3,9);
textbackground(3);
textcolor(10);
write('2. By Producer')
end;
4 : begin
gotoxy(3,13);
write('4. By Code Number');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Begin search with a known clip SUBJECT');
gotoxy(3,11);
textbackground(3);
textcolor(10);
write('3. By Subject')
end;
5 : begin
gotoxy(3,15);
write('5. Main Menu');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Enter the code number of the clip to find the exact clip');
gotoxy(3,13);
textbackground(3);
textcolor(10);
write('4. By Code Number')
end;
end;
end
else begin
case index of (*bar down*)
1 : begin
gotoxy(3,7);
write('1. By Clip Name');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Begin search with a known clip PRODUCER');
gotoxy(3,9);
textbackground(3);
textcolor(10);
write('2. By Producer');
end;
2 : begin
gotoxy(3,9);
write('2. By Producer');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Begin search with a known clip SUBJECT');
gotoxy(3,11);
textbackground(3);
textcolor(10);
write('3. By Subject')
end;
3 : begin
gotoxy(3,11);
write('3. By Subject');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Enter the code number of the clip to find the exact clip');
gotoxy(3,13);
textbackground(3);
textcolor(10);
write('4. By Code Number')
end;
4 : begin
gotoxy(3,13);
write('4. By Code Number');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Go back to main menu');
gotoxy(3,15);
textbackground(3);
textcolor(10);
write('5. Main Menu')
end;
5 : begin
gotoxy(3,15);
write('');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('');
gotoxy(3,17);
textbackground(3);
textcolor(10);
write('')
end;
end;
end;
textbackground(0);
textcolor(15);
end;
(*** [Search] Move bar ***)
(*** [Search] Selection ***)
procedure SearchMenu;
var
ch, Key1, Key2 : char;
Current : integer;
Bool : boolean;
begin
MMTColor[2] := 10;
MMBGColor[2] := 3;
DrawAll;
Current := 1;
textcolor(12);
gotoxy(35,3);
write('Search Menu');
textcolor(Ucolor);
gotoxy(25,4);
write('Please select one option below');
textcolor(10);
textbackground(3);
gotoxy(3,7);
write('1. By Clip Name');
textbackground(0);
textcolor(15);
gotoxy(3,9);
write('2. By Producer');
gotoxy(3,11);
write('3. By Subject');
gotoxy(3,13);
write('4. By Code Number');
gotoxy(3,15);
write('5. Main Menu');
gotoxy(3,Bottom+2);
textcolor(Ucolor);
writeln('Begin search with a known clip NAME');
textcolor(15);
Bool := true;
while Bool do
begin
Key1 := readkey;
if Key1 = #0
then begin
Key2 := readkey;
case Key2 of
#72 : if Current <> 1
then begin
SearchMovecursor(Current, Key2);
Current := Current - 1
end;
#80 : if Current <> 5
then begin
SearchMovecursor(Current, Key2);
Current := Current + 1
end;
end;
end
else if Key1 = #13
then begin
case Current of
1 : SearchByName;
2 : SearchByProducer;
3 : SearchBySubject;
4 : SearchByCodeNo;
5 : MainMenu;
end;
end;
end;
end;
(*** [Search] Selection ***)
(*** [Edit clips] Amend Clips ***)
procedure AmendClips;
var
Newname, Name : string[30];
Newpro, pro : string[20];
Newsub, sub : string[15];
code : string[4];
target : string[30];
data : text;
counter, i : integer;
Position, Found, Bool : boolean;
ch : char;
begin
DrawThree;
textcolor(12);
gotoxy(23,3);
write(#31,' MODIFY DATABASE (AMEND CLIPS) ',#31);
textcolor(15);
found := False;
counter := 0;
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Please use CAPITAL leters (press the CAPS LOCK)');
textcolor(15);
gotoxy(3, 7);
write('Enter the video name to be modified: ');
readln(target);
Target := Target + ' ';
assign(data, 'a:\Database.txt');
reset(data);
while (not eof(data)) and not Found do
begin
counter := Counter + 1;
readln(data, Namelist[Counter], ProducerList[counter], SubjectList[counter], CodeList[Counter]);
if namelist[Counter] = target
then begin
counter := Counter - 1;
Found := True
end
end;
while not eof(data) do
begin
counter := Counter +1;
readln(data, Namelist[Counter], ProducerList[counter], SubjectList[counter], CodeList[Counter]);
end;
close(data);
if not Found
then begin
DrawThree;
textcolor(12 +128);
gotoxy(3,7);
writeln('The name is not Found!');
textcolor(12);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch := readkey;
if (ch = 'Q') or (ch = 'q')
then Bool := false
end;
ModifyDB;
end;
rewrite(data);
for i := 1 to Counter do
writeln(data, Namelist[I], ProducerList[I], SubjectList[I], CodeList[I]);
close(data);
if found
then begin
position := False;
counter := 0 ;
DrawThree;
textcolor(12);
gotoxy(28,3);
write(#31,' AMEND CLIPS ',#31);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Please use CAPITAL leters (press the CAPS LOCK)');
textcolor(15);
gotoxy(3, 7);
Write('Enter the ');
textcolor(11);
write('NEW ');
textcolor(15);
write('video name : ');
readln(Newname);
Newname := Newname + ' ';
gotoxy(3, 9);
textcolor(15);
Write('Enter the ');
textcolor(11);
write('NEW ');
textcolor(15);
write('producer : ');
readln(newpro);
Newpro := Newpro + ' ';
gotoxy(3, 11);
textcolor(15);
Write('Enter the ');
textcolor(11);
write('NEW ');
textcolor(15);
write('subject : ');
readln(newsub);
Newsub := Newsub + ' ';
gotoxy(3, 18);
write('Are you sure you add this file ?');
gotoxy(3, 19);
write('Press ENTER if you are sure');
gotoxy(3, 20);
write('Press other keys to go back to main menu');
Bool := true;
while Bool = true do
begin
ch := readkey;
if ch = #13
then begin
CountCode;
assign(data, 'a:\DATABASE.txt');
reset(data);
While (not eof(data)) and (not position) do
begin
readln(data, Name, pro, sub, code);
IF Newname < Name
then Position := True
else begin
Counter := Counter + 1;
NameList[Counter] := Name;
producerList[Counter] := Pro;
subjectlist[counter] := sub;
CodeList[Counter] := code;
end
end;
counter := Counter + 1;
NameList[Counter] := NewName;
ProducerList[Counter] := NewPro;
subjectlist[counter] := NEWsub;
CodeList[Counter] := UserCode;
if NewName < Name
then begin
counter := Counter +1;
NameList[Counter] := Name;
ProducerList[Counter] := Pro;
subjectlist[counter] := sub;
CodeList[Counter] := code;
end;
while not eof(data) do
begin
Counter := Counter +1 ;
readln(data, NameList[Counter], ProducerList[Counter], Subjectlist[Counter], CodeList[Counter])
end;
close(data);
rewrite(data);
for i := 1 to counter do
writeln(data, NameList[i],ProducerList[i], Subjectlist[i], CodeList[i]);
close(data);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Clip amended. Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch := readkey;
if (ch = 'Q') or (ch = 'q')
then Bool := false
end;
ModifyDB;
end
else ModifyDB;
end;
end;
end;
(*** [Edit clips] Amend Clips ***)
(*** [Edit clips] Add Clips ***)
procedure AddClips;
var
Newname, Name : string[30];
Newpro, pro : string[20];
Newsub, sub : string[15];
code : string[4];
data : text;
counter, i : integer;
position : boolean;
ch : char;
Bool : boolean;
begin
DrawThree;
textcolor(12);
gotoxy(24,3);
write(#31,' MODIFY DATABASE (ADD CLIPS) ',#31);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Please use CAPITAL leters (press the CAPS LOCK)');
textcolor(15);
position := False;
counter := 0 ;
gotoxy(3, 7);
Write('Enter the ');
textcolor(11);
write('NEW ');
textcolor(15);
write('video name to insert: ');
readln(Newname);
Newname := Newname + ' ';
gotoxy(3, 9);
textcolor(15);
Write('Enter the ');
textcolor(11);
write('NEW ');
textcolor(15);
write('producer : ');
readln(newpro);
Newpro := Newpro + ' ';
gotoxy(3, 11);
textcolor(15);
Write('Enter the ');
textcolor(11);
write('NEW ');
textcolor(15);
write('subject : ');
readln(newsub);
Newsub := Newsub + ' ';
gotoxy(3, 18);
write('Are you sure you want to add this file ?');
gotoxy(3, 19);
write('Press ENTER if you are sure');
gotoxy(3, 20);
write('Press other keys to go back to main menu');
Bool := true;
while Bool = true do
begin
ch := readkey;
if ch = #13
then begin
CountCode;
assign(data, 'a:\DATABASE.txt');
reset(data);
While (not eof(data)) and (not position) do
begin
readln(data, Name, pro, sub, code);
IF Newname < Name
then Position := True
else begin
Counter := Counter + 1;
NameList[Counter] := Name;
ProducerList[Counter] := Pro;
SubjectList[counter] := sub;
CodeList[Counter] := code;
end
end;
counter := Counter + 1;
NameList[Counter] := NewName;
ProducerList[Counter] := NewPro;
SubjectList[counter] := NEWsub;
CodeList[Counter] := UserCode;
if NewName < Name
then begin
counter := Counter +1;
NameList[Counter] := Name;
ProducerList[Counter] := Pro;
SubjectList[counter] := sub;
CodeList[Counter] := code;
end;
while not eof(data) do
begin
Counter := Counter +1 ;
readln(data, NameList[Counter], ProducerList[Counter], SubjectList[Counter], CodeList[Counter])
end;
close(data);
rewrite(data);
for i := 1 to counter do
writeln(data, NameList[i],ProducerList[i], SubjectList[i], CodeList[i]);
close(data);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Clip added. Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch := readkey;
if (ch = 'Q') or (ch = 'q')
then Bool := false
end;
ModifyDB;
end
else ModifyDB;
end;
end;
(*** [Edit clips] Add Clips ***)
(*** [Edit clips] Delete Clips ***)
procedure DeleteClips;
var
target : string[30];
data : text;
counter, i : integer;
Found : boolean;
ch : char;
Bool : boolean;
begin
DrawThree;
textcolor(12);
gotoxy(23,3);
write(#31,' MODIFY DATABASE (DELETE CLIPS) ',#31);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Please use CAPITAL leters (press the CAPS LOCK)');
textcolor(15);
found := False;
counter := 0;
gotoxy(3, 7);
write('Enter a name to delete: ');
readln(target);
gotoxy(3, 18);
write('Are you sure you want to remove the file permanently?');
gotoxy(3, 19);
write('Press ENTER if you are sure');
gotoxy(3, 20);
write('Press other keys to go back to main menu');
Bool := true;
while Bool = true do
begin
ch := readkey;
if ch = #13
then begin
Target := Target + ' ';
assign(data, 'a:\Database.txt');
reset(data);
while (not eof(data)) and not Found do
begin
counter := Counter + 1;
readln(data, NameList[Counter], ProducerList[counter], SubjectList[counter]);
if NameList[Counter] = target
then begin
counter := Counter - 1;
Found := True
end
end;
If Found
then begin
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
writeln('Data is deleted.');
textcolor(15);
end;
while not eof(data) do
begin
counter := Counter +1;
readln(data, NameList[Counter], ProducerList[counter], SubjectList[counter]);
end;
close(data);
if not Found
then begin
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
writeln('The name is not Found!');
textcolor(15);
end;
rewrite(data);
for i := 1 to Counter do
writeln(data, NameList[I], ProducerList[I], SubjectList[I]);
close(data);
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Press Q or q to return');
textcolor(15);
Bool := true;
while Bool = true do
begin
ch := readkey;
if (ch = 'Q') or (ch = 'q')
then Bool := false
end;
ModifyDB;
end
else ModifyDB;
end;
end;
(*** [Edit clips] Delete Clips ***)
(*** [Edit clips] Change Password ***)
procedure ChangePW;
var
str : string[10];
str1, str2 : string[10];
Bool : boolean;
ch3 : char;
begin
Bool := true;
clrscr;
DrawQB;
textcolor(Ucolor);
gotoxy(22,10);
writeln('Enter old password :');
while Bool = true do
begin
clrscr;
DrawQB;
textcolor(Ucolor);
textcolor(Ucolor);
gotoxy(22,10);
write('Enter');
textcolor(11);
write(' OLD ');
textcolor(Ucolor);
write('password :');
strStar := '';
Login;
str := strStar;
if str = Password
then while Bool = true do
begin
clrscr;
DrawQB;
textcolor(Ucolor);
gotoxy(22,10);
write('Enter');
textcolor(11);
write(' NEW ');
textcolor(Ucolor);
write('password :');
gotoxy(22,12);
strStar := '';
Login;
str1 := strStar;
clrscr;
DrawQB;
gotoxy(22,10);
textcolor(Ucolor);
gotoxy(22,10);
write('RE-ENTER');
textcolor(11);
write(' NEW');
textcolor(Ucolor);
write(' password :');
gotoxy(22,12);
strStar := '';
Login;
str2 := strStar;
if str1 = str2
then begin
Password := str1;
assign(UserData, 'a:/USER.txt');
rewrite(UserData);
writeln(UserData, Str1);
writeln(UserData, Ucolor);
writeln(UserData, UserCode);
close(UserData);
ModifyDB;
end;
clrscr;
DrawQB;
textcolor(4 + 128);
gotoxy(22,10);
writeln('Inconsistent password.');
textcolor(Ucolor);
gotoxy(22,12);
writeln('Please enter again.');
delay(200);
end
else begin
clrscr;
DrawQB;
textcolor(Ucolor);
gotoxy(21,10);
writeln(' Incorrect password');
gotoxy(21,11);
writeln(' Press "Q" or "q" to quit');
gotoxy(21,12);
writeln(' Or press other keys to re-enter');
ch3 := readkey;
if (ch3 = 'Q') or (ch3 = 'q')
then MainMenu
end;
end;
end;
(*** [Edit clips] Change Password ***)
(*** [Edit clips] Move bar ***)
procedure Movecursor2(index : integer; ch : char);
begin
if ch = #72
then begin
case index of (*bar up*)
2 : begin
gotoxy(3,9);
write('2. Add Clips');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Amend information in clip');
gotoxy(3,7);
textbackground(3);
textcolor(10);
write('1. Amend Clips')
end;
3 : begin
gotoxy(3,11);
write('3. Delete Clips');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Add new clips to database');
gotoxy(3,9);
textbackground(3);
textcolor(10);
write('2. Add Clips')
end;
4 : begin
gotoxy(3,13);
write('4. Change Password');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Delete clips from database');
gotoxy(3,11);
textbackground(3);
textcolor(10);
write('3. Delete Clips')
end;
5 : begin
gotoxy(3,15);
write('5. Main Menu');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Change user password');
gotoxy(3,13);
textbackground(3);
textcolor(10);
write('4. Change Password')
end;
6 : begin
gotoxy(3,17);
write('');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('');
gotoxy(3,15);
textbackground(3);
textcolor(10);
write('')
end;
7 : begin
gotoxy(3,19);
write('');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('');
gotoxy(3,17);
textbackground(3);
textcolor(10);
write('')
end;
end;
end
else begin
case index of (*bar down*)
1 : begin
gotoxy(3,7);
write('1. Amend Clips');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Add new clips to database');
gotoxy(3,9);
textbackground(3);
textcolor(10);
write('2. Add Clips');
end;
2 : begin
gotoxy(3,9);
write('2. Add Clips');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Delete clips from database');
gotoxy(3,11);
textbackground(3);
textcolor(10);
write('3. Delete Clips')
end;
3 : begin
gotoxy(3,11);
write('3. Delete Clips');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Change user password');
gotoxy(3,13);
textbackground(3);
textcolor(10);
write('4. Change Password')
end;
4 : begin
gotoxy(3,13);
write('4. Change Password');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Go back to main menu');
gotoxy(3,15);
textbackground(3);
textcolor(10);
write('5. Main Menu')
end;
5 : begin
gotoxy(3,15);
write('');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('');
gotoxy(3,17);
textbackground(3);
textcolor(10);
write('')
end;
6 : begin
gotoxy(3,17);
write('');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('');
gotoxy(3,19);
textbackground(3);
textcolor(10);
write('')
end;
end;
end;
textbackground(0);
textcolor(15);
end;
(*** [Edit clips] Move bar ***)
(*** [Edit clips] Selection ***)
procedure ModifyDB;
var
ch, Key1, Key2 : char;
Current : integer;
Bool : boolean;
begin
MMTColor[2] := 10;
MMBGColor[2] := 3;
DrawAll;
Current := 1;
textcolor(12);
gotoxy(32,3);
write(#31,' MODIFY MENU ',#31);
textcolor(Ucolor);
gotoxy(25,4);
write('Please select one option below');
textcolor(10);
textbackground(3);
gotoxy(3,7);
write('1. Amend Clips');
textbackground(0);
textcolor(15);
gotoxy(3,9);
write('2. Add Clips');
gotoxy(3,11);
write('3. Delete Clips');
gotoxy(3,13);
write('4. Change Password');
gotoxy(3,15);
write('5. Main Menu');
gotoxy(3,Bottom+2);
textcolor(Ucolor);
writeln('Amend information in clip');
textcolor(15);
Bool := true;
while Bool do
begin
Key1 := readkey;
if Key1 = #0
then begin
Key2 := readkey;
case Key2 of
#72 : if Current <> 1
then begin
Movecursor2(Current, Key2);
Current := Current - 1
end;
#80 : if Current <> 5
then begin
Movecursor2(Current, Key2);
Current := Current + 1
end;
end;
end
else if Key1 = #13
then begin
case Current of
1 : AmendClips;
2 : AddClips;
3 : DeleteClips;
4 : ChangePW;
5 : MainMenu;
end;
end;
end;
end;
(*** [Edit clips] Selection ***)
(*** [Edit clips] Login ***)
procedure Login;
var
ch1, ch3 : char;
i : integer;
begin
repeat
gotoxy(21,12);
ch1 := readkey;
if (ord(ch1) >= 32) and (ord(ch1) <= 126) and (length(strStar) < 8)
then begin
strStar := strStar + ch1;
for i := 1 to length(strStar) do
begin
gotoxy(21+i,12);
textcolor(12);
write('*');
end;
end
else if ch1 = #8
then begin
delete(strStar, length(strStar), 1);
for i := 1 to 10 do
begin
gotoxy(21+i,12);
write(chr(0));
end;
for i := 1 to length(strStar) do
begin
gotoxy(21+i,12);
textcolor(12);
write('*');
end;
end;
until ch1 = #13;
textcolor(15);
end;
(*** [Edit clips] Login ***)
(*** [Edit clips] Login Menu ***)
procedure LoginMenu;
var
ch, ch3 : char;
Bool : boolean;
i : integer;
begin
Bool := true;
clrscr;
DrawWindow(Left+19, Right+39, Top+3, Bottom-8);
textcolor(Ucolor);
gotoxy(21,10);
writeln('This area is restricted to authorized ');
gotoxy(21,11);
writeln('people. Do you have the access password ?');
gotoxy(21,12);
writeln('* Please type in (Y/N) : ');
gotoxy(44,12);
while Bool = true do
begin
ch := readkey;
if (ch = 'Y') or (ch = 'y')
then begin
repeat
clrscr;
DrawQB;
textcolor(Ucolor);
gotoxy(21,10);
writeln(' Please type in the password ');
strStar := '';
Login;
strPW := strStar;
if strPW = Password
then ModifyDB
else begin
clrscr;
DrawQB;
textcolor(Ucolor);
gotoxy(21,10);
writeln(' Incorrect password');
gotoxy(21,11);
writeln(' Press "Q" or "q" to quit');
gotoxy(21,12);
writeln(' Or press other keys to re-enter');
ch3 := readkey;
if (ch3 = 'Q') or (ch3 = 'q')
then MainMenu
end;
until strPW = Password;
end
else if (ch = 'N') or (ch = 'n')
then begin
clrscr;
gotoxy(21,11);
textcolor(Ucolor);
writeln('We are bringing you back to menu....');
textcolor(15);
textbackground(0);
delay(200);
MainMenu;
end
end;
end;
(*** [Edit clips] Login Menu ***)
(*** [MainMenu] Move bar ***)
procedure Movecursor(index : integer; ch : char);
begin
if ch = #72
then begin
case index of (*bar up*)
2 : begin
gotoxy(3,9);
write('2. Modify Data Base');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Find specific clip');
gotoxy(3,7);
textbackground(3);
textcolor(10);
write('1. Search Clips')
end;
3 : begin
gotoxy(3,11);
write('3. View Entry');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Add, delete and amend clips in data base');
gotoxy(3,9);
textbackground(3);
textcolor(10);
write('2. Modify Data Base')
end;
4 : begin
gotoxy(3,13);
write('4. Options');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('View all the clip files in list form');
gotoxy(3,11);
textbackground(3);
textcolor(10);
write('3. View Entry')
end;
5 : begin
gotoxy(3,15);
write('5. Readme');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Change passwords, screen appearance');
gotoxy(3,13);
textbackground(3);
textcolor(10);
write('4. Options')
end;
6 : begin
gotoxy(3,17);
write('6. Back Up');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Need a help? Read some guidelines here');
gotoxy(3,15);
textbackground(3);
textcolor(10);
write('5. Readme')
end;
7 : begin
gotoxy(3,19);
write('7. Exit');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Back up the database');
gotoxy(3,17);
textbackground(3);
textcolor(10);
write('6. Back Up')
end;
end;
end
else begin
case index of (*bar down*)
1 : begin
gotoxy(3,7);
write('1. Search Clips');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Add, delete and amend clips in data base');
gotoxy(3,9);
textbackground(3);
textcolor(10);
write('2. Modify Data Base');
end;
2 : begin
gotoxy(3,9);
write('2. Modify Data Base');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('View all the clip files in list form');
gotoxy(3,11);
textbackground(3);
textcolor(10);
write('3. View Entry')
end;
3 : begin
gotoxy(3,11);
write('3. View Entry');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Change passwords, screen appearance');
gotoxy(3,13);
textbackground(3);
textcolor(10);
write('4. Options')
end;
4 : begin
gotoxy(3,13);
write('4. Options');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Need a help? Read some guidelines here');
gotoxy(3,15);
textbackground(3);
textcolor(10);
write('5. Readme')
end;
5 : begin
gotoxy(3,15);
write('5. Readme');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Back up the database');
gotoxy(3,17);
textbackground(3);
textcolor(10);
write('6. Back Up')
end;
6 : begin
gotoxy(3,17);
write('6. Back Up');
Eraseln;
gotoxy(3,Bottom+2);
textcolor(Ucolor);
write('Quit [567 Video Enquiry System]');
gotoxy(3,19);
textbackground(3);
textcolor(10);
write('7. Exit')
end;
end;
end;
textbackground(0);
textcolor(15);
end;
(*** [MainMenu] Move bar ***)
(*** [MainMenu] Selection ***)
procedure MainMenu;
var
ch, Key1, Key2 : char;
Current, i : integer;
Bool : boolean;
begin
MMTColor[1] := 10;
MMBGColor[1] := 3;
for i := 2 to 7 do
begin
MMTColor[i] := 15;
MMBGColor[i] := 0;
end;
Current := 1;
DrawMM;
Bool := true;
while Bool do
begin
Key1 := readkey;
if Key1 = #0
then begin
Key2 := readkey;
case Key2 of
#72 : if Current <> 1
then begin
Movecursor(Current, Key2);
Current := Current - 1
end;
#80 : if Current <> 7
then begin
Movecursor(Current, Key2);
Current := Current + 1
end;
end;
end
else if Key1 = #13
then case Current of
1 : SearchMenu;
2 : LoginMenu; (*Login;*)
3 : ViewEntry;
4 : SelectionOp;
5 : ReadMe;
6 : BackupMenu;
7 : EndP;
end
end;
end;
(*** [MainMenu] Selection ***)
(*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
begin
clrscr;
(*Scan USER.txt*)
assign(UserData, 'a:/USER.txt');
reset(UserData);
readln(UserData, UserPW);
readln(UserData, UserColor);
readln(UserData, UserCode);
close(UserData);
(*Scan USER.txt*)
Password := UserPW;
Ucolor := UserColor;
textcolor(Ucolor);
textbackground(0);
MainMenu;
end.
(
geocities.com/hk/alxc0717) (
geocities.com/hk)