jvxpbar.pas

East make Tray Icon in delphi

begin
  Result := False;
  for I := 0 to Count - 1 do
    if Items[I] = Item then
    begin
      Result := True;
      Break;
    end;
end;

procedure TJvXPBarVisibleItems.Add(Item: TJvXPBarItem);
begin
  if not Exists(Item) then
  begin
    FItems.Add(Item);
    FWinXPBar.SortVisibleItems(False);
  end;
end;

procedure TJvXPBarVisibleItems.Delete(Item: TJvXPBarItem);
begin
  if Exists(Item) then
    FItems.Delete(FItems.IndexOf(Item));
end;

//=== { TJvXPFadeThread } ====================================================

constructor TJvXPFadeThread.Create(WinXPBar: TJvXPCustomWinXPBar;
  RollDirection: TJvXPBarRollDirection);
begin
  inherited Create(True);
  FWinXPBar := WinXPBar;
  FRollDirection := RollDirection;
  FreeOnTerminate := True;
  Suspended := False;
end;

procedure TJvXPFadeThread.Execute;
var
  NewOffset: Integer;
begin
  while not Terminated do
  try
    FWinXPBar.FRolling := True;

    { calculate new roll offset }
    if FRollDirection = rdCollapse then
      NewOffset := FWinXPBar.RollOffset - FWinXPBar.FRollStep
    else
      NewOffset := FWinXPBar.RollOffset + FWinXPBar.FRollStep;

    { validate offset ranges }
    if NewOffset < 0 then
      NewOffset := 0;
    if NewOffset > FWinXPBar.FItemHeight then
      NewOffset := FWinXPBar.FItemHeight;
    FWinXPBar.RollOffset := NewOffset;

    { terminate on 'out-of-range' }
    if ((FRollDirection = rdCollapse) and (NewOffset = 0)) or
      ((FRollDirection = rdExpand) and (NewOffset = FWinXPBar.FItemHeight)) then
      Terminate;
    {$IFDEF VisualCLX}
    WakeUpGUIThread;
    {$ENDIF VisualCLX}

    { idle process }
    Sleep(FWinXPBar.FRollDelay);
  finally
    FWinXPBar.FRolling := False;
  end;

  { redraw button state }
  FWinXPBar.FCollapsed := FRollDirection = rdCollapse;
  if FWinXPBar.FShowRollButton then
    FWinXPBar.InternalRedraw;

  { update inspector }
  if csDesigning in FWinXPBar.ComponentState then
    {$IFDEF VCL}
    TCustomForm(FWinXPBar.Owner).Designer.Modified
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    TCustomForm(FWinXPBar.Owner).DesignerHook.Modified
    {$ENDIF VisualCLX}
  else
    PostMessage(FWinXPBar.Handle, WM_XPBARAFTERCOLLAPSE,
      Ord(FRollDirection = rdCollapse), 0);
  {$IFDEF VisualCLX}
  WakeUpGUIThread;
  {$ENDIF VisualCLX}
end;

//=== { TJvXPBarColors } =====================================================

constructor TJvXPBarColors.Create;
{$IFDEF JVCLThemesEnabled}
var
  Details: TThemedElementDetails;
  AColor: COLORREF;
{$ENDIF JVCLThemesEnabled}
begin
  inherited Create;
  // (rom) needs local color constants
  FBodyColor := TColor($00F7DFD6);
  FBorderColor := clWhite;
  FGradientFrom := clWhite;
  FGradientTo := TColor($00F7D7C6);
  FSeparatorColor := TColor($00F7D7C6);
  FCheckedColor := dxColor_CheckedColorXP;
  FFocusedColor := dxColor_FocusedColorXP;
  FCheckedFrameColor := dxColor_CheckedFrameColorXP;
  FFocusedFrameColor := dxColor_FocusedFrameColorXP;
  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(tebHeaderBackgroundNormal);
    with Details do
    begin
      if GetThemeColor(ThemeServices.Theme[Element], Part, State,
        TMT_FILLCOLOR, AColor) = 0 then
        FBodyColor := AColor;
      if GetThemeColor(ThemeServices.Theme[Element], Part, State,
        TMT_GRADIENTCOLOR1, AColor) = 0 then
        FGradientFrom := AColor;
      if GetThemeColor(ThemeServices.Theme[Element], Part, State,
        TMT_GRADIENTCOLOR2, AColor) = 0 then
        FGradientTo := AColor;
      if GetThemeColor(ThemeServices.Theme[Element], Part, State,
        TMT_EDGEFILLCOLOR, AColor) = 0 then
        FSeparatorColor := AColor;
    end;
  end;
  {$ENDIF JVCLThemesEnabled}
