paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-10 00:47:20 +01:00
Code Issues Packages Projects Releases Wiki Activity

* support for MCBS from bug #4211

Browse Source 
git-svn-id: trunk@1353 -
This commit is contained in:
peter 2005-10-11 06:36:07 +00:00
parent bfb2c916dc
commit 6314aa118f
1 changed files with 36 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
rtl/win32/crt.pp
View File

@ -638,21 +638,54 @@ begin
end; { while }
end;
procedure WriteStr(const s: string);
var
WritePos: Coord; { Upper-left cell to write from }
numWritten : DWord;
WinAttr : word;
i: integer;
begin
WritePos.X := currX - 1;
WritePos.Y := currY - 1;
WriteConsoleOutputCharacter(GetStdhandle(STD_OUTPUT_HANDLE), @s[1], Length(s), writePos, numWritten);
WinAttr:=TextAttr;
dec(WritePos.X);
for i:=0 to Length(s)-1 do
begin
inc(WritePos.X);
WriteConsoleOutputAttribute(GetStdhandle(STD_OUTPUT_HANDLE),@WinAttr, 1, writePos, numWritten);
end;
Inc(CurrX,Length(s));
end;
Function CrtWrite(var f : textrec) : integer;
var
i : longint;
s : string;
begin
GetScreenCursor(CurrX, CurrY);
s:='';
for i:=0 to f.bufpos-1 do
WriteChar(f.buffer[i]);
if f.buffer[i]<#32 then
begin
if s<>'' then
WriteStr(s);
WriteChar(f.buffer[i]);
end
else
s:=s+f.buffer[i];
if s<>'' then
WriteStr(s);
SetScreenCursor(CurrX, CurrY);
f.bufpos:=0;
CrtWrite:=0;
end;
Function CrtRead(Var F: TextRec): Integer;
procedure BackSpace;