cxstyles.pas

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

    IcxStyleChangeListener(FListeners[I]).StyleChanged(Self);
end;

procedure TcxCustomStyle.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  StyleRepository := TcxStyleRepository(Reader.Parent);
end;

function TcxCustomStyle.GetIndex: Integer;
begin
  if StyleRepository <> nil then
    Result := StyleRepository.StyleIndexOf(self)
  else Result := -1;  
end;

procedure TcxCustomStyle.SetStyleRepository(Value: TcxStyleRepository);
begin
  if FStyleRepository <> Value then
  begin
    if FStyleRepository <> nil then
      FStyleRepository.RemoveItem(Self);
    FStyleRepository := Value;   
    if Value <> nil then
      Value.AddItem(Self);
  end;
end;

{ TcxCustomStyleSheet }

constructor TcxCustomStyleSheet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBuiltIn := csDesigning in ComponentState;
  FStyles := GetStylesClass.Create(self);
  FStyles.FOwnerStyleSheet := self;
  FStylesList := TList.Create;
end;

destructor TcxCustomStyleSheet.Destroy;
begin
  Destroying;
  while FStylesList.Count > 0 do
    TcxCustomStyles(FStylesList[FStylesList.Count - 1]).StyleSheet := nil;
  StyleRepository := nil;
  FStyles.Free;
  FStylesList.Free;
  inherited Destroy;
end;

procedure TcxCustomStyleSheet.AddStyles(AStyles: TcxCustomStyles);
begin
  if FStylesList.IndexOf(AStyles) < 0 then
    FStylesList.Add(AStyles);
end;

procedure TcxCustomStyleSheet.Assign(Source: TPersistent);
begin
  if Source is TcxCustomStyleSheet then
    with TcxCustomStyleSheet(Source) do
    begin
      Self.Caption := Caption;
      Self.SetStyles(GetStyles);
    end
  else
    inherited;
end;

procedure TcxCustomStyleSheet.CopyFrom(AStyleSheet: TcxCustomStyleSheet);
var
  I: Integer;
  AStyle: TcxCustomStyle;
begin
  if (AStyleSheet <> nil) and (GetStylesClass = AStyleSheet.GetStylesClass) then
  begin
    for I := 0 to AStyleSheet.GetStyles.Count - 1 do
    begin
      if StyleRepository <> nil then
        AStyle := StyleRepository.CreateItemEx(
          TcxCustomStyleClass(AStyleSheet.GetStyles.Items[I].Item.ClassType),
          StyleRepository.Owner)
      else
        AStyle := TcxCustomStyleClass(AStyleSheet.GetStyles.Items[I].Item.ClassType).Create(Owner);
      AStyle.Assign(AStyleSheet.GetStyles.Items[I].Item);
      GetStyles.Values[AStyleSheet.GetStyles.Items[I].Index] := AStyle;
    end;
  end;
end;

class function TcxCustomStyleSheet.GetStylesClass: TcxCustomStylesClass;
begin
  Result := TcxCustomStyles;
end;

function TcxCustomStyleSheet.GetParentComponent: TComponent;
begin
  Result := StyleRepository;
end;

function TcxCustomStyleSheet.HasParent: Boolean;
begin
  Result := StyleRepository <> nil;
end;

function TcxCustomStyleSheet.GetStyles: TcxCustomStyles;
begin
  Result := FStyles;
end;

procedure TcxCustomStyleSheet.RemoveStyles(AStyles: TcxCustomStyles);
begin
  FStylesList.Remove(AStyles);
end;

procedure TcxCustomStyleSheet.SetStyles(const Value: TcxCustomStyles);
begin
  FStyles.Assign(Value);
end;

procedure TcxCustomStyleSheet.SetParentComponent(AParent: TComponent);
begin
  if not (csLoading in ComponentState) then
    StyleRepository := AParent as TcxStyleRepository;
end;

procedure TcxCustomStyleSheet.DefineProperties(AFiler: TFiler);
begin
  inherited;
  AFiler.DefineProperty('BuiltIn', ReadBuiltIn, WriteBuiltIn, True);
end;

procedure TcxCustomStyleSheet.DoStyleChanged(AIndex: Integer);
var
  I: Integer;
