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
  Graphics, Controls, Classes, Registry, Menus,
  RDGlobal, RQThemes, RDFileUtil, GR32;

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 RepaintAllWindows;
  procedure SetContactsThemeUse(b: Boolean);
  procedure ReloadCurrentTheme;

var
  statusPics: array [0 .. 15] of array [Boolean] of TRnQThemedElementDtls;
  RQSmilesPath, RQEmojisPath, RQSoundsPath: TThemePath;
  RegChange: TRegChangeThread;
  Prevalence: Integer = 1;
  AccentColor: TColor = clWhite;
  AccentColorInactive: TColor = clWhite;

implementation

uses
  Windows, Forms, SysUtils, Math, StrUtils,
  SciterLib, UtilLib, GlobalLib, IniLib, RoasterLib,
  RQUtil, RnQGlobal, RnQGraphics32, RnQPics,
  Protocols_all, Protocol_ICQ, ICQClients, ICQConsts,
  prefSheet, events, mainDlg;

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;
  RepaintAllWindows;
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 RepaintAllWindows;

  procedure RepaintRecur(c: Tcontrol);
  var
    i: integer;
  begin
    if c = NIL then
      Exit;
    if c is Twincontrol then
      with c as Twincontrol do
        for i := controlCount - 1 downto 0 do
          RepaintRecur(Controls[i]);
    c.repaint;
  end; // RepaintRecur

var
  i: integer;
begin
  for i := 0 to Screen.FormCount - 1 do
    RepaintRecur(Screen.Forms[i]);
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 RGBToColor(Color: Integer): TColor;
  begin
    Result := RGB(Byte(Color), Byte(Color shr 8), Byte(Color shr 16));
  end;

begin
  Prevalence := 1;
  AccentColor := clWhite;
  AccentColorInactive := clWhite;
  if FReg.ValueExists('ColorPrevalence') then
    Prevalence := FReg.ReadInteger('ColorPrevalence');
  if FReg.ValueExists('AccentColor') then
    AccentColor := RGBToColor(FReg.ReadInteger('AccentColor'));
  if FReg.ValueExists('AccentColorInactive') then
    AccentColorInactive := RGBToColor(FReg.ReadInteger('AccentColorInactive'));
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.ApplySystemColor;
        if Assigned(UI.Chat) and UI.Chat.Visible then
          UI.Chat.ApplyTitleColors(GetForegroundWindow = UI.Chat.Window);
      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
  if TOSVersion.Check(10) then
  begin
    RegChange := TRegChangeThread.Create;
    RegChange.FreeOnTerminate := True;
    RegChange.Start;
  end;

finalization
  if TOSVersion.Check(10) then
    RegChange.NotifyTerminate;

end.