end;

procedure TJvXPBarColors.Assign(Source: TPersistent);
begin
  if Source is TJvXPBarColors then
    with TJvXPBarColors(Source) do
    begin
      Self.CheckedColor := CheckedColor;
      Self.FocusedColor := FocusedColor;
      Self.CheckedFrameColor := CheckedFrameColor;
      Self.FocusedFrameColor := FocusedFrameColor;
      Self.BodyColor := BodyColor;
      Self.GradientTo := GradientTo;
      Self.GradientFrom := GradientFrom;
      Self.SeparatorColor := SeparatorColor;
    end
  else
    inherited Assign(Source);
end;

procedure TJvXPBarColors.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvXPBarColors.SetBodyColor(const Value: TColor);
begin
  if FBodyColor <> Value then
  begin
    FBodyColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetGradientFrom(const Value: TColor);
begin
  if FGradientFrom <> Value then
  begin
    FGradientFrom := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetGradientTo(const Value: TColor);
begin
  if FGradientTo <> Value then
  begin
    FGradientTo := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetSeparatorColor(const Value: TColor);
begin
  if FSeparatorColor <> Value then
  begin
    FSeparatorColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetCheckedColor(const Value: TColor);
begin
  if FCheckedColor <> Value then
  begin
    FCheckedColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetBorderColor(const Value: TColor);
begin
  if FBorderColor <> Value then
  begin
    FBorderColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetFocusedColor(const Value: TColor);
begin
  if FFocusedColor <> Value then
  begin
    FFocusedColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetCheckedFrameColor(const Value: TColor);
begin
  if FCheckedFrameColor <> Value then
  begin
    FCheckedFrameColor := Value;
    Change;
  end;
end;

procedure TJvXPBarColors.SetFocusedFrameColor(const Value: TColor);
begin
  if FFocusedFrameColor <> Value then
  begin
    FFocusedFrameColor := Value;
    Change;
  end;
end;

//=== { TJvXPCustomWinXPBar } ================================================

constructor TJvXPCustomWinXPBar.Create(AOwner: TComponent);
const
  MouseEvents: TJvXPControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave];
begin
  inherited Create(AOwner);
  FStoredHint := '|'; // no one in their right mind uses a pipe as the only character in a hint...
  ControlStyle := ControlStyle - [csDoubleClicks] + [csAcceptsControls, csActionClient];
  ExControlStyle := [csRedrawCaptionChanged];
  ExControlStyle := ExControlStyle + MouseEvents;
  Height := 46;
  HotTrack := True; // initialize mouse events
  Width := 153;
  FColors := TJvXPBarColors.Create;
  FColors.OnChange := DoColorsChange;
  FCollapsed := False;
  FFadeThread := nil;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := DoColorsChange;
  FRollChangeLink := TChangeLink.Create;
  FRollChangeLink.OnChange := DoColorsChange;
  FTopSpace := 5;

  FFont := TFont.Create;
  FFont.Color := $00840000;
  FFont.Size := 8;
  FFont.OnChange := FontChange;
  FGradient := TBitmap.Create;
  FHeaderHeight := 28;
  FHeaderRounded := True;
  FGradientWidth := 0;
  FHeaderFont := TFont.Create;
  FHeaderFont.Color := $00840000;
  FHeaderFont.Size := 8;
  FHeaderFont.Style := [fsBold];
  FHeaderFont.OnChange := FontChange;

  FHitTest := htNone;

  FHotTrackColor := $00FF7C35;
  FHoverIndex := -1;
  FIcon := TIcon.Create;
  FItemHeight := 20;
  FItems := GetBarItemsClass.Create(Self);
  FRollDelay := 25;
  FRolling := False;
  FRollMode := rmShrink;
  FRollOffset := FItemHeight;
  FRollStep := 3;
  FShowLinkCursor := True;
  FShowRollButton := True;
  FVisibleItems := TJvXPBarVisibleItems.Create(Self);
end;

