jvqtransparentbutton.pas

East make Tray Icon in delphi

end;

procedure TJvTransparentButton.SetGlyph(Bmp: TBitmap);
begin
  FGlyph.Assign(Bmp);
  CalcGlyphCount;
  Invalidate;
end;

procedure TJvTransparentButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if FNumGlyphs <> Value then
  begin
    FNumGlyphs := Value;
    GlyphChanged(Self);
    Invalidate;
  end;
end;

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

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

procedure TJvTransparentButton.SetBorderWidth(Value: Cardinal);
begin
  if FBorderSize <> Value then
  begin
    FBorderSize := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.SetWordWrap(Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    Invalidate;
  end;
end;

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

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

procedure TJvTransparentButton.SetTextAlign(Value: TJvTextAlign);
begin
  if FTextAlign <> Value then
  begin
    FTextAlign := Value;
    Invalidate;
  end;
end;

procedure TJvTransparentButton.PaintFrame(Canvas: TCanvas);
var
  TmpRect: TRect;
  FDrawIt: Boolean;
begin
  TmpRect := Rect(0, 0, Width, Height);
  { draw the outline }
  with Canvas do
  begin
    Brush.Color := Color;
    Pen.Color := clBlack;
    Pen.Width := BorderWidth;

    if not Transparent then
      FillRect(TmpRect);

    if (bsMouseDown in MouseStates) or Down then
    begin
      case FrameStyle of
        fsRegular:
          if ShowPressed then
          begin
            Frame3D(Canvas, TmpRect, clBlack, clBtnHighlight, BorderWidth);
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnFace, BorderWidth);
          end;
        fsExplorer:
          if (bsMouseInside in MouseStates) or Down then
          begin
            if ShowPressed then
              Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, BorderWidth)
            else
              Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
          end;
        fsIndent:
          if ShowPressed then
          begin
            Frame3D(Canvas, TmpRect, clBlack, clBtnHighlight, BorderWidth);
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnFace, BorderWidth);
          end;
        fsLight:
          if ShowPressed then
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, BorderWidth);
        fsDark:
          if ShowPressed then
            Frame3D(Canvas, TmpRect, cl3DDkShadow, clBtnFace, BorderWidth);
        fsMono:
          if ShowPressed then
            Frame3D(Canvas, TmpRect, cl3DDkShadow, clBtnHighlight, BorderWidth);
      end;
    end
    else
    begin
      FDrawIt := ((bsMouseInside in MouseStates) and Transparent) or not Transparent or (csDesigning in ComponentState);
      case FrameStyle of
        fsNone:
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBlack, clBlack, 1);
        fsRegular:
          if FDrawIt then
          begin
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBlack, BorderWidth);
            Frame3D(Canvas, TmpRect, RGB(223, 223, 223), clBtnShadow, BorderWidth);
          end;
        fsExplorer:
          if (bsMouseInside in MouseStates) or (csDesigning in ComponentState) then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
        fsIndent:
          if FDrawIt then
          begin
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, BorderWidth);
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
          end;
        fsLight:
          if FDrawIt then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
        fsDark:
          if FDrawIt then
            Frame3D(Canvas, TmpRect, clBtnFace, cl3DDkShadow, BorderWidth);
        fsMono:
          if FDrawIt then
            Frame3D(Canvas, TmpRect, clBtnHighlight, cl3DDkShadow, BorderWidth);
      end;
    end;
  end;
end;

procedure TJvTransparentButton.PaintButton(Canvas: TCanvas);
var
  Dest: TRect;
  TmpWidth: Integer;
