tetheme.pas

这个东西的功能很强大

      begin
        Result.Free;
        Result := nil;
      end;
      Exit;
    end;
    { Restore stream pos }
    AStream.Position := SavePos;
  end;
end;

procedure TteThemeManager.SaveToStream(ATheme: TteTheme; AStream: TStream);
begin
  if (ATheme <> nil) and (ATheme.GetThemeOptions.CanStore) then
  begin
    { Save theme to stream }
    ATheme.SaveToStream(AStream);
  end;
end;

function TteThemeManager.IsThemeAvailable(const ATheme: TteTheme): boolean;
begin
  Result := false;

  if (CurrentTheme <> nil) and (ATheme = CurrentTheme) then
  begin
    Result := true;
    Exit;
  end;
end;

function TteThemeManager.IsThemeAvailable(const AThemeName: string): boolean;
var
  i: integer;
begin
  Result := false;

  if (CurrentTheme <> nil) and (AnsiLowerCase(CurrentTheme.GetThemeName) = AnsiLowerCase(AThemeName)) then
  begin
    Result := true;
    Exit;
  end;

  if FThemeList <> nil then
    for i := 0 to FThemeList.Count - 1 do
      if AnsiLowerCase(TteThemeClass(FThemeList[i]).GetThemeName) = AnsiLowerCase(AThemeName) then
      begin
        Result := true;
        Exit;
      end;
end;

function TteThemeManager.IsThemeAvailable(const AThemeClass: TteThemeClass): boolean;
var
  i: integer;
begin
  Result := false;

  if (CurrentTheme <> nil) and (CurrentTheme is AThemeClass) then
  begin
    Result := true;
    Exit;
  end;

  if FThemeList <> nil then
    for i := 0 to FThemeList.Count - 1 do
      if TteThemeClass(FThemeList[i]) = AThemeClass then
      begin
        Result := true;
        Exit;
      end;
end;

procedure TteThemeManager.ChangeTheme(const ATheme: TteTheme);
begin
//  if IsThemeAvailable(ATheme) then
  begin
    Broadcast(SNM_THEMEMESSAGE, SMP_BEFORECHANGE, 0);

    if IsThemeAvailable(CurrentTheme) then
    begin
      FreeAndNil(CurrentTheme);
      CurrentTheme := ATheme;
      Broadcast(SNM_THEMEMESSAGE, SMP_CHANGETHEME, 0);
    end
    else
    begin
      CurrentTheme := ATheme;
      Broadcast(SNM_THEMEMESSAGE, SMP_APPLYTHEME, 0);
    end;

    Broadcast(SNM_THEMEMESSAGE, SMP_AFTERCHANGE, 0);
  end;
end;

procedure TteThemeManager.ChangeTheme(const AThemeName: string);
var
  i: integer;
begin
//  if IsThemeAvailable(AThemeName) then
  begin
    Broadcast(SNM_THEMEMESSAGE, SMP_BEFORECHANGE, 0);

    if IsThemeAvailable(CurrentTheme) then
    begin
      FreeAndNil(CurrentTheme);
      if FThemeList <> nil then
        for i := 0 to FThemeList.Count - 1 do
          if AnsiLowerCase(TteThemeClass(FThemeList[i]).GetThemeName) = AnsiLowerCase(AThemeName) then
          begin
            CurrentTheme := TteThemeClass(FThemeList[i]).Create;
            Break;
          end;
      Broadcast(SNM_THEMEMESSAGE, SMP_CHANGETHEME, 0);
    end
    else
    begin
      if FThemeList <> nil then
        for i := 0 to FThemeList.Count - 1 do
          if AnsiLowerCase(TteThemeClass(FThemeList[i]).GetThemeName) = AnsiLowerCase(AThemeName) then
          begin
            CurrentTheme := TteThemeClass(FThemeList[i]).Create;
            Break;
          end;
      Broadcast(SNM_THEMEMESSAGE, SMP_APPLYTHEME, 0);
    end;

    Broadcast(SNM_THEMEMESSAGE, SMP_AFTERCHANGE, 0);
  end;
end;

procedure TteThemeManager.ChangeTheme(const AThemeClass: TteThemeClass);
begin
//  if IsThemeAvailable(AThemeClass) then
  begin
    Broadcast(SNM_THEMEMESSAGE, SMP_BEFORECHANGE, 0);

    if IsThemeAvailable(CurrentTheme) then
    begin
      FreeAndNil(CurrentTheme);
      CurrentTheme := AThemeClass.Create;
      Broadcast(SNM_THEMEMESSAGE, SMP_CHANGETHEME, 0);
    end
    else
    begin
      CurrentTheme := AThemeClass.Create;
      Broadcast(SNM_THEMEMESSAGE, SMP_APPLYTHEME, 0);
    end;

    Broadcast(SNM_THEMEMESSAGE, SMP_AFTERCHANGE, 0);
  end;
