RnQ/RnQ/ThemesLib.pas

{
  This file is part of R&Q.
  Under same license
}
unit themesLib;
{$I RnQConfig.inc}
{$WRITEABLECONST OFF} // Read-only typed constants

interface

uses
  System.Classes, System.UITypes, System.Win.Registry, Vcl.Graphics,
  RDGlobal, RQThemes, RDFileUtil;

type
  TRegChangeThread = class(TThread)
  private
    FReg: TRegistry;
    FUpdateEvent: THandle;
    FTerminateEvent: THandle;
    procedure GetColors;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute; override;
    procedure NotifyTerminate;
  end;

{$I NoRTTI.inc}

  procedure ResetThemePaths;
  procedure ResetTheme;
  procedure ApplyTheme;
  procedure SetContactsThemeUse(b: Boolean);
  procedure ReloadCurrentTheme;

const
  DefaultAccentColor = TAlphaColor($FF696455);

var
  statusPics: array [0 .. 15] of array [Boolean] of TRnQThemedElementDtls;
  RQSmilesPath, RQEmojisPath, RQSoundsPath: TThemePath;
  RegChange: TRegChangeThread;
  Prevalence: Integer = 0;
  AccentColor: TAlphaColor = DefaultAccentColor;
  AccentColorInactive: TAlphaColor = TAlphaColor(clWindow);

implementation

uses
  Winapi.Windows, System.SysUtils,
  SciterLib, GlobalLib, RoasterLib, UtilLib,
  RnQGlobal, RnQPics, ICQClients, events;

procedure ApplyTheme;
begin
  LoadClientsDefs;

  UI.CL.ApplyTheme;

  if Assigned(UI.Chat) then
  with UI.Chat do
  begin
    UpdateGraphics;
    InitSettings;
    ApplyTheme;
  end;

  TextBGColor := theme.GetColor('history.bg', clWindow);
//!  historyVCL.hisBGColor := theme.GetColor(ClrHistBG + '.his', TextBGColor);
//!  historyVCL.myBGColor := theme.GetColor(ClrHistBG + '.my', TextBGColor);
  with theme.GetPicSize(RQteDefault, PIC_MSG_OK) do
    hasMsgOK := (cx > 0) and (cy > 0);
  with theme.GetPicSize(RQteDefault, PIC_MSG_SERVER) do
    hasMsgSRV := (cx > 0) and (cy > 0);
  { mainFrm.roaster.background.Bitmap.Dormant;
    mainFrm.roaster.background.bitmap.FreeImage;
    mainFrm.roaster.background.bitmap.ReleaseHandle; }
  // bmp := TBitmap.Create;
//  color := theme.GetColor('roaster.bar', clBtnFace); // roster.barcolor
//  roster.colors.focusedselectioncolor := theme.GetColor('roaster.selection', $CFCFCF); // roaster.selectioncolor;
//  roster.colors.focusedselectionbordercolor := roster.colors.focusedselectioncolor;
//  roster.colors.unfocusedselectioncolor := roster.colors.focusedselectioncolor;
//  roster.colors.unfocusedselectionbordercolor := roster.colors.focusedselectioncolor;

  UI.CL.InitThemeList;
  UI.CL.UpdateStatusGlyphs;
  roasterLib.RebuildCL;

  if Assigned(StatusIcon) and Assigned(StatusIcon.TrayIcon) then
    StatusIcon.ReDraw;
end; // ApplyTheme

procedure ResetTheme;
begin
  { theme.addProp('roaster', mainfrm.font);
    theme.addProp('history.my', mainfrm.font);
    theme.addProp('history.his', mainfrm.font); }
end; // resetTheme

procedure ResetThemePaths;
begin
  theme.ThemePath.pathType := pt_zip;
  theme.ThemePath.fn := 'RnQ.Theme.rtz';
  theme.ThemePath.subfn := defaultThemePrefix + defaultThemePostfix;
  RQSmilesPath.pathType := pt_path;
  RQSmilesPath.fn := '';
  RQSmilesPath.subfn := '';
  RQEmojisPath.pathType := pt_path;
  RQEmojisPath.fn := '';
  RQEmojisPath.subfn := '';
  RQSoundsPath.pathType := pt_path;
  RQSoundsPath.fn := '';
  RQSoundsPath.subfn := '';
end;

procedure SetContactsThemeUse(b: Boolean);
// var

begin
  if UseContactThemes <> b then
  begin
    if b then
    begin
      UseContactThemes := True;
      if not FileExists(AccPath + contactsthemeFilename) then
        Exit;
      if not Assigned(ContactsTheme) then
        ContactsTheme := TRQtheme.Create;
      ContactsTheme.load(AccPath + contactsthemeFilename, '', false);
      ContactsTheme.loadThemeScript(userthemeFilename, AccPath);
    end
      else
    begin
      if Assigned(ContactsTheme) then
        ContactsTheme.Free;
      ContactsTheme := nil;
      UseContactThemes := false;
    end;
  end
  { else
    if b then
    if not Assigned(ContactThemes) then
    begin

    end;
  }
end;