begin
  with Canvas do
  begin
    { find glyph bounding rect - adjust according to textalignment}
    TmpWidth := FImList.Width;
    if TmpWidth <= 0 then
      TmpWidth := FGlyph.Width;

    { do top }
    if Self.TextAlign in [ttaBottomLeft, ttaBottom, ttaBottomRight] then
      Dest.Top := Spacing
    else
    if Self.TextAlign in [ttaTopLeft, ttaTop, ttaTopRight] then
      Dest.Top := Height - FImList.Height - Spacing
    else
      Dest.Top := (Height - FImList.Height) div 2;

    { do left }
    if Self.TextAlign = ttaLeft then
      Dest.Left := Width - TmpWidth - Spacing
    else
    if Self.TextAlign = ttaRight then
      Dest.Left := Spacing
    else { left, center, right }
      Dest.Left := (Width - TmpWidth) div 2;
    Dest.Bottom := Dest.Top + FImList.Height;
    Dest.Right := Dest.Left + TmpWidth;

    if not FGlyph.Empty then
    begin
      DrawTheBitmap(Dest, Canvas);
      FGlyph.Dormant;
    end;
    { finally, do the caption }
    if Length(Caption) > 0 then
      DrawTheText(Dest, Canvas);
  end;
end;

{ just like DrawText, but draws disabled instead }

function DrawDisabledText(DC: HDC; Caption: TCaption;
  nCount: Integer; var lpRect: TRect; uFormat: Integer): Integer;
var
  OldCol: Integer;
begin
  OldCol := SetTextColor(DC, ColorToRGB(clBtnHighlight));
  OffsetRect(lpRect, 1, 1);
  DrawText(DC, Caption, nCount, lpRect, uFormat);
  OffsetRect(lpRect, -1, -1);
  SetTextColor(DC, ColorToRGB(clBtnShadow));
  Result := DrawText(DC, Caption, nCount, lpRect, uFormat);
  SetTextColor(DC, OldCol);
end;

{ ARect contains the bitmap bounds }

procedure TJvTransparentButton.DrawTheText(ARect: TRect; Canvas: TCanvas);
var
  Flags, MidX, MidY: Integer;
  DC: HDC; { Col: TColor; }
  TmpRect: TRect;
begin
  if (bsMouseInside in MouseStates) and HotTrack then
    Canvas.Font := HotTrackFont
  else
    Canvas.Font := Self.Font;
  DC := Canvas.Handle; { reduce calls to GetHandle }

  if FWordWrap then
    Flags := DT_WORDBREAK
  else
    Flags := DT_SINGLELINE;

  TmpRect := Rect(0, 0, Width, Height);

  { calculate width and height of text: }
  DrawText(DC, Caption, Length(Caption), TmpRect, Flags or DT_CALCRECT);
{
  if FWordWrap then
    Canvas.TextExtent(Caption, TmpRect, WordBreak)
  else
    Canvas.TextExtent(Caption, TmpRect, 0);
}
  MidY := TmpRect.Bottom - TmpRect.Top;
  MidX := TmpRect.Right - TmpRect.Left;
  Flags := DT_CENTER;
  { div 2 and shr 1 generates the exact same Asm code... }
  case Self.TextAlign of
    ttaTop:
      OffsetRect(TmpRect, Width div 2 - MidX div 2, ARect.Top - MidY - Spacing);
    ttaTopLeft:
      OffsetRect(TmpRect, Spacing, ARect.Top - MidY - Spacing);
    ttaTopRight:
      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, QWindows.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;  
    FImList.Draw(Canvas, ARect.Left, ARect.Top, Index); 
  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; 
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;  
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor); 
    end
    else
      Exit;

    if Assigned(FDisabledList) and (FDisabledIndex > -1) then
    begin  
      FDisabledList.GetBitmap(FDisabledIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor); 
    end
    else
    begin
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      DisabledBitmap(Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor);
    end;

    if Assigned(FDownList) and (FDownIndex > -1) then
    begin  
      FDownList.GetBitmap(FDownIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor); 
    end
    else
    begin  
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor); 
    end;

    if Assigned(FGrayList) and (FGrayIndex > -1) then
    begin  
      FGrayList.GetBitmap(FGrayIndex, Bmp);
      FImList.AddMasked(Bmp, Bmp.TransparentColor); 
    end
    else
    begin  
      FActiveList.GetBitmap(FActiveIndex, Bmp);
      GrayBitmap(Bmp, 11, 59, 30);
      FImList.AddMasked(Bmp, Bmp.TransparentColor); 
    end;
  finally
    Bmp.Free;
    Repaint;
  end;
end;

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