jvdataprovider.pas

East make Tray Icon in delphi

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDataProvider.pas,v $';
    Revision: '$Revision: 1.53 $';
    Date: '$Date: 2005/03/10 09:13:02 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF MSWINDOWS}
  ActiveX,
  {$ENDIF MSWINDOWS}
  SysUtils, Consts, TypInfo,
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  JclStrings,
  JvTypes, JvConsts, JvResources, JvJCLUtils;

const
  vifHasChildren = Integer($80000000);
  vifCanHaveChildren = Integer($40000000);
  vifExpanded = Integer($20000000);

  cClassName = 'ClassName';
  cName = 'Name';
  cProvider = 'Provider';

function HexBytes(const Buf; Length: Integer): string;
var
  P: PChar;
begin
  Result := '';
  P := @Buf;
  while Length > 1 do
  begin
    Result := Result + IntToHex(Ord(P^), 2);
    Inc(P);
    Dec(Length);
  end;
end;

//TODO: Copied from JvLabel.pas to avoid dependency. Must move to another unit.

type
  TShadowPosition = (spLeftTop, spLeftBottom, spRightBottom, spRightTop);

function DrawShadowText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect;
  Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
  ShadowPos: TShadowPosition): Integer;
var
  RText, RShadow: TRect;
  Color: TColorRef;
  OldBkMode: Integer;
begin
  RText := Rect;
  RShadow := Rect;
  Color := SetTextColor(DC, ShadowColor);
  case ShadowPos of
    spLeftTop:
      OffsetRect(RShadow, -ShadowSize, -ShadowSize);
    spRightBottom:
      OffsetRect(RShadow, ShadowSize, ShadowSize);
    spLeftBottom:
      begin
        {OffsetRect(RText, ShadowSize, 0);}
        OffsetRect(RShadow, -ShadowSize, ShadowSize);
      end;
    spRightTop:
      begin
        {OffsetRect(RText, 0, ShadowSize);}
        OffsetRect(RShadow, ShadowSize, -ShadowSize);
      end;
  end;
  Result := DrawText(DC, Str, Count, RShadow, Format);
  if Result > 0 then
    Inc(Result, ShadowSize);
  SetTextColor(DC, Color);
  OldBkMode := SetBkMode(DC, TRANSPARENT);
  try
    DrawText(DC, Str, Count, RText, Format);
  finally
    SetBkMode(DC, OldBkMode);
  end;
  UnionRect(Rect, RText, RShadow);
end;

procedure DisabledTextRect(ACanvas: TCanvas; var ARect: TRect; Left, Top: Integer; Text: string);
begin
  ACanvas.Font.Color := clGrayText;
  {$IFDEF VisualCLX}
  ACanvas.Start;
  SetPainterFont(ACanvas.Handle, ACanvas.Font);
  {$ENDIF VisualCLX}
  DrawShadowText(ACanvas.Handle, PChar(Text), Length(Text), ARect, 0, 1, ColorToRGB(clBtnHighlight),
    spRightBottom);
  {$IFDEF VisualCLX}
  ACanvas.Stop;
  {$ENDIF VisualCLX}
end;

procedure AddItemsToList(AItems: IJvDataItems; ItemList: TStrings; Level: Integer);
var
  I: Integer;
  ThisItem: IJvDataItem;
  SubItems: IJvDataItems;
begin
  for I := 0 to AItems.Count - 1 do
  begin
    ThisItem := AItems.Items[I];
    ItemList.AddObject(ThisItem.GetID, TObject(Level));
    if Supports(ThisItem, IJvDataItems, SubItems) then
      AddItemsToList(SubItems, ItemList, Level + 1);
  end;
end;

function DP_FindItemsIntf(AItem: IJvDataItem; IID: TGUID; out Obj): Boolean;
begin
  while (AItem <> nil) and not Supports(AItem.GetItems, IID, Obj) do
    AItem := AItem.GetItems.Parent;
  Result := AItem <> nil;
end;

function DP_FindItemsRenderer(AItem: IJvDataItem; out Renderer: IJvDataItemsRenderer): Boolean;
begin
  Result := DP_FindItemsIntf(AItem, IJvDataItemsRenderer, Renderer);
end;

function DP_FindItemsImages(AItem: IJvDataItem; out Images: IJvDataItemsImages): Boolean;
begin
  Result := DP_FindItemsIntf(AItem, IJvDataItemsImages, Images);
end;

procedure DP_GenItemsList(RootList: IJvDataItems; ItemList: TStrings);
begin
  ItemList.Clear;
  AddItemsToList(RootList, ItemList, 0);
end;

function DP_OwnerDrawStateToProviderDrawState(State: TOwnerDrawState): TProviderDrawStates;
begin
  Move(State, Result, SizeOf(State));
end;

