jvxpbar.pas

East make Tray Icon in delphi

  if FHoverIndex <> -1 then
    DoDrawItem(FHoverIndex, [dsFocused]);
end;

procedure TJvXPCustomWinXPBar.HookMouseLeave;
begin
  inherited HookMouseLeave;
  if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
    (not FVisibleItems[FHoverIndex].Checked) then
    DoDrawItem(FHoverIndex, []);
end;

procedure TJvXPCustomWinXPBar.HookMouseMove(X, Y: Integer);
const
  cPipe = '|';
var
  Rect: TRect;
  OldHitTest: TJvXPBarHitTest;
  NewIndex, Header: Integer;
begin
  OldHitTest := FHitTest;
  FHitTest := GetHitTestAt(X, Y);
  if FHitTest <> OldHitTest then
  begin
    Rect := Bounds(0, 5, Width, FHeaderHeight); // header
    Windows.InvalidateRect(Handle, @Rect, False);
    if FShowLinkCursor then
      if FHitTest <> htNone then
        Cursor := crHandPoint
      else
        Cursor := crDefault;
  end;

  Header := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN;
  if (Y < Header) or (Y > Height - FC_ITEM_MARGIN) then
    NewIndex := -1
  else
    NewIndex := (Y - Header) div ((Height - Header + 4 - FTopSpace) div FVisibleItems.Count);
  if (NewIndex >= 0) and (NewIndex < VisibleItems.Count) then
  begin
    if FStoredHint = cPipe then
      FStoredHint := Hint;
    if Action is TCustomAction then
      inherited Hint := TCustomAction(Action).Hint
    else
      inherited Hint := VisibleItems[NewIndex].Hint;
  end
  else
  begin
    if FStoredHint <> cPipe then
      inherited Hint := FStoredHint;
    FStoredHint := cPipe;
  end;

  if NewIndex <> FHoverIndex then
  begin
    if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) then
      if FVisibleItems[FHoverIndex].Checked then
        DoDrawItem(FHoverIndex, [dsClicked])
      else
        DoDrawItem(FHoverIndex, []);
    FHoverIndex := NewIndex;
    if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
      (FVisibleItems[FHoverIndex].Enabled) then
    begin
      DoDrawItem(FHoverIndex, [dsFocused]);
      if FShowLinkCursor then
        Cursor := crHandPoint;
    end
    else
    if FShowLinkCursor then
      Cursor := crDefault;
  end;

  inherited HookMouseMove(X, Y);
end;

procedure TJvXPCustomWinXPBar.HookParentFontChanged;
begin
  if ParentFont then
  begin
    FFontChanging := True;
    try
      FFont.Color := $00E75100;
      FFont.Name := inherited Font.Name;
      FFont.Size := 8;
      FFont.Style := inherited Font.Style;
      FHeaderFont.Color := $00E75100;
      FHeaderFont.Name := Font.Name;
      FHeaderFont.Size := 8;
      FHeaderFont.Style := [fsBold];
    finally
      FFontChanging := False;
    end;
    inherited HookParentFontChanged;
  end;
end;

procedure TJvXPCustomWinXPBar.HookResized;
begin
  // perform actions only on 'width'-change
  if FGradientWidth <> Width then
  begin
    FGradientWidth := Width;
    {$IFDEF VCL}
    // recreate gradient rect
    JvXPCreateGradientRect(Width, FHeaderHeight,
      clWhite, $00F7D7C6, 32, gsLeft, False, FGradient);
    {$ENDIF VCL}
  end;

  // resize to maximum height
  ResizeToMaxHeight;
  inherited HookResized;
end;

procedure TJvXPCustomWinXPBar.SetCollapsed(Value: Boolean);
begin
  if Value <> FCollapsed then
  begin
    if not (csLoading in ComponentState) then
    begin
      if Assigned(FBeforeCollapsedChange) then
        FBeforeCollapsedChange(Self, Value);
      if Value then
        FFadeThread := TJvXPFadeThread.Create(Self, rdCollapse)
      else
        FFadeThread := TJvXPFadeThread.Create(Self, rdExpand);
      if Assigned(FOnCollapsedChange) then
        FOnCollapsedChange(Self, Value);
    end
    else
    begin
      FCollapsed := Value;
      FRolling := True;
      if Value then
        RollOffset := 0
      else
        RollOffset := FItemHeight;
      FRolling := False;
      if Grouped and not Value then
        GroupMessage;
    end;
  end;
