paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-19 22:29:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

carbon: improved -dVerboseKeyboard

Browse Source 
git-svn-id: trunk@16015 -
This commit is contained in:
mattias 2008-08-10 12:35:28 +00:00
parent cb1c9a3077
commit 7915b1e5d8
4 changed files with 39 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
examples/icons/project1.lpi
View File

@ -1,14 +1,14 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<PathDelim Value="/"/>
<Version Value="6"/>
<General>
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -30,40 +30,16 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Units Count="1">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<CursorPos X="41" Y="12"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="140"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<CursorPos X="40" Y="12"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
</Units>
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="project1.lpr"/>
<Caret Line="12" Column="41" TopLine="1"/>
</Position1>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
@ -78,11 +54,4 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Watches Count="1">
<Item1>
<Expression Value="l"/>
</Item1>
</Watches>
</Debugging>
</CONFIG>

52
lcl/interfaces/carbon/carbonprivatewindow.inc
View File

@ -384,14 +384,14 @@ const
optionKey : VKKeyCode := VK_MENU; //option is alt
cmdKey : VKKeyCode := VK_LWIN; //meta... map to left Windows Key?
else begin
debugln(['EmulateModifiersDownUp TODO: more than one modifier changed ',diff]);
debugln(['CarbonWindow_KeyboardProc.EmulateModifiersDownUp TODO: more than one modifier changed ',diff]);
exit; //Error! More that one bit changed in the modifiers?
end;
end;
Result:=true;
{$IFDEF VerboseKeyboard}
DebugLn('[EmulateModifiersDownUp] VK =', DbgsVKCode(VKKeyCode));
DebugLn('[CarbonWindow_KeyboardProc.EmulateModifiersDownUp] VK =', DbgsVKCode(VKKeyCode));
{$ENDIF}
end;
@ -417,6 +417,7 @@ const
TextLen : UInt32;
CharLen : integer;
buf : array[1..6] of Char; //isn't 4 bytes enough?
widebuf: array[1..2] of widechar;
U: Cardinal;
Layout: UCKeyboardLayoutPtr;
KeyboardLayout: KeyboardLayoutRef;
@ -469,23 +470,25 @@ const
begin
//stop here, we won't send char or UTF8KeyPress
{$IFDEF VerboseKeyboard}
DebugLn('[TranslateMacKeyCode] VK = ', DbgsVKCode(VKKeyCode));
DebugLn('[TranslateMacKeyCode] non printable VK = ', DbgsVKCode(VKKeyCode));
{$ENDIF}
Result:=true;
exit;
end;
// untranslated key (key without modifiers)
// get untranslated key (key without modifiers)
OSError(KLGetCurrentKeyboardLayout(KeyboardLayout), SName, 'KLGetCurrentKeyboardLayout');
OSError(KLGetKeyboardLayoutProperty(KeyboardLayout, kKLuchrData, Layout), SName, 'KLGetKeyboardLayoutProperty');
TextLen:=0;
DeadKeys:=0;
OSError(UCKeyTranslate(Layout^, KeyCode, kUCKeyActionDisplay,
0, LMGetKbdType,
kUCKeyTranslateNoDeadKeysMask, DeadKeys, 6, TextLen, @Buf[1]), SName, 'UCKeyTranslate');
kUCKeyTranslateNoDeadKeysMask, DeadKeys, 6, TextLen, @WideBuf[1]), SName, 'UCKeyTranslate');
UTF8VKCharacter:='';
VKKeyChar:=#0;
CharLen:=0;
if TextLen>0 then begin
u:=UTF16CharacterToUnicode(PWideChar(@Buf[1]),CharLen);
u:=UTF16CharacterToUnicode(@WideBuf[1],CharLen);
if CharLen>0 then begin
UTF8VKCharacter:=UnicodeToUTF8(u);
if (UTF8VKCharacter<>'') and (ord(Utf8VKCharacter[1])<=127) then //It's (true) ascii.
@ -497,7 +500,9 @@ const
'kEventParamKeyMacCharCodes');
end;
end;
{$IFDEF VerboseKeyboard}
debugln(['TranslateMacKeyCode TextLen=',TextLen,' CharLen=',CharLen,' UTF8VKCharacter=',UTF8VKCharacter,' VKKeyChar=',VKKeyChar]);
{$ENDIF}
//printable keys
//for these keys, send char or UTF8KeyPress
@ -508,21 +513,24 @@ const
DeadKeys := 0;
OSError(UCKeyTranslate(Layout^, KeyCode, kUCKeyActionDisplay,
(GetCurrentEventKeyModifiers and not cmdkey) shr 8, LMGetKbdType,
kUCKeyTranslateNoDeadKeysMask, DeadKeys, 6, TextLen, @Buf[1]), SName, 'UCKeyTranslate');
kUCKeyTranslateNoDeadKeysMask, DeadKeys, 6, TextLen, @WideBuf[1]), SName, 'UCKeyTranslate');
{$IFDEF VerboseKeyboard}
debugln(['TranslateMacKeyCode IsSysKey: TextLen=',TextLen,' CharLen=',CharLen,' UTF8VKCharacter=',UTF8VKCharacter]);
{$ENDIF}
end;
if TextLen = 0 then
begin
if OSError(
GetEventParameter(AEvent, kEventParamKeyUnicodes, typeUnicodeText, nil,
6, @TextLen, @Buf[1]), SName, AGetEvent, 'kEventParamKeyUnicodes') then Exit;
6, @TextLen, @WideBuf[1]), SName, AGetEvent, 'kEventParamKeyUnicodes') then Exit;
end;
if TextLen>0 then
begin
SendChar:=true;
u:=UTF16CharacterToUnicode(PWideChar(@Buf[1]),CharLen);
u:=UTF16CharacterToUnicode(@WideBuf[1],CharLen);
if CharLen=0 then exit;
UTF8Character:=UnicodeToUTF8(u);
@ -534,6 +542,10 @@ const
Sizeof(KeyChar), nil, @KeyChar), SName, AGetEvent,
'kEventParamKeyMacCharCodes') then Exit;
{$IFDEF VerboseKeyboard}
debugln(['TranslateMacKeyCode printable key: TextLen=',TextLen,' UTF8Character=',UTF8Character,' KeyChar=',KeyChar,' VKKeyChar=',VKKeyChar]);
{$ENDIF}
// the VKKeyCode is independent of the modifier
// => use the VKKeyChar instead of the KeyChar
case VKKeyChar of
@ -573,17 +585,19 @@ const
end;
end;
// There is no known VK_ code for this characther. Use a dummy keycode
// (E8, which is unused by Windows) so that KeyUp/KeyDown events will be
// triggered by LCL.
// Note: we can't use the raw mac keycode, since it could collide with
// well known VK_ keycodes (e.g on my italian ADB keyboard, keycode for
// "&egrave;" is 33, which is the same as VK_PRIOR)
if VKKeyCode=VK_UNKNOWN then VKKeyCode:=$E8;
if VKKeyCode=VK_UNKNOWN then begin
// There is no known VK_ code for this characther. Use a dummy keycode
// (E8, which is unused by Windows) so that KeyUp/KeyDown events will be
// triggered by LCL.
// Note: we can't use the raw mac keycode, since it could collide with
// well known VK_ keycodes (e.g on my italian ADB keyboard, keycode for
// "&egrave;" is 33, which is the same as VK_PRIOR)
VKKeyCode:=$E8;
end;
{$IFDEF VerboseKeyboard}
DebugLn('[TranslateMacKeyCode] VK=', DbgsVKCode(VKKeyCode), ' Utf8="',
UTF8Character, '" VKKeyChar="', VKKeyChar, '" KeyChar="',KeyCHar,'"' );
DebugLn('[TranslateMacKeyCode] VKKeyCode=', DbgsVKCode(VKKeyCode), ' Utf8="',
UTF8Character, '" VKKeyChar="', VKKeyChar, '" KeyChar="',KeyChar,'"' );
{$ENDIF}
Result := True;

8
lcl/interfaces/carbon/carbonwinapi.inc
View File

@ -1331,9 +1331,7 @@ const
begin
Result := 0;
{$IFDEF VerboseKeyboard}
DebugLn('TCarbonWidgetSet.GetKeyState ' + DbgSVKCode(nVirtKey));
{$ENDIF}
// DebugLn('TCarbonWidgetSet.GetKeyState ' + DbgSVKCode(nVirtKey));
case nVirtKey of
VK_MENU:
@ -1366,9 +1364,7 @@ begin
DebugLn('TCarbonWidgetSet.GetKeyState TODO ', DbgSVKCode(Word(nVirtkey)));
end;
{$IFDEF VerboseKeyboard}
DebugLn('TCarbonWidgetSet.GetKeyState Result: ' + DbgS(Result));
{$ENDIF}
// DebugLn('TCarbonWidgetSet.GetKeyState Result: ' + DbgS(Result));
end;
{------------------------------------------------------------------------------

5
lcl/tests/test1_1simpleform1.lpi
View File

@ -2,7 +2,7 @@
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<Version Value="6"/>
<General>
<Flags>
<SaveClosedFiles Value="False"/>
@ -40,9 +40,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<LCLWidgetType Value="gtk2"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>