cxlookandfeels.pas

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

    Result := nil
  else
    if FMasterLookAndFeel = nil then
      Result := FRootLookAndFeel
    else
      Result := FMasterLookAndFeel;
end;

function TcxLookAndFeel.GetNativeStyle: Boolean;
begin
  Result := FCurrentState.NativeStyle;
end;

function TcxLookAndFeel.GetPainter: TcxCustomLookAndFeelPainterClass;
begin
  if FPainter = nil then
    Result := FCurrentState.Painter
  else
    Result := FPainter;
end;

function TcxLookAndFeel.GetSkinName: TdxSkinName;
begin
  Result := FCurrentState.SkinName;
end;

procedure TcxLookAndFeel.SetAssignedValues(Value: TcxLookAndFeelValues);
begin
  if Value <> FAssignedValues then
  begin
    SaveState;
    FAssignedValues := Value;
    CheckStateChanges;
  end;
end;

procedure TcxLookAndFeel.SetKind(Value: TcxLookAndFeelKind);
var
  AOldKind: TcxLookAndFeelKind;
begin
  AOldKind := Kind;
  Include(FAssignedValues, lfvKind);
  FData.Kind := Value;
  if AOldKind <> InternalGetKind then
    Changed([lfvKind]);
end;

procedure TcxLookAndFeel.SetMasterLookAndFeel(Value: TcxLookAndFeel);
begin
  if FIsRootLookAndFeel or (Value = Self) then Exit;
  if Value <> MasterLookAndFeel then
  begin
    SaveState;
    if MasterLookAndFeel <> nil then
      MasterLookAndFeel.RemoveChangeListener(Self);
    FMasterLookAndFeel := Value;
    if MasterLookAndFeel <> nil then
      MasterLookAndFeel.AddChangeListener(Self);
    CheckStateChanges;
  end;
end;

procedure TcxLookAndFeel.SetNativeStyle(Value: Boolean);
var
  AOldNativeStyle: Boolean;
begin
  AOldNativeStyle := NativeStyle;
  Include(FAssignedValues, lfvNativeStyle);
  FData.NativeStyle := Value;
  if AOldNativeStyle <> InternalGetNativeStyle then
    Changed([lfvNativeStyle]);
end;

procedure TcxLookAndFeel.SetPainter(Value: TcxCustomLookAndFeelPainterClass);
begin
  if Painter <> Value then
  begin
    FPainter := Value;
    Changed([lfvKind, lfvNativeStyle]);
  end;
end;

procedure TcxLookAndFeel.SetSkinName(const Value: TdxSkinName);
var
  AOldSkinName: string;
begin
  AOldSkinName := SkinName;
  Include(FAssignedValues, lfvSkinName);
  FData.SkinName := Value;
  if AOldSkinName <> InternalGetSkinName then
    Changed([lfvSkinName]);
end;

procedure TcxLookAndFeel.CheckStateChanges;
var
  AChangedValues: TcxLookAndFeelValues;
begin
  AChangedValues := [];
  if FPrevState.Kind <> InternalGetKind then
    Include(AChangedValues, lfvKind);
  if FPrevState.NativeStyle <> InternalGetNativeStyle then
    Include(AChangedValues, lfvNativeStyle);
  if FPrevState.SkinName <> InternalGetSkinName then 
    Include(AChangedValues, lfvSkinName);
  Changed(AChangedValues);
end;

function TcxLookAndFeel.GetDefaultKind: TcxLookAndFeelKind;
begin
  if FIsRootLookAndFeel then
    Result := cxDefaultLookAndFeelKind
  else
    if FMasterLookAndFeel = nil then
      if FRootLookAndFeel = nil then
        Result := cxDefaultLookAndFeelKind
      else
        Result := FRootLookAndFeel.Kind
    else
      Result := FMasterLookAndFeel.Kind;
end;

function TcxLookAndFeel.GetDefaultNativeStyle: Boolean;
begin
  if FIsRootLookAndFeel then
    Result := cxDefaultLookAndFeelNativeStyle
  else
    if FMasterLookAndFeel = nil then
      if FRootLookAndFeel = nil then
        Result := cxDefaultLookAndFeelNativeStyle
      else
        Result := FRootLookAndFeel.NativeStyle
    else
      Result := FMasterLookAndFeel.NativeStyle;
end;

function TcxLookAndFeel.GetDefaultSkinName: string;
begin
  if FIsRootLookAndFeel then
    Result := cxDefaultLookAndFeelSkinName
  else
    if FMasterLookAndFeel = nil then
      if FRootLookAndFeel = nil then
        Result := cxDefaultLookAndFeelSkinName
      else
        Result := FRootLookAndFeel.SkinName
    else
      Result := FMasterLookAndFeel.SkinName;
end;

function TcxLookAndFeel.GetDefaultSkinPainter: TcxCustomLookAndFeelPainterClass;
begin
  if FIsRootLookAndFeel then
    Result := nil
  else
    if FMasterLookAndFeel = nil then
      if FRootLookAndFeel = nil then
        Result := nil
      else
       FRootLookAndFeel.IsVisualSkinAvailable(FRootLookAndFeel.SkinName, Result)
    else
      FMasterLookAndFeel.IsVisualSkinAvailable(FMasterLookAndFeel.SkinName, Result);
