win32: respect show accelerator windows option for controls (windows 2000 and next)

git-svn-id: trunk@20666 -

lcl/interfaces/win32/win32callback.inc

@@ -1052,18 +1052,26 @@ var
   var
     DrawInfo: PNMCustomDraw absolute NMHdr;
     ARect: TRect;
+    ShowFocus: Boolean;
   begin
     case DrawInfo^.dwDrawStage of
       CDDS_PREPAINT:
       begin
-        lmNotify.result := CDRF_DODEFAULT;
+        lmNotify.Result := CDRF_DODEFAULT;
         WinProcess := False;
         if ABitBtn.Focused then
         begin
-          ARect := DrawInfo^.rc;
-          InflateRect(ARect, -3, -3);
-          if not IsRectEmpty(ARect) then
-            DrawFocusRect(DrawInfo^.hdc, ARect);
+          if WindowsVersion >= wv2000 then
+            ShowFocus := (SendMessage(ABitBtn.Handle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEFOCUS) = 0
+          else
+            ShowFocus := True;
+          if ShowFocus then
+          begin
+            ARect := DrawInfo^.rc;
+            InflateRect(ARect, -3, -3);
+            if not IsRectEmpty(ARect) then
+              DrawFocusRect(DrawInfo^.hdc, ARect);
+          end;
         end;
       end;
     end;
@@ -1156,6 +1164,27 @@ var
         Result:= true;
     end;
   end;
+
+  procedure UpdateUIState(CharCode: Word);
+  // This piece of code is taken from ThemeMgr.pas of Mike Lischke
+  // Beginning with Windows 2000 the UI in an application may hide focus rectangles and accelerator key indication.
+  // We have to take care to show them if the user starts navigating using the keyboard.
+  var
+    ParentForm: TCustomForm;
+  begin
+    case CharCode of
+      VK_LEFT..VK_DOWN, VK_TAB:
+        begin
+          ParentForm := GetParentForm(lWinControl);
+          SendMessage(ParentForm.Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), 0);
+        end;
+      VK_MENU:
+        begin
+          ParentForm := GetParentForm(lWinControl);
+          SendMessage(ParentForm.Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEACCEL), 0);
+        end;
+    end;
+  end;
   
 begin
   Assert(False, 'Trace:WindowProc - Start');
@@ -1686,7 +1715,8 @@ begin
     WM_KEYDOWN:
     begin
       NotifyUserInput := True;
-      PLMsg:=@LMKey;
+      PLMsg := @LMKey;
+      UpdateUIState(Word(WParam));
       with LMKey Do
       begin
         Msg := CN_KEYDOWN;
@@ -2228,7 +2258,8 @@ begin
     WM_SYSKEYDOWN:
     begin
       NotifyUserInput := True;
-      PLMsg:=@LMKey;
+      UpdateUIState(Word(WParam));
+      PLMsg := @LMKey;
       with LMKey Do
       begin
         Msg := CN_SYSKEYDOWN;

lcl/interfaces/win32/win32wsbuttons.pp

@@ -165,6 +165,7 @@ var
 
   procedure DrawBitmap(AState: TButtonState; UseThemes, AlphaDraw: Boolean);
   const
+    DSS_HIDEPREFIX = $0200;
     StateToDetail: array[TButtonState] of TThemedButton =
     (
      { bsUp        } tbPushButtonNormal,
@@ -174,7 +175,7 @@ var
      { bsHot       } tbPushButtonHot
     );
   var
-    TextFlags: integer; // flags for caption (enabled or disabled)
+    TextFlags: DWord; // flags for caption (enabled or disabled)
     glyphWidth, glyphHeight: integer;
     OldBitmapHandle: HBITMAP; // Handle of the provious bitmap in hdcNewBitmap
     AIndex: Integer;
@@ -183,17 +184,15 @@ var
     PaintBuffer: HPAINTBUFFER;
     Options: TDTTOpts;
     Details: TThemedElementDetails;
+    ShowAccel: Boolean;
   begin
     glyphWidth := srcWidth;
     glyphHeight := srcHeight;