procedure DP_SelectConsumerContext(Provider: IJvDataProvider; Consumer: IJvDataConsumer; Context: IJvDataContext);
begin
  Provider.SelectConsumer(Consumer);
  try
    Provider.SelectContext(Context);
  except
    Provider.ReleaseConsumer;
    raise;
  end;
end;

procedure DP_ReleaseConsumerContext(Provider: IJvDataProvider);
var
  CurConsumer: IJvDataConsumer;
begin
  CurConsumer := Provider.SelectedConsumer;
  Provider.ReleaseConsumer;
  try
    Provider.ReleaseContext;
  except
    Provider.SelectConsumer(CurConsumer);
    raise;
  end;
end;

function IsExtensionSpecificIntf(IID: TGUID): Boolean;
begin
  Result := IsEqualGuid(IID, IJvDataContextSensitive);
end;

function GetContextPath(Context: IJvDataContext): string;
begin
  if Context <> nil then
  begin
    Result := Context.Name;
    while Context <> nil do
    begin
      Context := Context.Contexts.Ancestor;
      if Context <> nil then
        Result := Context.Name + '\' + Result;
    end;
  end;
end;

function GetItemIDPath(Item: IJvDataItem): string;
begin
  if Item <> nil then
  begin
    Result := Item.GetID;
    while Item <> nil do
    begin
      Item := Item.Items.Parent;
      if Item <> nil then
        Result := Item.GetID + '\' + Result;
    end;
  end;
end;

procedure InsertIntArray(var Arr: TDynIntegerArray; Index: Integer; Item: Integer);
begin
  SetLength(Arr, Length(Arr) + 1);
  if Index < High(Arr) then
    Move(Arr[Index], Arr[Index + 1], (High(Arr) - Index) * SizeOf(Integer));
  Arr[Index] := Item;
end;

function GetItemIndexPath(Item: IJvDataItem): TDynIntegerArray;
begin
  if Item <> nil then
  begin
    SetLength(Result, 1);
    Result[0] := Item.GetIndex;
    while Item <> nil do
    begin
      Item := Item.Items.Parent;
      if Item <> nil then
        InsertIntArray(Result, 0, Item.GetIndex);
    end;
  end
  else
    SetLength(Result, 0);
end;

function GetUniqueCtxName(Contexts: IJvDataContexts; Prefix: string): string;
var
  PrefixLen: Integer;
  SuffixNum: Int64;
  CtxIdx: Integer;
  TmpNum: Int64;
begin
  PrefixLen := Length(Prefix);
  SuffixNum := 1;
  for CtxIdx := 0 to Contexts.GetCount - 1 do
    if AnsiSameStr(Prefix, Copy(Contexts.GetContext(CtxIdx).Name, 1, PrefixLen)) then
      with Contexts.GetContext(CtxIdx) do
      begin
        if StrIsSubset(Copy(Name, PrefixLen + 1, Length(Name) - PrefixLen), DigitSymbols) then
        begin
          TmpNum := StrToInt64(Copy(Name, PrefixLen + 1, Length(Name) - PrefixLen));
          if TmpNum >= SuffixNum then
            SuffixNum := TmpNum + 1;
        end;
      end;
  Result := Prefix + IntToStr(SuffixNum);
end;

function GetItemCheckedState(Item: IJvDataItem): TDataItemState;
var
  Provider: IJvDataProvider;
  ConsState: IJvDataConsumerItemState;
  ItemState: IJvDataItemStates;
begin
  Result := disNotUsed;
  if Item <> nil then
  begin
    Provider := Item.Items.Provider;
    if Supports(Provider.SelectedConsumer, IJvDataConsumerItemState, ConsState) then
      Result := ConsState.Checked(Item);
    if (Result = disNotUsed) and Supports(Item, IJvDataItemStates, ItemState) then
      Result := ItemState.Checked;
  end;
end;

function GetItemEnabledState(Item: IJvDataItem): TDataItemState;
var
  Provider: IJvDataProvider;
  ConsState: IJvDataConsumerItemState;
  ItemState: IJvDataItemStates;
begin
  Result := disNotUsed;
  if Item <> nil then
  begin
    Provider := Item.Items.Provider;
    if Supports(Provider.SelectedConsumer, IJvDataConsumerItemState, ConsState) then
      Result := ConsState.Enabled(Item);
    if (Result <> disFalse) and Supports(Item, IJvDataItemStates, ItemState) then
      Result := ItemState.Enabled;
  end;
end;

function GetItemVisibleState(Item: IJvDataItem): TDataItemState;
var
  Provider: IJvDataProvider;
  ConsState: IJvDataConsumerItemState;
  ItemState: IJvDataItemStates;
begin
  Result := disNotUsed;
  if Item <> nil then
  begin
    Provider := Item.Items.P