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

* added checks for windows calls and better set console mode for windows

Browse Source 
git-svn-id: trunk@6122 -
This commit is contained in:
pierre 2007-01-22 04:15:20 +00:00
parent b6fc04080e
commit d28d17b6c6
1 changed files with 58 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
ide/fpusrscr.pas
View File

@ -222,6 +222,10 @@ type
ConsoleMode,IdeMode : Dword; ConsoleMode,IdeMode : Dword;
IdeScreenMode : TVideoMode; IdeScreenMode : TVideoMode;
procedure BufferCopy(src,dest : THandle); procedure BufferCopy(src,dest : THandle);
{$ifdef debug}
procedure Complain(St : string);
Procedure SetConsoleMode(FH : Handle;Mode : DWord);
{$endif debug}
end; end;
{$endif} {$endif}
@ -984,6 +988,10 @@ end;
const const
ENABLE_INSERT_MODE = $20; ENABLE_INSERT_MODE = $20;
ENABLE_QUICK_EDIT_MODE = $40; ENABLE_QUICK_EDIT_MODE = $40;
ENABLE_EXTENDED_FLAGS = $80;
ENABLE_AUTO_POSITION = $100;
procedure UpdateFileHandles; procedure UpdateFileHandles;
begin begin
@ -1021,6 +1029,7 @@ begin
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode); GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
IdeMode:=ConsoleMode; IdeMode:=ConsoleMode;
{$ifdef debug} {$ifdef debug}
Complain('Starting ConsoleMode is $'+hexstr(ConsoleMode,8));
{define Windowsbigwin} {define Windowsbigwin}
{$endif debug} {$endif debug}
{$ifdef Windowsbigwin} {$ifdef Windowsbigwin}
@ -1265,9 +1274,17 @@ end;
{ dummy for Windows as the Buffer screen { dummy for Windows as the Buffer screen
do hold all the info } do hold all the info }
procedure TWindowsScreen.SaveIDEScreen; procedure TWindowsScreen.SaveIDEScreen;
var
NowIdeMode : Dword;
begin begin
IdeScreenMode:=ScreenMode; IdeScreenMode:=ScreenMode;
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode); GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @NowIdeMode);
{$ifdef debug}
Complain('IDE ConsoleMode is $'+hexstr(NowIdeMode,8));
if NowIdeMode<>IdeMode then
Complain('is not equal to IDEMode $'+hexstr(IdeMode,8));
{$endif debug}
IdeMode:=NowIdeMode;
{ set the dummy buffer as active already now PM } { set the dummy buffer as active already now PM }
SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle); SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
UpdateFileHandles; UpdateFileHandles;
@ -1278,6 +1295,9 @@ end;
procedure TWindowsScreen.SaveConsoleScreen; procedure TWindowsScreen.SaveConsoleScreen;
begin begin
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode); GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
{$ifdef debug}
Complain('ConsoleMode now is $'+hexstr(ConsoleMode,8));
{$endif debug}
{ set the dummy buffer as active already now PM } { set the dummy buffer as active already now PM }
SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle); SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
UpdateFileHandles; UpdateFileHandles;
@ -1307,7 +1327,9 @@ begin
{ Needed to force InitSystemMsg to use the right console handle } { Needed to force InitSystemMsg to use the right console handle }
DoneEvents; DoneEvents;
InitEvents; InitEvents;
IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) IdeMode:=({IdeMode or }ENABLE_MOUSE_INPUT or
ENABLE_WINDOW_INPUT or
ENABLE_EXTENDED_FLAGS)
and not (ENABLE_PROCESSED_INPUT or and not (ENABLE_PROCESSED_INPUT or
ENABLE_LINE_INPUT or ENABLE_LINE_INPUT or
ENABLE_ECHO_INPUT or ENABLE_ECHO_INPUT or
@ -1340,6 +1362,39 @@ begin
IDEActive:=true; IDEActive:=true;
end; end;
{$ifdef debug}
procedure TWindowsScreen.Complain(St : string);
begin
if IDEActive then
DebugMessage('',St,0,0)
else
Writeln(stderr,St);
end;
procedure TWindowsScreen.SetConsoleMode(FH : Handle;Mode: DWord);
var
Test: DWord;
begin
If not Windows.SetConsoleMode(FH,Mode) then
begin
Complain('SetConsoleMode call failed GetLastError='+IntToStr(GetLastError));
end
else
begin
if not GetConsoleMode(FH,Test) then
begin
Complain('GetConsoleMode call failed GetLastError='+IntToStr(GetLastError));
end
else if (Test<>Mode) then
begin
Complain('GetConsoleMode result '+IntToStr(Test)+' <> '+
IntToStr(Mode));
end;
end;
end;
{$endif DEBUG}
{$endif} {$endif}
{**************************************************************************** {****************************************************************************