cxstyles.pas

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

procedure TcxCustomStyles.StyleChanged(Sender: TcxCustomStyle);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Items[I].Item = Sender then
      DoChanged(Items[I].Index);
end;

procedure TcxCustomStyles.StyleRemoved(Sender: TcxCustomStyle);
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    if Items[I].Item = Sender then
      Delete(I);
end;

procedure TcxCustomStyles.Clear;
begin
  while Count > 0 do
    Delete(Count - 1);
end;

procedure TcxCustomStyles.Delete(AItemIndex: Integer);
var
  AItem: TcxCustomStylesItem;
  AIndex: Integer;
begin
  AItem := Items[AItemIndex];
  AIndex := AItem.Index;
  AItem.Item.RemoveListener(Self);
  AItem.Free;
  FItems.Delete(AItemIndex);
  DoChanged(AIndex);
end;

procedure TcxCustomStyles.DoChanged(AIndex: Integer);
begin
  if Destroying then Exit;
  Changed(AIndex);
  if OwnerStyleSheet <> nil then
    OwnerStyleSheet.DoStyleChanged(AIndex);
end;

function TcxCustomStyles.Find(AIndex: Integer; var AItemIndex: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  AItemIndex := 0; 
  Result := False;
  L := 0;
  H := Count - 1;
  if L <= H then
    repeat
      I := (L + H) div 2;
      C := Items[I].Index - AIndex;
      if C = 0 then
      begin
        AItemIndex := I;
        Result := True;
        Break;
      end
      else
        if C < 0 then
          L := I + 1
        else
          H := I - 1;
      if L > H then
      begin
        AItemIndex := L;
        Break;
      end;
    until False;
end;

function TcxCustomStyles.GetValue(Index: Integer): TcxCustomStyle;
var
  AItemIndex: Integer;
begin
  if Find(Index, AItemIndex) then
    Result := Items[AItemIndex].Item
  else
    Result := nil;
  if (Result = nil) and (StyleSheet <> nil) and
    ((GetOwner = nil) or not (GetOwner is TComponent) or  // don't persist a stylesheet's style 
    not (csWriting in TComponent(GetOwner).ComponentState)) then
    Result := StyleSheet.GetStyles.GetValue(Index);
end;

procedure TcxCustomStyles.ResetStyles;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Values[I] := nil;
end;

procedure TcxCustomStyles.SetValue(Index: Integer; Value: TcxCustomStyle);
var
{$IFDEF DELPHI6}
  AStylesRootOwner, AValueOwner: TPersistent;
{$ENDIF}
  AItem: TcxCustomStylesItem;
  AItemIndex: Integer;
begin
{$IFDEF DELPHI6}
  if (Value <> nil) and (Value.Name <> '') then
  begin
    AStylesRootOwner := Owner;
    while GetUltimateOwner(AStylesRootOwner) <> nil do
      AStylesRootOwner := GetUltimateOwner(AStylesRootOwner);
    AValueOwner := Value.Owner;
    if (AStylesRootOwner <> AValueOwner) and
      (AStylesRootOwner is TComponent) and (AValueOwner is TComponent) and
      AStylesRootOwner.InheritsFrom(AValueOwner.ClassType) then
      Value := TComponent(AStylesRootOwner).FindComponent(Value.Name) as TcxCustomStyle;
  end;
{$ENDIF}
  if GetValue(Index) <> Value then
    if Find(Index, AItemIndex) then
    begin
      AItem := Items[AItemIndex];
      AItem.Item.RemoveListener(Self);
      if Value <> nil then
      begin
        AItem.Item := Value;
        Value.AddListener(Self);
      end
      else
      begin
        AItem.Free;
        FItems.Delete(AItemIndex);
      end;
      DoChanged(Index);
    end
    else
      if Value <> nil then
      begin
        AItem := TcxCustomStylesItem.Create(Index, Value);
        FItems.Insert(AItemIndex, AItem);
        Value.AddListener(Self);
        DoChanged(Index);
      end;
end;

procedure TcxCustomStyles.Changed(AIndex: Integer);
begin
end;

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

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

procedure TcxCustomStyles.SetStyleSheet(const Value: TcxCustomStyleSheet);
var
  AChangedStyles: TList;

  procedure AddChangedStyles(AStyleSheet: TcxCustomStyleSheet);
  var
    I: Integer;
    AIndex: Pointer;
  begin
    if AStyleSheet = nil then exit;
    if AChangedStyles = nil then
      AChangedStyles := TList.Create;
    for I := 0 to AStyleSheet.GetStyles.Count - 1 do
    begin
      AIndex := Pointer(AStyleSheet.GetStyles.Items[I].Index);
      if AChangedStyles.IndexOf(AIndex) < 0 then
        AChangedStyles.Add(AIndex);
    end;
    if AStyleSheet.GetStyles.StyleSheet <> nil then
      AddChangedStyles(AStyleSheet.GetStyles.StyleSheet);
  end;

var
  I: Integer;
begin
  if (StyleSheet <> Value) and IsValidStyleSheet(Value) then
  begin
    AChangedStyles := nil;
    if (StyleSheet <> nil) then
    begin
      StyleSheet.RemoveStyles(self);
      if not Destroying then
        AddChangedStyles(StyleSheet);
    end;
    FStyleSheet := Value;
    if StyleSheet <> nil then
    begin
      StyleSheet.AddStyles(self);
      AddChangedStyles(StyleSheet);
    end;
    if AChangedStyles <> nil then
    begin
      for I := 0 to AChangedStyles.Count - 1 do
        DoChanged(Integer(AChangedStyles[I]));
      AChangedStyles.Free;
    end;
  end;
end;

{ TcxStyle }

constructor TcxStyle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColor := clDefault;
  FBitmap := TBitmap.Create;
  FBitmap.OnChange := BitmapChanged;
  FFont := TFont.Create;
  FFont.OnChange := FontChanged;
  FTextColor := clDefault;
end;

destructor TcxStyle.Destroy;
begin
  FreeAndNil(FFont);
  FreeAndNil(FBitmap);
  inherited Destroy;
end;

procedure TcxStyle.SetAssignedValues(Value: TcxStyleValues);
begin
  if FAssignedValues <> Value then
  begin
    FAssignedValues := Value;
    Changed;
  end;
end;

procedure TcxStyle.SetBitmap(Value: TBitmap);
begin
  FBitmap.Assign(Value);
end;

procedure TcxStyle.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    if FColor = clDefault then // It's correct?
      Exclude(FAssignedValues, svColor)
    else
      Include(FAssignedValues, svColor);
    Changed;
  end;
end;

procedure TcxStyle.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TcxStyle.SetTextColor(Value: TColor);
begin
  if FTextColor <> Value then
  begin
    FTextColor := Value;
    if FTextColor = clDefault then // It's correct?
      Exclude(FAssignedValues, svTextColor)
    else
      Include(FAssignedValues, svTextColor);
    Changed;
  end;
end;

procedure TcxStyle.BitmapChanged(Sender: TObject);
begin
  if FBitmap.Empty then
    Exclude(FAssignedValues, svBitmap)
  else
    Include(FAssignedValues, svBitmap);
  Changed;
end;

procedure TcxStyle.FontChanged(Sender: TObject);
begin
  Include(FAssignedValues, svFont);
  Changed;
end;

function TcxStyle.IsBitmapStored: Boolean;
begin
  Result := svBitmap in FAssignedValues;
end;

function TcxStyle.IsColorStored: Boolean;
begin
  Result := svColor in FAssignedValues;
end;

function TcxStyle.IsFontStored: Boolean;
begin
  Result := svFont in FAssignedValues;
end;

function TcxStyle.IsTextColorStored: Boolean;
begin
  Result := svTextColor in FAssignedValues;
end;

procedure TcxStyle.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if StyleRepository <> nil then
    Font.Height := StyleRepository.GetScaledValue(Font.Height);
end;

procedure TcxStyle.Assign(Source: TPersistent);
begin
  if Source is TcxStyle then
    with TcxStyle(Source) do
    begin
      Self.Bitmap := Bitmap;
      Self.Color := Color;
      Self.Font := Font;
      Self.TextColor := TextColor;
      Self.AssignedValues := AssignedValues;
    end
  else
    inherited Assign(Source);
end;

procedure TcxStyle.RestoreDefaults;
begin
  FAssignedValues := [];
  FBitmap.Assign(nil);
  FColor := clDefault;
  FTextColor := clDefault;
  Changed;
end;

{ TcxStyles }

procedure TcxStyles.DefaultFontChanged(Sender: TObject; AFont: TFont);
var
  I: Integer;
  AParams: TcxViewParams;
begin
  for I := 0 to FMaxDefaultViewParamsIndex do
    if IsDefaultFont(I) then
    begin
      GetDefaultViewParams(I, nil, AParams);
      if AParams.Font = AFont then DoChanged(I);
    end;
end;

function TcxStyles.GetValue(Index: Integer): TcxStyle;
begin
  Result := TcxStyle(inherited GetValue(Index));
end;

procedure TcxStyles.SetValue(Index: Integer; Value: TcxStyle);
begin
  inherited SetValue(Index, Value);
end;

procedure TcxStyles.GetDefaultViewParams(Index: Integer; AData: TObject;
  out AParams: TcxViewParams);
begin
  AParams.Bitmap := nil;
  if Index > FMaxDefaultViewParamsIndex then FMaxDefaultViewParamsIndex := Index;
end;

function TcxStyles.IsDefaultFont(Index: Integer): Boolean;
begin
  Result := not UseStyle(Values[Index], svFont);
end;

function TcxStyles.GetBitmap(Index: Integer): TBitmap;
var
  AAssignedStyle: TcxStyle;
begin
  AAssignedStyle := Values[Index];
  if UseStyle(AAssignedStyle, svBitmap) and not AAssignedStyle.Bitmap.Empty then
    Result := AAssignedStyle.Bitmap
  else
    Result := nil;
end;

procedure TcxStyles.GetViewParams(Index: Integer; AData: TObject; AStyle: TcxStyle;
  out AParams: TcxViewParams);
var
  AAssignedStyle: TcxStyle;
  ADefaultParams: TcxViewParams;

  function GetBitmap: TBitmap;
  begin
    if UseStyle(AStyle, svBitmap) then
      Result := AStyle.Bitmap
    else
      if UseStyle(AAssignedStyle, svBitmap) then
        Result := AAssignedStyle.Bitmap
      else
        Result := nil;
  end;

  function GetColor: TColor;
  begin
    if UseStyle(AStyle, svColor) then
      Result := AStyle.Color
    else
      if UseStyle(AAssignedStyle, svColor) then
        Result := AAssignedStyle.Color
      else
        Result := clDefault;
  end;

  function GetFont: TFont;