cxlookandfeels.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,008 行 · 第 1/3 页

  ReleaseOffice11Colors;
  inherited Destroy;
end;
                                                        
procedure TcxSystemPaletteChangedListener.AddNotifier(
  ANotifier: TcxSystemPaletteChangedNotifier; AIsPrimary: Boolean);
begin
  if AIsPrimary then
  begin
    if FPrimaryNotifierList <> nil then
      FPrimaryNotifierList.Add(ANotifier);
  end
  else
    if FNotifierList <> nil then
      FNotifierList.Add(ANotifier);
end;

procedure TcxSystemPaletteChangedListener.RemoveNotifier(
  ANotifier: TcxSystemPaletteChangedNotifier; AIsPrimary: Boolean);
begin
  if AIsPrimary then
  begin
    if FPrimaryNotifierList <> nil then
      FPrimaryNotifierList.Remove(ANotifier);
  end
  else
    if FNotifierList <> nil then
      FNotifierList.Remove(ANotifier);
end;

procedure TcxSystemPaletteChangedListener.DoChange;
var
  I: Integer;
begin
  RefreshOffice11Colors;
  for I := FPrimaryNotifierList.Count - 1 downto 0 do
  //for I := 0 to FPrimaryNotifierList.Count - 1 do
    TcxSystemPaletteChangedNotifier(FPrimaryNotifierList[I]).DoChanged;
  for I := FNotifierList.Count - 1 downto 0 do
  //for I := 0 to FNotifierList.Count - 1 do
    TcxSystemPaletteChangedNotifier(FNotifierList[I]).DoChanged;
end;

procedure TcxSystemPaletteChangedListener.WndProc(var Msg: TMessage);
begin
  with Msg do
    try
      if Msg = WM_SYSCOLORCHANGE then
        DoChange;
    finally
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
    end;
end;

{ TcxLookAndFeel }

constructor TcxLookAndFeel.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FChangeListenerList := TList.Create;
  FData.Kind := cxDefaultLookAndFeelKind;
  FData.NativeStyle := cxDefaultLookAndFeelNativeStyle;
  FCurrentState := FData;
  FSystemPaletteChangedNotifier := TcxSystemPaletteChangedNotifier.Create;
  FSystemPaletteChangedNotifier.OnSystemPaletteChanged := SystemPaletteChanged;
  if FRootLookAndFeel <> nil then
  begin
    FRootLookAndFeel.AddChangeListener(Self);
    FCurrentState.Kind := InternalGetKind;
    FCurrentState.NativeStyle := InternalGetNativeStyle;
    FCurrentState.SkinName := InternalGetSkinName;
    FSkinPainter := nil;
    if not FCurrentState.NativeStyle then
      FSkinPainter := InternalGetSkinPainter;
  end;
  FCurrentState.Painter := GetAvailablePainter();
end;

destructor TcxLookAndFeel.Destroy;
var
  I: Integer;
begin
  if GetExtendedStylePainters <> nil then
    GetExtendedStylePainters.RemoveListener(Self);
  FreeAndNil(FSystemPaletteChangedNotifier);
  FIsDestruction := True;
  for I := 0 to FChangeListenerList.Count - 1 do
  begin
    IcxLookAndFeelNotificationListener(FChangeListenerList.Items[I]).MasterLookAndFeelDestroying(Self);
  end;
  FIsDestruction := False;
  FreeAndNil(FChangeListenerList);

  if MasterLookAndFeel <> nil then
    MasterLookAndFeel.RemoveChangeListener(Self);

  if FIsRootLookAndFeel then
  begin
    FRootLookAndFeel := nil;
    FIsRootLookAndFeel := False;
  end;
  inherited Destroy;
end;

procedure TcxLookAndFeel.AddChangeListener(AListener: IcxLookAndFeelNotificationListener);
var
  AIsLookAndFeelController: Boolean;
begin
  if AListener = nil then
    Exit;
  AIsLookAndFeelController := AListener.GetObject is TcxLookAndFeelController;
  if not FIsRootLookAndFeel and AIsLookAndFeelController then
    Exit;
  if FChangeListenerList.IndexOf(TObject(AListener)) >= 0 then
    Exit;

  if FIsRootLookAndFeel and AIsLookAndFeelController then
    Inc(FLookAndFeelControllerCount);
  FChangeListenerList.Add(TObject(AListener));
end;

function TcxLookAndFeel.GetAvailablePainter(ANeededThemedObjectType:
  TdxThemedObjectType): TcxCustomLookAndFeelPainterClass;
begin
  if NativeStyle and AreVisualStylesAvailable(ANeededThemedObjectType) then
    Result := TcxWinXPLookAndFeelPainter
  else
    if FSkinPainter <> nil then
      Result := FSkinPainter
    else
      Result := LookAndFeelPainterMap[Kind];
end;

function TcxLookAndFeel.GetAvailablePainter(ANeededThemedObjectTypes:
  TdxThemedObjectTypes = []): TcxCustomLookAndFeelPainterClass;
begin
  if NativeStyle and AreVisualStylesAvailable(ANeededThemedObjectTypes) then
    Result := TcxWinXPLookAndFeelPainter
  else
    if FSkinPainter <> nil then
      Result := FSkinPainter
    else
      Result := LookAndFeelPainterMap[Kind];
end;

procedure TcxLookAndFeel.Assign(Source: TPersistent);
begin
  if Source is TcxLookAndFeel then
    with Source as TcxLookAndFeel do
    begin
      Self.SaveState;
      Self.FData := FData;
      Self.FAssignedValues := FAssignedValues;
      Self.MasterLookAndFeel := MasterLookAndFeel;
      Self.CheckStateChanges;
    end
  else
    inherited Assign(Source);
