mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-28 09:03:43 +02:00
53 lines
1.0 KiB
ObjectPascal
53 lines
1.0 KiB
ObjectPascal
unit VidUtil;
|
|
|
|
{$MODE objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
KbdUtil;
|
|
|
|
procedure TextOut(X, Y: Integer; const S: string; TextAttr: Byte);
|
|
procedure DrawKey(const Key: TKey; TextAttr: Byte);
|
|
procedure DrawKeyboard(const Kbd: TKeyboard);
|
|
|
|
implementation
|
|
|
|
uses
|
|
Video;
|
|
|
|
procedure TextOut(X, Y: Integer; const S: string; TextAttr: Byte);
|
|
var
|
|
W, P, I, M: Integer;
|
|
begin
|
|
P := ((X-1)+(Y-1)*ScreenWidth);
|
|
M := Length(S);
|
|
if (P+M) > ScreenWidth*ScreenHeight then
|
|
M := ScreenWidth*ScreenHeight-P;
|
|
for I := 1 to M do
|
|
VideoBuf^[P+I-1] := Ord(S[I]) + (TextAttr shl 8);
|
|
end;
|
|
|
|
procedure DrawKey(const Key: TKey; TextAttr: Byte);
|
|
var
|
|
Y: Integer;
|
|
begin
|
|
for Y := Key.YTop to Key.YBottom do
|
|
begin
|
|
if Y = Key.Y then
|
|
TextOut(Key.X + 1, Y + 1, Key.KeyLabel, TextAttr)
|
|
else
|
|
TextOut(Key.X + 1, Y + 1, StringOfChar(' ', Length(Key.KeyLabel)), TextAttr);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawKeyboard(const Kbd: TKeyboard);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Low(kbd.Keys) to High(kbd.Keys) do
|
|
DrawKey(kbd.Keys[I], $70);
|
|
end;
|
|
|
|
end.
|