end;

procedure TteThemeManager.ReleaseTheme;
begin
  Broadcast(SNM_THEMEMESSAGE, SMP_BEFORECHANGE, 0);
  FreeAndNil(CurrentTheme);
  Broadcast(SNM_THEMEMESSAGE, SMP_REMOVETHEME, 0);
  Broadcast(SNM_THEMEMESSAGE, SMP_AFTERCHANGE, 0);
end;

function TteThemeManager.GetThemeCount: integer;
begin
  if FThemeList <> nil then
    Result := FThemeList.Count
  else
    Result := 0;
end;

function TteThemeManager.GetTheme(AIndex: integer): TteThemeClass;
var
  i: integer;
begin
  Result := nil;
  if FThemeList <> nil then
    for i := 0 to FThemeList.Count - 1 do
      if AIndex = i then
      begin
        Result := TteThemeClass(FThemeList[i]);
        Exit;
      end;
end;


{ Persitent objects store =====================================================}


var
  StoredObject: TList = nil;

type
  PStoreRec = ^TStoreRec;
  TStoreRec = record
    StoredObject: TPersistent;
    CopyObject: TPersistent;
  end;

procedure AddObjectToStore(AObject: TPersistent);
var
  i: integer;
  Rec: PStoreRec;
begin
  if StoredObject = nil then
    StoredObject := TList.Create;

  for i := 0 to StoredObject.Count - 1 do
  begin
    Rec := PStoreRec(StoredObject[i]);
    if Rec^.StoredObject = AObject then
    begin
      Rec^.CopyObject.Assign(AObject);
      Exit;
    end;
  end;

  New(Rec);
  Rec^.StoredObject := AObject;

  if AObject is TFont then
    Rec^.CopyObject := TPersistent(TFont.Create)
  else
    Rec^.CopyObject := TPersistent(AObject.ClassType.Create);

  Rec^.CopyObject.Assign(AObject);

  StoredObject.Add(Rec);
end;

procedure RemoveObjectFromStore(AObject: TPersistent);
var
  i: integer;
  Rec: PStoreRec;
begin
  if StoredObject <> nil then
  begin
    for i := 0 to StoredObject.Count - 1 do
    begin
      Rec := PStoreRec(StoredObject[i]);
      if Rec^.StoredObject = AObject then
      begin
        Rec^.CopyObject.Free;
        StoredObject.Remove(Rec);
        Dispose(Rec);
        Break;
      end;
    end;
  end;
end;

procedure AssignFromStoredObject(AObject: TPersistent);
var
  i: integer;
  Rec: PStoreRec;
begin
  if StoredObject <> nil then
  begin
    for i := 0 to StoredObject.Count - 1 do
    begin
      Rec := PStoreRec(StoredObject[i]);
      if Rec^.StoredObject = AObject then
      begin
        AObject.Assign(Rec^.CopyObject);
        Break;
      end;
    end;
  end;
end;

procedure ReleaseObjectStore;
var
  i: integer;
  Rec: PStoreRec;
begin
  if StoredObject <> nil then
  begin
    for i := 0 to StoredObject.Count - 1 do
    begin
      Rec := PStoreRec(StoredObject[i]);
      Rec^.CopyObject.Free;
      Dispose(Rec);
    end;
    StoredObject.Free;
    StoredObject := nil;
  end;
end;

{ Prop store }

var
  StoredProp: TList = nil;

type
  PPropStoreRec = ^TPropStoreRec;
  TPropStoreRec = record
    StoredObject: TObject;
    PropName: string;
    Value: TtePropValue;
  end;

procedure AddPropToStore(AObject: TObject; APropName: string; AValue: TtePropValue);
var
  i: integer;
  Rec: PPropStoreRec;
begin
  if StoredProp = nil then
    StoredProp := TList.Create;

  for i := 0 to StoredProp.Count - 1 do
  begin
    Rec := PPropStoreRec(StoredProp[i]);
    if (Rec^.StoredObject = AObject) and (Rec^.PropName = LowerCase(APropName)) then
    begin
      Rec^.Value := AValue;
      Exit;
    end;
  end;

  New(Rec);
  Rec^.StoredObject := AObject;
  Rec^.PropName := LowerCase(APropName);
  Rec^.Value := AValue;

  StoredProp.Add(Rec);
