mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
145 lines
3.3 KiB
ObjectPascal
145 lines
3.3 KiB
ObjectPascal
// ***************************************************************************
|
|
//
|
|
// Delphi MVC Framework
|
|
//
|
|
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
|
|
//
|
|
// https://github.com/danieleteti/delphimvcframework
|
|
//
|
|
// ***************************************************************************
|
|
//
|
|
// Licensed under the Apache License, Version 2.0 (the "License");
|
|
// you may not use this file except in compliance with the License.
|
|
// You may obtain a copy of the License at
|
|
//
|
|
// http://www.apache.org/licenses/LICENSE-2.0
|
|
//
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
// See the License for the specific language governing permissions and
|
|
// limitations under the License.
|
|
//
|
|
// *************************************************************************** }
|
|
|
|
unit MVCFramework.Console;
|
|
|
|
interface
|
|
|
|
type
|
|
TConsoleMode = (Normal, Bright);
|
|
TConsoleColor = (Black = 30, Red = 31, Green = 32, Yellow = 33, Blue = 34, Magenta = 35, Cyan = 36, White = 37);
|
|
|
|
procedure ResetConsole;
|
|
procedure TextColor(const Color: TConsoleColor);
|
|
procedure TextBackground(const Color: TConsoleColor);
|
|
procedure SetMode(const ConsoleMode: TConsoleMode);
|
|
|
|
implementation
|
|
|
|
uses
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
WinApi.Windows,
|
|
|
|
{$ENDIF}
|
|
System.SysUtils;
|
|
|
|
const
|
|
ESC = Chr(27);
|
|
|
|
var
|
|
GForeGround: TConsoleColor;
|
|
GBackGround: TConsoleColor;
|
|
GMode: TConsoleMode = TConsoleMode.Normal;
|
|
|
|
function ToBackGround(const ForeGround: Byte): Byte;
|
|
begin
|
|
if (GMode = TConsoleMode.Bright) and (ForeGround <> Byte(TConsoleColor.Black)) then
|
|
begin
|
|
Result := ForeGround + 10 + 60;
|
|
end
|
|
else
|
|
begin
|
|
Result := ForeGround + 10;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF LINUX}
|
|
|
|
procedure EnableVirtualTerminalProcessing; inline;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
procedure EnableVirtualTerminalProcessing; inline;
|
|
|
|
const
|
|
ENABLE_VIRTUAL_TERMINAL_PROCESSING = $0004;
|
|
|
|
var
|
|
hOut: THandle;
|
|
dwMode: UInt32;
|
|
begin
|
|
hOut := GetStdHandle(STD_OUTPUT_HANDLE);
|
|
if hOut = INVALID_HANDLE_VALUE then
|
|
raise Exception.CreateFmt('GetLastError() = %d', [GetLastError]);
|
|
|
|
dwMode := 0;
|
|
if (not GetConsoleMode(hOut, &dwMode)) then
|
|
raise Exception.CreateFmt('GetLastError() = %d', [GetLastError]);
|
|
|
|
dwMode := dwMode or ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
|
if (not SetConsoleMode(hOut, dwMode)) then
|
|
raise Exception.CreateFmt('GetLastError() = %d', [GetLastError]);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure ResetConsole;
|
|
begin
|
|
write(ESC + '[0m');
|
|
end;
|
|
|
|
function GetColorString: string;
|
|
begin
|
|
if GMode = TConsoleMode.Bright then
|
|
Result := Format('[%d;1;%dm', [Byte(GForeGround), ToBackGround(Byte(GBackGround))])
|
|
else
|
|
Result := Format('[%d;%dm', [Byte(GForeGround), ToBackGround(Byte(GBackGround))]);
|
|
end;
|
|
|
|
procedure TextColor(const Color: TConsoleColor);
|
|
begin
|
|
GForeGround := Color;
|
|
write(ESC + GetColorString);
|
|
end;
|
|
|
|
procedure TextBackground(const Color: TConsoleColor);
|
|
begin
|
|
GBackGround := Color;
|
|
write(ESC + GetColorString);
|
|
end;
|
|
|
|
procedure SetMode(const ConsoleMode: TConsoleMode);
|
|
begin
|
|
GMode := ConsoleMode;
|
|
end;
|
|
|
|
procedure InitDefault;
|
|
begin
|
|
GForeGround := TConsoleColor.White;
|
|
GBackGround := TConsoleColor.Black;
|
|
end;
|
|
|
|
initialization
|
|
|
|
EnableVirtualTerminalProcessing;
|
|
InitDefault;
|
|
|
|
finalization
|
|
|
|
end.
|