CONFIG2.PAS
15 KB
706f9920e98fe974…
unit config2;
interface uses crt,dos,gentypes,configrt,subs1,subs2,gensubs,windows;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure cConfEdit(conf : byte);
Procedure cThemeEdit;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
implementation
var cValue : array[1..2] of byte;
cSelectChar : array[1..26] of char;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function cBoolToggle(b : boolean) : boolean;
begin
asm xor b, 1 end;
cBoolToggle := b;
cChange := true;
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function b00lean(b00l : boolean) : string;
begin
if (b00l=true) then b00lean := 'Yup ' else
b00lean := 'Nope';
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function cInputStr(x,y,fg,bg,len : byte; bufStr : lStr) : lStr;
var iPos : byte;
iStr : lStr;
iChar : char;
begin
cChange := true;
iStr := bufStr;
goxy(x,y);
for iPos := 1 to len do multicolor('|B0|07'+#32);goxy(x,y);
inputbox2(len, bufStr);
if inpt<>'<<undo>>' then cInputStr := inpt else
cInputStr := iStr;
end;
Function cInputCh(x,y,fg,bg,len : byte;bufStr : char) : char;
var s : string;
begin
s := cInputStr(x,y,fg,bg,1,bufStr);
cInputCh := s[1];
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function cSelectShit(cOptions : byte) : char;
var cInKey : char;
cKill : boolean;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure cShowSelection;
begin
goXY(1,2+cValue[1]);multicolor('|08(|15'+chr(cValue[1]+96)+'|08)');
goXY(1,2+cValue[2]);multicolor('|B7 |08'+chr(cValue[2]+96)+'|B7 ');
goXY(1,1);
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin
cShowSelection;
repeat
cInKey := upCase(ArrowKey(True));
case cInKey of
^A : begin
cValue[1] := cValue[2];
if (cValue[1]<>1) then dec(cValue[2]);
cShowSelection;
end;
^B : begin
cValue[1] := cValue[2];
if (cValue[1]<>cOptions) then inc(cValue[2]);
cShowSelection;
end;
']' : begin
cSelectShit := ']';
cKill := true;
end;
'[' : begin
cSelectShit := '[';
cKill := true;
end;
' ' : begin
cSelectShit := #32;
cKill := true;
end;
#27,'X' : begin
cSelectShit := 'X';
cKill := True;
end;
'A'..'Z': begin
if (ord(cInkey)<=64+cOptions) then
begin
cValue[1] := cValue[2];
cValue[2] := ord(cInKey)-64;
cShowSelection;
cSelectShit := cInkey;
cKill := true;
end;
end;
#13 : begin
cSelectShit := cSelectChar[cValue[2]];
cKill := true;
end;
#27 : begin
cSelectShit := #0;
cKill := true;
end;
end;
until (cKill=true);
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure cConfEdit(conf : byte);
const
fFiles : array[1..2] of string[12] = ('XFERCONF.DAT','MSGCONF.DAT');
fType : array[1..2] of string[10] = ('File','Messsage');
type
fConfRec = Record
Name,
Password : Lstr;
Flags : String[26];
Minlevel,
Maxlevel : integer;
OpenTime,
CloseTime : Sstr;
End;
var
fData : ^fConfRec;
fCurrent : byte;
fTotal : byte;
fConf : byte;
Procedure fInitConfFile;
var f : file;
begin
fillChar(fData^,sizeOf(fData^),0);
fData^.Name := 'Generic '+fType[conf]+' Conference';
fData^.MinLevel := 0;
fData^.MaxLevel := 3200;
fData^.OpenTime := '1:01 am';
fData^.CloseTime := '1:00 am';
assign(f,cfg.dataDir+fFiles[conf]);
rewrite(f,1);
blockWrite(f,fData^,sizeOf(fData^));
close(f);
end;
Procedure fLoadData(num : byte);
var f : file;
begin
if not exist(cfg.dataDir+fFiles[conf]) then fInitConfFile;
fillChar(fData^,sizeOf(fData^),0);
assign(f,cfg.dataDir+fFiles[conf]);
reset(f,1);
fTotal := (fileSize(f) div sizeOf(fConfRec));
seek(f,pred(num)*sizeOf(fConfRec));
blockRead(f,fData^,sizeOf(fData^));
close(f);
end;
Procedure fWriteCurrent;
var f : file;
begin
assign(f,cfg.dataDir+fFiles[conf]);
reset(f,1);
seek(f,pred(fCurrent)*sizeOf(fConfRec));
blockWrite(f,fData^,sizeOf(fData^));
close(f);
end;
Procedure fInsertConference;
var f : file;
begin
assign(f,cfg.dataDir+fFiles[conf]);
reset(f,1);
seek(f,fileSize(f));
fillChar(fData^,sizeOf(fData^),0);
fData^.Name := 'Generic '+fType[conf]+' Conference';
fData^.MinLevel := 0;
fData^.MaxLevel := 3200;
fData^.OpenTime := '1:01 am';
fData^.CloseTime := '1:00 am';
blockWrite(f,fData^,sizeOf(fData^));
close(f);
end;
Procedure fDeleteConference;
var f : file;
fTmpData : fConfRec;
fCount : byte;
begin
assign(f,cfg.dataDir+fFiles[conf]);
reset(f,1);
if (fCurrent=fTotal) and (fTotal>1) then
begin
seek(f,pred(fCurrent)*sizeOf(fConfRec));
truncate(f);
dec(fCurrent,1);
dec(fTotal,1);
end else
if (fCurrent<fTotal) and (fTotal>1) then
begin
for fCount := fTotal downto (fCurrent+1) do
begin
seek(f,pred(fCount)*sizeOf(fConfRec));
blockRead(f,fTmpData,sizeOf(fTmpData));
seek(f,(fCount-2)*sizeOf(fConfRec));
blockWrite(f,fTmpData,sizeOf(fTmpData));
end;
seek(f,fileSize(f)-sizeOf(fConfRec));
truncate(f);
dec(fTotal,1);
end;
close(f);
end;
Procedure fDrawScreens(scrn : byte);
begin
if (scrn=1) then
begin
ansiCls;
multiColor('|08┌|07:|15: |03infusion conference editor |15:|07:|08──────────────────────────────────────────────┐');
multiColor('|08└──────────────────────────────────────────────────────────────────────────────┘');
goXY(50,1);multiColor('|07:|15: |03'+strr(fCurrent)+' of '+strr(fTotal)+' |15:|07:');
goXY(1,3); multiColor('|08(|15a|08) |07Conference Name |08: |15'+fData^.name);
goXY(1,4); multiColor('|08(|15b|08) |07Conference Password |08: |15'+fData^.password);
goXY(1,5); multiColor('|08(|15c|08) |07Conference Flags |08: |15'+fData^.flags);
goXY(1,6); multiColor('|08(|15d|08) |07Minimum Entry Level |08: |15'+strr(fData^.minLevel));
goXY(1,7); multiColor('|08(|15e|08) |07Maximum Entry Level |08: |15'+strr(fData^.maxLevel));
goXY(1,8); multiColor('|08(|15f|08) |07Conference Open Time |08: |15'+fData^.openTime);
goXY(1,9); multiColor('|08(|15g|08) |07Conference Close Time |08: |15'+fData^.closeTime);
goXY(1,10);multiColor('|08(|15h|08) |07Next Conference');
goXY(1,11);multiColor('|08(|15i|08) |07Previous Conference');
goXY(1,12);multiColor('|08(|15j|08) |07Insert Conference');
goXY(1,13);multiColor('|08(|15k|08) |07Delete Conference|CR');
multiColor('|08┌──────────────────────────────────────────────────────────────────────────────┐');
multiColor('|08└|07:|15: |03arrow keys navigate, X exits, hot keys jump to editing field |15:|07:|08────────────┘');
end;
end;
Procedure fEditConf(num : byte);
begin
case num of
1 : fData^.name := cInputStr(30,3,00,7,40,fData^.name);
2 : fData^.password := cInputStr(30,4,00,7,30,fData^.password);
3 : fData^.flags := cInputStr(30,5,00,7,26,fData^.flags);
4 : fData^.minLevel := stoi(cInputStr(30,6,00,7,4,strr(fData^.minLevel)));
5 : fData^.maxLevel := stoi(cInputStr(30,7,00,7,4,strr(fData^.maxLevel)));
6 : fData^.openTime := cInputStr(30,8,00,7,12,fData^.openTime);
7 : fData^.closeTime := cInputStr(30,9,00,7,12,fData^.closeTime);
end;
fDrawScreens(1);
end;
Procedure fMainSelection;
var fInKey : char;
fDone : boolean;
begin
fCurrent := 1;
fLoadData(fCurrent);
fDrawScreens(1);
repeat
fInKey := cSelectShit(11);
case fInKey of
'A'..'G' : fEditConf(ord(fInKey)-64);
'X' : fDone := true;
'H',']' : begin
fWriteCurrent;
if (fCurrent<fTotal) then
begin
inc(fCurrent);
fLoadData(fCurrent);
fDrawScreens(1);
end;
end;
'I','[' : begin
fWriteCurrent;
if (fCurrent>1) then
begin
dec(fCurrent);
fLoadData(fCurrent);
fDrawScreens(1);
end;
end;
'J' : if (fTotal<255) then
begin
fWriteCurrent;
fInsertConference;
fLoadData(fCurrent);
fDrawScreens(1);
end;
'K' : if (fTotal>1) then
begin
fDeleteConference;
fDrawScreens(1);
end;
end;
until (fDone=true);
end;
begin
new(fData);
fMainSelection;
fWriteCurrent;
dispose(fData);
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure cThemeEdit;
type
tDataArray = array[1..10] of themeRec;
var
tData : ^tDataArray;
tCurrent : byte;
tTotal : byte;
Procedure tDrawScreens(scrn : byte);
begin
ansiCls;
multiColor('|08┌|07:|15: |03infusion theme editor |15:|07:|08───────────────────────────────────────────────────┐');
multiColor('|08└──────────────────────────────────────────────────────────────────────────────┘');
goXY(40,1);multiColor('|07:|15:|03 '+strr(tCurrent)+' of '+strr(tTotal)+' |15:|07:');
goXY(1,3); multiColor('|08(|15a|08) |07Theme Name |08: |15'+tData^[tCurrent].name);
goXy(1,4); multiColor('|08(|15b|08) |07Theme Textfile Dir |08: |15'+tData^[tCurrent].textDir);
goXY(1,5); multiColor('|08(|15c|08) |07Allow Pullbar Menus |08: |15'+b00lean(tData^[tCurrent].allowBars));
goXY(1,6); multiColor('|08(|15d|08) |07Minimum Level |08: |15'+strr(tData^[tCurrent].minLevel));
goXY(1,7); multiColor('|08(|15e|08) |07Maximum Level |08: |15'+strr(tData^[tCurrent].maxLevel));
goXY(1,8); multiColor('|08(|15f|08) |07Access Flags |08: |15'+tData^[tCurrent].e_flags);
goXY(1,9); multiColor('|08(|15g|08) |07Theme ID Number |08: |15'+strr(tData^[tCurrent].identity));
goXY(1,10);multiColor('|08(|15h|08) |07Next Theme');
goXY(1,11);multiColor('|08(|15i|08) |07Previous Theme');
goXY(1,12);multiColor('|08(|15j|08) |07Insert New Theme');
goXY(1,13);multiColor('|08(|15k|08) |07Delete Current Theme|CR');
multiColor('|08┌──────────────────────────────────────────────────────────────────────────────┐');
multiColor('|08└|07:|15: |03arrow keys navigate, X exits, hot keys jump to editing field |15:|07:|08────────────┘');
end;
Procedure tMakeNew;
var tFile : file;
begin
fillChar(tData^,sizeOf(tData^),0);
tData^[1].Name := 'Generic';
tData^[1].TextDir := cfg.TextFileDir;
tData^[1].AllowBars := True;
tData^[1].MaxLevel := 32767;
tData^[1].Identity := 1;
tCurrent := 1;
tTotal := 1;
assign(tFile,cfg.dataDir+'THEMES.DAT');
rewrite(tFile,1);
blockWrite(tFile,tData^[1],sizeOf(tData^[1]));
close(tFile);
end;
Procedure tLoadData;
var tFile : file;
tCount : byte;
begin
if not exist(cfg.dataDir+'THEMES.DAT') then tMakeNew else
begin
fillChar(tData^,sizeOf(tData^),0);
assign(tFile,cfg.dataDir+'THEMES.DAT');
reset(tFile,1);
tTotal := (fileSize(tFile) div sizeOf(themeRec));
for tCount := 1 to tTotal do blockRead(tFile,tData^[tCount],sizeOf(tData^[tCount]));
close(tFile);
end;
end;
Procedure tInsertNew;
begin
inc(tCurrent);
inc(tTotal);
fillChar(tData^[tCurrent],sizeOf(tData^[tCurrent]),0);
tData^[tCurrent].Name := 'New Infusion Theme';
tData^[tCurrent].TextDir := cfg.TextFileDir;
tData^[tCurrent].AllowBars := True;
tData^[tCurrent].MaxLevel := 32767;
tData^[tCurrent].Identity := 1;
end;
Procedure tDeleteCurrent;
var count : byte;
begin
goXY(1,16); writeStr('Please confirm deletion of theme #'+strr(tCurrent)+' - @');
goXY(1,16); multiColor('|07 ');
if not yes then exit;
for count := tCurrent to tTotal do
tData^[count] := tData^[count+1];
dec(tTotal);
dec(tCurrent);
end;
Procedure tEditShit(num : byte);
begin
case num of
1 : tData^[tCurrent].name := cInputStr(30,3,00,7,40,tData^[tCurrent].name);
2 : tData^[tCurrent].textDir := cInputStr(30,4,00,7,44,tData^[tCurrent].textDir);
3 : tData^[tCurrent].AllowBars := cBoolToggle(tData^[tCurrent].allowBars);
4 : tData^[tCurrent].minLevel := stoi(cInputStr(30,6,00,7,4,strr(tData^[tCurrent].minLevel)));
5 : tData^[tCurrent].maxLevel := stoi(cInputStr(30,7,00,7,4,strr(tData^[tCurrent].maxLevel)));
6 : tData^[tCurrent].e_flags := cInputStr(30,8,00,7,26,tData^[tCurrent].e_flags);
7 : tData^[tCurrent].identity := stoi(cInputStr(30,9,00,7,3,strr(tData^[tCurrent].identity)));
end;
tDrawScreens(1);
end;
Procedure tSaveThemes;
var f : file;
count : byte;
begin
assign(f,cfg.dataDir+'THEMES.DAT');
rewrite(f,1);
for count := 1 to tCurrent do
blockWrite(f,tData^[count],sizeOf(tData^[count]));
close(f);
end;
Procedure tGetEntry;
var
gInKey : char;
gDone : boolean;
begin
tDrawScreens(1);
repeat
gInKey := cSelectShit(11);
case gInKey of
'X' : gDone := true;
'A'..'G': tEditShit(ord(gInKey)-64);
'H',']': if (tCurrent<tTotal) then
begin
inc(tCurrent);
tDrawScreens(1);
end;
'I','[': if (tCurrent>1) then
begin
dec(tCurrent);
tDrawScreens(1);
end;
'J' : if (tTotal<10) then
begin
tInsertNew;
tDrawScreens(1);
end;
'K' : if (tTotal>1) then
begin
tDeleteCurrent;
tDrawScreens(1);
end else
begin
goXY(1,16); multiColor('|07Error - At least ONE THEME must exist!');
delay(2000); goXY(1,16); multiColor(' ');
end;
end;
until (gDone=true);
gotoXY(1,16);writeStr('Would you like to save your changes - @');
if yes then tSaveThemes;
end;
begin
new(tData);
tLoadData;
tGetEntry;
dispose(tData);
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin end.