jvtransparentbutton.pas

East make Tray Icon in delphi

      OffsetRect(TmpRect, Width - TmpRect.Right - Spacing, ARect.Top - MidY - Spacing);
    ttaBottom:
      OffsetRect(TmpRect, Width div 2 - MidX div 2, ARect.Bottom + Spacing);
    ttaBottomLeft:
      OffsetRect(TmpRect, Spacing, ARect.Bottom + Spacing);
    ttaBottomRight:
      OffsetRect(TmpRect, Width - MidX - Spacing, ARect.Bottom + Spacing);
    ttaCenter:
      OffsetRect(TmpRect, Width div 2 - MidX div 2, Height div 2 - MidY div 2);
    ttaRight:
      OffsetRect(TmpRect, Width - MidX - Spacing, Height div 2 - MidY div 2);
    ttaLeft:
      OffsetRect(TmpRect, Spacing, Height div 2 - MidY div 2);
  end;
  if FWordWrap then
    Flags := Flags or DT_WORDBREAK or DT_NOCLIP
  else
    Flags := Flags or DT_SINGLELINE or DT_NOCLIP;

  if ((bsMouseDown in MouseStates) or Down) and FShowPressed then
    OffsetRect(TmpRect, FOffset, FOffset);

  SetBkMode(DC, Windows.TRANSPARENT);
  if not Enabled then
    DrawDisabledText(DC, Caption, -1, TmpRect, Flags)
  else
  begin
    if (bsMouseInside in MouseStates) and HotTrack then
      SetTextColor(DC, ColorToRGB(HotTrackFont.Color))
    else
      SetTextColor(DC, ColorToRGB(Self.Font.Color));
    DrawText(DC, Caption, -1, TmpRect, Flags);
  end;
end;

procedure TJvTransparentButton.DrawTheBitmap(ARect: TRect; Canvas: TCanvas);
var
  Index: Integer;
  HelpRect: TRect;
begin
  with FImList do
  begin
    Index := 0;

    case FNumGlyphs of {normal,disabled,down,down }
      2:
        if not Enabled then
          Index := 1;
      3:
        if not Enabled then
          Index := 1
        else
        if (bsMouseDown in MouseStates) or Down then
          Index := 2;
      4:
        if not Enabled then
          Index := 1
        else
        if (bsMouseDown in MouseStates) or Down then
          Index := 2;
    else
      Index := 0;
    end;

    if FGlyph.Empty then
      Exit;

    if ((bsMouseDown in MouseStates) and FShowPressed) or Down then
      OffsetRect(ARect, FOffset, FOffset);
    { do we need the grayed bitmap ? }
    if (Flat or (FrameStyle = fsExplorer)) and FAutoGray and not (bsMouseInside in MouseStates) and not Down then
      Index := Count - 2;

    { do we need the disabled bitmap ? }
    if not Enabled and (FNumGlyphs = 1) then
      Index := Count - 1;

    { Norris }
    if (bsMouseInside in MouseStates) and Down then
    begin
      HelpRect := ClientRect;
      InflateRect(HelpRect, -BorderWidth - 1, -BorderWidth - 1);
      Canvas.Brush.Bitmap := Pattern;
      Self.Canvas.FillRect(HelpRect);
    end;
    {$IFDEF VCL}
    ImageList_DrawEx(Handle, Index, Canvas.Handle, ARect.Left, ARect.Top, 0, 0,
      clNone, clNone, ILD_TRANSPARENT);
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    FImList.Draw(Canvas, ARect.Left, ARect.Top, Index);
    {$ENDIF VisualCLX}
  end;
end;

procedure TJvTransparentButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
  AddGlyphs(Glyph, Glyph.TransparentColor, NumGlyphs);
end;

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

  procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  begin
    with Glyph do
    begin
      Width := ImageList.Width;
      Height := ImageList.Height;
      Self.Canvas.Brush.Color := clFuchsia; //! for lack of a better color
      Self.Canvas.FillRect(Rect(0,0, Width, Height));
      ImageList.Draw(Self.Canvas, 0, 0, Index);
    end;
    GlyphChanged(Glyph);
  end;

begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults then
        Self.Down := Checked;
      { 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;

function TJvTransparentButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TJvTransparentButtonActionLink;
end;

//=== { TJvTransparentButton2 } ==============================================

constructor TJvTransparentButton2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AllowAllUp := True;
  FAutoGray := True;
  FShowPressed := True;
  FBorderSize := 1;
  FTransparent := True;
  Flat := True;
  FGrayLink := TChangeLink.Create;
  FGrayLink.OnChange := GlyphChanged;
  FActiveLink := TChangeLink.Create;
  FActiveLink.OnChange := GlyphChanged;
  FDisabledLink := TChangeLink.Create;
  FDisabledLink.OnChange := GlyphChanged;
  FDownLink := TChangeLink.Create;
  FDownLink.OnChange := GlyphChanged;
  FActiveIndex := -1;
  FDisabledIndex := -1;
  FDownIndex := -1;
  FGrayIndex := -1;
  FImList := TImageList.CreateSize(Width, Height);
  FSpacing := 2;
  FTextAlign := ttaCenter;
  FWordWrap := False;
  FOutline := fsExplorer;
end;

destructor TJvTransparentButton2.Destroy;
begin
  FGrayLink.Free;
  FActiveLink.Free;
  FDisabledLink.Free;
  FDownLink.Free;
  FImList.Free;
  inherited Destroy;
end;

procedure TJvTransparentButton2.AddGlyphs;
var
  Bmp: TBitmap;
  {$IFDEF VCL}
  Icon: HICON;
  {$ENDIF VCL}
begin
  Bmp := TBitmap.Create;
  try
    { destroy old list }
    FImList.Clear;
    { create the imagelist }
    if Assigned(FActiveList) and (FActiveIndex > -1) then
    begin
      FImList.Height := FActiveList.Height;
      FImList.Width := FActiveList.Width;
      Bmp.Height := FImList.Height;
      Bmp.Width := FImList.Width;
      {$IFDEF VCL}
      Icon := ImageList_GetIcon(FActiveList.Handle, FActiveIndex, ILD_TRANSPARENT);
      ImageList_AddIcon(FImList.Handle, Icon);
      DeleteObject(Icon);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VisualCLX}
    end
    else
      Exit;

    if Assigned(FDisabledList) and (FDisabledIndex > -1) then
    begin
      {$IFDEF VCL}
      Icon := ImageList_GetIcon(FDisabledList.Handle, FDisabledIndex, ILD_TRANSPARENT);
      ImageList_AddIcon(FImList.Handle, Icon);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FDisabledList.GetBitmap(FDisabledIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VisualCLX}
    end
    else
    begin
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      DisabledBitmap(Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
    end;

    if Assigned(FDownList) and (FDownIndex > -1) then
    begin
      {$IFDEF VCL}
      Icon := ImageList_GetIcon(FDownList.Handle,FDownIndex, ILD_TRANSPARENT);
      ImageList_AddIcon(FImList.Handle, Icon);
      DeleteObject(Icon);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FDownList.GetBitmap(FDownIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VisualCLX}
    end
    else
    begin
      {$IFDEF VCL}
      Icon := ImageList_GetIcon(FActiveList.Handle,FActiveIndex, ILD_TRANSPARENT);
      ImageList_AddIcon(FImList.Handle, Icon);
      DeleteObject(Icon);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VisualCLX}
    end;

    if Assigned(FGrayList) and (FGrayIndex > -1) then
    begin
      {$IFDEF VCL}
      Icon := ImageList_GetIcon(FGrayList.Handle,FGrayIndex, ILD_TRANSPARENT);
      ImageList_AddIcon(FImList.Handle, Icon);
      DeleteObject(Icon);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FGrayList.GetBitmap(FGrayIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VisualCLX}
    end
    else
    begin
      {$IFDEF VCL}
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      GrayBitmap(Bmp, 11, 59, 30);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      GrayBitmap(Bmp, 11, 59, 30);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
      {$ENDIF VisualCLX}
    end;
  finally
    Bmp.Free;
    Repaint;
  end;
end;

procedure TJvTransparentButton2.SetAutoGray(Value: Boolean);
begin
  if FAutoGray <> Value then
  begin
    FAutoGray := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton2.SetGrayList(Value: TImageList);
begin
  if FGrayList <> nil then
    FGrayList.UnRegisterChanges(FGrayLink);
  FGrayList := Value;

  if FGrayList <> nil then
    FGrayList.RegisterChanges(FGrayLink);
  AddGlyphs;
end;

procedure TJvTransparentButton2.SetActiveList(Value: TImageList);
begin
  if FActiveList <> nil then
    FActiveList.UnRegisterChanges(FActiveLink);
  FActiveList := Value;

  if FActiveList <> nil then
  begin
    FImList.Assign(FActiveList); // get properties
    FImList.BkColor := clNone;
    FActiveList.RegisterChanges(FActiveLink);
  end;
  AddGlyphs;
end;

procedure TJvTransparentButton2.SetDisabledList(Value: TImageList);
begin
  if FDisabledList <> nil then
    FDisabledList.UnRegisterChanges(FDisabledLink);
  FDisabledList := Value;

  if FDisabledList <> nil then
    FDisabledList.RegisterChanges(FDisabledLink);
  AddGlyphs;
end;

procedure TJvTransparentButton2.SetDownList(Value: TImageList);
begin
  if FDownList <> nil then
    FDownList.UnRegisterChanges(FDownLink);
  FDownList := Value;

  if FDownList <> nil then
    FDownList.RegisterChanges(FDownLink);
  AddGlyphs;
end;

procedure TJvTransparentButton2.SetGrayIndex(Value: Integer);
begin
  if FGrayIndex <> Value then
  begin
    FGrayIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButton2.SetActiveIndex(Value: Integer);
begin
  if FActiveIndex <> Value then
  begin
    FActiveIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButton2.SetDisabledIndex(Value: Integer);
begin
  if FDisabledIndex <> Value then
  begin
    FDisabledIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButton2.SetDownIndex(Value: Integer);
begin
  if FDownIndex <> Value then
  begin
    FDownIndex := Value;
    AddGlyphs;
  end;
end;

procedure TJvTransparentButton2.SetFrameStyle(Value: TJvFrameStyle);
begin
  if FOutline <> Value then
  begin
    FOutline := Value;
    Flat := FTransparent;
    Invalidate;
  end;
end;

procedure TJvTransparentButton2.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Flat := FTransparent;
    Invalidate;
  end;
end;
procedure TJvTransparentButton2.SetBorderWidth(Value: Cardinal);
begin
  if FBorderSize <> Value then
  begin
    FBorderSize := Value;
    Invalidate;
  end;
end;