end;

procedure TcxLookAndFeel.Refresh;
begin
  Changed(LookAndFeelValueAll);
end;

procedure TcxLookAndFeel.RemoveChangeListener(AListener: IcxLookAndFeelNotificationListener);
var
  AIsLookAndFeelController: Boolean;
begin
  if AListener = nil then
    Exit;
  AIsLookAndFeelController := AListener.GetObject is TcxLookAndFeelController;
  if FChangeListenerList.IndexOf(TObject(AListener)) < 0 then
    Exit;

  if not FIsDestruction then
    FChangeListenerList.Remove(TObject(AListener));

  if FIsRootLookAndFeel and AIsLookAndFeelController then
  begin
    Dec(FLookAndFeelControllerCount);
    if FLookAndFeelControllerCount = 0 then
      Reset;
  end;
end;

procedure TcxLookAndFeel.Reset;
begin
  AssignedValues := [];
end;

procedure TcxLookAndFeel.SetStyle(Value: TcxLookAndFeelStyle);
begin
  NativeStyle := Value = lfsNative;
  if not NativeStyle then
    Kind := LookAndFeelKindMap[Value];
end;

procedure TcxLookAndFeel.Changed(AChangedValues: TcxLookAndFeelValues);
var
  I, APrevCount: Integer;
begin
  if (AChangedValues = []) or FIsDestruction then Exit;
  FCurrentState.Kind := InternalGetKind;
  FCurrentState.NativeStyle := InternalGetNativeStyle;
  FCurrentState.SkinName := InternalGetSkinName;
  FSkinPainter := nil;
  if not FCurrentState.NativeStyle then
    FSkinPainter := InternalGetSkinPainter;
  FCurrentState.Painter := GetAvailablePainter;
  if GetExtendedStylePainters <> nil then
  begin
    if FSkinPainter <> nil then
      GetExtendedStylePainters.AddListener(Self)
    else
      GetExtendedStylePainters.RemoveListener(Self);
  end;
  I := 0;
  while I < FChangeListenerList.Count do
  begin
    APrevCount := FChangeListenerList.Count;
    IcxLookAndFeelNotificationListener(FChangeListenerList.Items[I]).MasterLookAndFeelChanged(Self, AChangedValues);
    if APrevCount = FChangeListenerList.Count then
      Inc(I);
  end;
  if Assigned(FOnChanged) then
    FOnChanged(Self, AChangedValues);
end;

procedure TcxLookAndFeel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('SkinName', ReadSkinName, WriteSkinName, IsSkinNameStored);
end;

procedure TcxLookAndFeel.ReadSkinName(Reader: TReader);
begin
  SkinName := Reader.ReadString;
end;

procedure TcxLookAndFeel.WriteSkinName(Writer: TWriter);
begin
  Writer.WriteString(SkinName);
end;

function TcxLookAndFeel.InternalGetKind: TcxLookAndFeelKind;
begin
  if lfvKind in FAssignedValues then
    Result := FData.Kind
  else
    Result := GetDefaultKind;
end;

function TcxLookAndFeel.InternalGetNativeStyle: Boolean;
begin
  if lfvNativeStyle in FAssignedValues then
    Result := FData.NativeStyle
  else
    Result := GetDefaultNativeStyle;
end;

function TcxLookAndFeel.InternalGetSkinName: string;
begin
  if lfvSkinName in FAssignedValues then
    Result := FData.SkinName
  else
    Result := GetDefaultSkinName;
end;

function TcxLookAndFeel.InternalGetSkinPainter: TcxCustomLookAndFeelPainterClass;
begin
  if lfvSkinName in FAssignedValues then
    IsVisualSkinAvailable(FData.SkinName, Result)
  else
    Result := GetDefaultSkinPainter;
end;

function TcxLookAndFeel.IsVisualSkinAvailable(const ASkinName: string;
  out Painter: TcxCustomLookAndFeelPainterClass): Boolean;
begin
  Result := (ASkinName <> '') and
    GetExtendedStylePainters.GetPainterByName(ASkinName, Painter);
  if not Result or not cxUseSkins then
    Painter := nil;
end;

procedure TcxLookAndFeel.MasterLookAndFeelChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues);
var
  AOwnChangedValues: TcxLookAndFeelValues;
begin
  AOwnChangedValues := (LookAndFeelValueAll - FAssignedValues) * AChangedValues;
  Changed(AOwnChangedValues);
end;

procedure TcxLookAndFeel.NotifyChanged;
var
  AListener: TObject;
  APrevCount, I: Integer;
begin
  if FIsDestruction then
    Exit;
  I := 0;
  while I < FChangeListenerList.Count do
  begin
    APrevCount := FChangeListenerList.Count;
    AListener := IcxLookAndFeelNotificationListener(FChangeListenerList.Items[I]).GetObject;
    if AListener is TcxLookAndFeel then
      TcxLookAndFeel(AListener).NotifyChanged;
    if APrevCount = FChangeListenerList.Count then
      Inc(I);
  end;
  if Assigned(FOnChanged) then
    FOnChanged(Self, []);
end;

procedure TcxLookAndFeel.SystemPaletteChanged;
begin
  Changed([lfvNativeStyle]);
end;

function TcxLookAndFeel.GetActiveStyle: TcxLookAndFeelStyle;
begin
  if NativeStyle and AreVisualStylesAvailable then
    Result := lfsNative
  else
    Result := LookAndFeelStyleMap[Kind];
end;

function TcxLookAndFeel.GetKind: TcxLookAndFeelKind;
begin
  Result := FCurrentState.Kind;
end;

function TcxLookAndFeel.GetMasterLookAndFeel: TcxLookAndFeel;
begin
  if FIsRootLookAndFeel then