jvqspeedbutton.pas

East make Tray Icon in delphi

procedure TJvCustomSpeedButton.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TJvCustomSpeedButton.SetHotTrackFont(const Value: TFont);
begin
  FHotTrackFont.Assign(Value);
end;

procedure TJvCustomSpeedButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
  if FHotTrackFontOptions <> Value then
  begin
    FHotTrackFontOptions := Value;
    UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions);
  end;
end;

procedure TJvCustomSpeedButton.SetInactiveGrayed(Value: Boolean);
begin
  if Value <> FInactiveGrayed then
  begin
    FInactiveGrayed := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetMarkDropDown(Value: Boolean);
begin
  if Value <> FMarkDropDown then
  begin
    FMarkDropDown := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetStyle(Value: TButtonStyle);
begin
  if Style <> Value then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetWordWrap(Value: Boolean);
begin
  if Value <> WordWrap then
  begin
    TJvxButtonGlyph(FGlyph).WordWrap := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Interval := RepeatInterval;
  if (FState = rbsDown) and MouseCapture then
  try
    Click;
  except
    FRepeatTimer.Enabled := False;
    raise;
  end;
end;

procedure TJvCustomSpeedButton.UpdateExclusive;
var
  Msg: TCMButtonPressed;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.Index := FGroupIndex;
    Msg.Control := Self;
    Msg.Result := 0;  
    BroadcastMsg(Parent, Msg); 
  end;
end;

procedure TJvCustomSpeedButton.UpdateTracking;
var
  P: TPoint;
  NewValue: Boolean;
begin
  GetCursorPos(P);
  NewValue := Enabled and (FindDragTarget(P, True) = Self) and IsForegroundTask;
  if MouseOver <> NewValue then  
    if NewValue then
      MouseEnter(Self)
    else
      MouseLeave(Self); 
end;




procedure TJvCustomSpeedButton.DblClick;
begin
  if not FMenuTracking then
  begin
    inherited DblClick;
    if FDown then
      DblClick;
  end;
end;




{Inserted by (ag) 2004-09-04}
procedure TJvCustomSpeedButton.SetHotTrackOptions(Value: TJvSpeedButtonHotTrackOptions);
begin
  FHotTrackOptions.Assign(Value);
end;
{Insert End}


//=== { TJvGlyphCache } ======================================================

constructor TJvGlyphCache.Create;
begin
  inherited Create;
  FGlyphLists := TList.Create;
end;

destructor TJvGlyphCache.Destroy;
begin
  FGlyphLists.Free;
  inherited Destroy;
end;

function TJvGlyphCache.Empty: Boolean;
begin
  Result := FGlyphLists.Count = 0;
end;

function TJvGlyphCache.GetList(AWidth, AHeight: Integer): TJvGlyphList;
var
  I: Integer;
begin
  for I := FGlyphLists.Count - 1 downto 0 do
  begin
    Result := FGlyphLists[I];
    with Result do
      if (AWidth = Width) and (AHeight = Height) then
        Exit;
  end;
  Result := TJvGlyphList.CreateSize(AWidth, AHeight);
  FGlyphLists.Add(Result);
end;

procedure TJvGlyphCache.ReturnList(List: TJvGlyphList);
begin
  if List = nil then
    Exit;
  if List.Count = 0 then
  begin
    FGlyphLists.Remove(List);
    List.Free;
  end;
end;

//=== { TJvGlyphList } =======================================================

function TJvGlyphList.Add(Image, Mask: TBitmap): Integer;
begin
  Result := AllocateIndex;
  Replace(Result, Image, Mask);
  Inc(FCount);
end;

function TJvGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
begin
  Result := AllocateIndex;
  ReplaceMasked(Result, Image, MaskColor);
  Inc(FCount);
end;

function TJvGlyphList.AllocateIndex: Integer;
begin
  Result := FUsed.OpenBit;
  if Result >= FUsed.Size then
  begin
    Result := inherited Add(nil, nil);
    FUsed.Size := Result + 1;
  end;
  FUsed[Result] := True;
end;

constructor TJvGlyphList.CreateSize(AWidth, AHeight: Integer);
begin
  inherited CreateSize(AWidth, AHeight);
  FUsed := TBits.Create;
end;

procedure TJvGlyphList.Delete(Index: Integer);
begin
  if FUsed[Index] then
  begin
    Dec(FCount);
    FUsed[Index] := False;
  end;
end;

