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

* overcome buffer win32 problem due to a bug in ReadConsoleOutput

Browse Source
This commit is contained in:
pierre 2001-11-08 16:07:41 +00:00
parent 94d9d8fe46
commit 1d4499f32e
1 changed files with 61 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
ide/fpusrscr.pas
View File

@ -620,6 +620,13 @@ begin
if not res then if not res then
error:=GetLastError; error:=GetLastError;
{$endif win32bigwin} {$endif win32bigwin}
{ make sure that both Screen Handle have the sme buffer }
GetConsoleScreenBufferInfo(IDEScreenBufferHandle,
@ConsoleScreenBufferInfo);
res:=SetConsoleScreenBufferSize(DosScreenBufferHandle,
ConsoleScreenBufferInfo.dwSize);
if not res then
error:=GetLastError;
Capture; Capture;
SwitchBackToIDEScreen; SwitchBackToIDEScreen;
end; end;
@ -730,13 +737,20 @@ type
var var
LineBuf : ^CharInfoArray; LineBuf : ^CharInfoArray;
BufSize,BufCoord : Coord; BufSize,BufCoord : Coord;
LineSize : longint; Error, LineSize,
Part, OnePartY: longint;
res : boolean;
WriteRegion : SMALL_RECT; WriteRegion : SMALL_RECT;
ConsoleScreenBufferInfo : Console_screen_buffer_info; ConsoleScreenBufferInfo : Console_screen_buffer_info;
DestConsoleScreenBufferInfo : Console_screen_buffer_info;
begin begin
GetConsoleScreenBufferInfo(Src, GetConsoleScreenBufferInfo(Src,
@ConsoleScreenBufferInfo); @ConsoleScreenBufferInfo);
GetConsoleScreenBufferInfo(Dest,
@DestConsoleScreenBufferInfo);
GetMem(LineBuf,SizeOf(CharInfoArray)); GetMem(LineBuf,SizeOf(CharInfoArray));
FillChar(LineBuf^,SizeOf(CharInfoArray),#0);
LineSize:=ConsoleScreenBufferInfo.dwSize.X; LineSize:=ConsoleScreenBufferInfo.dwSize.X;
If LineSize>256 then If LineSize>256 then
LineSize:=256; LineSize:=256;
@ -751,10 +765,48 @@ begin
Bottom := ConsoleScreenBufferInfo.dwSize.Y-1; Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
Right := LineSize-1; Right := LineSize-1;
end; end;
ReadConsoleOutput(Src, PChar_info(LineBuf), if BufSize.X*BufSize.Y*Sizeof(CHAR_INFO) >= $8000 then
begin
OnePartY := ($8000 -1) div (BufSize.X * SizeOf(Char_Info) );
BufSize.Y:=OnePartY;
Part:=0;
while ((Part+1)*OnePartY < ConsoleScreenBufferInfo.dwSize.Y) do
begin
WriteRegion.Top := Part*OnePartY;
WriteRegion.Bottom := (Part+1)*OnePartY-1;
res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
BufSize, BufCoord, @WriteRegion); BufSize, BufCoord, @WriteRegion);
WriteConsoleOutput(Dest, PChar_info(LineBuf), if not res then
Error:=GetLastError;
res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
BufSize, BufCoord, @WriteRegion); BufSize, BufCoord, @WriteRegion);
if not res then
Error:=GetLastError;
Inc(Part);
end;
BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y - Part*OnePartY;
WriteRegion.Top := Part*OnePartY;
WriteRegion.Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
BufSize, BufCoord, @WriteRegion);
if not res then
Error:=GetLastError;
res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
BufSize, BufCoord, @WriteRegion);
if not res then
Error:=GetLastError;
end
else
begin
res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
BufSize, BufCoord, @WriteRegion);
if not res then
Error:=GetLastError;
res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
BufSize, BufCoord, @WriteRegion);
if not res then
Error:=GetLastError;
end;
FreeMem(LineBuf,SizeOf(CharInfoArray)); FreeMem(LineBuf,SizeOf(CharInfoArray));
SetConsoleCursorPosition(Dest, ConsoleScreenBufferInfo.dwCursorPosition); SetConsoleCursorPosition(Dest, ConsoleScreenBufferInfo.dwCursorPosition);
end; end;
@ -834,7 +886,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2001-10-24 14:17:27 pierre Revision 1.5 2001-11-08 16:07:41 pierre
* overcome buffer win32 problem due to a bug in ReadConsoleOutput
Revision 1.4 2001/10/24 14:17:27 pierre
* try to fix the Win2000 mouse problem * try to fix the Win2000 mouse problem
Revision 1.3 2001/09/09 20:44:53 carl Revision 1.3 2001/09/09 20:44:53 carl