procedure ReloadCurrentTheme;
begin
  theme.load(theme.ThemePath.fn, theme.ThemePath.subfn);

  if (RQSmilesPath.fn > '') and FileExists(MyPath + themesPath + RQSmilesPath.fn) then
    theme.load(RQSmilesPath.fn, RQSmilesPath.subfn, false, tsc_smiles)
  else
  begin
    RQSmilesPath.fn := '';
    RQSmilesPath.subfn := '';
    theme.smileArray.Clear;
    if Assigned(theme.smileNotify) then
      theme.smileNotify;
  end;

  if (RQEmojisPath.fn > '') and FileExists(MyPath + themesPath + RQEmojisPath.fn) then
    theme.load(RQEmojisPath.fn, RQEmojisPath.subfn, false, tsc_emojis)
  else
  begin
    RQEmojisPath.fn := '';
    RQEmojisPath.subfn := '';
    if Assigned(theme.emojisNotify) then
      theme.emojisNotify;
  end;

  if (RQSoundsPath.fn > '') and FileExists(MyPath + themesPath + RQSoundsPath.fn) then
    theme.load(RQSoundsPath.fn, RQSoundsPath.subfn, false, tsc_sounds)
  else
  begin
    RQSoundsPath.fn := '';
    RQSoundsPath.subfn := '';
  end;

  theme.loadThemeScript(userthemeFilename, AccPath);
  if UseContactThemes then
  begin
    if FileExists(AccPath + contactsthemeFilename) then
    begin
      if not Assigned(ContactsTheme) then
        ContactsTheme := TRQtheme.Create;
    end else
      FreeAndNil(ContactsTheme);
    if Assigned(ContactsTheme) then
    begin
      ContactsTheme.load(AccPath + contactsthemeFilename, '', false);
      ContactsTheme.loadThemeScript(userthemeFilename, AccPath);
    end;
  end;
  ApplyTheme;
end; // reloadCurrentTheme

{ TRegChangeThread }

constructor TRegChangeThread.Create;
begin
  inherited Create(True);
  FReg := TRegistry.Create;
end;

destructor TRegChangeThread.Destroy;
begin
  CloseHandle(FUpdateEvent);
  CloseHandle(FTerminateEvent);
  FReg.CloseKey;
  FReg.Free;
  inherited;
end;

procedure TRegChangeThread.GetColors;

  function RGBToAlphaColor(Color: Integer; Alpha: Byte = 255): TAlphaColor;
  var
    Rec: TAlphaColorRec;
  begin
    //Rec.A := Byte(Color shr 24);
    Rec.A := Alpha;
    Rec.R := Byte(Color);
    Rec.G := Byte(Color shr 8);
    Rec.B := Byte(Color shr 16);
    Result := Rec.Color;
  end;

begin
  if IsTen then
  begin
    if FReg.ValueExists('ColorPrevalence') then
      Prevalence := FReg.ReadInteger('ColorPrevalence');
    if FReg.ValueExists('AccentColor') then
      AccentColor := FReg.ReadInteger('AccentColor');
    if FReg.ValueExists('AccentColorInactive') then
      AccentColorInactive := FReg.ReadInteger('AccentColorInactive');
  end
    else
  begin
    if FReg.ValueExists('ColorizationColor') and FReg.ValueExists('ColorizationColorBalance') then
      AccentColor := RGBToAlphaColor(FReg.ReadInteger('ColorizationColor'), Round(FReg.ReadInteger('ColorizationColorBalance') / 100 * 255));
    AccentColorInactive := TAlphaColor($FFEBEBEB);
  end;
end;

procedure TRegChangeThread.NotifyTerminate;
begin
  SetEvent(FTerminateEvent);
end;

procedure TRegChangeThread.Execute;
var
  events: array [0..1] of THandle;
  rnd: Integer;
begin
  FReg.RootKey := HKEY_CURRENT_USER;
  if not FReg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\DWM') then
    Exit;
  GetColors;

  Randomize;
  rnd := Random(10000);
  FUpdateEvent := CreateEvent(nil, LongBool(True), LongBool(False), PWideChar('RegChangeUpdateEvent' + IntToStr(rnd)));
  RegNotifyChangeKeyValue(FReg.CurrentKey, LongBool(False), REG_NOTIFY_CHANGE_NAME or REG_NOTIFY_CHANGE_LAST_SET, FUpdateEvent, LongBool(True));
  FTerminateEvent := CreateEvent(nil, LongBool(True), LongBool(False), PWideChar('RegChangeTerminateEvent' + IntToStr(rnd)));
  ResetEvent(FTerminateEvent);
  events[0] := FUpdateEvent;
  events[1] := FTerminateEvent;

  while not Terminated do
  case WaitForMultipleObjects(2, @events, False, INFINITE) of
    WAIT_OBJECT_0:
    begin
      GetColors;
      TThread.Synchronize(nil, procedure
      begin
        if Assigned(UI) then
          UI.ApplySystemSettings;
      end);
      ResetEvent(FUpdateEvent);
      RegNotifyChangeKeyValue(FReg.CurrentKey, LongBool(False), REG_NOTIFY_CHANGE_NAME or REG_NOTIFY_CHANGE_LAST_SET, FUpdateEvent, LongBool(True));
    end;
    WAIT_OBJECT_0 + 1:
    begin
      Terminate;
      Exit;
    end;
  end;
end;

initialization
  RegChange := TRegChangeThread.Create;
  RegChange.FreeOnTerminate := True;
  RegChange.Start;

finalization
  RegChange.NotifyTerminate;

end.