Thread: [GExperts-Checkins] SF.net SVN: gexperts:[4268] branches/dark-mode/Source

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Revision: 4268
          http://sourceforge.net/p/gexperts/code/4268
Author:   akalwahome
Date:     2024-06-09 16:14:29 +0000 (Sun, 09 Jun 2024)
Log Message:
-----------
New paint code for THotKey in dark mode.

Modified Paths:
--------------
    branches/dark-mode/Source/Framework/GX_ConfigureExperts.pas
    branches/dark-mode/Source/IdeShortCuts/GX_IdeShortCuts.pas

Added Paths:
-----------
    branches/dark-mode/Source/Utils/GX_HotkeyDrawFix.pas

Modified: branches/dark-mode/Source/Framework/GX_ConfigureExperts.pas
===================================================================

--- branches/dark-mode/Source/Framework/GX_ConfigureExperts.pas	2024-06-09 16:13:41 UTC (rev 4267)
+++ branches/dark-mode/Source/Framework/GX_ConfigureExperts.pas	2024-06-09 16:14:29 UTC (rev 4268)
@@ -84,6 +84,7 @@
     procedure SetAllEnabled(_Value: Boolean);
     procedure SetDefaultShortcutClick(_Sender: TObject);
     procedure HandleVerticalScroll(_Sender: TObject);
+    procedure RepaintHotKeyControls(_Sender: TObject);
     procedure SetConfigButtonHotkey;
     procedure ScrollBy(_DeltaY: Integer);
     procedure AdjustScrollRange;
@@ -108,6 +109,11 @@
   {$IFOPT D+} GX_DbugIntf, {$ENDIF}
   GX_GenericUtils,
   GX_BaseExpert,
+  GX_OtaUtils,
+  GX_IdeUtils,
+{$IFDEF GX_SUPPORTS_THEMING}
+  GX_HotkeyDrawFix,
+{$ENDIF}
   u_dzVclUtils;
 
 resourcestring
@@ -178,6 +184,7 @@
 begin
   sbxExperts.VertScrollBar.Position := sbxExperts.VertScrollBar.Position + FThumbSize * _DeltaY;
   SetConfigButtonHotkey;
+  RepaintHotKeyControls(sbxExperts);
 end;
 
 function TryGetButton(_pnl: TPanel; const _Caption: string; out _btn: TButton): Boolean;
@@ -219,6 +226,31 @@
   end;
 end;
 
+procedure TfrConfigureExperts.RepaintHotKeyControls(_Sender: TObject);
+{$IFDEF GX_SUPPORTS_THEMING}
+var
+  PanelIdx : Integer;
+  Panel    : TPanel;
+  HK       : THotKey;
+begin
+  if _Sender is TScrollBox then
+  begin
+    for PanelIdx := 0 to sbxExperts.ControlCount - 1 do begin
+      Panel := sbxExperts.Controls[PanelIdx] as TPanel;
+      if Panel <> pnlExpertLayout then begin
+        if Panel.Visible then begin
+          if TryGetHotkeyEdit(Panel, HK) then
+            HK.Invalidate;
+        end;
+      end;
+    end;
+  end;
+end;
+{$ELSE}
+begin
+end;
+{$ENDIF}
+
 procedure TfrConfigureExperts.SetConfigButtonHotkey;
 var
   h: Integer;
@@ -246,6 +278,7 @@
 procedure TfrConfigureExperts.HandleVerticalScroll(_Sender: TObject);
 begin
   SetConfigButtonHotkey;
+  RepaintHotKeyControls(_Sender);
 end;
 
 function TryGetControl(_Owner: TControl; _CtrlClass: TControlClass; out _Ctrl: TControl): Boolean;
@@ -382,6 +415,9 @@
   THotKeyHack = class(THotKey)
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
+{$IFDEF GX_SUPPORTS_THEMING}
+    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
+{$ENDIF}
   end;
 
 { THotKeyHack }
@@ -429,6 +465,44 @@
 end;
 {$ENDIF}
 
+{$IFDEF GX_SUPPORTS_THEMING}
+procedure THotKeyHack.WMPaint(var Msg: TWMPaint);
+begin
+  PaintHotkey(Self);
+  Msg.Result := 0;
+end;
+(*
+var
+  LText      : string;
+  LBackColor : TColor;
+  LTextColor : TColor;
+  DC         : HDC;
+  PS         : TPaintStruct;
+  OldFont    : HFONT;
+begin
+  LText := Self.Caption;
+  LText := UpperCase(ShortCutToText(Self.HotKey));
+  LText := StringReplace(LText, '+', ' + ', [rfReplaceAll]);
+  if LText.Length = 0 then LText := 'None';
+
+  LBackColor := ColorToRGB(GxOtaGetStyleColor(TStyleColor.scEdit, clWindow));
+  LTextColor := ColorToRGB(GxOtaGetStyleFontColor(TStyleFont.sfEditBoxTextNormal, clWindowText));
+
+  DC := BeginPaint(Self.Handle, PS);
+  if DC <> 0 then
+  begin
+    OldFont := SelectObject(DC, TForm(Parent).Font.Handle);
+    SetBkColor(DC, LBackColor);
+    SetTextColor(DC, LTextColor);
+    TextOut(DC, PS.rcPaint.Left+2, PS.rcPaint.Top+2, PChar(LText), LText.Length);
+    if OldFont <> 0 then SelectObject(DC, OldFont);
+  end;
+  EndPaint(Self.Handle, PS);
+  Msg.Result := 0;
+end;
+*)
+{$ENDIF}
+
 procedure THotKeyHack.KeyDown(var Key: Word; Shift: TShiftState);
 var
   HkMods: THKModifiers;
