[Win32] Themed drawing: GetThemeFont retourneert fout

[Tomatoman]

Zie het plaatje hierboven. De complete explorer bar aan de linkerkant van het venster inclusief headers, icons en dergelijke teken ik met behulp van standaard Win32 API calls zoals DrawThemeBackground en DrawThemeText. Dat werkt als een zonnetje.

Nu wil ik dat als je met de muis over de bovenste link beweegt (die met de tekst 'Clear All Filter Criteria'), de tekst onderstreept wordt getekend. De enige manier die ik kan verzinnen is de font handle achterhalen met GetThemeFont en op basis daarvan zelf wat tekenwerk verrichten, maar GetThemeFont retourneert altijd een foutcode met als foutmelding 'A call to an OS function failed'. Ik heb me al suf gepiekerd wat er fout gaat, maar ik kom er niet uit.

1. Wat gaat er mis?
2. Is er een andere manier om de tekst onderstreept te tekenen?

Delphi:

var
  ALogFont: LOGFONT;
begin
  // MijnThemeHandle is een geldige handle (heb ik gecontroleerd)
  if GetThemeFont(MijnThemeHandle, 0, EBP_NORMALGROUPBACKGROUND,
    EBHC_NORMAL, TMT_GLYPHFONT, ALogFont) <> S_OK then
    RaiseLastWin32Error;
end;

[H!GHGuY]

ik ken eigenlijk zo goed als geen bal van hoe je die dingen exact programmeert, maar mij lijkt het logische dat dit niet zomaar tekst is, maar eerder URL-tekst ? maw bestaat er een mogelijkheid om geen standaard tekst, maar URL tekst to tonen ?

[Tomatoman]

URL-tekst is feitelijk niet meer dan tekst die onderstreept is (dat is een font-eigenschap). Het punt is dat ik geen enkele manier ken om het font waarmee functies zoals DrawThemeText werken aan te passen. Om toch onderstreepte tekst te krijgen wil ik daarom een andere weg kiezen: font handle verkrijgen, font aanpassen en aangepaste font gebruiken om met de (non-themed) API call DrawText de tekst dan maar zelf te schrijven

[Tomatoman]

Een update, omdat ik het probleem heb opgelost. De problemen worden veroorzaakt door twee fouten in de documentatie.

1. Ten eerste zijn GetThemeFont en GetThemeSysFont verkeerd gedeclareerd in Delphi: als laatste parameter moet een TLogFontW worden gebruikt, terwijl in Delphi een TLogFontA is gedeclareerd.
2. Ten tweede geeft de documentatie van de Platform SDK aan dat GetThemeFont in de iPropId parameter de waarde TMT_GLYPHFONT. Na heel veel testen heb ik uitgevonden dat dat fout is en dat hier TMT_FONT moet worden gebruikt.

Het resultaat:

Delphi:

interface

uses ..., Themes, UxTheme;

{ GetThemeElementFont retrieves the font for a themed element.
    - ElementDetails: The themed element for which to retrieve the font. Not all
      themed elements have an associated font.
    - Font: The font settings for the themed element. If themed painting is
      disabled or if the function fails, Font is unaffected.
    - Result: True upon success or False if there is no font associated with the
      themed element. If themed painting is disabled, the function returns True.
}
function GetThemeElementFont(ElementDetails: TThemedElementDetails;
  Font: TFont): Boolean;

implementation

function GetThemeElementFont(ElementDetails: TThemedElementDetails;
  Font: TFont): Boolean;
var
  FontW: TLogFontW;
  PFontA: PLogFontA;
  AColor: TColor;
begin
  with ThemeServices, ElementDetails do
    if ThemesEnabled then
    begin
      { GetThemeFont expects Unicode arguments, but is declared in UxTheme with
        ANSI arguments. Workaround: pass a (Unicode) TLogFontW to the function,
        but cast it as if it were an (ANSI) TLogFontA. Furthermore, the iPropId
        argument must be set to TMT_FONT instead of TMT_GLYPHFONT, as suggested
        by the documentation. }
      PLogFont(PFontA) := @FontW;
      Result := GetThemeFont(Theme[Element], 0, Part, State, TMT_FONT,
        PFontA^) = S_OK;

      if Result then
      begin
        { Create a font from the retrieved LogFont and set the color }
        Font.Handle := CreateFontIndirectW(FontW);
        if GetThemeColor(Theme[Element], Part, State, TMT_TEXTCOLOR,
          Cardinal(AColor)) = S_OK then
          Font.Color := AColor;
      end;
    end
    else
      Result := True;
end;

Een voorbeeldje met de OnPaint handler van een TPaintBox:

Delphi:

procedure TForm1.PaintBoxPaint(Sender: TObject);
begin
  GetThemeElementFont(ThemeServices.GetElementDetails(tebNormalGroupBackground),
    PaintBox.Canvas.Font);
  PaintBox.Canvas.TextOut(0, 0, 'Woei, gelukt!');
end;