end;

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

procedure TJvXPCustomWinXPBar.SetHeaderFont(Value: TFont);
begin
  FHeaderFont.Assign(Value);
  InternalRedraw;
end;

procedure TJvXPCustomWinXPBar.SetHotTrack(Value: Boolean);
const
  MouseEvents: TJvXPControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave];
begin
  if Value <> FHotTrack then
  begin
    FHotTrack := Value;
//    if FHotTrack then
//      ExControlStyle := ExControlStyle + MouseEvents
//    else
//      ExControlStyle := ExControlStyle - MouseEvents;
    if not (csLoading in ComponentState) then
      InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetHotTrackColor(Value: TColor);
begin
  if Value <> FHotTrackColor then
  begin
    FHotTrackColor := Value;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetIcon(Value: TIcon);
begin
  if Value <> FIcon then
  begin
    FIcon.Assign(Value);
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetImageList(Value: TCustomImageList);
begin
  if Value <> FImageList then
  begin
    if FImageList <> nil then
      FImageList.UnRegisterChanges(FImageChangeLink);
    FImageList := Value;
    if FImageList <> nil then
    begin
      FImageList.FreeNotification(Self);
      FImageList.RegisterChanges(FImageChangeLink);
    end;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.SetItemHeight(Value: Integer);
begin
  if Value <> FItemHeight then
  begin
    FItemHeight := Value;
    if not FCollapsed then
      RollOffset := FItemHeight;
  end;
end;

procedure TJvXPCustomWinXPBar.SetItems(Value: TJvXPBarItems);
begin
  FItems.Assign(Value);
end;

procedure TJvXPCustomWinXPBar.SetRollOffset(const Value: Integer);
begin
  if Value <> FRollOffset then
  begin
    FRollOffset := Value;
    ResizeToMaxHeight;
  end;
end;

procedure TJvXPCustomWinXPBar.SetShowRollButton(Value: Boolean);
begin
  if Value <> FShowRollButton then
  begin
    FShowRollButton := Value;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.EndUpdate;
begin
  inherited EndUpdate;
  ResizeToMaxHeight;
end;

procedure TJvXPCustomWinXPBar.Click;
var
  AllowChange, CallInherited: Boolean;
  {$IFDEF VCL}
  LItem: TJvXPBarItem;
  {$ENDIF VCL}
begin
  CallInherited := True;
  if FShowRollButton and (FHitTest <> htNone) then
    Collapsed := not Collapsed;
  if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and
    FVisibleItems[FHoverIndex].Enabled then
  begin
    AllowChange := True;
    if Assigned(FOnCanChange) then
      FOnCanChange(Self, FVisibleItems[FHoverIndex], AllowChange);
    if not AllowChange then
      Exit;

    //dejoy add
    {$IFDEF VCL}
    LItem := FVisibleItems[FHoverIndex];
    with LItem do
    begin
      {$IFDEF COMPILER6_UP}
      if (not Assigned(ActionLink) and AutoCheck) or
        (Assigned(ActionLink) and not ActionLink.IsAutoCheckLinked and AutoCheck) then
      {$ELSE}
      if AutoCheck then
      {$ENDIF COMPILER6_UP}
        LItem.Checked := not LItem.Checked;
    end;
    {$ENDIF VCL}
    if FVisibleItems[FHoverIndex].Checked then
      DrawState := DrawState + [dsClicked]
    else
      DrawState := DrawState - [dsClicked];

    if Assigned(FOnItemClick) then
    begin
      FOnItemClick(Self, FVisibleItems[FHoverIndex]);
      CallInherited := False;
    end;
    if Assigned(FVisibleItems[FHoverIndex].FOnClick) then
    begin
      { set linked 'action' as Sender }
      if Assigned(FVisibleItems[FHoverIndex].Action) then
        FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex].Action)
      else
        FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex]);
      CallInherited := False;
    end;
    Collapsed := False;
    InternalRedraw; //dejoy
  end;
  if CallInherited then
    inherited Click;
end;

procedure TJvXPCustomWinXPBar.DoDrawItem(const Index: Integer; State: TJvXPDrawState);
var
  Bitmap: TBitmap;
  ItemRect: TRect;
  HasImages: Boolean;
