* modified version of patch by James Richters from bug #32558 - allow use of OEM coodepage, e.g. to support semigraphic symbols as available in TP/BP

git-svn-id: trunk@37673 -

packages/rtl-console/src/win/crt.pp

@@ -18,6 +18,8 @@ interface
 
 {$i crth.inc}
 
+procedure SetSafeCPSwitching(Switching:Boolean);
+procedure SetUseACP(ACP:Boolean);
 procedure Window32(X1,Y1,X2,Y2: DWord);
 procedure GotoXY32(X,Y: DWord);
 function WhereX32: DWord;
@@ -35,6 +37,17 @@ var
     SaveCursorSize: Longint;
     Win32Platform : Longint; // pulling in sysutils changes exception behaviour
 
+    UseACP        : Boolean; (* True means using active process codepage for
+                                console output, False means use the original
+                                setting (usually OEM codepage). *)
+    SafeCPSwitching : Boolean; (* True in combination with UseACP means that
+                                  the console codepage will be set on every
+                                  output, False means that the console codepage
+                                  will only be set on Initialization and
+                                  Finalization *)
+    OriginalConsoleOutputCP : Word;
+ 
+
 {****************************************************************************
                            Low level Routines
 ****************************************************************************}
@@ -94,6 +107,29 @@ end;
                              Public Crt Functions
 ****************************************************************************}
 
+procedure SetSafeCPSwitching(Switching:Boolean);
+begin
+    SafeCPSwitching:=Switching;
+    if SafeCPSwitching then
+      SetConsoleOutputCP(OriginalConsoleOutputCP)  // Set Console back to Original since it will now be switched
+                                                   // every read and write
+    else
+      if UseACP then
+        SetConsoleOutputCP(GetACP);   // Set Console only once here if SafeCPSwitching is False and
+                                      // if UseACP is true
+end;
+
+procedure SetUseACP(ACP:Boolean);
+begin
+    UseACP:=ACP;
+    if UseACP then
+      if not(SafeCPSwitching) then
+        SetConsoleOutputCP(GetACP)   // Set console CP only once here if SafeCPSwitching is False and
+                                     // if UseACP is True
+      else
+       SetConsoleOutputCP(OriginalConsoleOutputCP)    // Set console back to original if UseACP is False
+    else
+end;
 
 procedure TextMode (Mode: word);
 begin
@@ -753,8 +789,11 @@ var
   s : string;
   OldConsoleOutputCP : Word;
 begin
-  OldConsoleOutputCP:=GetConsoleOutputCP;
-  SetConsoleOutputCP(GetACP);
+  if SafeCPSwitching and UseACP then    //Switch codepage on every Write.
+    begin
+      OldConsoleOutputCP:=GetConsoleOutputCP;
+      SetConsoleOutputCP(GetACP);
+    end;
 
   GetScreenCursor(CurrX, CurrY);
   s:='';
@@ -781,7 +820,8 @@ begin
     WriteStr(s);
   SetScreenCursor(CurrX, CurrY);
 
-  SetConsoleOutputCP(OldConsoleOutputCP);
+  if SafeCPSwitching and UseACP then     //restore codepage on every write if set previously
+    SetConsoleOutputCP(OldConsoleOutputCP);
 
   f.bufpos:=0;
 end;
@@ -802,9 +842,12 @@ Procedure CrtRead(Var F: TextRec);
 var
   ch : Char;
   OldConsoleOutputCP : Word;
-Begin
-  OldConsoleOutputCP:=GetConsoleOutputCP;
-  SetConsoleOutputCP(GetACP);
+begin
+  if SafeCPSwitching and UseACP then    //Switch codepage on every Read
+    begin
+      OldConsoleOutputCP:=GetConsoleOutputCP;
+      SetConsoleOutputCP(GetACP);
+    end;
 
   GetScreenCursor(CurrX,CurrY);
   f.bufpos:=0;
@@ -883,7 +926,8 @@ Begin
       end;
   until false;
 
-  SetConsoleOutputCP(OldConsoleOutputCP);
+  if SafeCPSwitching and UseACP then    //Restore codepage on every Read if set previously
+    SetConsoleOutputCP(OldConsoleOutputCP);
 	
   f.bufpos:=0;
   SetScreenCursor(CurrX, CurrY);
@@ -985,6 +1029,13 @@ Initialization
 
   SetActiveWindow(0);
 
+  OriginalConsoleOutputCP:=GetConsoleOutputCP;  //Always save the original console codepage so it can be restored on exit.
+  UseACP:=True;  // Default to use GetACP CodePage to remain compatible with previous CRT version.
+  SafeCPSwitching:=True;  // Default to switch codepage on every read and write to remain compatible with previous CRT version.
+
+  //SetSafeCPSwitching(False); // With these defaults the code page does not need to be changed here. If SafeCPSwitching defaulted
+                               // to False and UseACP to True then SetSafeCPSwitching(False) needs to be run here.
+
   {--------------------- Get the cursor size and such -----------------------}
   FillChar(CursorInfo, SizeOf(CursorInfo), 00);
   GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
@@ -1030,4 +1081,6 @@ finalization
     CloseHandle(beeperDevice);
     DefineDosDevice(DDD_REMOVE_DEFINITION,'DosBeep','\Device\Beep');
   end;
+  SetConsoleOutputCP(OriginalConsoleOutputCP);  //Always put the console back the way it was on start;
+                                                //useful if the program is executed from command line.
 end. { unit Crt }