destructor TJvXPCustomWinXPBar.Destroy;
begin
  FFont.Free;
  FHeaderFont.Free;
  FGradient.Free;
  FIcon.Free;
  FItems.Free;
  FVisibleItems.Free;
  FColors.Free;
  FImageChangeLink.Free;
  FRollChangeLink.Free;
  inherited Destroy;
end;

procedure TJvXPCustomWinXPBar.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  if not (csDestroying in ComponentState) and (Operation = opRemove) then
  begin
    if AComponent = FImageList then
      ImageList := nil;
    if AComponent = FRollImages then
      RollImages := nil;
    for I := 0 to FItems.Count - 1 do
      FItems[I].Notification(AComponent);
  end;
  inherited Notification(AComponent, Operation);
end;

function TJvXPCustomWinXPBar.IsFontStored: Boolean;
begin
  Result := not ParentFont {$IFDEF VCL} and not DesktopFont {$ENDIF};
end;

procedure TJvXPCustomWinXPBar.FontChange(Sender: TObject);
begin
  if (not FFontChanging) and not (csLoading in ComponentState) then
    ParentFont := False;
  InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.ResizeToMaxHeight;
var
  NewHeight: Integer;
begin
  { TODO: Check this!!! }
  if IsLocked then
    Exit;
  NewHeight := FC_HEADER_MARGIN + HeaderHeight + FVisibleItems.Count * FRollOffset + FC_ITEM_MARGIN + 1;
  { full collapsing }
  if ((FRolling and not FCollapsed) or (not FRolling and FCollapsed) or
    (FVisibleItems.Count = 0)) then
    Dec(NewHeight, FC_ITEM_MARGIN);
//  if Height <> NewHeight then
  Height := NewHeight - 5 + FTopSpace;
end;

function TJvXPCustomWinXPBar.GetHitTestAt(X, Y: Integer): TJvXPBarHitTest;
begin
  Result := htNone;
  if PtInRect(GetHitTestRect(htHeader), Point(X, Y)) then
    Result := htHeader;
  if PtInRect(GetHitTestRect(htRollButton), Point(X, Y)) then
    Result := htRollButton;
end;

function TJvXPCustomWinXPBar.GetItemRect(Index: Integer): TRect;
begin
  Result.Left := 3;
  Result.Right := Width - 3;
  if FRollMode = rmShrink then
    Result.Top := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN div 2 +
      Index * FRollOffset - 4 + FTopSpace
  else
    Result.Top := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN div 2 +
      Index * FItemHeight - 4 + FTopSpace;
  Result.Bottom := Result.Top + FItemHeight;
end;

function TJvXPCustomWinXPBar.GetRollHeight: Integer;
begin
  if Assigned(FRollImages) then
    Result := FRollImages.Height
  else
    Result := 18;
end;

function TJvXPCustomWinXPBar.GetRollWidth: Integer;
begin
  if Assigned(FRollImages) then
    Result := FRollImages.Width
  else
    Result := 18;
end;

function TJvXPCustomWinXPBar.GetHitTestRect(const HitTest: TJvXPBarHitTest): TRect;

begin
  case HitTest of
    htHeader:
      Result := Bounds(0, 5, Width, FHeaderHeight);
    htRollButton:
      Result := Bounds(Width - 24, (FHeaderHeight - GetRollHeight) div 2, GetRollWidth, GetRollHeight);
  end;
end;

procedure TJvXPCustomWinXPBar.SortVisibleItems(const Redraw: Boolean);
begin
  if (csLoading in ComponentState) or (csDestroying in ComponentState) then
    Exit;
  FVisibleItems.FItems.Sort(@SortByIndex);
  if Redraw then
    InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.ItemVisibilityChanged(Item: TJvXPBarItem);
begin
  // update visible-item list
  if Item.Visible then
    FVisibleItems.Add(Item)
  else
    FVisibleItems.Delete(Item);
end;

procedure TJvXPCustomWinXPBar.HookMouseDown;
var
  Rect: TRect;
begin
  inherited HookMouseDown; // update drawstate
  if FHitTest = htRollButton then
  begin
    Rect := GetHitTestRect(htRollButton);
    Windows.InvalidateRect(Handle, @Rect, False);
  end;
end;

procedure TJvXPCustomWinXPBar.HookMouseEnter;
begin
  inherited HookMouseEnter;