unit ScreenClass;
{==============================================================================}
{$mode objfpc}{$H+}
interface
{==============================================================================}
uses
Video;
{==============================================================================}
type
TScreen = class
private
FVideoMode : TVideoMode;
FCursorX,
FCursorY : Word;
protected
procedure SetCursorX(AX : Word);
procedure SetCursorY(AY : Word);
function GetCursorX : Word;
function GetCursorY : Word;
public
constructor Create(AWidth, AHeight : Word);
destructor Destroy; override;
public
procedure Clear;
procedure Update;
procedure WriteXY(AX, AY : Word; const Text : String);
public
property CursorX : Word read GetCursorX write SetCursorX;
property CursorY : Word read GetCursorY write SetCursorY;
end;
{==============================================================================}
implementation
{==============================================================================}
{-- private -------------------------------------------------------------------}
{-- protected -----------------------------------------------------------------}
procedure TScreen.SetCursorX(AX : Word);
begin
FCursorX := AX;
CursorX := AX;
SetCursorPos(FCursorX, FCursorY);
end;
{------------------------------------------------------------------------------}
procedure TScreen.SetCursorY(AY : Word);
begin
FCursorY := AY;
CursorY := AY;
SetCursorPos(FCursorX, FCursorY);
end;
{------------------------------------------------------------------------------}
function TScreen.GetCursorX : Word;
begin
result := FCursorX;
end;
{------------------------------------------------------------------------------}
function TScreen.GetCursorY : Word;
begin
result := FCursorY;
end;
{-- public --------------------------------------------------------------------}
constructor TScreen.Create(AWidth, AHeight : Word);
begin
inherited Create;
InitVideo;
FVideoMode.Col := AWidth;
FVideoMode.Row := AHeight;
FVideoMode.Color := True;
SetVideoMode(FVideoMode);
FCursorX := CursorX;
FCursorY := CursorY;
end;
{------------------------------------------------------------------------------}
destructor TScreen.Destroy;
begin
DoneVideo;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TScreen.Clear;
begin
ClearScreen;
end;
{------------------------------------------------------------------------------}
procedure TScreen.Update;
begin
UpdateScreen(false);
end;
{------------------------------------------------------------------------------}
procedure TScreen.WriteXY(AX, AY : Word; const Text : String);
var
P,I,M : Word;
begin
LockScreenUpdate;
P := ((AX - 1) + (AY - 1) * ScreenWidth);
M := Length(Text);
If P + M > ScreenWidth * ScreenHeight then
M := ScreenWidth * ScreenHeight - P;
For I := 1 to M do
VideoBuf^[P+I-1]:=Ord(Text[I])+($07 shl 8);
UnlockScreenUpdate;
end;
{==============================================================================}
end.
unit WindowClass;
{==============================================================================}
{$mode objfpc}{$H+}
{==============================================================================}
interface
{==============================================================================}
uses
ScreenClass;
{==============================================================================}
type
TBorderEnum = (LeftTop, RightTop, RightBottom, LeftBottom, Horizontal, Vertical);
TBorderType = (NoBorder, SingleBorder, DoubleBorder);
TWindowBuffer = array of Char;
{------------------------------------------------------------------------------}
type
TWindow = class
private
FLeft,
FTop,
FWidth,
FHeight : Byte;
FBorderType : TBorderType;
FTitle : string;
FOwner : TScreen;
FWindowBuffer : TWindowBuffer;
protected
procedure SetTitle(ATitle : string);
procedure SetWidth(AWidth : Byte);
procedure SetHeight(AHeight : Byte);
procedure SetBorderType(ABorderType : TBorderType);
procedure DrawBorder;
public
constructor Create(ALeft, ATop, AWidth, AHeight : Byte; ABorderType : TBorderType; ATitle : String; var AOwner : TScreen);
destructor Destroy; override;
public
procedure WriteXY(AX, AY : Byte; const AString : String);
procedure Draw;
public
property Title : String read FTitle write SetTitle;
property Top : Byte read FTop write FTop;
property Left : Byte read FLeft write FLeft;
property Width : Byte read FWidth write SetWidth;
property Height : Byte read FHeight write SetHeight;
property BorderType : TBorderType read FBorderType write SetBorderType;
end;
{==============================================================================}
const
BorderArr : array[TBorderType, TBorderEnum] of Char = ((' ', ' ', ' ', ' ', ' ', ' '),
(#218, #191, #217, #192, #196, #179),
(#201, #187, #188, #200, #205, #186));
{==============================================================================}
implementation
{==============================================================================}
{-- private -------------------------------------------------------------------}
{-- protected -----------------------------------------------------------------}
procedure TWindow.SetTitle(ATitle : String);
begin
FTitle := ' ' + ATitle + ' ';
end;
{------------------------------------------------------------------------------}
procedure TWindow.SetWidth(AWidth : Byte);
begin
FWidth := AWidth;
SetLength(FWindowBuffer, FWidth * FHeight);
DrawBorder;
end;
{------------------------------------------------------------------------------}
procedure TWindow.SetHeight(AHeight : Byte);
begin
FHeight := AHeight;
SetLength(FWindowBuffer, FWidth * FHeight);
DrawBorder;
end;
{------------------------------------------------------------------------------}
procedure TWindow.SetBorderType(ABorderType : TBorderType);
begin
FBorderType := ABorderType;
end;
{------------------------------------------------------------------------------}
procedure TWindow.DrawBorder;
var
i : byte;
begin
//Rysowanie obramowania
// Lewy gówny róg.
FWindowBuffer[0] := BorderArr[FBorderType, LeftTop];
// Prawy górny róg.
FWindowBuffer[FWidth - 1] := BorderArr[FBorderType, RightTop];
// Lewy dolny róg.
FWindowBuffer[(FHeight - 1) * FWidth] := BorderArr[FBorderType, LeftBottom];
// Prawy dolny róg.
FWindowBuffer[(FHeight - 1) * FWidth + FWidth - 1] := BorderArr[FBorderType, RightBottom];
// Poziome obramowanie
for i := 1 to FWidth - 2 do
begin
// Górna krawędź.
FWindowBuffer[i] := BorderArr[FBorderType, Horizontal];
// Dolna krawędź.
FWindowBuffer[(FHeight - 1) * FWidth + i] := BorderArr[FBorderType, Horizontal];
end;
// Pionowe obramowanie
for i := 1 to FHeight - 2 do
begin
// Lewa krawędź
FWindowBuffer[i * FWidth] := BorderArr[FBorderType, Vertical];
// Prawa krawędź.
FWindowBuffer[i * FWidth + FWidth - 1] := BorderArr[FBorderType, Vertical];
end;
// Wstawianie tytułu.
for i := 1 to Length(FTitle) do
FWindowBuffer[FWidth div 2 - 2 - Length(FTitle) div 2 + i] := FTitle[i];
end;
{-- public --------------------------------------------------------------------}
constructor TWindow.Create(ALeft, ATop, AWidth, AHeight : Byte; ABorderType : TBorderType; ATitle : String; var AOwner : TScreen);
begin
// Przypisanie wartości początkowych polom klasy
FLeft := ALeft;
FTop := ATop;
FWidth := AWidth;
FHeight := AHeight;
FBorderType := ABorderType;
FTitle := ' ' + ATitle + ' ';
FOwner := AOwner;
// Ustawienie wielkości bufora okna
SetLength(FWindowBuffer, FWidth * FHeight);
DrawBorder;
end;
{------------------------------------------------------------------------------}
destructor TWindow.Destroy;
begin
SetLength(FWindowBuffer, 0);
FOwner := nil;
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TWindow.WriteXY(AX, AY : Byte; const AString : String);
var
i, j : Byte;
BorderPosition : Word;
begin
if AY = 0 then
Inc(AY);
if AX = 0 then
Inc(AX);
j := AY * FWidth + AX;
BorderPosition := FWidth - 1;
for i := 1 to Length(AString) do
begin
if i = BorderPosition then
begin
Inc(j, 2);
BorderPosition := BorderPosition + (FWidth - 2);
end;
FWindowBuffer[j] := AString[i];
Inc(j);
end;
end;
{------------------------------------------------------------------------------}
procedure TWindow.Draw;
var
i : Word;
begin
for i := 0 to Length(FWindowBuffer) - 1 do
FOwner.WriteXY(i mod FWidth + FLeft, i div FWidth + FTop, FWindowBuffer[i]);
end;
{==============================================================================}
end.
Kod jest dopiero w fazie pisania jest to alfa alfy alfy alfy alfy. Więc może być tam sporo mindfucków.
A dokładnie chodzi mi o metodę TWindow.Draw gdzie FOwner ma być albo oknem nadrzędnym albo ekranem.