jvqcolorprovider.pas

East make Tray Icon in delphi

  case ListNum of
    0:
      begin
        if I >= ColorProvider.GetStandardCount then
          TList.Error(SListIndexError, I)
        else
          Result := TJvColorItem.Create(Self, 0, I);
      end;
    1:
      begin
        if I >= ColorProvider.GetSystemCount then
          TList.Error(SListIndexError, I)
        else
          Result := TJvColorItem.Create(Self, 1, I);
      end;
    2:
      begin
        if I >= ColorProvider.GetCustomCount then
          TList.Error(SListIndexError, I)
        else
          Result := TJvColorItem.Create(Self, 2, I);
      end;
    else
      TList.Error(SListIndexError, I);
  end;
end;

procedure TJvColorItemsList.AfterConstruction;
begin
  inherited AfterConstruction;
  ListNum := TJvColorHeaderItem(GetParent.GetImplementer).ListNumber;
end;

//=== { TJvColorItem } =======================================================

constructor TJvColorItem.Create(AOwner: IJvDataItems; AListNumber, AListIndex: Integer);
begin
  inherited Create(AOwner);
  FListNumber := AListNumber;
  FListIndex := AListIndex;
end;

function TJvColorItem.GetCaption: string;
var
  ColorFound: Boolean;
  ColorValue: TColor;
begin
  case ListNumber of
    0:
      ColorFound := (GetItems.GetProvider as IJvColorProvider).GetStandardColor(ListIndex, ColorValue, Result);
    1:
      ColorFound := (GetItems.GetProvider as IJvColorProvider).GetSystemColor(ListIndex, ColorValue, Result);
    2:
      ColorFound := (GetItems.GetProvider as IJvColorProvider).GetCustomColor(ListIndex, ColorValue, Result);
    else
    begin
      ColorFound := False;
      Result := '';
    end;
  end;
  if (Result = '') and ColorFound then
    ColorToIdent(ColorValue, Result);
end;

procedure TJvColorItem.SetCaption(const Value: string);
begin
  case ListNumber of
    0:
      (GetItems.GetProvider as IJvColorProvider).SetStandardColorName(ListIndex, Value);
    1:
      (GetItems.GetProvider as IJvColorProvider).SetSystemColorName(ListIndex, Value);
    2:
      (GetItems.GetProvider as IJvColorProvider).SetCustomColorName(ListIndex, Value);
  end;
end;

function TJvColorItem.Editable: Boolean;
begin
  Result := True;
end;

function TJvColorItem.Get_Color: TColor;
begin
  if not GetItemColorValue(Self, Result) then
    Result := ColorProvider_NotAColor;
end;

procedure TJvColorItem.InitID;
var
  ColorFound: Boolean;
  ColorValue: TColor;
  ColorName: string;
begin
  case ListNumber of
    0:
      ColorFound := (GetItems.GetProvider as IJvColorProvider).GetStandardColor(ListIndex, ColorValue, ColorName);
    1:
      ColorFound := (GetItems.GetProvider as IJvColorProvider).GetSystemColor(ListIndex, ColorValue, ColorName);
    2:
      ColorFound := (GetItems.GetProvider as IJvColorProvider).GetCustomColor(ListIndex, ColorValue, ColorName);
    else
    begin
      ColorFound := False;
      ColorValue := -1;
    end;
  end;
  if ColorFound then
  begin


    SetID(cColorItemIDPrefix + IntToHex(ColorValue, 8));
  end
  else
    SetID('Item' + IntToStr(ListNumber) + '.' + IntToStr(ListIndex));
end;

//=== { TJvColorHeaderItem } =================================================

constructor TJvColorHeaderItem.Create(AOwner: IJvDataItems; AListNumber: Integer);
begin
  inherited Create(AOwner);
  FListNumber := AListNumber;
end;

function TJvColorHeaderItem.GetCaption: string;
var
  Settings: IJvColorProviderSettings;
begin
  Supports(GetItems.GetProvider.SelectedConsumer, IJvColorProviderSettings, Settings);
  if Settings = nil then
    Result := RsNoSettings
  else
    case ListNumber of
      0:
        Result := Settings.StandardColorSettings.Caption;
      1:
        Result := Settings.SystemColorSettings.Caption;
      2:
        Result := Settings.CustomColorSettings.Caption;
    end;