begin
  Bitmap := TBitmap.Create;
  with Canvas do
  try
    {$IFDEF VisualCLX}
    Start;
    {$ENDIF VisualCLX}
    Bitmap.Assign(nil);
    ItemRect := GetItemRect(Index);
    HasImages := FVisibleItems[Index].Images <> nil;
    if HasImages then begin
{$ifdef XP_TRANSPARENCY_FIX}
      BitmapBgPaint( Bitmap, {WinXPBar.}Colors.BodyColor);
{$endif}
      FVisibleItems[Index].Images.GetBitmap(FVisibleItems[Index].ImageIndex, Bitmap);
    end;
    Bitmap.Transparent := True;
    if OwnerDraw then
    begin
      if Assigned(FOnDrawItem) then
        FOnDrawItem(Self, Canvas, ItemRect, State, FVisibleItems[Index], Bitmap);
    end
    else
      FVisibleItems[Index].DrawItem(Self, Canvas, ItemRect, State, ShowItemFrame, Bitmap);
  finally
    Bitmap.Free;
    {$IFDEF VisualCLX}
    Stop;
    {$ENDIF VisualCLX}
  end;
end;

procedure TJvXPCustomWinXPBar.Paint;
var
  ARect: TRect;
  Bitmap: TBitmap;
  Index, I: Integer;
  OwnColor: TColor;

  // (rom) Do as prefix for a local function is not ideal
  procedure DoDrawBackground(ACanvas: TCanvas; var R: TRect);
  begin
    {$IFDEF VisualCLX}
    ACanvas.Brush.Color := TJvXPWinControl(Parent).Color;
    { fill non-client area }
    with R do
      ACanvas.FillRect(Bounds(Left, Top, Right - Left, FTopSpace));
    {$ENDIF VisualCLX}
    ACanvas.Brush.Color := FColors.BodyColor; //$00F7DFD6;
    Inc(R.Top, FTopSpace + FHeaderHeight);
    if OwnerDraw then
    begin
      if Assigned(FOnDrawBackground) then
        FOnDrawBackground(Self, ACanvas, R);
    end
    else
      ACanvas.FillRect(R);
  end;

  procedure DoDrawHeader(ACanvas: TCanvas; var R: TRect);
  begin
    Dec(R.Top, FHeaderHeight);
    R.Bottom := R.Top + FHeaderHeight;
    if OwnerDraw then
    begin
      ACanvas.Brush.Color := FColors.FBorderColor;
      if Assigned(FOnDrawHeader) then
        FOnDrawHeader(Self, ACanvas, R);
    end
    else
    begin
      {$IFDEF VCL}
      JvXPCreateGradientRect(Width, FHeaderHeight, FColors.GradientFrom,
        FColors.GradientTo, 32, gsLeft, True, FGradient);
      ACanvas.Draw(0, R.Top, FGradient);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FillGradient(ACanvas.Handle, Bounds(0, R.Top, Width, FHeaderHeight),
        32, FColors.GradientFrom, FColors.GradientTo, gdHorizontal);
      {$ENDIF VisualCLX}

      { draw frame... }
      ACanvas.Brush.Color := FColors.FBorderColor;
      {$IFDEF VCL}
      ACanvas.FrameRect(R);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FrameRect(ACanvas, R);
      {$ENDIF VisualCLX}

      if FHeaderRounded then
      begin
        OwnColor := TJvXPWinControl(Parent).Color;
        ACanvas.Pixels[0, R.Top] := OwnColor;
        ACanvas.Pixels[0, R.Top + 1] := OwnColor;
        ACanvas.Pixels[1, R.Top] := OwnColor;
        ACanvas.Pixels[1, R.Top + 1] := FColors.FBorderColor;
        ACanvas.Pixels[Width - 1, R.Top] := OwnColor;
        ACanvas.Pixels[Width - 2, R.Top] := OwnColor;
        ACanvas.Pixels[Width - 1, R.Top + 1] := OwnColor;
        ACanvas.Pixels[Width - 2, R.Top + 1] := FColors.FBorderColor;
      end;
      if FShowRollButton and (Width >= 115) then
      begin
        Bitmap := TBitmap.Create;
        try
          if Assigned(FRollImages) then
          begin
          // format:
          // 0 - normal collapsed
          // 1 - normal expanded
          // 2 - hot collapsed
          // 3 - hot expanded
          // 4 - down collapsed
          // 5 - down expanded
            Index := 0; // normal
            if FHitTest = htRollButton then
            begin
              if dsHighlight in DrawState then
                Index := 2; // hot
              if (dsClicked in DrawState) and (dsHighlight in DrawState) then