destructor TJvGlyphList.Destroy;
begin
  FUsed.Free;
  inherited Destroy;
end;

//=== { TJvImageSpeedButton } ================================================

procedure TJvImageSpeedButton.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if (not CheckDefaults or (Self.Images = nil)) and (ActionList <> nil) then
        Self.Images := ActionList.Images;
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
    end;
end;

constructor TJvImageSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FImageIndex := -1;
end;

destructor TJvImageSpeedButton.Destroy;
begin
  FreeAndNil(FImageChangeLink);
  inherited Destroy;
end;

function TJvImageSpeedButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TJvImageSpeedButtonActionLink;
end;

procedure TJvImageSpeedButton.ImageListChange(Sender: TObject);
begin
  InvalidateImage;
end;

procedure TJvImageSpeedButton.InvalidateImage;
begin
  Invalidate;
end;

function TJvImageSpeedButton.IsImageVisible: Boolean;
begin
  Result := {FImageVisible and} Assigned(FImages) and (FImageIndex >= 0)
end;

procedure TJvImageSpeedButton.PaintImage(Canvas: TCanvas; ARect: TRect;
  const Offset: TPoint; AState: TJvButtonState; DrawMark: Boolean);
var
  LImageIndex: TImageIndex;
begin
  if (MouseOver or FDragging) and HotTrack and (HotTrackImageIndex <> -1) then
    LImageIndex := HotTrackImageIndex
  else
    LImageIndex := ImageIndex;
  TJvxButtonGlyph(FGlyph).DrawEx(Canvas, ARect, Offset, Caption, FLayout,
    FMargin, FSpacing, DrawMark, Images, LImageIndex, AState, DrawTextBiDiModeFlags(Alignments[Alignment]));
end;

procedure TJvImageSpeedButton.SetHotTrackImageIndex(
  const Value: TImageIndex);
begin
  if FHotTrackImageIndex <> Value then
  begin
    FHotTrackImageIndex := Value;
    { Only invalidate when hot }
    if (MouseOver or FDragging) and HotTrack then
      InvalidateImage;
  end;
end;

procedure TJvImageSpeedButton.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    { Only invalidate when not hot }
    if not (MouseOver or FDragging) or not HotTrack then
      InvalidateImage;
  end;
end;

procedure TJvImageSpeedButton.SetImages(const Value: TCustomImageList);
begin
  if FImages <> nil then
    FImages.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if FImages <> nil then
  begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end
  else
    SetImageIndex(-1);
  InvalidateImage;
end;

//=== { TJvImageSpeedButtonActionLink } ======================================

procedure TJvImageSpeedButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TJvImageSpeedButton;
end;

function TJvImageSpeedButtonActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and (FClient.GroupIndex <> 0) and
    FClient.AllowAllUp and (FClient.Down = (Action as TCustomAction).Checked);
end;

 


function TJvImageSpeedButtonActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

procedure TJvImageSpeedButtonActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked then
    FClient.Down := Value;
end;

procedure TJvImageSpeedButtonActionLink.SetImageIndex(Value: Integer);
begin
  if IsImageIndexLinked then
    FClient.ImageIndex := Value;
end;

//=== { TJvSpeedButton } =====================================================

procedure TJvSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);

  procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  begin
    with Glyph do
    begin
      Width := ImageList.Width;
      Height := ImageList.Height;
      Canvas.Brush.Color := clFuchsia;
      Canvas.FillRect(Rect(0, 0, Width, Height));
      ImageList.Draw(Canvas, 0, 0, Index);
      TransparentColor := clFuchsia;
    end;
  end;

begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if CheckDefaults or (Self.GroupIndex = 0) then
        Self.GroupIndex := GroupIndex;
      { Copy image from action's imagelist }
      if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
        CopyImage(ActionList.Images, ImageIndex);
    end;
end;

constructor TJvSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TJvxButtonGlyph(FGlyph).OnChange := GlyphChanged;
  FHotTrackGlyph := TJvxButtonGlyph.Create;
  TJvxButtonGlyph(FHotTrackGlyph).OnChange := HotTrackGlyphChanged;
end;

destructor TJvSpeedButton.Destroy;
begin
  TJvxButtonGlyph(FHotTrackGlyph).Free;
  inherited Destroy;
end;

function TJvSpeedButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TJvSpeedButtonActionLink;
end;

function TJvSpeedButton.GetGlyph: TBitmap;
begin
  Result := TJvxButtonGlyph(FGlyph).Glyph;