end;

function TJvColorHeaderItem.Editable: Boolean;
begin
  Result := False;
end;

procedure TJvColorHeaderItem.SetCaption(const Value: string);
begin
end;

procedure TJvColorHeaderItem.InitID;
begin
  SetID(cColorProviderGroupHeaderID + IntToStr(ListNumber));
end;

procedure TJvColorHeaderItem.InitImplementers;
var
  Settings: IJvColorProviderSettings;
begin
  inherited InitImplementers;
  // (rom) suppress warnings about abstract methods
  // (rom) TJvBaseDataItems.InternalAdd, InternalDelete and InternalMove
  // (rom) can this be fixed by empty methods?
  {$WARNINGS OFF}
  if GetItems.GetProvider.SelectedConsumer = MasterColorConsumer then
    TJvColorItemsList.Create(Self)
  else
  if Supports(GetItems.GetProvider.SelectedConsumer, IJvColorProviderSettings, Settings) then
  begin
    if not Settings.GroupingSettings.FlatList then
      TJvColorItemsList.Create(Self);
    if (FListNumber = 2) and Settings.CustomColorSettings.AddColorSettings.Active and
        (Settings.CustomColorSettings.AddColorSettings.Location = ailUseHeader) then
      TJvColorItemAddExecute.Create(Self);
  end;
  {$WARNINGS ON}
end;

function TJvColorHeaderItem.IsDeletable: Boolean;
begin
  Result := False;
end;

//=== { TJvColorAddItem } ====================================================

function TJvColorAddItem.GetCaption: string;
var
  Settings: IJvColorProviderSettings;
begin
  Supports(GetItems.GetProvider.SelectedConsumer, IJvColorProviderSettings, Settings);
  if Settings = nil then
    Result := RsNoSettings
  else
    Result := Settings.CustomColorSettings.AddColorSettings.Caption;
end;

procedure TJvColorAddItem.SetCaption(const Value: string);
begin
end;

function TJvColorAddItem.Editable: Boolean;
begin
  Result := False;
end;

procedure TJvColorAddItem.InitID;
begin
  SetID(cColorProviderAddItemID);
end;

procedure TJvColorAddItem.InitImplementers;
begin
  inherited InitImplementers;
  TJvColorItemAddExecute.Create(Self);
end;

//=== { TJvColorItemAddExecute } =============================================

function TJvColorItemAddExecute.Execute(Sender: TObject): Boolean;
var
  ColorSettings: IJvColorProviderSettings;
  StyleIdx: Integer;
  Color: TColor;
  DoAdd: Boolean;
  Callback: TJvColorProviderColorAdder;
begin
  Result := Supports(Item.Items.Provider.SelectedConsumer, IJvColorProviderSettings, ColorSettings);
  if Result then
  begin
    StyleIdx := ColorSettings.CustomColorSettings.AddColorSettings.Style;
    Color := ColorProvider_NotAColor;
    DoAdd := False;
    Callback := ColorProviderColorAdderRegister.Callbacks(StyleIdx);
    if Assigned(Callback) then
      Callback(Item.Items.Provider as IJvColorProvider, ctCustom, Color, DoAdd);
    if DoAdd then
      (Item.Items.Provider as IJvColorProvider).AddColor(ctCustom, Color);
  end;
end;

//=== { TJvColorProvider } ===================================================

constructor TJvColorProvider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMappings := TJvColorProviderNameMappings.Create(Self);
  GenDelphiConstantMapping;
  GenEnglishMapping;
  (DataContextsImpl as IJvDataContextsManager).Add(TJvColorContext.Create(DataContextsImpl, 'Default'));
  InitColors;
  FColorListChanged := False;
end;

destructor TJvColorProvider.Destroy;
begin
  FreeAndNil(FMappings);
  inherited Destroy;
end;

procedure TJvColorProvider.NotifyChanging(Reason: TDataProviderChangeReason; ContextIndex: Integer;
  GroupedItem, RootItem: IUnknown);
var
  I: Integer;
  Consumer: IJvDataConsumer;
  ConCtx: IJvDataConsumerContext;
  Settings: IJvColorProviderSettings;
  CtxIdx: Integer;
