From d81443f7f44756733bbb8e12fdb906ec441ef106 Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Thu, 24 Jan 2013 15:44:47 -0500 Subject: [PATCH] Initial import scrollback class extends generic tOutput layer --- mdl/m_output_scrollback.pas | 116 ++++++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 mdl/m_output_scrollback.pas diff --git a/mdl/m_output_scrollback.pas b/mdl/m_output_scrollback.pas new file mode 100644 index 0000000..0133c01 --- /dev/null +++ b/mdl/m_output_scrollback.pas @@ -0,0 +1,116 @@ +Unit m_Output_ScrollBack; + +{$I M_OPS.PAS} + +Interface + +Uses + m_Types, + m_Output; + +Const + MaxScrollBufferSize = 1000; + +Type + TConsoleScrollback = Class(TOutput) + ScrollBuf : Array[1..MaxScrollBufferSize] of TConsoleLineRec; + ScrollPos : SmallInt; + Capture : Boolean; + + Constructor Create (A: Boolean); + Destructor Destroy; Override; + + Procedure ClearBuffer; + Procedure AddLine (Line: Word); + Function IsBlankLine (Line: Word) : Boolean; + Procedure ClearScreen; Override; + Procedure ScrollWindow; Override; + End; + +Implementation + +Constructor TConsoleScrollback.Create (A: Boolean); +Begin + Inherited Create(A); + + ClearBuffer; + + Capture := False; +End; + +Destructor TConsoleScrollback.Destroy; +Begin + Inherited Destroy; +End; + +Procedure TConsoleScrollback.ClearBuffer; +Var + Count1 : LongInt; + Count2 : LongInt; +Begin + ScrollPos := 0; + + For Count1 := 1 to MaxScrollBufferSize Do + For Count2 := 1 to 80 Do Begin + ScrollBuf[Count1][Count2].Attributes := 7; + ScrollBuf[Count1][Count2].UnicodeChar := ' '; + End; +End; + +Procedure TConsoleScrollback.AddLine (Line: Word); +Begin + If ScrollPos = MaxScrollBufferSize Then Begin + Move(ScrollBuf[2][1], ScrollBuf[1][1], SizeOf(TConsoleLineRec) * (MaxScrollBufferSize - 1)); + Dec(ScrollPos); + End; + + Inc (ScrollPos); + Move (Buffer[Line][1], ScrollBuf[ScrollPos][1], SizeOf(TConsoleLineRec)); +End; + +Function TConsoleScrollback.IsBlankLine (Line: Word) : Boolean; +Var + Count : LongInt; +Begin + Result := True; + + For Count := 1 to 80 Do + If (Buffer[Line][Count].UnicodeChar <> #0) and ((Buffer[Line][Count].UnicodeChar <> ' ') and (Buffer[Line][Count].Attributes <> 7)) Then Begin + Result := False; + Exit; + End; +End; + +Procedure TConsoleScrollback.ClearScreen; +Var + Line : LongInt; + Count : LongInt; +Begin + If Capture Then Begin + {$IFDEF WIN32} + Line := Window.Bottom + 1; + {$ELSE} + Line := FWinBot; + {$ENDIF} + + While Line > 0 Do Begin + If Not IsBlankLine(Line) Then Break; + Dec(Line); + End; + + If Line <> 0 Then + For Count := 1 to Line Do + AddLine(Count); + End; + + Inherited ClearScreen; +End; + +Procedure TConsoleScrollBack.ScrollWindow; +Begin + If Capture Then AddLine(1); + + Inherited ScrollWindow; +End; + +End.