end;

procedure RemovePropFromStore(AObject: TObject; APropName: string);
var
  i: integer;
  Rec: PPropStoreRec;
begin
  if StoredProp <> nil then
  begin
    for i := 0 to StoredProp.Count - 1 do
    begin
      Rec := PPropStoreRec(StoredProp[i]);
      if (Rec^.StoredObject = AObject) and (Rec^.PropName = LowerCase(APropName)) then
      begin
        StoredProp.Remove(Rec);
        Dispose(Rec);
        Break;
      end;
    end;
  end;
end;

function GetPropFromStore(AObject: TObject; APropName: string): TtePropValue;
var
  i: integer;
  Rec: PPropStoreRec;
begin
  Result := 0;
  if StoredProp <> nil then
  begin
    for i := 0 to StoredProp.Count - 1 do
    begin
      Rec := PPropStoreRec(StoredProp[i]);
      if (Rec^.StoredObject = AObject) and (Rec^.PropName = LowerCase(APropName)) then
      begin
        Result := Rec^.Value;
        Break;
      end;
    end;
  end;
end;

procedure ReleasePropStore;
var
  i: integer;
  Rec: PPropStoreRec;
begin
  if StoredProp <> nil then
  begin
    for i := 0 to StoredProp.Count - 1 do
    begin
      Rec := PPropStoreRec(StoredProp[i]);
      Dispose(Rec);
    end;
    StoredProp.Free;
    StoredProp := nil;
  end;
end;

{ Need to write only default property's value }

procedure BeforeWriteState(AObject: TComponent);
var
  M: TMessage;
begin
  if (csDesigning in AObject.ComponentState) and (IsThemeAvailable(CurrentTheme)) then
  begin
    M.Msg := SNM_THEMEMESSAGE;
    M.WParam := SMP_REMOVETHEME;
    if AObject is TControl then
      TControl(AObject).Perform(SNM_THEMEMESSAGE, SMP_REMOVETHEME, 0)
    else
      AObject.Dispatch(M);
  end; 
end;

procedure AfterWriteState(AObject: TComponent);
var
  M: TMessage;
begin
  if (csDesigning in AObject.ComponentState) and (IsThemeAvailable(CurrentTheme)) then
  begin
    M.Msg := SNM_THEMEMESSAGE;
    M.WParam := SMP_APPLYTHEME;
    if AObject is TControl then
      TControl(AObject).Perform(SNM_THEMEMESSAGE, SMP_APPLYTHEME, 0)
    else
      AObject.Dispatch(M);
  end;
end;

{ Theme managment ==============================================================}

procedure RegisterTheme(Theme: TteThemeClass);
begin
  ThemeManager.RegisterTheme(Theme);
end;

function IsThemeAvailable(ATheme: TteTheme): boolean;
begin
  Result := ThemeManager.IsThemeAvailable(ATheme);
end;

function IsThemeAvailable(AThemeName: string): boolean;
begin
  Result := ThemeManager.IsThemeAvailable(AThemeName);
end;

procedure AddThemeNotification(AObject: TObject);
begin
  ThemeManager.AddNotification(AObject);
end;

procedure RemoveThemeNotification(AObject: TObject);
begin
  ThemeManager.RemoveNotification(AObject);
end;

procedure ChangeTheme(const ATheme: TteTheme); overload;
begin
  ThemeManager.ChangeTheme(ATheme);
end;

procedure ChangeTheme(const AThemeName: string);
begin
  ThemeManager.ChangeTheme(AThemeName);
end;

procedure ChangeTheme(const AThemeClass: TteThemeClass);
begin
  ThemeManager.ChangeTheme(AThemeClass);
end;

function GetThemeByFileName(FileName: string): TteThemeClass;
begin
  Result := ThemeManager.GetThemeByFileName(FileName);
end;

function GetDialogFilter: string;
begin
  Result := ThemeManager.GetDialogFilter;
end;

function LoadThemeFromFile(AFileName: string): TteTheme;
begin
  Result := ThemeManager.LoadFromFile(AFileName);
end;

function LoadThemeFromStream(AStream: TStream): TteTheme;
begin
  Result := ThemeManager.LoadFromStream(AStream);
end;

procedure SaveThemeToFile(ATheme: TteTheme; AFileName: string);
begin
  ThemeManager.SaveToFile(ATheme, AFileName);
end;

procedure SaveThemeToStream(ATheme: TteTheme; AStream: TStream);
begin
  ThemeManager.SaveToStream(ATheme, AStream);
end;

procedure ReleaseTheme;
begin
  ThemeManager.ReleaseTheme;
end;