MG: ShortCut support for buttons from Andrew

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

View File

@ -23,6 +23,12 @@
constructor TButton.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
With FShortcut do begin
OldKey := 0;
OldModifier := [ssCtrl];
NewModifier := [ssCtrl];
NewKey := 0;
end;
{set the component style to csButton}
fCompStyle := csButton;
ControlStyle:=ControlStyle-[csClickEvents];
@ -42,6 +48,8 @@ end;
procedure TButton.CreateWnd;
begin
inherited CreateWnd;
If HandleAllocated then
SetText(Caption);//To ensure shortcut is set
end;
{------------------------------------------------------------------------------
@ -121,9 +129,30 @@ begin
Click;
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$
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
MG: changed license to LGPL

View File

@ -1430,10 +1430,19 @@ const
function MapIrregularVirtualKey(vk: word): word;
Function Char2VK(C : Char) : Word;
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;
begin
@ -1461,6 +1470,9 @@ end.
{
$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
MG: improved Clipping, TextOut, Polygon functions