jvqxpbar.pas

East make Tray Icon in delphi

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; 
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 
    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 
    Start; 
    Bitmap.Assign(nil);
    ItemRect := GetItemRect(Index);
    HasImages := FVisibleItems[Index].Images <> nil;
    if HasImages then
      FVisibleItems[Index].Images.GetBitmap(FVisibleItems[Index].ImageIndex, Bitmap);
    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; 
    Stop; 
  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 
    ACanvas.Brush.Color := TJvXPWinControl(Parent).Color;
    { fill non-client area }
    with R do
      ACanvas.FillRect(Bounds(Left, Top, Right - Left, FTopSpace)); 
    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  
      FillGradient(ACanvas.Handle, Bounds(0, R.Top, Width, FHeaderHeight),
        32, FColors.GradientFrom, FColors.GradientTo, gdHorizontal); 

      { draw frame... }
      ACanvas.Brush.Color := FColors.FBorderColor;  
      FrameRect(ACanvas, R); 

      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
                Index := 4; // down
            end;
            if not FCollapsed then
              Inc(Index);
            if Index >= FRollImages.Count then
              Index := Ord(not FCollapsed);
            FRollImages.GetBitmap(Index, Bitmap);
          end
          else
          begin
            Index := 0;
            if FHitTest = htRollButton then
            begin
              if dsHighlight in DrawState then
                Index := 1; // hot
              if (dsClicked in DrawState) and (dsHighlight in DrawState) then
                Index := 2; // down
            end;
            if FCollapsed then
              Bitmap.LoadFromResourceName(HInstance, 'JvXPCustomWinXPBarEXPAND' + IntToStr(Index))
            else
              Bitmap.LoadFromResourceName(HInstance, 'JvXPCustomWinXPBarCOLLAPSE' + IntToStr(Index));
          end;
          Bitmap.Transparent := True;
          ACanvas.Draw(R.Right - 24, R.Top + (HeaderHeight - GetRollHeight) div 2, Bitmap);
        finally
          Bitmap.Free;
        end;
        Dec(R.Right, 25);
      end;
      Inc(R.Left, 22);
      ACanvas.Pen.Color := FColors.SeparatorColor;
      JvXPDrawLine(ACanvas, 1, ARect.Top + FHeaderHeight, Width - 1, ARect.Top + FHeaderHeight);
      if not FIcon.Empty then
      begin
        ACanvas.Draw(2, 0, FIcon);
        Inc(R.Left, 16);
      end;
      Dec(ARect.Right, 25);
    end;

    { draw seperator line }
    ACanvas.Pen.Color := FColors.SeparatorColor;
    JvXPDrawLine(ACanvas, 1, ARect.Top + FHeaderHeight, Width - 1, ARect.Top + FHeaderHeight);

    { draw icon }
//    Inc(ARect.Left, 22);
    if not FIcon.Empty then
    begin
      ACanvas.Draw(2, 1, FIcon);
      Inc(ARect.Left, 6);
    end
    else
      Dec(ARect.Left, 16);
    SetBkMode(ACanvas.Handle, TRANSPARENT);
    ACanvas.Font.Assign(FHeaderFont);
    if FHotTrack and (dsHighlight in DrawState) and (FHitTest <> htNone) and (FHotTrackColor <> clNone) then
      ACanvas.Font.Color := FHotTrackColor;
    ARect.Bottom := ARect.Top + FHeaderHeight;
    Dec(ARect.Right, 3); 
    DrawText(ACanvas, Caption, -1, ARect,
      DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX); 
  end;
begin
  { get client rect }
  ARect := GetClientRect;
  DoDrawBackground(Canvas, ARect);
  { draw header }
  DoDrawHeader(Canvas, ARect);
  { draw visible items }
  Canvas.Brush.Color := FColors.BodyColor;
  if not FCollapsed or FRolling then
    for I := 0 to FVisibleItems.Count - 1 do
      if FVisibleItems[I].Checked then
        DoDrawItem(I, [dsClicked])
      else
        DoDrawItem(I, []);
end;

procedure TJvXPCustomWinXPBar.WMAfterXPBarCollapse(var Msg: TMessage);
begin
  if Assigned(FAfterCollapsedChange) then
    FAfterCollapsedChange(Self, Msg.WParam <> 0);
  if Grouped and not FCollapsed then
    GroupMessage;
end;