begin
  for I := 0 to FStylesList.Count - 1 do
     TcxCustomStyles(FStylesList[I]).DoChanged(AIndex);
  UpdateFakeLinks;   
end;

procedure TcxCustomStyleSheet.GetFakeComponentLinks(AList: TList);
var
  I: Integer;
begin
  for I := 0 to FStyles.Count - 1 do
    if (FStyles.Items[I].Item.Owner <> Owner) and (Owner <> nil) and
      (AList.IndexOf(FStyles.Items[I].Item.Owner) < 0) then
      AList.Add(FStyles.Items[I].Item.Owner);
end;

procedure TcxCustomStyleSheet.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  StyleRepository := TcxStyleRepository(Reader.Parent);
end;

function TcxCustomStyleSheet.GetCaptionStored: Boolean;
begin
  Result := FCaption <> '';
end;

function TcxCustomStyleSheet.GetCaption: string;
begin
  if FCaption <> '' then
    Result := FCaption
  else Result := Name;
end;

function TcxCustomStyleSheet.GetIndex: Integer;
begin
  if StyleRepository <> nil then
    Result := StyleRepository.StyleSheetIndexOf(self)
  else Result := -1;  
end;

procedure TcxCustomStyleSheet.SetCaption(const Value: String);
begin
  if FCaption <> Value then
  begin
    if CompareText(Name, Value) <> 0 then
      FCaption := Value
    else FCaption := '';
  end;
end;

procedure TcxCustomStyleSheet.SetStyleRepository(Value: TcxStyleRepository);
begin
  if FStyleRepository <> Value then
  begin
    if FStyleRepository <> nil then
      FStyleRepository.RemoveStyleSheet(Self);
    FStyleRepository := Value;
    if Value <> nil then
      Value.AddStyleSheet(Self);
  end;
end;

procedure TcxCustomStyleSheet.ReadBuiltIn(AReader: TReader);
begin
  FBuiltIn := AReader.ReadBoolean;
end;

procedure TcxCustomStyleSheet.WriteBuiltIn(AWriter: TWriter);
begin
  AWriter.WriteBoolean(FBuiltIn);
end;

{ TcxStyleRepository }

constructor TcxStyleRepository.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TList.Create;
  FStyleSheets := TList.Create;
end;

destructor TcxStyleRepository.Destroy;
begin
  Clear;
  ClearStyleSheets;
  FItems.Free;
  FItems := nil;
  FStyleSheets.Free;
  FStyleSheets := nil;
  inherited Destroy;
end;

procedure TcxStyleRepository.Clear;
begin
  while Count > 0 do
    Items[Count - 1].Free;
end;

procedure TcxStyleRepository.ClearStyleSheets;
begin
  while StyleSheetCount > 0 do
    StyleSheets[StyleSheetCount - 1].Free;
end;

function TcxStyleRepository.CreateItem(AStyleClass: TcxCustomStyleClass): TcxCustomStyle;
begin
  Result := CreateItemEx(AStyleClass, Self);
end;

function TcxStyleRepository.CreateItemEx(AStyleClass: TcxCustomStyleClass;
  AOwner: TComponent): TcxCustomStyle;
begin
  Result := AStyleClass.Create(AOwner);
  Result.StyleRepository := Self;
end;

function TcxStyleRepository.CreateStyleSheet(AStyleSheetClass: TcxCustomStyleSheetClass): TcxCustomStyleSheet;
begin
  Result := CreateStyleSheetEx(AStyleSheetClass, Self);
end;

function TcxStyleRepository.CreateStyleSheetEx(AStyleSheetClass: TcxCustomStyleSheetClass;
  AOwner: TComponent): TcxCustomStyleSheet;
begin
  Result := AStyleSheetClass.Create(AOwner);
  Result.StyleRepository := Self;
end;

function TcxStyleRepository.StyleIndexOf(AStyle: TcxCustomStyle): Integer;
begin
  Result := FItems.IndexOf(AStyle);
end;

function TcxStyleRepository.StyleSheetIndexOf(AStyleSheet: TcxCustomStyleSheet): Integer;
begin
  Result := FStyleSheets.IndexOf(AStyleSheet);
end;