@@ -487,6 +561,7 @@
   chk: TCheckBox;
   hk: THotKeyHack;
   btn: TButton;
+
 begin
   FIsInitializing := True;
   try
@@ -654,6 +729,7 @@
   AdjustScrollRange;
 
   SetConfigButtonHotkey;
+  RepaintHotKeyControls(sbxExperts);
 end;
 
 procedure TfrConfigureExperts.AdjustScrollRange;

Modified: branches/dark-mode/Source/IdeShortCuts/GX_IdeShortCuts.pas
===================================================================
--- branches/dark-mode/Source/IdeShortCuts/GX_IdeShortCuts.pas	2024-06-09 16:13:41 UTC (rev 4267)
+++ branches/dark-mode/Source/IdeShortCuts/GX_IdeShortCuts.pas	2024-06-09 16:14:29 UTC (rev 4268)
@@ -8,9 +8,14 @@
 
 uses
   Classes, Controls, Forms, StdCtrls, Menus, ExtCtrls, ComCtrls,
-  GX_Experts, GX_OtaUtils, GX_BaseForm;
+  GX_Experts, GX_OtaUtils, 
+  {$IFDEF GX_SUPPORTS_THEMING}GX_HotkeyDrawFix,{$ENDIF} 
+  GX_BaseForm;
 
 type
+{$IFDEF GX_SUPPORTS_THEMING}
+  THotkey = class(THotkeyDrawFix);
+{$ENDIF}
   TfmIdeShortCuts = class(TfmBaseForm)
     MainMenu: TMainMenu;
     lblMenuStruc: TLabel;
@@ -363,6 +368,7 @@
 begin
   inherited;
   InitializeForm;
+  hkShortCut.Invalidate;
 end;
 
 procedure TfmIdeShortCuts.chkUseShortCutClick(Sender: TObject);

Added: branches/dark-mode/Source/Utils/GX_HotkeyDrawFix.pas
===================================================================
--- branches/dark-mode/Source/Utils/GX_HotkeyDrawFix.pas	                        (rev 0)
+++ branches/dark-mode/Source/Utils/GX_HotkeyDrawFix.pas	2024-06-09 16:14:29 UTC (rev 4268)
@@ -0,0 +1,74 @@
+unit GX_HotkeyDrawFix;
+
+interface
+
+uses
+  Windows, Messages, Themes, ComCtrls;
+
+type
+  THotkeyDrawFix = class(THotkey)
+  protected
+    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
+  end;
+
+procedure PaintHotkey(AHotkey: THotkey);
+
+implementation
+
+uses
+  Graphics,
+  Controls,
+  Menus,
+  SysUtils,
+  GX_OtaUtils;
+
+{ THotkeyDrawFix }
+
+type
+  TWinControlAccess = class(TWinControl);
+
+procedure PaintHotkey(AHotkey: THotkey);
+var
+  LText      : string;
+  LBackColor : TColor;
+  LTextColor : TColor;
+  LParent    : TWinControl;
+  WNd        : HWND;
+  DC         : HDC;
+  PS         : TPaintStruct;
+  OldFont    : HFONT;
+begin
+  if AHotKey.HandleAllocated then
+  begin
+    LText := TWinControlAccess(AHotKey).Caption;
+    LText := UpperCase(ShortCutToText(AHotKey.HotKey));
+    LText := StringReplace(LText, '+', ' + ', [rfReplaceAll]);
+    if LText.Length = 0 then LText := 'None';
+
+    LParent := TWinControlAccess(AHotKey).Parent;
+    LBackColor := ColorToRGB(GxOtaGetStyleColor(TStyleColor.scEdit, clWindow));
+    LTextColor := ColorToRGB(GxOtaGetStyleFontColor(TStyleFont.sfEditBoxTextNormal, clWindowText));
+
+    Wnd := AHotKey.Handle;
+    DC := BeginPaint(Wnd, PS);
+    if DC <> 0 then
+    begin
+      OldFont := SelectObject(DC, TWinControlAccess(LParent).Font.Handle);
+      SetBkColor(DC, LBackColor);
+      SetTextColor(DC, LTextColor);
+      TextOut(DC, PS.rcPaint.Left+2, PS.rcPaint.Top+2, PChar(LText), LText.Length);
+      if OldFont <> 0 then SelectObject(DC, OldFont);
+    end;
+    EndPaint(Wnd, PS);
+  end;
+end;
+
+{ THotkeyDrawFix }
+
+procedure THotkeyDrawFix.WMPaint(var Msg: TWMPaint);
+begin
+  PaintHotkey(Self);
+  Msg.Result := 0;
+end;
+
+end.

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.





Thread: [GExperts-Checkins] SF.net SVN: gexperts:[4268] branches/dark-mode/Source

gexperts-checkins