Contributor: ROBERT L. EDWARDS
{ ***** FIRST OFF! The credits and such ***** }
{ Written in Turbo Pascal (TM) v6.0 on 10 May 1991 ( yes, one day) by }
{ Robert L. Edwards. The idea was to make it a little simpler to generate }
{ both ANSI and ASCI bulletins for DOOR programs. I was in the final stages}
{ of a DOOR developement and needed this tool. The idea is to set up a }
{ string with the text you want saved weaved in with your ANSI calls. I }
{ got this idea from the Pheonix Software Group PSG (tm) collection of DOOR }
{ routines named PSGIO(tm). In that collection a routine is called PRINT }
{ and PRINTLN that handle calls from a routine ANSIColor to set the }
{ attributes. This function was not flexible enough for me to use in file }
{ writes (or I am just too stupid?!?). }
{ }
{ !!! THIS CODE IS CONSIDERED PUBLIC DOMAIN !!! }
{ - Please, if you improve on it, upload a copy to my board. I used only }
{ one afternoon to produce this and the code is quite shakey. }
{ }
{ If you find this program usefull (no, I am not going to ask for money }
{ Please call me and let me know (VIA BBS). If enough support and interest }
{ is shown, I will further clean and enhance this program. As it is now }
{ it fits my needs. Any recomendations are greatly appreciated. }
{ Respectfully, }
{ }
{ Robert L. Edwards }
{ RaJE Computer Emirates (RJE) }
{ Box 6725 NSGA }
{ Winter Harbor, ME 04693 }
{ }
{ Call The Force! Demon-Sion BBS @ 1(207)963-2683 USR HST 14400 }
{ or Voice @ 1(207)963-7056 }
Unit Bulletin;
Interface
Uses tpCRT;
Function A_St(FG, BG : Word) : String;
{ - DESCRIPTION: This function takes the WORDs input and translates them }
{ if possible, to ANSI escape sequences. The global }
{ variable ANS (Record type) is checked for repeat requests }
{ and will not duplicate ANSI code. IE: A call to set }
{ colors to YELLOW foreground and BLUE background when }
{ the background (ANS.BG) is already blue will produce }
{ only the YELLOW escapes sequences. If the global ANS.ON }
{ is FALSE, the function will return a NUL string. }
{ - CALLING: YourString := A_St(Yellow + Bold + Blink, Blue); }
{ }
{ Will yield the escape sequence for a bold blinking yellow }
{ foreground on a blue background. Global variable are set for }
{ the allowable ANSI colors. This variables are Mnemonics and }
{ are in no way related to their ANSI escape sequences. For ease}
{ non-conflict the values are duplicate of the TURBO PASCAL }
{ UNIT CRT global declarations. }
{ - RESULTS: This function returns a string of characters equal to the }
{ escape sequences need to reproduce the called foreground }
{ and background collors. If global ANS.ON is FALSE, a NUL }
{ string will be returned. }
{ - CALLED FROM: Your routines. }
{ - VARIABLES: }
{ Type }
{ CAns = Record }
{ Att : Word; Current Attribute }
{ Valid values: }
{ OFF }
{ Blink }
{ Bold }
{ Blink + Bold }
{ FG : Word; Current ForeGround }
{ Valid Values }
{ Black, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ Red, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ Green, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ Yellow, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ Blue, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ Magenta, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ Cyan, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ White, [+ Blink], [+ Bold], [+ Blink + Bold] }
{ BG : WOrd; Current BackGround }
{ Valid Values: }
{ Black }
{ Red }
{ Green }
{ Yellow }
{ Blue }
{ Magenta }
{ Cyan }
{ White }
{ ON : Boolean; Generate ANSI codes? }
{ Valid Values: }
{ True }
{ False }
{ End; }
{ }
{ var }
{ Ans : CAns; Holds current attributes, described above }
{ Const }
{ Esc = #27 + '['; Escape sequence }
{ Off = 50; Off Mnemonic }
{ Bold = 51; Bold Mnemonic }
{ Black = 0; Black Mnemonic, CRT Constant }
{ Red = 4; Red Mnemonic, CRT Constant }
{ Green = 2; Green Mnemonic, CRT Constant }
{ Yellow = 14; Yellow Mnemonic, CRT Constant }
{ Blue = 1; Blue Mnemonic, CRT Constant }
{ Magenta = 5; Magenta Mnemonic, CRT Constant }
{ Cyan = 3; Cyan Mnemonic, CRT Constant }
{ White = 15; White Mnemonic, CRT Constant }
{ Blink = 128; Blink Mnemonic, CRT Constant }
Type
CAns = Record
Att : Word;
FG : Word;
BG : WOrd;
ON : Boolean;
End;
var
Ans : CAns; { Holds Current Information on }
{ Attribute ( Off, Bold, Blink, ETC }
{ ForeGround Color }
{ BackGround Color }
Const
Esc = #27 + '['; { Escape sequence }
Off = 50; { Off Mnemonic }
Bold = 51; { Bold Mnemonic }
Black = 0; { Black Mnemonic, CRT Constant }
Red = 4; { Red Mnemonic, CRT Constant }
Green = 2; { Green Mnemonic, CRT Constant }
Yellow = 14; { Yellow Mnemonic, CRT Constant }
Blue = 1; { Blue Mnemonic, CRT Constant }
Magenta = 5; { Magenta Mnemonic, CRT Constant }
Cyan = 3; { Cyan Mnemonic, CRT Constant }
White = 15; { White Mnemonic, CRT Constant }
Blink = 128; { Blink Mnemonic, CRT Constant }
Nul = 100; { No Change Mnemonic }
Implementation
Function SetATT(A : Word) : String;
Begin
SetAtt := '';
Case A of
Off : If Ans.ATT <> Off then
Begin
SetAtt := '0';
Ans.Att := Off;
Ans.FG := 255;
Ans.BG := 255;
End;
Bold : Case Ans.Att of
Off,
Blink : Begin
SetATT := '1';
Inc(Ans.Att,Bold);
End;
Bold, Bold +
Blink : Begin
End;
Else Begin
SetATT := '1';
Ans.Att := Bold;
End;
End;
Blink : Case Ans.Att of
Off : Begin
SetAtt := '5';
Ans.Att := Blink;
End;
Bold : Begin
SetAtt := '5';
Inc(Ans.Att,Blink);
End;
Blink,
Bold +
Blink : Begin
End;
Else Begin
SetAtt := '5';
Ans.Att := Blink;
End;
End;
Blink +
Bold : Case Ans.ATT of
Off : Begin
SetAtt := '1;5';
Ans.ATT := Blink + Bold;
End;
Blink : Begin
SetAtt := '1';
Ans.ATT := Blink + Bold;
End;
Bold : Begin
SetAtt := '5';
Ans.Att := Blink + Bold;
End;
Blink +
Bold : Begin
End;
Else Begin
SetAtt := '1;5';
Ans.Att := Blink + Bold;
End;
End; { Ans.ATT }
End; { Case A }
End; { SetATT }
Function SetFG(f : word) : string;
Begin
SetFg := '';
If Ans.FG = F then Exit;
Case F of
Black : SetFG := '30';
Red : SetFG := '31';
Green : SetFG := '32';
Yellow : SetFG := '33';
Blue : SetFG := '34';
Magenta: SetFG := '35';
Cyan : SetFG := '36';
White : SetFG := '37';
Else Exit;
End;
Ans.FG := F;
End;
Function SetBG(f : word) : string;
Begin
SetBg := '';
If Ans.BG = F then Exit;
Case F of
Black : SetBG := '40';
Red : SetBG := '41';
Green : SetBG := '42';
Yellow : SetBG := '43';
Blue : SetBG := '44';
Magenta: SetBG := '45';
Cyan : SetBG := '46';
White : SetBG := '47';
Else Exit;
End;
Ans.BG := F;
End;
Function A_St(FG, BG : Word) : String;
Var
T : String;
T2 : String;
T3 : String;
Begin
A_ST := '';
If NOT ANS.ON then Exit;
t := '';
t2 := '';
T3 := '';
Case FG of
100 : Begin; End; { No Change to FG go on to BG }
Off, Bold, Blink, Bold +
Blink : T := SetAtt(FG);
Black, Bold + Black, Blink + Black, Bold + Blink +
Black : Begin
T := SetATT(FG - Black);
T2 := SetFG(Black);
End;
Red, Bold + Red, Blink + Red, Bold + Blink +
Red : Begin
T := SetATT(FG - Red);
T2 := SetFG(Red);
End;
Green, Bold + Green, Blink + Green, Bold + Blink +
Green : Begin
T := SetATT(FG - Green);
T2 := SetFG(Green);
End;
Yellow, Bold + Yellow, Blink + Yellow, Bold + Blink +
Yellow : Begin
T := SetATT(FG - Yellow);
T2 := SetFG(Yellow);
End;
Blue, Bold + Blue, Blink + Blue, Bold + Blink +
Blue : Begin
T := SetATT(FG - Blue);
T2 := SetFG(Blue);
End;
Magenta, Bold + Magenta, Blink + Magenta, Bold + Blink +
Magenta : Begin
T := SetATT(FG - Magenta);
T2 := SetFG(Magenta);
End;
Cyan, Bold + Cyan, Blink + Cyan, Bold + Blink +
Cyan : Begin
T := SetATT(FG - Cyan);
T2 := SetFG(Cyan);
End;
White, Bold + White, Blink + White, Bold + Blink +
White : Begin
T := SetATT(FG - White);
T2 := SetFG(White);
End;
End;
Case BG of
100 : T3 := '';
Black : T3 := SetBG(Black);
Red : T3 := SetBG(Red);
Green : T3 := SetBG(Green);
Yellow : T3 := SetBG(Yellow);
Blue : T3 := SetBG(Blue);
Magenta : T3 := SetBG(Magenta);
Cyan : T3 := SetBG(Cyan);
White : T3 := SetBG(White);
End;
If T + T2 + T3 = '' Then Exit;
If T <> '' Then
Begin
If T2 <> '' Then T := T + ';' + T2;
if T3 <> '' Then T := T + ';' + T3;
End Else
Begin
If T2 <> '' Then
Begin
T := T2;
if T3 <> '' Then T := T + ';' + T3;
End Else
T := T3;
End;
A_ST := Esc + T +'m';
End;
Begin
Ans.Att := 255; { These Values set invalidly on purpose. When the first }
Ans.FG := 255; { call is made, this will FORCE! (pun for Jim and Guy) }
Ans.BG := 255; { them to be set. If I set them at say 0, and the user }
Ans.ON := True; { Called wanting a black backgroun, the function would not}
end. { Return the 40m required because it would think it was }
{ already in black background }