OK! THIS WORKS!! This code works and the Rewrite doesn't work at all!
Rewrite at bottom..
unit Color1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
OleCtrls, isp3, ActiveX,ExtCtrls, Menus, StdCtrls;
type
TAnsiState = Record
CurX,CurY,SavX,SavY,Width,Height,Color : Integer;
Escape,Active
: Boolean;
Temp
: String;
end;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Connect1: TMenuItem;
Image1: TImage;
TCP1: TTCP;
Memo1: TMemo;
procedure Connect1Click(Sender: TObject);
procedure TCP1DataArrival(Sender: TObject; bytesTotal:
Integer);
procedure TCP1Connect(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key:
Char);
procedure Memo1KeyPress(Sender: TObject; var Key:
Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AnsiState : TAnsiState;
Form1: TForm1;
ScrollBack : String;
ScrollBuffer : array [0 .. 200] of String;
ScrollCount : Integer;
implementation
{$R *.DFM}
Procedure UpdateBuffer (Ch : WideChar); // Scroll back buffer Write
var
ina : Integer;
begin
ina := length(ScrollBack) + 1;
Insert(Ch, ScrollBack, ina);
end;
Procedure AddScrollbackLine; // Add to Scroll back buffer array
begin
If ScrollCount = 200 then ScrollCount := 0;
ScrollBuffer[ScrollCount] := ScrollBack;
Inc(ScrollCount);
ScrollBack := '';
end;
Procedure AnsiMoveXY(var loc_string : String); // Moves Cursor Possistion
var
Index : Integer;
Pos : String;
begin
for Index := 1 to length(Loc_String) do
begin
Case Loc_String[Index] of
'0' .. '9' :
Pos := Pos + Loc_String[Index];
';'
: Begin If not(Pos = '') then AnsiState.CurY := StrtoInt(Pos); Pos := '';
end;
end;
end;
If not(Pos = '') then AnsiState.CurX := StrToInt(Pos);
loc_String := '';
AnsiState.Active := False;
AnsiState.Escape := False;
end;
Procedure SetAnsiColor(Index: Integer);
begin
case Index of
7 : InputBox('7','7','7');
0 : Form1.Image1.Canvas.Brush.Color := clBlack;
8 : InputBox('8','8','8');
30 : Form1.Image1.Canvas.Font.Color := clBlack;
31 : Form1.Image1.Canvas.Font.Color := clRed;
32 : Form1.Image1.Canvas.Font.Color := clGreen;
33 : Form1.Image1.Canvas.Font.Color := clYellow;
34 : Form1.Image1.Canvas.Font.Color := clBlue;
35 : Form1.Image1.Canvas.Font.Color := $00ff00ff;
36 : Form1.Image1.Canvas.Font.Color := $0000bbff;
37 : Form1.Image1.Canvas.Font.Color := clWhite;
40 : Form1.Image1.Canvas.Brush.Color := clBlack;
41 : Form1.Image1.Canvas.Brush.Color := $00ff0000;
42 : Form1.Image1.Canvas.Brush.Color := $00006600;
43 : Form1.Image1.Canvas.Brush.Color := $00884400;
44 : Form1.Image1.Canvas.Brush.Color := $00770000;
45 : Form1.Image1.Canvas.Brush.Color := $008800ff;
46 : Form1.Image1.Canvas.Brush.Color := $0000ffff;
47 : Form1.Image1.Canvas.Brush.Color := clWhite;
end;
end;
Procedure AnsiUp (var loc_String:String);
Begin
if loc_String = '' then Dec(AnsiState.CurY) else
AnsiState.CurY := AnsiState.CurY - StrtoINt(loc_String);
Loc_String := '';
AnsiState.Escape := False;
AnsiState.Active := False;
end;
Procedure AnsiDown (Var Loc_String:String);
begin
if loc_String = '' then Inc(AnsiState.CurY) else
AnsiState.CurY := AnsiState.CurY + StrtoInt(loc_String);
Loc_String := '';
AnsiState.Escape := False;
AnsiState.Active := False;
end;
Procedure AnsiLeft (Var Loc_String:String);
begin
if loc_String = '' then Dec(AnsiState.CurX) else
AnsiState.CurX := AnsiState.CurX - StrtoInt(loc_String);
Loc_String := '';
AnsiState.Escape := False;
AnsiState.Active := False;
end;
Procedure AnsiRight (Var Loc_String:String);
begin
if loc_String = '' then Inc(AnsiState.CurX) else
AnsiState.CurX := AnsiState.CurX + StrtoInt(loc_String);
Loc_String := '';
AnsiState.Escape := False;
AnsiState.Active := False;
end;
Procedure AnsiColor(var loc_String :String);
var
Index : Integer;
Pos : String;
begin
for Index := 1 to length(Loc_String) do
begin
Case Loc_String[Index] of
'0' .. '9' :
Pos := Pos + Loc_String[Index];
';'
: Begin SetAnsiColor(StrtoInt(Pos)); Pos := ''; end;
end;//Case
end; // for loop
SetAnsiColor(StrtoInt(Pos));
loc_String := '';
AnsiState.Active := False;
AnsiState.Escape := False;
end; {Procedure}
function AnsiPosX(X : Integer):Integer; forward;
function AnsiPosY(Y : Integer):Integer; forward;
Procedure AnsiFilter(AChar : WideChar);
var
Grr : Trect;
begin
Case AChar of
'0' .. '9',';' : AnsiState.Temp := AnsiState.Temp + AChar;
'H'
: AnsiMoveXY(AnsiState.Temp) ;
'f'
: AnsiMoveXY(AnsiState.Temp) ;
'A'
: AnsiUp(AnsiState.Temp);
'B'
: AnsiDown(AnsiState.Temp);
'C'
: AnsiRight(AnsiState.Temp);
'D'
: AnsiLeft(AnsiState.Temp);
'!'
: Form1.TCP1.SendData(#27#27 + 'ANSI');
//'s'
: {Save Curser Pos};
//'u'
: {Retore Curser pos};
'J'
: begin
Grr.Left := AnsiPosX(0);
Grr.Top := AnsiPosY(0);
Grr.Right := AnsiPosX(85);
Grr.Bottom := AnsiPosY(40);
AnsiState.Active := False;
AnsiState.Escape := False;
Form1.Image1.Canvas.FillRect(Grr); AnsiState.CurX :=0; AnsiState.CurY
:= 0 end;
'K'
: Begin
Form1.Image1.Canvas.TextOut(AnsiPosX(AnsiState.CurX),AnsiPosY(AnsiState.CurY),'
');
AnsiState.Active := False;
AnsiState.Escape := False;
AnsiState.Temp :='';
end;
'm'
: AnsiColor(AnsiState.Temp);
//'l'
: INPUTBOX('A','a','a');
//'p'
: {Error Message explaining no Keyboard Mapping};
else begin AnsiState.Active := False; AnsiState.Escape
:= False; AnsiState.Temp := ''; end;
end;
end;
function AnsiPosX(X : Integer):Integer;
begin
result := X * AnsiState.Width;
end;
function AnsiPosY(Y : Integer):Integer;
begin
Result := (-1 * AnsiState.Height - 1) * y ;
end;
procedure TForm1.Connect1Click(Sender: TObject);
begin
TCP1.RemoteHost := 'BBS.Purenrg.com';
TCP1.Connect(inputbox('Address','Address','Eclipse.ultranet.com'),23);
end;
procedure TForm1.TCP1DataArrival(Sender: TObject; bytesTotal: Integer);
Label 1,2;
var
Data: OleVariant;
Txt : WideString;
Counter : Integer;
A,B : TRect;
begin
TCP1.GetData(Data,VT_BSTR, bytesTotal);
txt := Data;
for Counter := 1 to length(txt) do
If AnsiState.Active then AnsiFilter(txt[Counter]) else
case txt[Counter] of
Char(27): AnsiState.Escape
:= True;
'['
: If AnsiState.Escape Then AnsiState.Active := True else Goto 1;
Char(7) : Beep;
Char(8) : begin
if AnsiState.CurX = 0 then Beep else
Dec(AnsiState.CurX); end;
Char(10): begin; Inc(AnsiSTate.CurY);
end;
Char(13): begin AnsiState.CurX
:= 0; AddScrollbackLine; end;
else
begin
1 :
UpdateBuffer(txt[Counter]);
Image1.Canvas.TextOut(AnsiPosX(AnsiState.CurX),AnsiPosY(AnsiState.CurY),txt[Counter]);
If AnsiState.CurX
= 80 then begin Inc(AnsiState.CurY); AnsiState.CurX := 0 end
else Inc(AnsiState.CurX);
If AnsiState.CurY >
30 then begin
Dec(AnsiState.CurY);
A.Left := AnsiPosX(0);
A.Top := AnsiPosY(1);
A.Right := AnsiPosX(85);
A.Bottom := AnsiPosY(35);
B.Left := AnsiPosX(0);
B.Top
:= AnsiPosY(0);
B.Right :=
AnsiPosX(85);
B.Bottom :=
AnsiPosY(34);
Image1.Canvas.CopyRect(B,Image1.Canvas,A);
2 :
end;
end;
end;
end;
procedure TForm1.TCP1Connect(Sender: TObject);
begin
Image1.Canvas.TextOut(10,10,'Connected');
end;
procedure TForm1.FormCreate(Sender: TObject);
Var
A : Integer;
begin
ScrollCount := 0;
Image1.Canvas.Font.Name := 'Terminal';
Image1.Canvas.Font.Size := 10;
Image1.Canvas.Font.Color := clWhite;
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.FloodFill(3, 3, clBlack, fsBorder);
with AnsiState do
begin
CurX := 0;
CurY := 0;
Width := Form1.Image1.Canvas.TextWidth('A');
Height := Form1.Image1.Canvas.Font.Height;
Active := False;
Escape := False;
Temp := '';
end;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
Var
A : Integer;
begin
if key = ';' then
begin
Memo1.Visible := True;
Memo1.Text := '';
For A := 0 to 200 do Memo1.Lines.Add(ScrollBuffer[A]);
end
else
If TCP1.State = 7 then TCP1.SendData(Key);
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = ';' then Memo1.Visible := False;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, ExtCtrls, ActiveX, Menus, OleCtrls, isp3;
type
TAnsi = record
X,Y,SavX,SavY
: ShortInt;
Width,Height
: SmallInt; // Used to Vector Display
Escape,Active,Bold,On : Boolean;
MoveA,MoveB,AllDisp : TRect;
Temp
: String;
end;
TBuffer = record // Initiualized in
Count : ShortInt; // Limits Buffer to a range of -128 .. 128
Lines : Array [-128 .. 128] of Ansistring;
Buffer : AnsiString;
Wrap : Boolean; // Tells if loop Starts
end;
TForm2 = class(TForm)
Image: TImage;
Memo: TMemo;
TCP1: TTCP;
PopupMenu: TPopupMenu;
MScrollBack: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MScrollBackClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key:
Char);
procedure MemoKeyPress(Sender: TObject; var Key:
Char);
procedure TCP1Connect(Sender: TObject);
procedure TCP1DataArrival(Sender: TObject; bytesTotal:
Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Ansi : TAnsi;
Buffer : TBuffer;
Form2 : TForm2;
implementation
{$R *.DFM}
{ First to Functions Ansi2Dis are used to convert the Ansi Screen Possistion
to Display Canvas screen possistion for writing text on Canvas
}
function Ansi2DisX(X : SmallInt):Integer;
begin
Result := X * Ansi.Width;
end; // End Fucntion Ansi2DisX
function Ansi2DisY(Y : SmallInt):Integer;
begin
Result := -1 * ( Ansi.Height * (Y -
1));
end; // End Function Ansi2DisY
Procedure TForm2.FormCreate(Sender: TObject);
begin
// ####### Buffer Var Initualized .. Count limited to -128 to 128
Buffer.Count := -128;
Buffer.Wrap := False;
Buffer.Buffer := '';
// ####### Ansi Possistioning Initualized
Image.Canvas.Font.Name := 'Terminal';
Image.Canvas.Font.Pitch := fpFixed;
Image.Canvas.Font.Size := 10;
Image.Canvas.Font.Color := clWhite;
Image.Canvas.Brush.Color := clBlack;
With Ansi do
begin
on
:= True;
X
:= 0;
Y
:= 0;
Escape
:= False;
Active
:= False;
Temp := '';
// Used for AnsiFilter
AllDisp.Left
:= Ansi2DisX(0); // Used for Clear Display Function
AllDisp.Top
:= Ansi2DisY(0);
AllDisp.Right
:= Ansi2DisX(85);
AllDisp.Bottom
:= Ansi2DisY(35);
MoveA.Left :=
Ansi2DisX(0); // Used for Moving down a line
MoveA.Top :=
Ansi2DisY(1);
MoveA.Right
:= Ansi2DisX(85);
MoveA.Bottom
:= Ansi2DisY(35);
MoveB.Left :=
Ansi2DisX(0);
MoveB.Top :=
Ansi2DisY(0);
MoveB.Right
:= Ansi2DisX(85);
MoveB.Bottom
:= Ansi2DisY(34);
Width := Form2.Image.Canvas.TextWidth('A');
{Neg #} Height := Form2.Image.Canvas.Font.Height;
end; // END With Ansi
// Display Canvas Initualized
end; // END Tform2.FormCreate
Procedure FillMemoBox;
var
Counter : SmallInt;
begin
Form2.Memo.Clear;
If Buffer.Wrap then begin
For Counter := Buffer.Count to 128 do Form2.Memo.Lines.Add(Buffer.Lines[Counter]);
For Counter := -128 to (Buffer.Count -1) do Form2.Memo.Lines.Add(Buffer.Lines[Counter]);
end
else for Counter := -128 to Buffer.Count do Form2.Memo.Lines.Add(Buffer.Lines[Counter]);
end; // Procedure FillMemoBox
Procedure UpDateBuffer;
begin
Buffer.Lines[Buffer.Count] := Buffer.Buffer;
Inc(Buffer.Count);
Buffer.Buffer := '';
if Buffer.Count = 128 then
begin Buffer.Count := -128;
Buffer.Wrap := True end; // End If
end;
Procedure WriteText (Loc_Char : Char);
Begin
Form2.Canvas.TextOut(Ansi2DisX(Ansi.X),Ansi2DisY(Ansi.Y),loc_Char);
Inc(Ansi.X);
If Ansi.X > 80 then
begin
Ansi.X := 0;
Inc(Ansi.Y);
end; // End if AnsiX (This is word wrap)
if Ansi.Y > 35 then
begin
Form2.Image.Canvas.CopyRect(Ansi.MoveB,Form2.Image.Canvas,Ansi.MoveA);
Dec(Ansi.Y);
end; // End if AnsiY (Line Scroll)
Insert(Loc_Char,Buffer.Buffer,(Length(Buffer.Buffer) + 1));
end; // End WriteText
Procedure Write2Display(DataString : String);
Var
Index : Integer;
Procedure FilterAnsi(Filt_Char : Char);
procedure CursorPos(var
loc_String : String); //Used to move Charactor
var
CursorPos_Index : SmallInt;
loc_Pos : String;
begin
loc_Pos := '';
for CursorPos_Index := 1 to Length(Loc_String) do
case loc_String[Cursorpos_Index] of
'0' .. '9' : Loc_Pos := loc_Pos + loc_String[Cursorpos_Index];
';' : Begin
if not(Loc_Pos = '') then Ansi.Y := StrtoInt(Loc_Pos);
Loc_Pos := '';
end; // ';'
end; // Case Loc_String
if not(Loc_Pos = '') then Ansi.X := StrtoInt(Loc_Pos);
Ansi.Escape := False;
Ansi.Active := False;
Loc_String := '';
end; // END PROCUDURE CursorPos
procedure CursorUp(var
loc_String : String); //Used to move Charactor
begin
if loc_String = '' then Dec(Ansi.Y) else Ansi.Y := Ansi.Y - StrtoInt(loc_String);
if Ansi.Y < 0 then Ansi.Y := 0;
loc_String := '';
Ansi.Active := False;
Ansi.Escape := False;
end; // End CursorUp
procedure CursorDown(var
loc_String : String); //Used to move Charactor
begin
if loc_String = '' then Inc(Ansi.Y) else Ansi.Y := Ansi.Y + StrtoInt(loc_String);
loc_String := '';
Ansi.Active := False;
Ansi.Escape := False;
end; // End CursorUp
procedure CursorLeft(var
loc_String : String); //Used to move Charactor
begin
if loc_String = '' then Dec(Ansi.X) else Ansi.X := Ansi.X - StrtoInt(loc_String);
if Ansi.X < 0 then Ansi.Y := 0;
loc_String := '';
Ansi.Active := False;
Ansi.Escape := False;
end; // End CursorUp
procedure CursorRight(var
loc_String : String); //Used to move Charactor
begin
if loc_String = '' then Inc(Ansi.X) else Ansi.X := Ansi.X + StrtoInt(loc_String);
loc_String := '';
Ansi.Active := False;
Ansi.Escape := False;
end; // End CursorUp
procedure SavePos;
begin
Ansi.SavX := Ansi.X;
Ansi.SavY := Ansi.Y;
Ansi.Temp := '';
Ansi.Active := False;
Ansi.Escape := False;
end; // End SavePos
procedure restorepos;
begin
Ansi.X := Ansi.SavX;
Ansi.Y := Ansi.SavY;
Ansi.Temp := '';
Ansi.Active := False;
Ansi.Escape := False;
end; //end Restorepos
procedure ClearDisplay;
begin
Ansi.Active := False;
Ansi.Escape := False;
Ansi.X := 0;
Ansi.Y := 0;
Form2.Image.Canvas.FillRect(Ansi.AllDisp);
end;
procedure ClearLine;
var
loc_String :
String;
Count
: SmallInt;
begin
loc_String := ' ';
Ansi.Active := False;
Ansi.Escape := False;
Ansi.Temp := '';
For Count := Ansi.X to 80 do Insert(' ',loc_String,1);
Form2.Image.Canvas.TextOut(Ansi2DisX(Ansi.X),Ansi2DisY(Ansi.Y),loc_String);
end;
procedure Setcolor(var
loc_String: String);
var
INDEX
: SmallInt;
loc_pos
: ShortString;
procedure loc_Setcolor;
begin
Case StrtoInt(loc_pos) of
0 : Begin
Ansi.Bold := False;
Form2.Image.Canvas.Font.Color := clWhite;
Form2.Image.Canvas.Brush.Color := clBlack;
end; // 0 End Attributes Off
1 : Ansi.Bold := True;
{BLACK} 30 : Form2.Image.Canvas.Font.Color
:= clBlack;
{RED} 31 : If Ansi.Bold
then Form2.Image.Canvas.Font.Color := $000000FF else Form2.Image.Canvas.Font.Color
:= $00000088;
{GREEN} 32 : If Ansi.Bold
then Form2.Image.Canvas.Font.Color := $0000FF00 else Form2.Image.Canvas.Font.Color
:= $00008800;
{YELLOW} 33 : If Ansi.Bold
then Form2.Image.Canvas.Font.Color := $00000FF0 else Form2.Image.Canvas.Font.Color
:= $00000880;
{BLUE} 34 : If Ansi.Bold
then Form2.Image.Canvas.Font.Color := $00FF0000 else Form2.Image.Canvas.Font.Color
:= $00880000;
35 : If Ansi.Bold then Form2.Image.Canvas.Font.Color := $00F000F0 else
Form2.Image.Canvas.Font.Color := $00800080;
36 : If Ansi.Bold then Form2.Image.Canvas.Font.Color := $000F000F else
Form2.Image.Canvas.Font.Color := $00080008;
37 : If Ansi.Bold then Form2.Image.Canvas.Font.Color := $00FFFFFF else
Form2.Image.Canvas.Font.Color := $00888888;
40 : Form2.Canvas.Brush.Color := clBlack;
41 : Form2.Canvas.Brush.Color := $00000088;
42 : Form2.Canvas.Brush.Color := $00008800;
43 : Form2.Canvas.Brush.Color := $00000880;
44 : Form2.Canvas.Brush.Color := $00880000;
45 : Form2.Canvas.Brush.Color := $00800080;
46 : Form2.Canvas.Brush.Color := $00080008;
47 : Form2.Canvas.Brush.Color := $00888888;
end; // Case End;
loc_pos := '';
end; //loc_Setcolor End
begin
loc_pos := '';
for INDEX := 1 to length(Loc_String) do
case Loc_String[Index] of
'0' .. '9' : loc_pos := loc_Pos + loc_String[Index];
';' : loc_setcolor;
end; // Case End;
loc_Setcolor;
loc_String := '';
Ansi.Active := False;
Ansi.Escape := False;
end; // PROCEDURE
SET COLOR
begin // Ansi Filter Start
Case Filt_Char of
'0' .. '9',';' : Insert(Filt_Char,Ansi.Temp,(Length(Ansi.Temp) + 1));
'H' :
CursorPos(Ansi.Temp);
'f' :
CursorPos(Ansi.Temp);
'A' :
CursorUp(Ansi.Temp);
'B' :
CursorDown(Ansi.Temp);
'D' :
CursorLeft(Ansi.Temp);
'C' :
CursorRight(Ansi.Temp);
's' :
SavePos;
'u' :
RestorePos;
'J' :
ClearDisplay;
'K' :
ClearLine;
'm' :
SetColor(Ansi.Temp);
else begin
Ansi.Temp := '';
Ansi.Escape := False;
Ansi.Active := False;
end; //end else
end; // End Case Filt_Char
end; // End Ansi Filter
procedure FilterText(loc_String : Char);
begin
Case loc_String of
Char(7) : Beep;
Char(8) : if Ansi.X = 0 then beep else Dec(Ansi.X);
Char(10) : begin Inc(Ansi.Y); UpdateBuffer; end;
Char(13) : Ansi.X := 0;
Char(27) : if Ansi.on then Ansi.Escape := True;
'[' : if Ansi.Escape = true then Ansi.Active
:= true else Writetext(loc_String);
else begin WriteText(loc_String); If Ansi.Escape = True then Ansi.Escape
:= False; end; // End Else
end; // end of Case Loc_String
end; //
End Procedure FilterText
BEGIN // BEGIN WRITE 2 DISPLAY
For Index := 1 to length(DataString)
do
begin
If Ansi.Active and Ansi.Escape then FilterAnsi(DataString[Index]) else
FilterText(DataString[Index]);
end; // FOR INDEX
DATASTRING Loop
END; // END PROCEDURE Write2Display
procedure TForm2.MScrollBackClick(Sender: TObject);
begin
If Memo.Visible then Memo.Visible := False else
begin
Memo.Visible := True;
FillMemoBox;
end; //If Memo.Visible
end; // End TformMScrollbackClick
procedure TForm2.FormKeyPress(Sender: TObject; var Key: Char);
begin
Case Key of
';' : PopupMenu.Popup(100,100);
else if TCP1.State = 7 then TCP1.SendData(Key);
end; //Case Key of
end;
// Tform2.Formkeypress
procedure TForm2.MemoKeyPress(Sender: TObject; var Key: Char);
begin
PopupMenu.Popup(200,200);
end;
procedure TForm2.TCP1Connect(Sender: TObject);
begin
Form2.Visible := True;
end;
procedure TForm2.TCP1DataArrival(Sender: TObject; bytesTotal: Integer);
var
TCP_String : OleVariant;
begin
TCP1.GetData(TCP_String,VT_BSTR, bytesTotal);
Write2Display(TCP_String);
end;
end.
>Am I missing some code that I didn't see in the
>book?
Perhaps it's a matter of the properties, not a matter of code. AFAIR some
property exists, that tells the control to remember it's contents. Compare the
form declaration in Text format, to find possible differences in the settings
of the properties and event handlers.
DoDi