{
  ==================================================

    Tahoma.pas
    ----------

    Verze 1.20, patchováno pro Delphi 6
    Copyright © 2001-2002 David Majda

  ==================================================
}

unit Tahoma;

interface

uses
  Forms, Controls, Graphics;

function GetLightColor: TColor;
procedure LightenControl(Control: TControl);
procedure TahomizeForm(Form: TForm);
procedure PatchTahoma;

implementation

uses
  Windows, ExtCtrls;

var
  LowBitsPerPixel: Boolean;

// TODO: někdy optimalizovat (vše pomocí bitvých operací)
function GetLightColor: TColor;
var
  Color: Longint;
  R, G, B: Byte;
begin
  if not LowBitsPerPixel then
  begin
    Color := ColorToRGB(clBtnFace);
    R := GetRValue(Color);
    G := GetGValue(Color);
    B := GetBValue(Color);
    Inc(R, (255 - R) div 2 + 1);
    Inc(G, (255 - G) div 2 + 1);
    Inc(B, (255 - B) div 2 + 1);
    Result := RGB(R, G, B);
  end
  else
    Result := clBtnFace;
end;

procedure LightenControl(Control: TControl);
var
  Color: TColor;
begin
  Color := GetLightColor;
  if Control is TPanel then TPanel(Control).Color := Color;
  if Control is TNotebook then TNotebook(Control).Color := Color;
end;

procedure TahomizeForm(Form: TForm);
const
  SubstFontName = 'MS Sans Serif';
var
  I: Integer;
begin
  if Screen.Fonts.IndexOf('Tahoma') = - 1 then
    with Form do
    begin
      Font.name := SubstFontName;
      for I := 0 to ComponentCount - 1 do
        if Components[I] is TControl then
          with TControl(Components[I]) do
            if not ParentFont then
              Font.name := SubstFontName;
    end;
end;

procedure PatchTahoma;
var
  I: Integer;
begin
  if Screen.Fonts.IndexOf('Tahoma') = - 1 then
  begin
    for I := 0 to Screen.FormCount - 1 do
      TahomizeForm(Screen.Forms[I]);
  end;
end;

procedure TahomaInitialization;
const
  { Tato konstanta není v Windows.pas v D3 definována a funguje jen v novějších
    verzích Windows. }
  ENUM_CURRENT_SETTINGS = Cardinal(-1);
var
  DeviceMode: TDeviceMode;
begin
  with DeviceMode do
  begin
    dmSize := SizeOf(TDeviceMode);
    dmDriverExtra := 0;
  end;
  { Ve starších verzích Windows použití ENUM_CURRENT_SETTINGS vede vždy k vrácení
    False, protože tato možnost byla do API přidána až později. Tím pádem se na
    starších Windowsech nikdy nenastaví LowBitsPerPixel na True, i když by měl.
    Pokud někdo ví, jak to obejít (tj. jak i v tom případě zjistit aktuální
    BPP obrazovky), dejte mi prosím vědět.
    P.S.: "Staršími Windows" zde míním všechny verze, kde nefunguje zmíněná
    detekce. Určitě tam patří Windows 95, možná i 98. Přesněji to nevím a je to
    z hlediska problému celkem jedno. }
  if EnumDisplaySettings(nil, ENUM_CURRENT_SETTINGS, DeviceMode) <> False then
    LowBitsPerPixel := DeviceMode.dmBitsPerPel <= 8;
end;

initialization

TahomaInitialization;

end.