procedure TJvXPCustomWinXPBar.DoColorsChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvXPCustomWinXPBar.SetColors(const Value: TJvXPBarColors);
begin
  FColors.Assign(Value);
end;

procedure TJvXPCustomWinXPBar.SetRollImages(const Value: TCustomImageList);
begin
  if FRollImages <> Value then
  begin
    if FRollImages <> nil then
      FRollImages.UnRegisterChanges(FRollChangeLink);
    FRollImages := Value;
    if FRollImages <> nil then
    begin
      FRollImages.FreeNotification(Self);
      FRollImages.RegisterChanges(FRollChangeLink);
    end;
    InternalRedraw;
  end;
end;

procedure TJvXPCustomWinXPBar.GroupMessage;
var
  Msg: TMessage; 
//  I: Integer; 
begin
  if Parent <> nil then
  begin
    Msg.Msg := WM_XPBARAFTEREXPAND;
    Msg.WParam := WPARAM(Self);
    Msg.Result := 0;  
    BroadcastMsg(Parent, Msg);
//    for I := 0 to Parent.ControlCount - 1 do
//      if Parent.Controls[I] is TJvCustomGraphicButton then
//        TJvCustomGraphicButton(Parent.Controls[I]).ButtonPressed(Self, GroupIndex); 
  end;
end;

procedure TJvXPCustomWinXPBar.WMAfterXPBarExpand(var Msg: TMessage);
begin
  if Grouped and (TObject(Msg.WParam) <> Self) then
    Collapsed := True;
end;

procedure TJvXPCustomWinXPBar.SetGrouped(const Value: Boolean);
begin
  if FGrouped <> Value then
  begin
    FGrouped := Value;
    if FGrouped and not Collapsed then
      Collapsed := True;
  end;
end;

procedure TJvXPCustomWinXPBar.AdjustClientRect(var Rect: TRect);
begin
  inherited AdjustClientRect(Rect);
  if ControlCount > 0 then
  begin
    Inc(Rect.Top, FHeaderHeight + 4);
    InflateRect(Rect, -4, -4);
  end;
end;

procedure TJvXPCustomWinXPBar.SetHeaderHeight(const Value: Integer);
begin
  if FHeaderHeight <> Value then
  begin
    FHeaderHeight := Value;
    ResizeToMaxHeight;
//    InternalRedraw;
  end;
end;

function TJvXPCustomWinXPBar.HintShow(var HintInfo: THintInfo): Boolean;
begin
  // draw the item hint (if available)
  if (FHoverIndex > -1) and (FVisibleItems[FHoverIndex] <> nil) then
  begin
    HintInfo.CursorRect := GetItemRect(FHoverIndex);
    with VisibleItems[FHoverIndex] do
    begin
      if Action is TCustomAction then
        HintInfo.HintStr := TCustomAction(Action).Hint
      else
        HintInfo.HintStr := VisibleItems[FHoverIndex].Hint;
    end;
  end
  else
  if (VisibleItems.Count > 0) and not Collapsed then
    HintInfo.CursorRect := GetHitTestRect(htHeader);

  if HintInfo.HintStr = '' then
    HintInfo.HintStr := Hint;
  Result := False; // use default hint window
end;





function TJvXPBarItemActionLink.DoShowHint(var HintStr: WideString): Boolean;

begin
  Result := True;
  if Action is TCustomAction then
  begin
    Result := TCustomAction(Action).DoHint(HintStr);
    if Result and Application.HintShortCuts and (TCustomAction(Action).ShortCut <> scNone) then
      if HintStr <> '' then
        HintStr := Format(RsHintShortcutFmt, [HintStr, ShortCutToText(TCustomAction(Action).ShortCut)]);
  end;
end;

procedure TJvXPCustomWinXPBar.InitiateAction;
var
  I: Integer;
begin
  inherited InitiateAction;
  // go through each item and update
  for I := 0 to Items.Count - 1 do
    Items[I].ActionChange(Items[I].Action, csLoading in ComponentState);
end;




function TJvXPCustomWinXPBar.WantKey(Key: Integer; Shift: TShiftState;
  const KeyText: WideString): Boolean;
var
  I: Integer;
begin
  if CanFocus then
  begin
    if IsAccel(Key, Caption) then
    begin
      Result := True;
      FHitTest := htHeader;
      FHoverIndex := -1;
      Click;
      Exit;
    end
    else