X-Button malen

[dataspider]

Hallo,

ein kleines Beispiel für einen CloseButton:

Delphi-Quellcode:

uses
  ..., Themes;

TrwCloseButton = class(TSpeedButton)
private
  FHotTrack: Boolean;
protected
  procedure Paint; override;
public
  constructor Create(AOwner: TComponent); override;
  property HotTrack: Boolean read FHotTrack write FHotTrack default True;
end;

constructor TrwCloseButton.Create(AOwner: TComponent);
begin
  inherited;
  FHotTrack := True;
  Width := 16;
  Height := 16;
  Flat := True;
end;

procedure TrwCloseButton.Paint;
var
  uType: Integer;
  uState: Integer;
  Details: TThemedElementDetails;
  // Win: TThemedWindow; // bei normalem CloseButton
  Win: TThemedExplorerBar;
begin
  if ThemeServices.ThemesEnabled then
  begin
    // bei norm. CloseButton
    // twCloseButtonNormal, twCloseButtonHot, twCloseButtonPushed, twCloseButtonDisabled
    // bei kleinem CloseButton
    // twSmallCloseButtonNormal, twSmallCloseButtonHot, twSmallCloseButtonPushed, 
    // twSmallCloseButtonDisabled
    if Enabled then
    begin
      if (Down) or (FState = bsDown) then
        Win := tebHeaderClosePressed
      else
        if MouseInControl then
          Win :=  tebHeaderCloseHot
        else
           Win :=  tebHeaderCloseNormal;
    end
    else
      Win :=  tebHeaderCloseNormal;
    Details := ThemeServices.GetElementDetails(Win);

    // Größe des Buttons optimieren
    // evtll. Prop ThemeAutoSize
    {
    DC := GetDC(0);
    try
      GetThemePartSize(ThemeServices.Theme[teButton], DC, Details.Part, CBS_NORMAL,
           nil, TS_TRUE, ASize);
    finally
      ReleaseDC(0, DC);
    end;

    if (ASize.cx <> Width) then
    begin
      Width := ASize.cx;
      Height := ASize.cy;
    end;
    }
    ThemeServices.DrawElement(Canvas.Handle, Details, ClientRect);
  end
  else
  begin
    uType := DFC_CAPTION;
    uState := DFCS_CAPTIONCLOSE;
    if Enabled then
    begin
      if (Down) or (FState = bsDown) then
        uState := uState or DFCS_PUSHED
      else
        if MouseInControl then
        begin
          if FHotTrack then
            uState := uState or DFCS_MONO
          else
            uState := uState or DFCS_FLAT;
        end
        else
          uState := uState or DFCS_FLAT;
    end
    else
      uState := uState or DFCS_INACTIVE;
    DrawFrameControl(Canvas.Handle, ClientRect, uType, uState);
  end;
end;

Sind noch die ersten Versuche, für Verbesserungen bin ich offen.
Bei D7 ist noch ein Bug in den Themes. Da liefert ThemesEnabled immer False. Sollte bei dir aber nicht mehr auftreten.

Cu, Frank