mirror of
https://github.com/vapaamies/KolibriOS.git
synced 2025-09-22 15:13:49 +02:00
CRT unit made more compatible with Turbo/FreePascal one
This commit is contained in:
@@ -39,7 +39,7 @@ begin
|
|||||||
TextBackground(White);
|
TextBackground(White);
|
||||||
WriteLn('White');
|
WriteLn('White');
|
||||||
|
|
||||||
ResetAttributes;
|
NormVideo;
|
||||||
|
|
||||||
TextColor(Black);
|
TextColor(Black);
|
||||||
WriteLn('Black');
|
WriteLn('Black');
|
||||||
|
@@ -4,29 +4,25 @@ uses
|
|||||||
KolibriOS, CRT;
|
KolibriOS, CRT;
|
||||||
|
|
||||||
var
|
var
|
||||||
SystemDate: TSystemDate;
|
CursorXY: TCursorXY;
|
||||||
SystemTime: TSystemTime;
|
|
||||||
CursorPos: TConsolePoint;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
InitConsole('Date/Time');
|
InitConsole('Date/Time');
|
||||||
|
|
||||||
SetCursorHeight(0);
|
CursorOff;
|
||||||
SetCursorPos(27, 11);
|
GotoXY(27, 11);
|
||||||
Write(
|
Write(
|
||||||
'System Date and System Time'#10 +
|
'System Date and System Time'#10 +
|
||||||
' '
|
' '
|
||||||
);
|
);
|
||||||
CursorPos := GetCursorPos;
|
CursorXY := WhereXY;
|
||||||
repeat
|
repeat
|
||||||
SystemDate := GetSystemDate;
|
with GetSystemDate, GetSystemTime do
|
||||||
SystemTime := GetSystemTime;
|
|
||||||
with SystemDate, SystemTime do
|
|
||||||
begin
|
begin
|
||||||
Write('%02x.%02x.%02x', Day, Month, Year);
|
Write('%02x.%02x.%02x', Day, Month, Year);
|
||||||
Write(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
|
Write(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
|
||||||
end;
|
end;
|
||||||
SetCursorPos(CursorPos);
|
GotoXY(CursorXY);
|
||||||
Sleep(50);
|
Delay(500);
|
||||||
until KeyPressed;
|
until KeyPressed;
|
||||||
end.
|
end.
|
||||||
|
@@ -9,7 +9,6 @@ var
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
InitConsole('Load File', False);
|
InitConsole('Load File', False);
|
||||||
|
|
||||||
Buffer := LoadFile('/sys/example.asm', FileSize);
|
Buffer := LoadFile('/sys/example.asm', FileSize);
|
||||||
WriteText(Buffer, FileSize);
|
WriteText(Buffer, FileSize);
|
||||||
end.
|
end.
|
||||||
|
86
Lib/CRT.pas
86
Lib/CRT.pas
@@ -1,3 +1,7 @@
|
|||||||
|
(*
|
||||||
|
KolibriOS CRT unit
|
||||||
|
*)
|
||||||
|
|
||||||
unit CRT;
|
unit CRT;
|
||||||
|
|
||||||
interface
|
interface
|
||||||
@@ -6,8 +10,8 @@ uses
|
|||||||
KolibriOS;
|
KolibriOS;
|
||||||
|
|
||||||
type
|
type
|
||||||
TConsolePoint = record
|
TCursorXY = record
|
||||||
X, Y: Integer;
|
X, Y: LongWord;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
const
|
const
|
||||||
@@ -31,11 +35,13 @@ const
|
|||||||
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean = True;
|
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean = True;
|
||||||
WndWidth: LongWord = $FFFFFFFF; WndHeight: LongWord = $FFFFFFFF; ScrWidth: LongWord = $FFFFFFFF; ScrHeight: LongWord = $FFFFFFFF);
|
WndWidth: LongWord = $FFFFFFFF; WndHeight: LongWord = $FFFFFFFF; ScrWidth: LongWord = $FFFFFFFF; ScrHeight: LongWord = $FFFFFFFF);
|
||||||
|
|
||||||
function GetCursorPos: TConsolePoint;
|
procedure GotoXY(X, Y: Integer); overload;
|
||||||
procedure SetCursorPos(X, Y: Integer); overload;
|
procedure GotoXY(const Point: TCursorXY); overload;
|
||||||
procedure SetCursorPos(const Point: TConsolePoint); overload;
|
function WhereX: Integer;
|
||||||
|
function WhereY: Integer;
|
||||||
|
function WhereXY: TCursorXY;
|
||||||
|
|
||||||
procedure ResetAttributes;
|
procedure NormVideo; // reset text attributes
|
||||||
procedure TextAttribute(Color, Background: Integer);
|
procedure TextAttribute(Color, Background: Integer);
|
||||||
procedure TextBackground(Color: Integer);
|
procedure TextBackground(Color: Integer);
|
||||||
procedure TextColor(Color: Integer);
|
procedure TextColor(Color: Integer);
|
||||||
@@ -43,10 +49,16 @@ procedure TextColor(Color: Integer);
|
|||||||
function WriteLn(LineBreaks: Integer = 1): LongInt; overload;
|
function WriteLn(LineBreaks: Integer = 1): LongInt; overload;
|
||||||
function WriteLn(Text: PKolibriChar; LineBreaks: Integer = 1): LongInt; overload;
|
function WriteLn(Text: PKolibriChar; LineBreaks: Integer = 1): LongInt; overload;
|
||||||
|
|
||||||
|
function CursorBig: LongWord;
|
||||||
|
function CursorOff: LongWord;
|
||||||
|
function CursorOn: LongWord;
|
||||||
|
|
||||||
|
procedure Delay(Milliseconds: LongWord); // absolute Sleep(Milliseconds);
|
||||||
|
|
||||||
var
|
var
|
||||||
|
CursorHeight: function(Height: LongWord): LongWord; stdcall;
|
||||||
KeyPressed: function: Boolean;
|
KeyPressed: function: Boolean;
|
||||||
ReadKey: function: KolibriChar; stdcall;
|
ReadKey: function: KolibriChar; stdcall;
|
||||||
SetCursorHeight: function(Height: Integer): Integer; stdcall;
|
|
||||||
Write: function(const Text: PKolibriChar): LongInt; cdecl varargs;
|
Write: function(const Text: PKolibriChar): LongInt; cdecl varargs;
|
||||||
WriteText: procedure(Text: PKolibriChar; Length: LongWord); stdcall;
|
WriteText: procedure(Text: PKolibriChar; Length: LongWord); stdcall;
|
||||||
|
|
||||||
@@ -55,7 +67,7 @@ implementation
|
|||||||
var
|
var
|
||||||
CloseWindow: Boolean;
|
CloseWindow: Boolean;
|
||||||
|
|
||||||
procedure ResetAttributes;
|
procedure NormVideo;
|
||||||
begin
|
begin
|
||||||
Write(#27'[0m');
|
Write(#27'[0m');
|
||||||
end;
|
end;
|
||||||
@@ -130,12 +142,17 @@ begin
|
|||||||
Result := Write(Text) + WriteLn(LineBreaks);
|
Result := Write(Text) + WriteLn(LineBreaks);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure Delay(Milliseconds: LongWord);
|
||||||
|
begin
|
||||||
|
Sleep(Milliseconds div 10);
|
||||||
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
hConsole: Pointer;
|
hConsole: Pointer;
|
||||||
ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
|
ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
|
||||||
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PKolibriChar); stdcall;
|
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PKolibriChar); stdcall;
|
||||||
GetCursorPosProc: procedure(var X, Y: Integer); stdcall;
|
GotoXYProc: procedure(X, Y: LongWord); stdcall;
|
||||||
SetCursorPosProc: procedure(X, Y: Integer); stdcall;
|
WhereXYProc: procedure(var X, Y: LongWord); stdcall;
|
||||||
|
|
||||||
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean;
|
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean;
|
||||||
WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord);
|
WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord);
|
||||||
@@ -143,11 +160,11 @@ begin
|
|||||||
hConsole := LoadLibrary('/sys/lib/console.obj');
|
hConsole := LoadLibrary('/sys/lib/console.obj');
|
||||||
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
|
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
|
||||||
ConsoleInit := GetProcAddress(hConsole, 'con_init');
|
ConsoleInit := GetProcAddress(hConsole, 'con_init');
|
||||||
GetCursorPosProc := GetProcAddress(hConsole, 'con_get_cursor_pos');
|
CursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
|
||||||
KeyPressed := GetProcAddress(hConsole, 'con_kbhit');
|
KeyPressed := GetProcAddress(hConsole, 'con_kbhit');
|
||||||
ReadKey := GetProcAddress(hConsole, 'con_getch');
|
ReadKey := GetProcAddress(hConsole, 'con_getch');
|
||||||
SetCursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
|
GotoXYProc := GetProcAddress(hConsole, 'con_set_cursor_pos');
|
||||||
SetCursorPosProc := GetProcAddress(hConsole, 'con_set_cursor_pos');
|
WhereXYProc := GetProcAddress(hConsole, 'con_get_cursor_pos');
|
||||||
Write := GetProcAddress(hConsole, 'con_printf');
|
Write := GetProcAddress(hConsole, 'con_printf');
|
||||||
WriteText := GetProcAddress(hConsole, 'con_write_string');
|
WriteText := GetProcAddress(hConsole, 'con_write_string');
|
||||||
|
|
||||||
@@ -155,20 +172,45 @@ begin
|
|||||||
CloseWindow := CloseWindowOnExit;
|
CloseWindow := CloseWindowOnExit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetCursorPos: TConsolePoint;
|
procedure GotoXY(X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
GetCursorPosProc(Result.X, Result.Y);
|
GotoXYProc(X, Y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SetCursorPos(X, Y: Integer);
|
procedure GotoXY(const Point: TCursorXY);
|
||||||
begin
|
|
||||||
SetCursorPosProc(X, Y);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure SetCursorPos(const Point: TConsolePoint);
|
|
||||||
begin
|
begin
|
||||||
with Point do
|
with Point do
|
||||||
SetCursorPosProc(X, Y);
|
GotoXYProc(X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WhereX: Integer;
|
||||||
|
begin
|
||||||
|
Result := WhereXY.X;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WhereY: Integer;
|
||||||
|
begin
|
||||||
|
Result := WhereXY.Y;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WhereXY: TCursorXY;
|
||||||
|
begin
|
||||||
|
WhereXYProc(Result.X, Result.Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CursorBig: LongWord;
|
||||||
|
begin
|
||||||
|
Result := CursorHeight(15);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CursorOff: LongWord;
|
||||||
|
begin
|
||||||
|
Result := CursorHeight(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CursorOn: LongWord;
|
||||||
|
begin
|
||||||
|
Result := CursorHeight(2);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
Reference in New Issue
Block a user