procedure TcxStyleRepository.AddItem(AItem: TcxCustomStyle);
var
  AIndex: Integer;
begin
  AIndex := FItems.IndexOf(AItem);
  if AIndex = -1 then
    FItems.Add(AItem);
end;

procedure TcxStyleRepository.AddStyleSheet(AStyleSheet: TcxCustomStyleSheet);
var
  AIndex: Integer;
begin
  AIndex := FStyleSheets.IndexOf(AStyleSheet);
  if AIndex = -1 then
    FStyleSheets.Add(AStyleSheet);
end;

procedure TcxStyleRepository.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('PixelsPerInch', ReadPixelsPerInch, WritePixelsPerInch, Filer.Ancestor = nil);
end;

procedure TcxStyleRepository.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  AItem: TcxCustomStyle;
  AStyleSheet: TcxCustomStyleSheet;
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    AItem := Items[I];
    if AItem.Owner = Root then
      Proc(AItem);
  end;
  for I := 0 to StyleSheetCount - 1 do
  begin
    AStyleSheet := StyleSheets[I];
    if AStyleSheet.Owner = Root then
      Proc(AStyleSheet);
  end;
end;

function TcxStyleRepository.GetScaledValue(AValue: Integer): Integer;
begin
  Result := AValue;
  if Scalable and (FPixelsPerInch <> 0) and (FPixelsPerInch <> cxGetScreenPixelsPerInch) then
    Result := MulDiv(Result, cxGetScreenPixelsPerInch, FPixelsPerInch);
end;

procedure TcxStyleRepository.RemoveItem(AItem: TcxCustomStyle);
begin
  FItems.Remove(AItem);
end;

procedure TcxStyleRepository.RemoveStyleSheet(AStyleSheet: TcxCustomStyleSheet);
begin
  FStyleSheets.Remove(AStyleSheet);
end;

function TcxStyleRepository.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TcxStyleRepository.GetStyleSheetCount: Integer;
begin
  Result := FStyleSheets.Count;
end;

function TcxStyleRepository.GetItem(Index: Integer): TcxCustomStyle;
begin
  Result := TcxCustomStyle(FItems[Index]);
end;

function TcxStyleRepository.GetStyleSheet(Index: Integer): TcxCustomStyleSheet;
begin
  Result := TcxCustomStyleSheet(FStyleSheets[Index]);
end;

procedure TcxStyleRepository.ReadPixelsPerInch(Reader: TReader);
begin
  FPixelsPerInch := Reader.ReadInteger;
end;

procedure TcxStyleRepository.WritePixelsPerInch(Writer: TWriter);
begin
  Writer.WriteInteger(cxGetScreenPixelsPerInch);
end;

{ TcxCustomStylesItem }

constructor TcxCustomStylesItem.Create(AIndex: Integer; AItem: TcxCustomStyle);
begin
  inherited Create;
  Index := AIndex;
  Item := AItem;
end;

{ TcxCustomStyles }

constructor TcxCustomStyles.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FItems := TList.Create;
end;  

destructor TcxCustomStyles.Destroy;
begin
  FDestroying := True;
  Clear;
  FItems.Free;
  StyleSheet := nil;
  inherited Destroy;
end;

procedure TcxCustomStyles.Assign(Source: TPersistent);
begin
  if Source is TcxCustomStyles then
    StyleSheet := TcxCustomStyles(Source).StyleSheet;
end;

function TcxCustomStyles.IsValidStyleSheet(AStyleSheet: TcxCustomStyleSheet): Boolean;
var
  AStyles: TcxCustomStyles;
begin
  Result := (AStyleSheet = nil) or
    ((AStyleSheet <> OwnerStyleSheet) and (AStyleSheet.GetStylesClass = TcxCustomStylesClass(ClassType)));
  if Result and (AStyleSheet <> nil) and (OwnerStyleSheet <> nil) then //check for a cycle
  begin
    AStyles := AStyleSheet.GetStyles;
    while AStyles.StyleSheet <> nil do
    begin
      if AStyles.StyleSheet = OwnerStyleSheet then
      begin
        Result := False;
        break;
      end;
      AStyles := AStyles.StyleSheet.GetStyles;
    end;
  end;
end;