paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-05 15:30:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved some drawing routines to a new unit 'vidutil'

Browse Source 
git-svn-id: branches/unicodekvm@40222 -
This commit is contained in:
nickysn 2018-11-05 14:17:27 +00:00
parent a7e13587a0
commit f964dacd24
3 changed files with 54 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7425,6 +7425,7 @@ packages/rtl-console/tests/kbd1.pp svneol=native#text/plain
packages/rtl-console/tests/kbddump.pp svneol=native#text/plain
packages/rtl-console/tests/kbdutil.pp svneol=native#text/plain
packages/rtl-console/tests/us101.txt svneol=native#text/plain
packages/rtl-console/tests/vidutil.pp svneol=native#text/plain
packages/rtl-extra/Makefile svneol=native#text/plain
packages/rtl-extra/Makefile.fpc svneol=native#text/plain
packages/rtl-extra/Makefile.fpc.fpcmake svneol=native#text/plain

35
packages/rtl-console/tests/kbddump.pp
View File

@ -3,40 +3,7 @@ program kbddump;
{$MODE objfpc}{$H+}
uses
Video, Keyboard, Mouse, kbdutil;
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;
Video, Keyboard, Mouse, kbdutil, vidutil;
procedure SampleAllKeys(const Kbd: TKeyboard; const OutFileName: string);
var

52
packages/rtl-console/tests/vidutil.pp Normal file
View File

@ -0,0 +1,52 @@
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.