paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 23:08:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TCustomRadioGroup, TCustomCheckBoxGroup - propagate OnKeyDown, OnKeyUp, OnKeyPress, OnUTF8KeyPress from TRadioButton/TCheckBox to our groupBox (parent).

Browse Source 
git-svn-id: trunk@29958 -
This commit is contained in:
zeljko 2011-03-21 10:03:23 +00:00
parent d981b42d5c
commit 67ed6805ce
3 changed files with 61 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/extctrls.pp
View File

@ -799,6 +799,9 @@ type
procedure ItemEnter(Sender: TObject);
procedure ItemExit(Sender: TObject);
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyPress(Sender: TObject; var Key: Char);
procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure ItemResize(Sender: TObject);
procedure ItemsChanged(Sender: TObject);
procedure SetAutoFill(const AValue: Boolean);
@ -906,6 +909,10 @@ type
procedure Clicked(Sender: TObject);
procedure DoClick(Index: integer);
procedure ItemsChanged (Sender : TObject);
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ItemKeyPress(Sender: TObject; var Key: Char);
procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure RaiseIndexOutOfBounds(Index: integer );
procedure SetAutoFill(const AValue: boolean);
procedure SetChecked(Index: integer; const AValue: boolean);

30
lcl/include/customcheckgroup.inc
View File

@ -57,6 +57,32 @@ begin
OwnerFormDesignerModified(Self);
end;
procedure TCustomCheckGroup.ItemKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key <> 0 then
KeyDown(Key, Shift);
end;
procedure TCustomCheckGroup.ItemKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key <> 0 then
KeyUp(Key, Shift);
end;
procedure TCustomCheckGroup.ItemKeyPress(Sender: TObject; var Key: Char);
begin
if Key <> #0 then
KeyPress(Key);
end;
procedure TCustomCheckGroup.ItemUTF8KeyPress(Sender: TObject;
var UTF8Key: TUTF8Char);
begin
UTF8KeyPress(UTF8Key);
end;
procedure TCustomCheckGroup.RaiseIndexOutOfBounds(Index: integer ) ;
begin
raise Exception.CreateFmt(rsIndexOutOfBounds,
@ -121,6 +147,10 @@ begin
BorderSpacing.CellAlignVertical:=ccaCenter;
Parent := Self;
OnClick :=@Self.Clicked;
OnKeyDown :=@Self.ItemKeyDown;
OnKeyUp := @Self.ItemKeyUp;
OnKeyPress := @Self.ItemKeyPress;
OnUTF8KeyPress := @Self.ItemUTF8KeyPress;
ParentFont := true;
ControlStyle := ControlStyle + [csNoDesignSelectable];
end;

24
lcl/include/radiogroup.inc
View File

@ -156,6 +156,9 @@ begin
OnEnter :=@Self.ItemEnter;
OnExit :=@Self.ItemExit;
OnKeyDown :=@Self.ItemKeyDown;
OnKeyUp := @Self.ItemKeyUp;
OnKeyPress := @Self.ItemKeyPress;
OnUTF8KeyPress := @Self.ItemUTF8KeyPress;
OnResize := @Self.ItemResize;
ParentFont := True;
BorderSpacing.CellAlignHorizontal:=ccaLeftTop;
@ -273,6 +276,27 @@ begin
VK_DOWN: MoveSelection(0,1);
end;
end;
if Key <> 0 then
KeyDown(Key, Shift);
end;
procedure TCustomRadioGroup.ItemKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key <> 0 then
KeyUp(Key, Shift);
end;
procedure TCustomRadioGroup.ItemKeyPress(Sender: TObject; var Key: Char);
begin
if Key <> #0 then
KeyPress(Key);
end;
procedure TCustomRadioGroup.ItemUTF8KeyPress(Sender: TObject;
var UTF8Key: TUTF8Char);
begin
UTF8KeyPress(UTF8Key);
end;
{------------------------------------------------------------------------------