end;

function TcxLookAndFeel.IsKindStored: Boolean;
begin                                                               
  Result := lfvKind in FAssignedValues;
end;

function TcxLookAndFeel.IsNativeStyleStored: Boolean;
begin
  Result := lfvNativeStyle in FAssignedValues;
end;

function TcxLookAndFeel.IsSkinNameStored: Boolean;
begin
  Result := lfvSkinName in FAssignedValues;
end;

procedure TcxLookAndFeel.SaveState;
begin
  FPrevState.Kind := Kind;
  FPrevState.NativeStyle := NativeStyle;
  FPrevState.SkinName := SkinName;
end;

function TcxLookAndFeel.GetObject: TObject;
begin
  Result := Self;
end;

procedure TcxLookAndFeel.MasterLookAndFeelDestroying(Sender: TcxLookAndFeel);
begin
  MasterLookAndFeel := nil;
end;

procedure TcxLookAndFeel.PainterChanged(APainter: TcxCustomLookAndFeelPainterClass);
begin
  Changed(LookAndFeelValueAll);
end;

{ TcxLookAndFeelController }

constructor TcxLookAndFeelController.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if RootLookAndFeel <> nil then
    RootLookAndFeel.AddChangeListener(Self);
end;

destructor TcxLookAndFeelController.Destroy;
begin
  if RootLookAndFeel <> nil then
    RootLookAndFeel.RemoveChangeListener(Self);
  inherited Destroy;
end;

function TcxLookAndFeelController.GetKind: TcxLookAndFeelKind;
begin
  if RootLookAndFeel = nil then
    Result := cxDefaultLookAndFeelKind
  else
    Result := RootLookAndFeel.Kind;
end;

function TcxLookAndFeelController.GetNativeStyle: Boolean;
begin
  if RootLookAndFeel = nil then
    Result := cxDefaultLookAndFeelNativeStyle
  else
    Result := RootLookAndFeel.NativeStyle;
end;

function TcxLookAndFeelController.GetSkinName: TdxSkinName;
begin
  if RootLookAndFeel = nil then
    Result := cxDefaultLookAndFeelSkinName
  else
    Result := RootLookAndFeel.SkinName;
end;

function TcxLookAndFeelController.IsSkinNameStored: Boolean;
begin
  Result := SkinName <> '';
end;

procedure TcxLookAndFeelController.SetKind(Value: TcxLookAndFeelKind);
begin
  if RootLookAndFeel <> nil then
    RootLookAndFeel.Kind := Value;
end;

procedure TcxLookAndFeelController.SetNativeStyle(Value: Boolean);
begin
  if RootLookAndFeel <> nil then
    RootLookAndFeel.NativeStyle := Value;
end;

procedure TcxLookAndFeelController.SetSkinName(const Value: TdxSkinName);
begin
  if RootLookAndFeel <> nil then
    RootLookAndFeel.SkinName := Value;
end;

procedure TcxLookAndFeelController.Modified;
begin
end;

function TcxLookAndFeelController.GetObject: TObject;
begin
  Result := Self;
end;

procedure TcxLookAndFeelController.MasterLookAndFeelChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues);
begin
  if csDesigning in ComponentState then
    Modified;
end;

procedure TcxLookAndFeelController.MasterLookAndFeelDestroying(Sender: TcxLookAndFeel);
var
  AOwnerForm: TCustomForm;
begin
  AOwnerForm := nil;
{$IFDEF DELPHI6}
  if (Owner is TFrame) and (TFrame(Owner).Owner is TForm) then
    AOwnerForm := TForm(TFrame(Owner).Owner)
  else
{$ENDIF}
    if Owner is TForm then
      AOwnerForm := TForm(Owner);
  if AOwnerForm = nil then
    Exit;
  if AOwnerForm.Designer <> nil then
    AOwnerForm.Designer.Modified;
end;

{ TcxSystemPaletteChangedNotifier }

constructor TcxSystemPaletteChangedNotifier.Create(AIsPrimary: Boolean = False);
begin
  inherited Create;
  FIsPrimary := AIsPrimary;
  AddRefSystemPaletteChangedListener;
  FSystemPaletteChangedListener.AddNotifier(Self, AIsPrimary);
end;

destructor TcxSystemPaletteChangedNotifier.Destroy;
begin
  FSystemPaletteChangedListener.RemoveNotifier(Self, FIsPrimary);
  ReleaseRefSystemPaletteChangedListener;
end;

procedure TcxSystemPaletteChangedNotifier.DoChanged;
begin
  if Assigned(FOnSystemPaletteChanged) then
    FOnSystemPaletteChanged;
end;

function ClassSupportsSkinHandler(AClass: TPersistent): Boolean;
begin
  Result := Supports(AClass, IdxSkinSupport);
end;

initialization
{$IFDEF DELPHI6}
  GroupDescendentsWith(TcxLookAndFeelController, TForm);
{$ENDIF}
  FRootLookAndFeel := TcxLookAndFeel.Create(nil);
  FRootLookAndFeel.FIsRootLookAndFeel := True;
  ClassSupportsSkinProc := ClassSupportsSkinHandler;

finalization
  FreeAndNil(FRootLookAndFeel);

end.