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

implement/fix button/label shortcut accelchar handling

Browse Source 
git-svn-id: trunk@7108 -
This commit is contained in:
micha 2005-04-27 12:37:28 +00:00
parent 847b359269
commit 2bfef4ae8e
8 changed files with 75 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/buttons.pp
View File

@ -82,6 +82,7 @@ type
procedure ControlKeyUp(var Key: Word; Shift: TShiftState); override;
procedure SetParent(AParent: TWinControl); override;
procedure RealSetText(const Value: TCaption); override;
function DialogChar(var Message: TLMKey): boolean; override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
public
constructor Create(TheOwner: TComponent); override;
@ -405,6 +406,9 @@ end.
{ =============================================================================
$Log$
Revision 1.96 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.95 2005/04/24 13:42:04 micha
update speedbutton state if Enabled changed (fixes bug 735)

13
lcl/forms.pp
View File

@ -1205,7 +1205,7 @@ function GetParentForm(Control:TControl): TCustomForm;
function GetDesignerForm(AComponent: TComponent): TCustomForm;
function FindRootDesigner(AComponent: TComponent): TIDesigner;
function IsAccel(VK : Word; const Str : ShortString): Boolean;
function IsAccel(VK: word; const Str: string): Boolean;
procedure NotifyApplicationUserInput(Msg: Cardinal);
function InitResourceComponent(Instance: TComponent;
@ -1346,9 +1346,16 @@ begin
end;
//------------------------------------------------------------------------------
function IsAccel(VK : Word; const Str : ShortString): Boolean;
function IsAccel(VK: word; const Str: string): Boolean;
var
lPos: integer;
begin
Result := true;
{ TODO: MBCS/UTF-8 }
lPos := Pos('&', Str);
Result := false;
if (0 < lPos) and (lPos < Length(Str)) then
if UpCase(Str[lPos+1]) = UpCase(char(VK)) then
Result := true;
end;
//==============================================================================

13
lcl/include/buttons.inc
View File

@ -186,6 +186,16 @@ Begin
inherited Click;
end;
function TCustomButton.DialogChar(var Message: TLMKey): boolean;
begin
if IsAccel(Message.CharCode, Caption) and CanFocus then
begin
Click;
Result := true;
end else
Result := inherited;
end;
procedure TCustomButton.ActiveDefaultControlChanged(NewControl: TControl);
var
lPrevActive: boolean;
@ -286,6 +296,9 @@ end;
{ =============================================================================
$Log$
Revision 1.45 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.44 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action

14
lcl/include/customcheckbox.inc
View File

@ -216,10 +216,24 @@ begin
AdjustSize;
end;
function TCustomCheckBox.DialogChar(var Message: TLMKey): boolean;
begin
if IsAccel(Message.CharCode, Caption) and CanFocus then
begin
SetFocus;
if Focused then Toggle;
Result := true;
end else
Result := inherited;
end;
// included by stdctrls.pp
{
$Log$
Revision 1.34 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.33 2005/04/06 10:43:40 micha
customcheckbox: do not unnecessarily ask state twice
first let widget process BM_SETCHECK, so we do not see itemindex=-1 in between

21
lcl/include/customlabel.inc
View File

@ -180,23 +180,17 @@ begin
end;
function TCustomLabel.DialogChar(var Message: TLMKey): boolean;
var
PrefixIndex: integer;
PrefixChar: char;
begin
Result := false;
if not FShowAccelChar then exit;
if FFocusControl = nil then exit;
PrefixIndex := Pos('&', Caption);
if PrefixIndex < Length(Caption) then
PrefixChar := Caption[PrefixIndex+1];
if ssAlt in KeyDataToShiftState(Message.KeyData) then
if char(Message.CharCode and $ff) = PrefixChar then
begin
Result := true;
FFocusControl.SetFocus;
end;
if IsAccel(Message.CharCode, Caption) then
begin
Result := true;
FFocusControl.SetFocus;
end else
Result := inherited;
end;
procedure TCustomLabel.Loaded;
@ -272,6 +266,9 @@ end;
{
$Log$
Revision 1.30 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.29 2005/04/19 15:06:30 mattias
fixed small aesthetical editoroptions bugs

13
lcl/include/radiobutton.inc
View File

@ -70,6 +70,16 @@ begin
AdjustSize;
end;
function TRadioButton.DialogChar(var Message: TLMKey): boolean;
begin
if IsAccel(Message.CharCode, Caption) and CanFocus then
begin
SetFocus;
Result := true;
end else
Result := inherited;
end;
{$IFNDEF EnablePreferredSize}
procedure TRadioButton.DoAutoSize;
var
@ -102,6 +112,9 @@ end;
{
$Log$
Revision 1.22 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.21 2005/01/24 12:23:11 mattias
fixed TColorButton.Paint

9
lcl/include/wincontrol.inc
View File

@ -3620,13 +3620,15 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.WMChar(var Message: TLMChar);
begin
DoRemainingKeyPress(Message);
if DoRemainingKeyPress(Message) then
Message.Result := 1;
Assert(False, Format('Trace:[TWinControl.WMChar] %s', [ClassName]));
end;
procedure TWinControl.WMSysChar(var Message: TLMChar);
begin
DoRemainingKeyPress(Message);
if DoRemainingKeyPress(Message) then
Message.Result := 1;
end;
{------------------------------------------------------------------------------
@ -4482,6 +4484,9 @@ end;
{ =============================================================================
$Log$
Revision 1.323 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.322 2005/04/19 15:06:30 mattias
fixed small aesthetical editoroptions bugs

5
lcl/stdctrls.pp
View File

@ -858,6 +858,7 @@ type
function RetrieveState: TCheckBoxState;
procedure InitializeWnd; override;
procedure Toggle; virtual;
function DialogChar(var Message: TLMKey): boolean; override;
function GetChecked: Boolean; override;
procedure SetChecked(Value: Boolean); override;
procedure RealSetText(const Value: TCaption); override;
@ -1047,6 +1048,7 @@ type
TRadioButton = class(TCustomCheckBox)
protected
function DialogChar(var Message: TLMKey): boolean; override;
procedure RealSetText(const Value: TCaption); override;
{$IFNDEF EnablePreferredSize}
procedure DoAutoSize; override;
@ -1238,6 +1240,9 @@ end.
{ =============================================================================
$Log$
Revision 1.202 2005/04/27 12:37:28 micha
implement/fix button/label shortcut accelchar handling
Revision 1.201 2005/04/19 15:06:30 mattias
fixed small aesthetical editoroptions bugs