瀏覽代碼

focus checkbox

Leandro Diaz 4 年之前
父節點
當前提交
8bb1d36984
共有 2 個文件被更改,包括 71 次插入2 次删除
  1. 10 0
      bgrasvgtheme.pas
  2. 61 2
      bgrathemecheckbox.pas

+ 10 - 0
bgrasvgtheme.pas

@@ -827,6 +827,7 @@ procedure TBGRASVGTheme.DrawCheckBox(Caption: string; State: TBGRAThemeButtonSta
 var
   Style: TTextStyle;
   svg: TBGRASVG;
+  r: TRect;
 begin
   with ASurface do
   begin
@@ -851,6 +852,15 @@ begin
         ARect.Right, ARect.Bottom),
         ARect.Height +  ScaleForCanvas(CheckBoxTextSpacing), 0, Caption, Style);
     end;
+    if Focused then
+    begin
+      DestCanvas.Pen.Color := DestCanvas.Font.Color;
+      DestCanvas.Pen.Style := psDash;
+      DestCanvas.Brush.Style := bsClear;
+      r := ARect;
+      DestCanvas.Rectangle(r);
+      DestCanvas.Pen.Style := psSolid;
+    end;
   end;
 end;
 

+ 61 - 2
bgrathemecheckbox.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BGRATheme, Types;
+  BGRATheme, Types, LMessages, LCLType;
 
 type
 
@@ -20,6 +20,11 @@ type
     FState: TBGRAThemeButtonState;
     procedure SetChecked(AValue: boolean);
   protected
+    procedure KeyDown(var Key: word; Shift: TShiftState); override;
+    procedure KeyUp(var Key: word; Shift: TShiftState); override;
+    procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
+    procedure WMKillFocus(var Message: {$IFDEF FPC}TLMKillFocus{$ELSE}TWMKillFocus{$ENDIF}); message {$IFDEF FPC}LM_KILLFOCUS{$ELSE}WM_KILLFOCUS{$ENDIF};
+    procedure UpdateFocus(AFocused: boolean);
     class function GetControlClassDefaultSize: TSize; override;
     procedure MouseEnter; override;
     procedure MouseLeave; override;
@@ -42,6 +47,8 @@ type
     property Font;
     property Enabled;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property TabStop;
+    property TabOrder;
   end;
 
 procedure Register;
@@ -66,6 +73,58 @@ begin
   if Assigned(FOnChange) then FOnChange(Self);
 end;
 
+procedure TBGRAThemeCheckBox.KeyDown(var Key: word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+
+  if (Key = VK_SPACE) or (Key = VK_RETURN) then
+    MouseDown(mbLeft, [], 0, 0);
+end;
+
+procedure TBGRAThemeCheckBox.KeyUp(var Key: word; Shift: TShiftState);
+begin
+  if (Key = VK_SPACE) or (Key = VK_RETURN) then
+  begin
+    MouseUp(mbLeft, [], 0, 0);
+    MouseLeave;
+  end;
+
+  inherited KeyUp(Key, Shift);
+end;
+
+procedure TBGRAThemeCheckBox.WMSetFocus(var Message: TLMSetFocus);
+begin
+  inherited;
+
+  UpdateFocus(True);
+end;
+
+procedure TBGRAThemeCheckBox.WMKillFocus(var Message: TLMKillFocus);
+begin
+  inherited;
+
+  if Message.FocusedWnd <> Handle then
+    UpdateFocus(False);
+end;
+
+procedure TBGRAThemeCheckBox.UpdateFocus(AFocused: boolean);
+var
+  lForm: TCustomForm;
+begin
+  lForm := GetParentForm(Self);
+  if lForm = nil then
+    exit;
+
+  {$IFDEF FPC}//#
+  if AFocused then
+    ActiveDefaultControlChanged(lForm.ActiveControl)
+  else
+    ActiveDefaultControlChanged(nil);
+  {$ENDIF}
+
+  Invalidate;
+end;
+
 class function TBGRAThemeCheckBox.GetControlClassDefaultSize: TSize;
 begin
   Result.CX := 165;
@@ -155,7 +214,7 @@ begin
   inherited Create(AOwner);
   FState := btbsNormal;
 
-  ControlStyle := ControlStyle + [csParentBackground];
+  ControlStyle := ControlStyle + [csParentBackground, csAcceptsControls];
 
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, CX, CY);