824 lines
27 KiB
Plaintext
824 lines
27 KiB
Plaintext
{$IFDEF WIN32}
|
||
{$I DEFINES.INC}
|
||
{$ENDIF}
|
||
|
||
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
||
|
||
UNIT SysOp2J;
|
||
|
||
INTERFACE
|
||
|
||
PROCEDURE ColorConfiguration;
|
||
|
||
IMPLEMENTATION
|
||
|
||
USES
|
||
Common,
|
||
File11,
|
||
File1,
|
||
Mail4,
|
||
TimeFunc;
|
||
|
||
PROCEDURE ColorConfiguration;
|
||
CONST
|
||
ColorName: ARRAY[0..7] OF STRING[7] = ('Black','Blue','Green','Cyan','Red','Magenta','Yellow','White');
|
||
VAR
|
||
TempScheme: SchemeRec;
|
||
Cmd: Char;
|
||
RecNumToList: Integer;
|
||
SaveTempPause: Boolean;
|
||
|
||
FUNCTION DisplayColorStr(Color: Byte): AStr;
|
||
VAR
|
||
TempStr: AStr;
|
||
BEGIN
|
||
TempStr := ColorName[Color AND 7]+' on '+ColorName[(Color SHR 4) AND 7];
|
||
IF ((Color AND 8) <> 0) THEN
|
||
TempStr := 'Bright '+TempStr;
|
||
IF ((Color AND 128) <> 0) THEN
|
||
TempStr := 'Blinking '+TempStr;
|
||
DisplayColorStr := TempStr;
|
||
END;
|
||
|
||
FUNCTION GetColor: Byte;
|
||
VAR
|
||
NewColor,
|
||
SaveOldColor,
|
||
TempColor,
|
||
Counter: Byte;
|
||
BEGIN
|
||
SetC(7);
|
||
NL;
|
||
FOR Counter := 0 TO 7 DO
|
||
BEGIN
|
||
SetC(7);
|
||
Prompt(IntToStr(Counter)+'. ');
|
||
SetC(Counter);
|
||
Prompt(PadLeftStr(ColorName[Counter],12));
|
||
SetC(7);
|
||
Prompt(PadRightInt((Counter + 8),2)+'. ');
|
||
SetC(Counter + 8);
|
||
Print(PadLeftStr(ColorName[Counter]+'!',9));
|
||
END;
|
||
InputByteWOC('%LFForeground',TempColor,[Numbersonly],0,15); (* Suppress Error *)
|
||
IF (TempColor IN [0..15]) THEN
|
||
NewColor := TempColor
|
||
ELSE
|
||
NewColor := 7;
|
||
NL;
|
||
FOR Counter := 0 TO 7 DO
|
||
BEGIN
|
||
SetC(7);
|
||
Prompt(IntToStr(Counter)+'. ');
|
||
SetC(Counter);
|
||
Print(PadLeftStr(ColorName[Counter],12));
|
||
END;
|
||
InputByteWOC('%LFBackground',TempColor,[NumbersOnly],0,7); (* Suppress Error *)
|
||
IF (TempColor IN [0..7]) THEN
|
||
NewColor := NewColor OR TempColor SHL 4;
|
||
IF PYNQ('%LFBlinking? ',0,FALSE) THEN
|
||
NewColor := NewColor OR 128;
|
||
SetC(7);
|
||
Prompt('%LFExample: ');
|
||
SetC(NewColor);
|
||
Print(DisplayColorStr(NewColor));
|
||
SetC(7);
|
||
GetColor := NewColor;
|
||
END;
|
||
|
||
PROCEDURE SystemColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
Counter,
|
||
NewColor: Byte;
|
||
BEGIN
|
||
REPEAT
|
||
CLS;
|
||
NL;
|
||
FOR Counter := 1 TO 10 DO
|
||
BEGIN
|
||
SetC(7);
|
||
Prompt(PadRightInt((Counter - 1),2)+'. System color '+PadRightInt((Counter - 1),2)+': ');
|
||
SetC(TempScheme1.Color[Counter]);
|
||
Print(DisplayColorStr(Scheme.Color[Counter]));
|
||
END;
|
||
LOneK('%LFSystem color to change [^50^4-^59^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'0123456789',TRUE,TRUE);
|
||
IF (Cmd1 IN ['0'..'9']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) - Ord('0') + 1] := NewColor;
|
||
Changed := TRUE;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE FileColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
F: FileInfoRecordType;
|
||
NewColor: Byte;
|
||
BEGIN
|
||
REPEAT
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
FileAreaNameDisplayed := FALSE;
|
||
DisplayFileAreaHeader;
|
||
WITH F DO
|
||
BEGIN
|
||
FileName := 'RENEGADE.ZIP';
|
||
Description := 'Latest version of Renegade!';
|
||
FilePoints := 0;
|
||
Downloaded := 0;
|
||
FileSize := 2743;
|
||
OwnerNum := 1;
|
||
OwnerName:= 'Exodus';
|
||
FileDate := Date2Pd(DateStr);
|
||
VPointer := -1;
|
||
VTextSize := 0;
|
||
FIFlags := [];
|
||
END;
|
||
lDisplay_File(F,1,'',FALSE);
|
||
PrintACR(PadLeftStr('',28)+'This is the latest version available');
|
||
PrintACR(PadLeftStr('',28)+'Uploaded by: Exodus');
|
||
WITH F DO
|
||
BEGIN
|
||
FileName := 'RG .ZIP';
|
||
Description := 'Latest Renegade upgrade.';
|
||
FilePoints := 0;
|
||
Downloaded := 0;
|
||
FileSize := 2158;
|
||
OwnerNum := 2;
|
||
OwnerName := 'Nuclear';
|
||
FileDate := Date2PD(DateStr);
|
||
VPointer := -1;
|
||
VTextSize := 0;
|
||
FIFlags := [];
|
||
END;
|
||
lDisplay_File(F,2,'RENEGADE',FALSE);
|
||
PrintACR(PadLeftStr('',28)+'This is the latest upgrade available');
|
||
PrintACR(PadLeftStr('',28)+'Uploaded by: Nuclear');
|
||
NL;
|
||
LCmds3(20,3,'A Border','B File Name field','C Pts Field');
|
||
LCmds3(20,3,'D Size field','E Desc Field','F Area field');
|
||
NL;
|
||
LCmds3(20,3,'G File name','H File Points','I File size');
|
||
LCmds3(20,3,'J File desc','K Extended','L Status flags');
|
||
LCmds(20,3,'M Uploader','N Search Match');
|
||
LOneK('%LFFile color to change [^5A^4-^5N^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKLMN',TRUE,TRUE);
|
||
IF (Cmd1 IN ['A'..'N']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) - 54] := NewColor;
|
||
Changed := TRUE;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE MsgColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
NewColor: Byte;
|
||
BEGIN
|
||
REPEAT
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
CLS; { starts at color 28 }
|
||
PrintACR(' <1C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
|
||
PrintACR(' <1C> Msg# <1C> Sender <1C> Receiver <1C> '+
|
||
'Subject <1C>! Posted <1C>');
|
||
PrintACR(' <1C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
PrintACR('''* "2# Exodus $Nuclear %Re: Renegade &01/01/93');
|
||
PrintACR('''> "3# Nuclear $Exodus %RG Update &01/01/93');
|
||
NL;
|
||
LCmds3(20,3,'A Border','B Msg Num field','C Sender Field');
|
||
LCmds3(20,3,'D Receiver field','E Subject Field','F Date field');
|
||
NL;
|
||
LCmds3(20,3,'G Msg Num','H Msg Sender','I Msg Receiver');
|
||
LCmds3(20,3,'J Subject','K Msg Date','L Status flags');
|
||
LOneK('%LFMessage color to change [^5A^4-^5L^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKL',TRUE,TRUE);
|
||
IF (Cmd1 IN ['A'..'L']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) - 37] := NewColor;
|
||
Changed := TRUE;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE FileAreaColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
NewColor: Byte;
|
||
FArea,
|
||
NumFAreas: Integer;
|
||
SaveConfSystem: Boolean;
|
||
BEGIN
|
||
SaveConfSystem := ConfSystem;
|
||
ConfSystem := FALSE;
|
||
IF (SaveConfSystem) THEN
|
||
NewCompTables;
|
||
REPEAT
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
Farea := 1;
|
||
NumFAreas := 0;
|
||
LFileAreaList(FArea,NumFAreas,10,TRUE); { starts at 45 }
|
||
NL;
|
||
LCmds3(20,3,'A Border','B Base Num field','C Base Name Field');
|
||
NL;
|
||
LCmds3(20,3,'D Scan Indicator','E Base Number','F Base Name');
|
||
LOneK('%LFFile area color to change [^5A^4-^5F^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEF',TRUE,TRUE);
|
||
IF (Cmd1 IN ['A'..'F']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) - 20] := NewColor;
|
||
Changed := TRUE;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
ConfSystem := SaveConfSystem;
|
||
IF (SaveConfSystem) THEN
|
||
NewCompTables;
|
||
END;
|
||
|
||
PROCEDURE MsgAreaColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
NewColor: Byte;
|
||
MArea,
|
||
NumMAreas: Integer;
|
||
BEGIN
|
||
REPEAT
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
MArea := 1;
|
||
NumMAreas := 0;
|
||
MessageAreaList(MArea,NumMAreas,5,TRUE); { starts at 55 }
|
||
NL;
|
||
LCmds3(20,3,'A Border','B Base Num field','C Base Name Field');
|
||
NL;
|
||
LCmds3(20,3,'D Scan Indicator','E Base Number','F Base Name');
|
||
LOneK('%LFMessage area color to change [^5A^4-^5F^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEF',TRUE,TRUE);
|
||
IF (Cmd1 IN ['A'..'F']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) - 10] := NewColor;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE QWKColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
NewColor: Byte;
|
||
BEGIN
|
||
REPEAT
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
CLS; { starts at 115 }
|
||
Print(Centre('|The QWK<57>System is now gathering mail.'));
|
||
NL;
|
||
PrintACR('s<><73><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
|
||
PrintACR('s<>t Num s<>u Message base name s<>v Short s<>w Echo s<>x Total '+
|
||
's<>y New s<>z Your s<>{ Size s<>');
|
||
PrintACR('s<><73><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
PrintACR(' }1 ~General GENERAL <13>No <13>530 <13>328 <13>13 <13>103k');
|
||
PrintACR(' }2 ~Not so general NSGEN <13>No <13>854 <13> 86 <13>15 <13>43k');
|
||
PrintACR(' }3 ~Vague VAGUE <13>No <13>985 <13>148 <13>8 <13>74k');
|
||
NL;
|
||
LCmds3(20,3,'A Border','B Base num field','C Base name field');
|
||
LCmds3(20,3,'D Short field','E Echo field','F Total field');
|
||
LCmds3(20,3,'G New field','H Your field','I Size field');
|
||
NL;
|
||
LCmds3(20,3,'J Title','K Base Number','L Base name');
|
||
LCmds3(20,3,'M Short','N Echo flag','O Total Msgs');
|
||
LCmds3(20,3,'P New Msgs','R Your Msgs','S Msgs size');
|
||
LOneK('%LFQWK color to change [^5A^4-^5S^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'ABCDEFGHIJKLMNOPRS'^M,TRUE,TRUE);
|
||
IF (Cmd1 IN ['A'..'P','R'..'S']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
IF (Cmd1 < 'Q') THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) + 50] := NewColor;
|
||
Changed := TRUE;
|
||
END
|
||
ELSE
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) + 49] := NewColor;
|
||
Changed := TRUE;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE EmailColors(VAR TempScheme1: SchemeRec; Cmd1: Char; VAR Changed: Boolean);
|
||
VAR
|
||
NewColor: Byte;
|
||
BEGIN
|
||
REPEAT
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
CLS; { starts at 135 }
|
||
PrintACR('<13><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
|
||
PrintACR('<13><><13> Num <13><><13> Date/Time <13><><13> Sender <13><><13> Subject <13><>');
|
||
PrintACR('<13><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
PrintACR(' <13>1 <13>01 Jan 1993 01:00a <13>Exodus <13>Renegade');
|
||
PrintACR(' <13>1 <13>01 Jan 1993 01:00a <13>Nuclear <13>Upgrades');
|
||
NL;
|
||
LCmds3(20,3,'A Border','B Number field','C Date/Time field');
|
||
LCmds(20,3,'D Sender field','E Subject field');
|
||
NL;
|
||
LCmds3(20,3,'F Number','G Date/Time','H Sender');
|
||
LCmds(20,3,'I Subject','');
|
||
LOneK('%LFEmail color to change [^5A^4-^5I^4,^5<CR>^4=^5Quit^4]: ',Cmd1,^M'QABCDEFGHI',TRUE,TRUE);
|
||
IF (Cmd1 IN ['A'..'I']) THEN
|
||
BEGIN
|
||
NewColor := GetColor;
|
||
IF PYNQ('%LFIs this correct? ',0,FALSE) THEN
|
||
BEGIN
|
||
TempScheme1.Color[Ord(Cmd1) + 70] := NewColor;
|
||
Changed := TRUE;
|
||
END;
|
||
END;
|
||
UNTIL (Cmd1 = ^M) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE InitSchemeVars(VAR Scheme: SchemeRec);
|
||
BEGIN
|
||
WITH Scheme DO
|
||
BEGIN
|
||
Description := '<< New Color Scheme >>';
|
||
FillChar(Color,SizeOf(Color),7);
|
||
Color[1] := 15;
|
||
Color[2] := 3;
|
||
Color[3] := 13;
|
||
Color[4] := 11;
|
||
Color[5] := 9;
|
||
Color[6] := 14;
|
||
Color[7] := 31;
|
||
Color[8] := 4;
|
||
Color[9] := 132;
|
||
Color[10] := 10;
|
||
END;
|
||
END;
|
||
|
||
PROCEDURE DeleteScheme(TempScheme1: SchemeRec; RecNumToDelete: SmallInt);
|
||
VAR
|
||
User: UserRecordType;
|
||
RecNum: Integer;
|
||
BEGIN
|
||
IF (NumSchemes = 0) THEN
|
||
Messages(4,0,'color schemes')
|
||
ELSE
|
||
BEGIN
|
||
RecNumToDelete := -1;
|
||
InputIntegerWOC('%LFColor scheme to delete',RecNumToDelete,[NumbersOnly],1,NumSchemes);
|
||
IF (RecNumToDelete >= 1) AND (RecNumToDelete <= NumSchemes) THEN
|
||
BEGIN
|
||
Reset(SchemeFile);
|
||
Seek(SchemeFile,(RecNumToDelete - 1));
|
||
Read(SchemeFile,TempScheme1);
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
Print('%LFColor scheme: ^5'+TempScheme1.Description);
|
||
IF PYNQ('%LFAre you sure you want to delete it? ',0,FALSE) THEN
|
||
BEGIN
|
||
Print('%LF[> Deleting color scheme record ...');
|
||
Dec(RecNumToDelete);
|
||
Reset(SchemeFile);
|
||
IF (RecNumToDelete >= 0) AND (RecNumToDelete <= (FileSize(SchemeFile) - 2)) THEN
|
||
FOR RecNum := RecNumToDelete TO (FileSize(SchemeFile) - 2) DO
|
||
BEGIN
|
||
Seek(SchemeFile,(RecNum + 1));
|
||
Read(SchemeFile,Scheme);
|
||
Seek(SchemeFile,RecNum);
|
||
Write(SchemeFile,Scheme);
|
||
END;
|
||
Seek(SchemeFile,(FileSize(SchemeFile) - 1));
|
||
Truncate(SchemeFile);
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
Dec(NumSchemes);
|
||
SysOpLog('* Deleted color scheme: ^5'+TempScheme1.Description);
|
||
Inc(RecNumToDelete);
|
||
Print('%LFUpdating user records ...');
|
||
Reset(UserFile);
|
||
RecNum := 1;
|
||
WHILE (RecNum < FileSize(UserFile)) DO
|
||
BEGIN
|
||
LoadURec(User,RecNum);
|
||
IF (User.ColorScheme = RecNumToDelete) THEN
|
||
BEGIN
|
||
User.ColorScheme := 1;
|
||
SaveURec(User,RecNum);
|
||
END
|
||
ELSE IF (User.ColorScheme > RecNumTodelete) THEN
|
||
BEGIN
|
||
Dec(User.ColorScheme);
|
||
SaveURec(User,RecNum);
|
||
END;
|
||
Inc(RecNum);
|
||
END;
|
||
Close(UserFile);
|
||
LastError := IOResult;
|
||
END;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
PROCEDURE CheckScheme(Scheme: SchemeRec; StartErrMsg,EndErrMsg: Byte; VAR Ok: Boolean);
|
||
VAR
|
||
Counter: Byte;
|
||
BEGIN
|
||
FOR Counter := StartErrMsg TO EndErrMsg DO
|
||
CASE Counter OF
|
||
1 : IF (Scheme.Description = '') OR (Scheme.Description = '<< New Color Scheme >>') THEN
|
||
BEGIN
|
||
Print('%LF^7The description is invalid!^1');
|
||
OK := FALSE;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
PROCEDURE EditScheme(TempScheme1: SchemeRec; VAR Scheme: SchemeRec; VAR Cmd1: Char;
|
||
VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean);
|
||
VAR
|
||
CmdStr: AStr;
|
||
Ok: Boolean;
|
||
BEGIN
|
||
WITH Scheme DO
|
||
REPEAT
|
||
IF (Cmd1 <> '?') THEN
|
||
BEGIN
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
CLS;
|
||
IF (Editing) THEN
|
||
PrintACR('^5Editing color scheme #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumSchemes))
|
||
ELSE
|
||
PrintACR('^5Inserting color scheme #'+IntToStr(RecNumToEdit)+' of '+IntToStr(NumSchemes + 1));
|
||
NL;
|
||
PrintACR('^11. Description : ^5'+Scheme.Description);
|
||
Prompt('^12. System colors : ');
|
||
ShowColors;
|
||
PrintACR('^13. File listings');
|
||
PrintACR('^14. Message listings');
|
||
PrintACR('^15. File area listings');
|
||
PrintACR('^16. Message area listings');
|
||
PrintACR('^17. Offline mail screen');
|
||
PrintACR('^18. Private mail listing');
|
||
END;
|
||
IF (NOT Editing) THEN
|
||
CmdStr := '12345678'
|
||
ELSE
|
||
CmdStr := '12345678[]FJL';
|
||
LOneK('%LFModify menu [^5?^4=^5Help^4]: ',Cmd1,'Q?'+CmdStr++^M,TRUE,TRUE);
|
||
CASE Cmd1 OF
|
||
'1' : REPEAT
|
||
TempScheme1.Description := Description;
|
||
Ok := TRUE;
|
||
InputWN1('%LFNew description: ',Description,(SizeOf(Description) - 1),[InterActiveEdit],Changed);
|
||
CheckScheme(Scheme,1,1,Ok);
|
||
IF (NOT Ok) THEN
|
||
Description := TempScheme1.Description;
|
||
UNTIL (Ok) OR (HangUp);
|
||
'2' : SystemColors(Scheme,Cmd1,Changed);
|
||
'3' : FileColors(Scheme,Cmd1,Changed);
|
||
'4' : MsgColors(Scheme,Cmd1,Changed);
|
||
'5' : FileAreaColors(Scheme,Cmd1,Changed);
|
||
'6' : MsgAreaColors(Scheme,Cmd1,Changed);
|
||
'7' : QWKColors(Scheme,Cmd1,Changed);
|
||
'8' : EmailColors(Scheme,Cmd1,Changed);
|
||
'[' : IF (RecNumToEdit > 1) THEN
|
||
Dec(RecNumToEdit)
|
||
ELSE
|
||
BEGIN
|
||
Messages(2,0,'');
|
||
Cmd1 := #0;
|
||
END;
|
||
']' : IF (RecNumToEdit < NumSchemes) THEN
|
||
Inc(RecNumToEdit)
|
||
ELSE
|
||
BEGIN
|
||
Messages(3,0,'');
|
||
Cmd1 := #0;
|
||
END;
|
||
'F' : IF (RecNumToEdit <> 1) THEN
|
||
RecNumToEdit := 1
|
||
ELSE
|
||
BEGIN
|
||
Messages(2,0,'');
|
||
Cmd1 := #0;
|
||
END;
|
||
'J' : BEGIN
|
||
InputIntegerWOC('%LFJump to entry?',RecNumToEdit,[NumbersOnly],1,NumSchemes);
|
||
IF (RecNumToEdit < 1) OR (RecNumToEdit > NumSchemes) THEN
|
||
Cmd1 := #0;
|
||
END;
|
||
'L' : IF (RecNumToEdit <> NumSchemes) THEN
|
||
RecNumToEdit := NumSchemes
|
||
ELSE
|
||
BEGIN
|
||
Messages(3,0,'');
|
||
Cmd1 := #0;
|
||
END;
|
||
'?' : BEGIN
|
||
Print('%LF^1<^3CR^1>Redisplay current screen');
|
||
Print('^31^1-^38^1:Modify item');
|
||
IF (NOT Editing) THEN
|
||
LCmds(20,3,'Quit and save','')
|
||
ELSE
|
||
BEGIN
|
||
LCmds(20,3,'[Back entry',']Forward entry');
|
||
LCmds(20,3,'First entry in list','Jump to entry');
|
||
LCmds(20,3,'Last entry in list','Quit and save');
|
||
END;
|
||
END;
|
||
END;
|
||
UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp);
|
||
END;
|
||
|
||
PROCEDURE InsertScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToInsertBefore: SmallInt);
|
||
VAR
|
||
User: UserRecordType;
|
||
RecNum,
|
||
RecNumToEdit: SmallInt;
|
||
Ok,
|
||
Changed: Boolean;
|
||
BEGIN
|
||
IF (NumSchemes = MaxSchemes) THEN
|
||
Messages(5,MaxSchemes,'color schemes')
|
||
ELSE
|
||
BEGIN
|
||
RecNumToInsertBefore := -1;
|
||
InputIntegerWOC('%LFColor scheme to insert before',RecNumToInsertBefore,[NumbersOnly],1,(NumSchemes + 1));
|
||
IF (RecNumToInsertBefore >= 1) AND (RecNumToInsertBefore <= (NumSchemes + 1)) THEN
|
||
BEGIN
|
||
Reset(SchemeFile);
|
||
InitSchemeVars(TempScheme1);
|
||
IF (RecNumToInsertBefore = 1) THEN
|
||
RecNumToEdit := 1
|
||
ELSE IF (RecNumToInsertBefore = (NumSchemes + 1)) THEN
|
||
RecNumToEdit := (NumSchemes + 1)
|
||
ELSE
|
||
RecNumToEdit := RecNumToInsertBefore;
|
||
REPEAT
|
||
OK := TRUE;
|
||
EditScheme(TempScheme1,TempScheme1,Cmd1,RecNumToEdit,Changed,FALSE);
|
||
CheckScheme(TempScheme1,1,1,Ok);
|
||
IF (NOT OK) THEN
|
||
IF (NOT PYNQ('%LFContinue inserting color scheme? ',0,TRUE)) THEN
|
||
Abort := TRUE;
|
||
UNTIL (OK) OR (Abort) OR (HangUp);
|
||
IF (NOT Abort) AND (PYNQ('%LFIs this what you want? ',0,FALSE)) THEN
|
||
BEGIN
|
||
Print('%LF[> Inserting color scheme record ...');
|
||
Seek(SchemeFile,FileSize(SchemeFile));
|
||
Write(SchemeFile,Scheme);
|
||
Dec(RecNumToInsertBefore);
|
||
FOR RecNum := ((FileSize(SchemeFile) - 1) - 1) DOWNTO RecNumToInsertBefore DO
|
||
BEGIN
|
||
Seek(SchemeFile,RecNum);
|
||
Read(SchemeFile,Scheme);
|
||
Seek(SchemeFile,(RecNum + 1));
|
||
Write(SchemeFile,Scheme);
|
||
END;
|
||
FOR RecNum := RecNumToInsertBefore TO ((RecNumToInsertBefore + 1) - 1) DO
|
||
BEGIN
|
||
Seek(SchemeFile,RecNum);
|
||
Write(SchemeFile,TempScheme1);
|
||
Inc(NumSchemes);
|
||
SysOpLog('* Inserted color scheme: ^5'+TempScheme1.Description);
|
||
END;
|
||
END;
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
Inc(RecNumToInsertBefore);
|
||
Print('%LFUpdating user records ...');
|
||
Reset(UserFile);
|
||
RecNum := 1;
|
||
WHILE (RecNum < FileSize(UserFile)) DO
|
||
BEGIN
|
||
LoadURec(User,RecNum);
|
||
IF (User.ColorScheme >= RecNumToInsertBefore) THEN
|
||
BEGIN
|
||
Inc(User.ColorScheme);
|
||
SaveURec(User,RecNum);
|
||
END;
|
||
Inc(RecNum);
|
||
END;
|
||
Close(UserFile);
|
||
LastError := IOResult;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
PROCEDURE ModifyScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToEdit: SmallInt);
|
||
VAR
|
||
SaveRecNumToEdit: Integer;
|
||
Ok,
|
||
Changed: Boolean;
|
||
BEGIN
|
||
IF (NumSchemes = 0) THEN
|
||
Messages(4,0,'color schemes')
|
||
ELSE
|
||
BEGIN
|
||
RecNumToEdit := -1;
|
||
InputIntegerWOC('%LFColor scheme to modify',RecNumToEdit,[NumbersOnly],1,NumSchemes);
|
||
IF (RecNumToEdit >= 1) AND (RecNumToEdit <= NumSchemes) THEN
|
||
BEGIN
|
||
SaveRecNumToEdit := -1;
|
||
Cmd1 := #0;
|
||
Reset(SchemeFile);
|
||
WHILE (Cmd1 <> 'Q') AND (NOT HangUp) DO
|
||
BEGIN
|
||
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||
BEGIN
|
||
Seek(SchemeFile,(RecNumToEdit - 1));
|
||
Read(SchemeFile,Scheme);
|
||
SaveRecNumToEdit := RecNumToEdit;
|
||
Changed := FALSE;
|
||
END;
|
||
REPEAT
|
||
Ok := TRUE;
|
||
EditScheme(TempScheme1,Scheme,Cmd1,RecNumToEdit,Changed,TRUE);
|
||
CheckScheme(Scheme,1,1,Ok);
|
||
IF (NOT OK) THEN
|
||
BEGIN
|
||
PauseScr(FALSE);
|
||
IF (RecNumToEdit <> SaveRecNumToEdit) THEN
|
||
RecNumToEdit := SaveRecNumToEdit;
|
||
END;
|
||
UNTIL (Ok) OR (HangUp);
|
||
IF (Changed) THEN
|
||
BEGIN
|
||
Seek(SchemeFile,(SaveRecNumToEdit - 1));
|
||
Write(SchemeFile,Scheme);
|
||
SysOpLog('* Modified color scheme: ^5'+Scheme.Description);
|
||
END;
|
||
END;
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
PROCEDURE PositionScheme(TempScheme1: SchemeRec);
|
||
VAR
|
||
User: UserRecordType;
|
||
RecNumToPosition,
|
||
RecNumToPositionBefore,
|
||
RecNum1,
|
||
RecNum2: SmallInt;
|
||
BEGIN
|
||
IF (NumSchemes = 0) THEN
|
||
Messages(4,0,'color schemes')
|
||
ELSE IF (NumSchemes = 1) THEN
|
||
Messages(6,0,'color schemes')
|
||
ELSE
|
||
BEGIN
|
||
RecNumToPosition := -1;
|
||
InputIntegerWOC('%LFPosition which color scheme',RecNumToPosition,[NumbersOnly],1,NumSchemes);
|
||
IF (RecNumToPosition >= 1) AND (RecNumToPosition <= NumSchemes) THEN
|
||
BEGIN
|
||
Print('%LFAccording to the current numbering system.');
|
||
RecNumToPositionBefore := -1;
|
||
InputIntegerWOC('%LFPosition before which color scheme',RecNumToPositionBefore,[NumbersOnly],1,(NumSchemes + 1));
|
||
IF (RecNumToPositionBefore >= 1) AND (RecNumToPositionBefore <= (NumSchemes + 1)) AND
|
||
(RecNumToPositionBefore <> RecNumToPosition) AND (RecNumToPositionBefore <> (RecNumToPosition + 1)) THEN
|
||
BEGIN
|
||
Print('%LF[> Positioning color scheme record ...');
|
||
Reset(SchemeFile);
|
||
IF (RecNumToPositionBefore > RecNumToPosition) THEN
|
||
Dec(RecNumToPositionBefore);
|
||
Dec(RecNumToPosition);
|
||
Dec(RecNumToPositionBefore);
|
||
Seek(SchemeFile,RecNumToPosition);
|
||
Read(SchemeFile,TempScheme1);
|
||
RecNum1 := RecNumToPosition;
|
||
IF (RecNumToPosition > RecNumToPositionBefore) THEN
|
||
RecNum2 := -1
|
||
ELSE
|
||
RecNum2 := 1;
|
||
WHILE (RecNum1 <> RecNumToPositionBefore) DO
|
||
BEGIN
|
||
IF ((RecNum1 + RecNum2) < FileSize(SchemeFile)) THEN
|
||
BEGIN
|
||
Seek(SchemeFile,(RecNum1 + RecNum2));
|
||
Read(SchemeFile,Scheme);
|
||
Seek(SchemeFile,RecNum1);
|
||
Write(SchemeFile,Scheme);
|
||
END;
|
||
Inc(RecNum1,RecNum2);
|
||
END;
|
||
Seek(SchemeFile,RecNumToPositionBefore);
|
||
Write(SchemeFile,TempScheme1);
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
Inc(RecNumToPosition);
|
||
Inc(RecNumToPositionBefore);
|
||
Print('%LFUpdating user records ...');
|
||
Reset(UserFile);
|
||
RecNum1 := 1;
|
||
WHILE (RecNum1 < FileSize(UserFile)) DO
|
||
BEGIN
|
||
LoadURec(User,RecNum1);
|
||
IF (User.ColorScheme = RecNumToPosition) THEN
|
||
BEGIN
|
||
User.ColorScheme := RecNumToPositionBefore;
|
||
SaveURec(User,RecNum1);
|
||
END
|
||
ELSE IF (User.ColorScheme = RecNumToPositionBefore) THEN
|
||
BEGIN
|
||
User.ColorScheme := RecNumToPosition;
|
||
SaveURec(User,RecNum1);
|
||
END;
|
||
Inc(RecNum1);
|
||
END;
|
||
Close(UserFile);
|
||
LastError := IOResult;
|
||
END;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
PROCEDURE ListSchemes(VAR RecNumToList1: Integer);
|
||
VAR
|
||
NumDone: Integer;
|
||
BEGIN
|
||
IF (RecNumToList1 < 1) OR (RecNumToList1 > NumSchemes) THEN
|
||
RecNumToList1 := 1;
|
||
Abort := FALSE;
|
||
Next := FALSE;
|
||
CLS;
|
||
PrintACR('^0###^4:^3'+PadLeftStr('Description',30)+'^4:^3Colors');
|
||
PrintACR('^4===:==============================:============================');
|
||
Reset(SchemeFile);
|
||
NumDone := 0;
|
||
WHILE (NumDone < (PageLength - 5)) AND (RecNumToList1 >= 1) AND (RecNumToList1 <= NumSchemes)
|
||
AND (NOT Abort) AND (NOT HangUp) DO
|
||
BEGIN
|
||
Seek(SchemeFile,(RecNumToList1 - 1));
|
||
Read(SchemeFile,Scheme);
|
||
WITH Scheme DO
|
||
Prompt('^0'+PadRightInt(RecNumToList1,3)+
|
||
' ^5'+PadLeftStr(Description,30)+
|
||
' ');
|
||
ShowColors;
|
||
Inc(RecNumToList1);
|
||
Inc(NumDone);
|
||
END;
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
IF (NumSchemes = 0) THEN
|
||
Print('*** No color schemes defined ***');
|
||
END;
|
||
|
||
BEGIN
|
||
SaveTempPause := TempPause;
|
||
TempPause := FALSE;
|
||
RecNumToList := 1;
|
||
Cmd := #0;
|
||
REPEAT
|
||
IF (Cmd <> '?') THEN
|
||
ListSchemes(RecNumToList);
|
||
LOneK('%LFColor scheme editor [^5?^4=^5Help^4]: ',Cmd,'QDIMP?'^M,TRUE,TRUE);
|
||
CASE Cmd OF
|
||
^M : IF (RecNumToList < 1) OR (RecNumToList > NumSchemes) THEN
|
||
RecNumToList := 1;
|
||
'D' : DeleteScheme(TempScheme,RecNumToList);
|
||
'I' : InsertScheme(TempScheme,Cmd,RecNumToList);
|
||
'M' : ModifyScheme(TempScheme,Cmd,RecNumToList);
|
||
'P' : PositionScheme(TempScheme);
|
||
'?' : BEGIN
|
||
Print('%LF^1<^3CR^1>Next screen or redisplay current screen');
|
||
Print('^1(^3?^1)Help/First color scheme');
|
||
LCmds(20,3,'Delete color scheme','Insert color scheme');
|
||
LCmds(20,3,'Modify color scheme','Position color scheme');
|
||
LCmds(20,3,'Quit','');
|
||
END;
|
||
END;
|
||
IF (CMD <> ^M) THEN
|
||
RecNumToList := 1;
|
||
UNTIL (Cmd = 'Q') OR (HangUp);
|
||
TempPause := SaveTempPause;
|
||
IF (ThisUser.ColorScheme < 1) OR (ThisUser.ColorScheme > FileSize(SchemeFile)) THEN
|
||
ThisUser.ColorScheme := 1;
|
||
Reset(SchemeFile);
|
||
Seek(SchemeFile,(ThisUser.ColorScheme - 1));
|
||
Read(SchemeFile,Scheme);
|
||
Close(SchemeFile);
|
||
LastError := IOResult;
|
||
END;
|
||
|
||
END.
|