begin
  if ContextIndex = -1 then
    ContextIndex := SelectedContextIndex;
  SelectContext((DataContextsImpl as IJvDataContexts).GetContext(ContextIndex));
  try
    for I := 0 to GetNotifierCount - 1 do
    begin
      if Supports(GetNotifier(I), IJvDataConsumer, Consumer) and
        Supports(Consumer, IJvDataConsumerContext, ConCtx) and
        Supports(Consumer, IJvColorProviderSettings, Settings) then
      begin
        CtxIdx := ConCtx.GetContext.Contexts.IndexOf(ConCtx.GetContext);
        if (CtxIdx = ContextIndex) or ((CtxIdx = -1) and (ContextIndex = 0)) then
        begin
          if Settings.GroupingSettings.Active and not Settings.GroupingSettings.FlatList then
            GetNotifier(I).DataProviderChanging(Self, Reason, GroupedItem)
          else
            GetNotifier(I).DataProviderChanging(Self, Reason, RootItem);
        end;
      end
      else
        { No consumer, contextless consumer or no color settings. Hand over the grouped item as it
          is more specific. }
        GetNotifier(I).DataProviderChanging(Self, pcrAdd, GroupedItem);
    end;
  finally
    ReleaseContext;
  end;
end;

procedure TJvColorProvider.NotifyChanged(Reason: TDataProviderChangeReason; ContextIndex: Integer;
  GroupedItem, RootItem: IUnknown);
var
  I: Integer;
  Consumer: IJvDataConsumer;
  ConCtx: IJvDataConsumerContext;
  Settings: IJvColorProviderSettings;
  CtxIdx: Integer;
begin
  if ContextIndex = -1 then
    ContextIndex := SelectedContextIndex;
  SelectConsumer(MasterColorConsumer);
  try
    SelectContext((DataContextsImpl as IJvDataContexts).GetContext(ContextIndex));
    try
      for I := 0 to GetNotifierCount - 1 do
      begin
        if Supports(GetNotifier(I), IJvDataConsumer, Consumer) and
          Supports(Consumer, IJvDataConsumerContext, ConCtx) and
          Supports(Consumer, IJvColorProviderSettings, Settings) then
        begin
          CtxIdx := ConCtx.GetContext.Contexts.IndexOf(ConCtx.GetContext);
          if (CtxIdx = ContextIndex) or ((CtxIdx = -1) and (ContextIndex = 0)) then
          begin
            if Settings.GroupingSettings.Active and not Settings.GroupingSettings.FlatList then
              GetNotifier(I).DataProviderChanged(Self, Reason, GroupedItem)
            else
              GetNotifier(I).DataProviderChanged(Self, Reason, RootItem);
          end;
        end
        else
          { No consumer, contextless consumer or no color settings. Hand over the grouped item as it
            is more specific. }
          GetNotifier(I).DataProviderChanged(Self, pcrAdd, GroupedItem);
      end;
    finally
      ReleaseContext;
    end;
  finally
    ReleaseConsumer;
  end;
end;

procedure TJvColorProvider.NotifyColorAdding(ColorType: TColorType; ContextIndex: Integer);
begin
  if ContextIndex = -1 then
    ContextIndex := SelectedContextIndex;
  SelectConsumer(MasterColorConsumer);
  try
    SelectContext((DataContextsImpl as IJvDataContexts).GetContext(ContextIndex));
    try
      NotifyChanging(pcrAdd, ContextIndex, TJvColorHeaderItem.Create(GetItems, Ord(ColorType)).Items,
        GetItems);
    finally
      ReleaseContext;
    end;
  finally
    ReleaseConsumer;
  end;
end;

procedure TJvColorProvider.NotifyColorAdded(ColorType: TColorType; ListIndex: Integer;
  ContextIndex: Integer);
var
  Grouped: IJvDataItem;
  Rooted: IJvDataItem;
begin
  if ContextIndex = -1 then
    ContextIndex := SelectedContextIndex;
  SelectConsumer(MasterColorConsumer);
  try
    SelectContext((DataContextsImpl as IJvDataContexts).GetContext(ContextIndex));
    try
      Grouped := TJvColorItem.Create(
        TJvColorHeaderItem.Create