-  { TODO: if we want to handle properly Windows settings about focus rect and
-    keyboard accelerator drawing we need to query control state using this method
-    if SendMessage(BitBtnHandle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEACCEL <> 0 then
-  }
-    TextFlags := DST_PREFIXTEXT;
 
-    if not UseThemes and (AState = bsDisabled) then
-      TextFlags := TextFlags or DSS_DISABLED;
+    if WindowsVersion >= wv2000 then
+      ShowAccel := (SendMessage(BitBtnHandle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEACCEL) = 0
+    else
+      ShowAccel := True;
 
     OldBitmapHandle := SelectObject(hdcNewBitmap, NewBitmap);
     if UseThemes and AlphaDraw then
@@ -258,6 +257,14 @@ var
     end;
     if PaintBuffer = 0 then
     begin
+      TextFlags := DST_PREFIXTEXT;
+
+      if not UseThemes and (AState = bsDisabled) then
+        TextFlags := TextFlags or DSS_DISABLED;
+
+      if not ShowAccel then
+        TextFlags := TextFlags or DSS_HIDEPREFIX;
+
       SetBkMode(TmpDC, TRANSPARENT);
       {$IFDEF WindowsUnicodeSupport}
       if UnicodeEnabledOS then
@@ -279,6 +286,9 @@ var
       FillChar(Options, SizeOf(Options), 0);
       Options.dwSize := SizeOf(Options);
       Options.dwFlags := DTT_COMPOSITED;
+      TextFlags := DT_SINGLELINE;
+      if not ShowAccel then
+        TextFlags := TextFlags or DT_HIDEPREFIX;
       if AState <> bsDisabled then
       begin
         // change color to requested or it will be black
@@ -288,7 +298,7 @@ var
       end;
       TWin32ThemeServices(ThemeServices).DrawTextEx(TmpDC, Details, ButtonCaption,
         Rect(XDestText, YDestText, XDestText + TextSize.cx, YDestText + TextSize.cy),
-        DT_SINGLELINE, @Options);
+        TextFlags, @Options);
     end;
 
     SelectObject(TmpDC, OldFontHandle);
@@ -482,6 +492,11 @@ begin
       begin
         Result := LResult(Control.Font.Reference.Handle);
       end;
+    WM_UPDATEUISTATE:
+      begin
+        Result := WindowProc(Window, Msg, WParam, LParam);
+        DrawBitBtnImage(TBitBtn(Control), TBitBtn(Control).Caption);
+      end;
     else
       Result := WindowProc(Window, Msg, WParam, LParam);
   end;

lcl/interfaces/win32/win32wscontrols.pp

@@ -252,14 +252,6 @@ begin
       else
         lhFont := AWinControl.Font.Reference.Handle;
       Windows.SendMessage(Window, WM_SETFONT, WPARAM(lhFont), 0);
-      // on themed applications windows for some reason hides focus rectangle if
-      // hide underlined letters for keyboard navigation setting is on
-      // read for example here: http://www.icetips.com/showarticle.php?articleid=450
-      // also windows hide accelerator chars and on Alt key press must show them
-      // but it does not happen if I press Alt in most of controls
-      if ThemeServices.ThemesEnabled then
-        Windows.SendMessage(Window, WM_CHANGEUISTATE,
-          MakeWParam(UIS_CLEAR, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0)
     end;
   end;
 end;

lcl/interfaces/win32/win32wsforms.pp

@@ -75,7 +75,7 @@ type
     class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
     class procedure SetBorderIcons(const AForm: TCustomForm;
           const ABorderIcons: TBorderIcons); override;
-    class function  CreateHandle(const AWinControl: TWinControl;
+    class function CreateHandle(const AWinControl: TWinControl;
           const AParams: TCreateParams): HWND; override;
     class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, 
           AWidth, AHeight: Integer); override;
@@ -320,6 +320,12 @@ begin
   FinishCreateWindow(AWinControl, Params, false);
 
   Result := Params.Window;
+  // Beginning with Windows 2000 the UI in an application may hide focus
+  // rectangles and accelerator key indication. According to msdn we need to
+  // initialize all root windows with this message
+  if WindowsVersion >= wv2000 then
+    Windows.SendMessage(Result, WM_CHANGEUISTATE,
+      MakeWParam(UIS_INITIALIZE, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0)
 end;
 
 class procedure TWin32WSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;