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

MG: ShortCut support for buttons from Andrew

Browse Source 
git-svn-id: trunk@3248 -
This commit is contained in:
lazarus 2002-08-27 06:40:50 +00:00
parent 277da25f30
commit 86fa4833c4
2 changed files with 41 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lcl/include/buttons.inc
View File

@ -23,6 +23,12 @@
constructor TButton.Create(AOwner: TComponent); constructor TButton.Create(AOwner: TComponent);
begin begin
Inherited Create(AOwner); Inherited Create(AOwner);
With FShortcut do begin
OldKey := 0;
OldModifier := [ssCtrl];
NewModifier := [ssCtrl];
NewKey := 0;
end;
{set the component style to csButton} {set the component style to csButton}
fCompStyle := csButton; fCompStyle := csButton;
ControlStyle:=ControlStyle-[csClickEvents]; ControlStyle:=ControlStyle-[csClickEvents];
@ -42,6 +48,8 @@ end;
procedure TButton.CreateWnd; procedure TButton.CreateWnd;
begin begin
inherited CreateWnd; inherited CreateWnd;
If HandleAllocated then
SetText(Caption);//To ensure shortcut is set
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -121,9 +129,30 @@ begin
Click; Click;
end; end;
procedure TButton.SetText(const Value: TCaption);
var
ParseStr : String;
AccelIndex : Longint;
begin
Inherited SetText(Value);
If not HandleAllocated then exit;
ParseStr := Value;
AccelIndex := DeleteAmpersands(ParseStr);
If AccelIndex > -1 then begin
With FShortcut do begin
Handle := Self.Handle;
OldKey := NewKey;
NewKey := Char2VK(ParseStr[AccelIndex]);
end;
CNSendMessage(LM_SETSHORTCUT, Self, @FShortcut);
end;
end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.9 2002/08/27 06:40:50 lazarus
MG: ShortCut support for buttons from Andrew
Revision 1.8 2002/05/10 06:05:51 lazarus Revision 1.8 2002/05/10 06:05:51 lazarus
MG: changed license to LGPL MG: changed license to LGPL

12
lcl/lcltype.pp
View File

@ -1430,10 +1430,19 @@ const
function MapIrregularVirtualKey(vk: word): word; function MapIrregularVirtualKey(vk: word): word;
Function Char2VK(C : Char) : Word;
implementation implementation
Function Char2VK(C : Char) : Word;
begin
Case C of
'0'..'9' :Result := VK_0 + Ord(C) - Ord('0');
'a'..'z' :Result := VK_A + Ord(C) - Ord('a');
'A'..'Z' :Result := VK_A + Ord(C) - Ord('A');
end;
end;
function MapIrregularVirtualKey(vk: word): word; function MapIrregularVirtualKey(vk: word): word;
begin begin
@ -1461,6 +1470,9 @@ end.
{ {
$Log$ $Log$
Revision 1.12 2002/08/27 06:40:50 lazarus
MG: ShortCut support for buttons from Andrew
Revision 1.11 2002/08/19 20:34:47 lazarus Revision 1.11 2002/08/19 20:34:47 lazarus
MG: improved Clipping, TextOut, Polygon functions MG: improved Clipping, TextOut, Polygon functions