Public Const VSCLASS_FLYOUT = "FLYOUT"

Public Enum FLYOUTPARTS 'FLYOUTSTYLEPARTS
  FLYOUT_HEADER = 1
  FLYOUT_BODY = 2
  FLYOUT_LABEL = 3
  FLYOUT_LINK = 4
  FLYOUT_DIVIDER = 5
  FLYOUT_WINDOW = 6
  FLYOUT_LINKAREA = 7
  FLYOUT_LINKHEADER = 8
End Enum

Public Enum LINKSTATES
  FLYOUTLINK_NORMAL = 1
  FLYOUTLINK_HOVER = 2
End Enum

 hLinkTest = CreateTheSysLink(PictureDigits.hwnd, 50, 20, 200, 15, "<A>This is my test SysLink</A>", Me.Font)

  Dim hTheme As Long
  hTheme = OpenThemeData(PictureTheme.hwnd, StrPtr(VSCLASS_FLYOUT))

  'Draw Syslink
  Dim hdc As Long
  hdc = GetDC(hLinkTest)
  DrawMyControl hdc, hLinkTest, hTheme, FLYOUTLINK_NORMAL
  ReleaseDC hLinkTest, hdc
  
  If (hTheme <> 0) Then CloseThemeData hTheme

Private Function DrawMyControl(hdc As Long, hwndSysLink As Long, hTheme As Long, iState As Long)
  Dim rc As RECT, rcContent As RECT
  Dim szSysLinkText As String * 256
  Dim cch As Long 'длина текста без \0
  'Dim SysLinkText As String 'текст в нормальном виде
  Dim hr As Long
  
  GetWindowRect hwndSysLink, rc
  
  ' Get the window's title.
  cch = GetWindowText(hwndSysLink, szSysLinkText, Len(szSysLinkText))
  'SysLinkText = Left$(szSysLinkText, cch)
  If hTheme <> 0 Then
    hr = DrawThemeBackground(hTheme, hdc, FLYOUT_LINK, iState, rc, rc)
    If hr = S_OK Then
      hr = GetThemeBackgroundContentRect(hTheme, hdc, FLYOUT_LINK, iState, rc, rcContent)
        If hr = S_OK Then
          hr = DrawThemeText(hTheme, hdc, FLYOUT_LINK, iState, _
           StrPtr(szSysLinkText), cch, _
           DT_CENTER Or DT_VCENTER Or DT_SINGLELINE, _
           0, rcContent)
        End If
    End If
  Else
    '// Draw the control without using visual styles.
  End If

End Function

// textColor is a COLORREF whose value has been set according to whether the button is "hot".
// paint is the PAINTSTRUCT whose members are filled in by BeginPaint.
...
    DrawThemeTextEx(theme, paint.hdc, BP_PUSHBUTTON, CBS_UNCHECKEDNORMAL, 
        caption, cch, DT_CENTER | DT_VCENTER | DT_SINGLELINE, 
        &paint.rcPaint, &opts);

 Select Case Msg
    Case WM_PAINT
      Form1.TextDebug.Text = Form1.TextDebug.Text & vbCrLf & "WM_PAINT(MyLink)"
      Dim tPS As PAINTSTRUCT  ' PaintStruct used in painting
      Dim the_hdc As Long
      Dim hTheme As Long
      Dim szSysLinkText As String * 256
      Dim cch As Long 'длина текста без \0
      Dim SysLinkText As String 'текст в нормальном виде
      Dim hr As Long
      Dim rcContent As RECT
      
      Form1.TextDebug.Text = Form1.TextDebug.Text & vbCrLf & hwnd & "/" & Form1.hLinkTest
      
      hTheme = OpenThemeData(hwnd, StrPtr(VSCLASS_FLYOUT))
      If hTheme <> 0 Then
        the_hdc = BeginPaint(hwnd, tPS)
'        cch = GetWindowText(hwnd, szSysLinkText, Len(szSysLinkText))
'        SysLinkText = Left$(szSysLinkText, cch)
         SysLinkText = "Change date and time settings..."
'        hr = DrawThemeBackground(hTheme, tPS.hdc, FLYOUT_LINK, FLYOUTLINK_NORMAL, tPS.rcPaint, tPS.rcPaint)
'        If hr = S_OK Then
'          hr = GetThemeBackgroundContentRect(hTheme, tPS.hdc, FLYOUT_LINK, FLYOUTLINK_NORMAL, tPS.rcPaint, rcContent)
'          If hr = S_OK Then
            hr = DrawThemeText(hTheme, tPS.hdc, FLYOUT_LINK, FLYOUTLINK_NORMAL, _
             StrPtr(SysLinkText), -1, _
             DT_LEFT Or DT_VCENTER Or DT_SINGLELINE, _
             0, tPS.rcPaint)
'          End If
'        End If
        EndPaint hwnd, tPS
        CloseThemeData hTheme
      End If

     RedrawWindow hwnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE Or RDW_FRAME Or RDW_UPDATENOW

    DrawThemeBackground hTheme, hdcDst, FLYOUT_LINKAREA, 0, rc, rc

  SetWindowTheme hSysLink, StrPtr("Flayout"), 0 '

00E: FlyoutStyle
0F8: Flyout