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

Merged revisions 1353,2869 via svnmerge from

Browse Source 
svn+ssh://marco@svn.freepascal.org/FPC/svn/fpc/trunk

........
r1353 | peter | 2005-10-11 08:36:07 +0200 (Tue, 11 Oct 2005) | 2 lines

  * support for MCBS from bug #4211

........
r2869 | marco | 2006-03-11 22:33:51 +0100 (Sat, 11 Mar 2006) | 2 lines

 * fix for double-write bug, probably in since r1353

........

git-svn-id: branches/fixes_2_0@2871 -
This commit is contained in:
marco 2006-03-11 22:06:12 +00:00
parent e9ad4bf890
commit 2cf4b55f01
1 changed files with 39 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
rtl/win32/crt.pp
View File

@ -638,21 +638,57 @@ 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] in [#7,#8,#10,#13] then // special chars directly.
begin
if s<>'' then
begin
WriteStr(s);
s:='';
end;
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;