jvqtransparentbutton.pas

East make Tray Icon in delphi

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;

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

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

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

{ paint everything but bitmap and text }

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

    case FrameStyle of
      fsNone:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBlack, clBlack, 1);
        end;
      fsExplorer:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, 1);
        end;
      fsRegular:
        begin
          { draw outline }
          Pen.Color := clBlack;
          if not Transparent then
            Rectangle(1, 1, Width, Height)
          else
          begin
            TmpRect := Rect(1, 1, Width, Height);
            Frame3D(Canvas, TmpRect, clBlack, clBlack, BorderWidth);
          end;
        end;
      fsIndent:
        begin
          { draw outline }
          Pen.Color := clBtnShadow;
          if not Transparent then
            Rectangle(0, 0, Width - 1, Height - 1)
          else
          begin
            TmpRect := Rect(0, 0, Width - 1, Height - 1);
            Frame3D(Canvas, TmpRect, clBtnShadow, clBtnShadow, BorderWidth)
          end;
          TmpRect := Rect(1, 1, Width, Height);
          Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnHighlight, BorderWidth);
        end;
      fsLight:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, 1);
        end;
      fsDark:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnFace, cl3DDkShadow, 1);
        end;
      fsMono:
        begin
          if not Transparent then
            FillRect(Rect(0, 0, Width, Height));
          if csDesigning in ComponentState then
            Frame3D(Canvas, TmpRect, clBtnHighlight, cl3DDkShadow, 1);
        end;
    end;

    TmpRect := Rect(1, 1, Width - 1, Height - 1);

    if (bsMouseDown in MouseStates) or Down then
    begin
      if FrameStyle <> fsNone then
      begin
        InflateRect(TmpRect, 1, 1);
        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, 1);
          fsDark:
            if ShowPressed then
              Frame3D(Canvas, TmpRect, cl3DDkShadow, clBtnFace, 1);
          fsMono:
            if ShowPressed then
              Frame3D(Canvas, TmpRect, cl3DDkShadow, clBtnHighlight, 1);
        end;
      end;
    end;

    if not (bsMouseDown in MouseStates) and not Down then
    begin
      InflateRect(TmpRect, 1, 1);
      case FrameStyle of
        fsRegular:
          begin
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBlack, BorderWidth);
            Frame3D(Canvas, TmpRect, clBtnFace, clBtnShadow, BorderWidth);
          end;
        fsExplorer:
          if bsMouseInside in MouseStates then
            Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, BorderWidth);
        fsIndent:
          Frame3D(Canvas, TmpRect, clBtnShadow, clBtnHighlight, BorderWidth);
        fsLight:
          Frame3D(Canvas, TmpRect, clBtnHighlight, clBtnShadow, 1);
        fsDark:
          Frame3D(Canvas, TmpRect, clBtnFace, cl3DDkShadow, 1);
        fsMono:
          Frame3D(Canvas, TmpRect, clBtnHighlight, cl3DDkShadow, 1);
      end;
    end;

    if (HotTrackFont <> Font) and (Caption <> '') then
    begin
      InflateRect(TmpRect, 1, 1);
      DrawTheText(TmpRect, Canvas);
    end;
  end;
end;

procedure TJvTransparentButton2.PaintButton(Canvas: TCanvas);
var
  Dest: TRect;
  TmpWidth: Integer;
begin
  with Canvas do
  begin
    TmpWidth := FImList.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;
    {
        if Dest.Top < Spacing then Dest.Top := Spacing;
        if Dest.Left < Spacing then Dest.Left := Spacing;
    }
    Dest.Bottom := Dest.Top + FImList.Height;
    Dest.Right := Dest.Left + TmpWidth;
    {
        if Dest.Bottom > Height - Spacing then
           Dest.Top := Height - FGlyph.Height - Spacing;
    }
    if FImList.Count > 0 then
      DrawTheBitmap(Dest, Canvas);
    { finally, do the caption }
    if Length(Caption) > 0 then
      DrawTheText(Dest, Canvas);
  end;
end;

{ ARect contains the bitmap bounds }

procedure TJvTransparentButton2.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(Canvas, Caption, Length(Caption), TmpRect, Flags or DT_CALCRECT); 
  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)) and FShowPressed then
    OffsetRect(TmpRect, 1, 1);

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

procedure TJvTransparentButton2.DrawTheBitmap(ARect: TRect; Canvas: TCanvas);
var
  Index: Integer;
  HelpRect: TRect;
begin
  if FImList.Count = 0 then
    Exit;

  with FImList do
  begin
    if not Enabled then
      Index := 1
    else
    if (bsMouseDown in MouseStates) or Down then
      Index := 2
    else
    if (FrameStyle = fsExplorer) and FAutoGray and (MouseStates = []) then
      Index := 3 { autogray }
    else
      Index := 0; { active }

    { Norris }
    if (bsMouseInside in MouseStates) and ((bsMouseDown in MouseStates) or Down) then
    begin
      HelpRect := ClientRect;
      InflateRect(HelpRect, -BorderWidth - 1, -BorderWidth - 1);
      Canvas.Brush.Bitmap := Pattern;
      Self.Canvas.FillRect(HelpRect);
    end;

    if ((bsMouseDown in MouseStates) or Down) and FShowPressed then
      OffsetRect(ARect, 1, 1);

    FImList.Draw(Canvas, ARect.Left, ARect.Top, Index);
  end;
end;

procedure TJvTransparentButton2.GlyphChanged(Sender: TObject);
begin
  AddGlyphs;
end;

procedure TJvTransparentButton2.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FGrayList then
      GrayImage := nil;
    if AComponent = FActiveList then
      ActiveImage := nil;
    if AComponent = FDisabledList then
      DisabledImage := nil;
    if AComponent = FDownList then
      DownImage := nil;
  end;
end;

procedure TJvTransparentButton2.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults then
        Self.Down := Checked;
      if not CheckDefaults or (ActiveIndex = -1) then
        Self.ActiveIndex := ImageIndex;
    end;
end;

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

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQTransparentButton.pas,v $';
    Revision: '$Revision: 1.30 $';
    Date: '$Date: 2004/12/21 09:45:19 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.