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

LCL: fixed non-ASCII accelerator keys handling, bug #19223

Browse Source 
git-svn-id: trunk@32158 -
This commit is contained in:
maxim 2011-09-02 19:59:14 +00:00
parent 50ac7e45f9
commit ac02acd3d9
3 changed files with 26 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lcl/forms.pp
View File

@ -1824,25 +1824,29 @@ end;
//------------------------------------------------------------------------------
function IsAccel(VK: word; const Str: string): Boolean;
const
AmpersandChar = '&';
var
lPos: integer;
position: integer;
ACaption, FoundChar: string;
begin
lPos:=1;
while (lPos<length(Str)) do begin
if Str[lPos]<>'&' then begin
inc(lPos);
end else begin
inc(lPos);
if (Str[lPos]<>'&') then begin
Result := UpCase(Str[lPos]) = UpCase(char(VK));
exit;
end else begin
// skip double &&
inc(lPos);
end;
ACaption := Str;
Result := false;
position := UTF8Pos(AmpersandChar, ACaption);
// if AmpersandChar is on the last position then there is nothing to underscore, ignore this character
while (position > 0) and (position < UTF8Length(ACaption)) do
begin
FoundChar := UTF8Copy(ACaption, position+1, 1);
// two AmpersandChar characters together are not valid hot key
if FoundChar <> AmpersandChar then begin
Result := UTF8UpperCase(UTF16ToUTF8(WideString(WideChar(VK)))) = UTF8UpperCase(FoundChar);
exit;
end
else begin
UTF8Delete(ACaption, 1, position+1);
position := UTF8Pos(AmpersandChar, ACaption);
end;
end;
Result := false;
end;
//==============================================================================

6
lcl/interfaces/win32/win32callback.inc
View File

@ -1133,7 +1133,7 @@ begin
Msg := CN_CHAR;
KeyData := LParam;
if UnicodeEnabledOS then
CharCode := Word(Char(WideChar(WParam)))
CharCode := Word(WideChar(WParam))
else
CharCode := Word(WParam);
OrgCharCode := CharCode;
@ -1158,7 +1158,7 @@ begin
WM_MENUCHAR:
begin
PLMsg^.Result := FindMenuItemAccelerator(chr(LOWORD(WParam)), HMENU(LParam));
PLMsg^.Result := FindMenuItemAccelerator(LOWORD(WParam), HMENU(LParam));
WinProcess := false;
end;
@ -2429,7 +2429,7 @@ begin
// to unicode char, if not change was made WParam has
// the right unicode char so just use it.
if (LMChar.Result = 1) or (OrgCharCode <> LMChar.CharCode) then
WParam := Word(WideChar(Char(LMChar.CharCode)));
WParam := Word(WideChar(LMChar.CharCode));
end
else
{$ENDIF}

33
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -82,7 +82,7 @@ type
function MenuItemSize(AMenuItem: TMenuItem; AHDC: HDC): TSize;
procedure DrawMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: Windows.RECT; const ItemAction, ItemState: UINT);
function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer;
function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer;
procedure DrawMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC;
const ImageRect: TRect; const ASelected: Boolean);
@ -162,36 +162,12 @@ begin
Result := IntToStr(GetLastError) + ' : ' + UTF8ToConsole(AnsiToUtf8(GetLastErrorText(GetLastError)));
end;
(* Returns index of the character in the menu item caption that is displayed
as underlined and is therefore the hot key of the menu item.
If the caption does not contain any underlined character, 0 is returned.
If there are more "underscored" characters in the caption, the last one is returned.
Does some Windows API function exists which can do the same?
AnUnderlinedChar - character which tells that tne following character should be underlined
ACaption - menu item caption which is parsed *)
function SearchMenuItemHotKeyIndex(const AnUnderlinedChar: char; ACaption: string): integer;
var
position: integer;
begin
position := pos(AnUnderlinedChar, ACaption);
Result := 0;
// if aChar is on the last position then there is nothing to underscore, ignore this character
while (position > 0) and (position < length(ACaption)) do
begin
// two 'AnUnderlinedChar' characters together are not valid hot key, they are replaced by one
if ACaption[position + 1] <> AnUnderlinedChar then
Result := position + 1;
position := posEx(AnUnderlinedChar, ACaption, position + 2);
end;
end;
function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer;
function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer;
var
MenuItemIndex: integer;
ItemInfo: MENUITEMINFO;
FirstMenuItem: TMenuItem;
SiblingMenuItem: TMenuItem;
HotKeyIndex: integer;
i: integer;
begin
Result := MakeLResult(0, MNC_IGNORE);
@ -205,8 +181,7 @@ begin
while (i < FirstMenuItem.Parent.Count) and (MenuItemIndex < 0) do
begin
SiblingMenuItem := FirstMenuItem.Parent.Items[i];
HotKeyIndex := SearchMenuItemHotKeyIndex('&', SiblingMenuItem.Caption);
if (HotKeyIndex > 0) and (Upcase(ACharCode) = Upcase(SiblingMenuItem.Caption[HotKeyIndex])) then
if IsAccel(ACharCode, SiblingMenuItem.Caption) then
MenuItemIndex := SiblingMenuItem.MenuVisibleIndex;
inc(i);
end;
@ -215,7 +190,7 @@ begin
end;
function GetMenuItemFont(const AFlags: TCaptionFlagsSet): HFONT;
var
var
lf: LOGFONT;
ncm: NONCLIENTMETRICS;
begin