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

carbon interface: implemented basic key handling

Browse Source 
git-svn-id: trunk@8521 -
This commit is contained in:
mattias 2006-01-14 23:27:42 +00:00
parent 3415dc8cdb
commit 51d730320c
5 changed files with 555 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -156,6 +156,7 @@ components/jpeg/lazjpeg.pas svneol=native#text/pascal
components/jpeg/readme.txt svneol=native#text/plain
components/macfiles/Makefile svneol=native#text/plain
components/macfiles/Makefile.fpc svneol=native#text/plain
components/macfiles/examples/Readme.txt svneol=native#text/plain
components/macfiles/examples/createmacapplication.lpi svneol=native#text/plain
components/macfiles/examples/createmacapplication.lpr svneol=native#text/plain
components/macfiles/macapplicationres.pas svneol=native#text/plain

14
components/macfiles/examples/Readme.txt Normal file
View File

@ -0,0 +1,14 @@
The createmacapplication.lpi is more than an example.
It is a tool to create the hidden directories, needed by graphical applications
on MacOSX.
When you start a native carbon application in Lazarus, it creates the sources
and .lpi files, and compiling will give you the executable.
Example:
Open the createmacapplication.lpi project and compile it.
cd /your/project/
/path/to/lazarus/components/macfiles/examples/createmacapplication projectname
ln -s ../../../projectname ./projectname.app/Contents/MacOS/projectname

2
lcl/include/wincontrol.inc
View File

@ -3350,7 +3350,7 @@ var
ShiftState: TShiftState;
AParent: TWinControl;
begin
//debugln('TWinControl.DoKeyDown ',Name,':',ClassName,' ');
//debugln('TWinControl.DoKeyDown ',DbgSName(Self),' ShiftState=',dbgs(KeyDataToShiftState(Message.KeyData)),' CharCode=',dbgs(Message.CharCode));
Result:=true;
with Message do

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

@ -40,7 +40,7 @@ begin
if (cmdKey and Modifiers)>0 then
inc(Result,MK_Control);
debugln('GetCarbonMsgKeyState Result=',dbgs(KeysToShiftState(Result)),' Modifiers=',hexstr(Modifiers,8),' ButtonState=',hexstr(ButtonState,8));
//debugln('GetCarbonMsgKeyState Result=',dbgs(KeysToShiftState(Result)),' Modifiers=',hexstr(Modifiers,8),' ButtonState=',hexstr(ButtonState,8));
end;
function GetCarbonShiftState: TShiftState;
@ -70,7 +70,7 @@ begin
if (alphaLock and Modifiers)>0 then
Include(Result,ssCaps);
debugln('GetCarbonShiftState Result=',dbgs(Result),' Modifiers=',hexstr(Modifiers,8),' ButtonState=',hexstr(ButtonState,8));
//debugln('GetCarbonShiftState Result=',dbgs(Result),' Modifiers=',hexstr(Modifiers,8),' ButtonState=',hexstr(ButtonState,8));
end;
@ -125,7 +125,9 @@ var
Msg: TLMMouseMove;
Info:PWidgetInfo;
begin
{$IFDEF VerboseMouse}
debugln('TrackProgress');
{$ENDIF}
GetGlobalMouse(AbsMousePos);
Window := HIViewGetWindow(AControl);
GetWindowBounds(Window, kWindowStructureRgn, R);
@ -169,7 +171,9 @@ var
R: FPCMacOSAll.Rect;
Msg: TLMMouseMove;
begin
{$IFDEF VerboseMouse}
DebugLn('CarbonPrivateWindow_ControlTrack');
{$ENDIF}
GetEventParameter(AEvent, kEventParamWindowMouseLocation, typeHIPoint, nil, SizeOf(MousePoint), nil, @MousePoint);
GetEventParameter(AEvent, kEventParamControlAction, typeControlActionUPP, nil, sizeof(ActionUPP), nil, @OldActionUPP);
GetEventParameter(AEvent, kEventParamMouseButton, typeMouseButton, nil, SizeOf(MouseButton), nil, @MouseButton);
@ -258,7 +262,9 @@ var
GetEventParameter(AEvent, kEventParamMouseWheelDelta, typeSInt32, nil,
SizeOf(WheelDelta), nil, @WheelDelta);
Result := WheelDelta;
{$IFDEF VerboseMouse}
debugln('GetMouseWheelDelta WheelDelta=',dbgs(WheelDelta),' ',hexstr(WheelDelta,8));
{$ENDIF}
end;
//
@ -280,7 +286,9 @@ var
Msg: ^TLMMouse;
Spec: EventTypeSpec;
begin
DebugLN('-- mouse down --');
{$IFDEF VerboseMouse}
DebugLN('HandleMouseDownEvent');
{$ENDIF}
Msg := @AMsg;
ClickCount := GetClickCount;
@ -314,7 +322,9 @@ var
MousePoint: TPoint;
Msg: ^TLMMouse;
begin
DebugLN('-- mouse up --');
{$IFDEF VerboseMouse}
DebugLN('HandleMouseUpEvent');
{$ENDIF}
// this is not called if NextHandler is called on MouseDown
// perhaps mousetracking can fix this
Msg := @AMsg;
@ -336,7 +346,9 @@ var
MousePoint: TPoint;
MSg: ^TLMMouseMove;
begin
{$IFDEF VerboseMouse}
DebugLN('HandleMouseMovedEvent');
{$ENDIF}
Msg := @AMsg;
MousePoint := GetMousePoint;
@ -349,7 +361,9 @@ var
procedure HandleMouseDraggedEvent(var AMsg);
begin
{$IFDEF VerboseMouse}
DebugLN('-- mouse dragged --');
{$ENDIF}
//TODO
end;
@ -358,7 +372,9 @@ var
MousePoint: TPoint;
MSg: ^TLMMouseEvent;
begin
{$IFDEF VerboseMouse}
DebugLN('HandleMouseWheelEvent');
{$ENDIF}
Msg := @AMsg;
MousePoint := GetMousePoint;
@ -456,82 +472,292 @@ var
SizeOf(KeyChar), nil, @KeyChar);
Result:=0;
case KeyCode of
0:
// Where is the "official" list of Mac key codes?
// alphabet
0: Result:=VK_A;
11: Result:=VK_B;
8: Result:=VK_C;
2: Result:=VK_D;
14: Result:=VK_E;
3: Result:=VK_F;
5: Result:=VK_G;
4: Result:=VK_H;
34: Result:=VK_I;
38: Result:=VK_J;
40: Result:=VK_K;
37: Result:=VK_L;
46: Result:=VK_M;
45: Result:=VK_N;
31: Result:=VK_O;
35: Result:=VK_P;
12: Result:=VK_Q;
15: Result:=VK_R;
1: Result:=VK_S;
17: Result:=VK_T;
32: Result:=VK_U;
9: Result:=VK_V;
13: Result:=VK_W;
7: Result:=VK_X;
16: Result:=VK_Y;
6: Result:=VK_Z;
// Numbers
29: Result:=VK_0;
18: Result:=VK_1;
19: Result:=VK_2;
20: Result:=VK_3;
21: Result:=VK_4;
23: Result:=VK_5;
22: Result:=VK_6;
26: Result:=VK_7;
28: Result:=VK_8;
25: Result:=VK_9;
// Symbols
{18: Result:=VK_exclam;
19: Result:=VK_at;
20: Result:=VK_numbersign;
21: Result:=VK_dollar;
23: Result:=VK_percent;
22: Result:=VK_asciicircum;
26: Result:=VK_ampersand;
28: Result:=VK_asterisk;
25: Result:=VK_parenleft;
29: Result:=VK_parenright;
27: Result:=VK_minus;
27: Result:=VK_underscore;
24: Result:=VK_equal;
24: Result:=VK_plus;}
//10: Result:=VK_grave;
//10: Result:=VK_asciitilde;
//33: Result:=VK_bracketleft;
//33: Result:=VK_braceleft;
//30: Result:=VK_bracketright;
//30: Result:=VK_braceright;
//41: Result:=VK_semicolon;
//41: Result:=VK_colon;
//39: Result:=VK_apostrophe;
//39: Result:=VK_quotedbl;
//43: Result:=VK_comma;
//43: Result:=VK_less;
//47: Result:=VK_period;
//47: Result:=VK_greater;
//44: Result:=VK_slash;
//44: Result:=VK_question;
//42: Result:=VK_backslash;
//42: Result:=VK_bar;
// "Special" keys
49: Result:=VK_space;
36: Result:=VK_Return;
117: Result:=VK_Delete;
48: Result:=VK_Tab;
53: Result:=VK_Escape;
//57: Result:=VK_Caps_Lock;
71: Result:=VK_NumLock;
107: Result:=VK_Scroll;
113: Result:=VK_Pause;
51: Result:=VK_Back;
114: Result:=VK_Insert;
// Cursor movement
126: Result:=VK_Up;
125: Result:=VK_Down;
123: Result:=VK_Left;
124: Result:=VK_Right;
116: Result:=VK_PRIOR;
121: Result:=VK_NEXT;
115: Result:=VK_Home;
119: Result:=VK_End;
// Numeric keypad
82: Result:=VK_0;
83: Result:=VK_1;
84: Result:=VK_2;
85: Result:=VK_3;
86: Result:=VK_4;
87: Result:=VK_5;
88: Result:=VK_6;
89: Result:=VK_7;
91: Result:=VK_8;
92: Result:=VK_9;
76: Result:=VK_RETURN;
65: Result:=VK_Decimal;
69: Result:=VK_Add;
78: Result:=VK_Subtract;
67: Result:=VK_Multiply;
75: Result:=VK_Divide;
// Function keys
122: Result:=VK_F1;
120: Result:=VK_F2;
99: Result:=VK_F3;
118: Result:=VK_F4;
96: Result:=VK_F5;
97: Result:=VK_F6;
98: Result:=VK_F7;
100: Result:=VK_F8;
101: Result:=VK_F9;
109: Result:=VK_F10;
103: Result:=VK_F11;
111: Result:=VK_F12;
// Modifier keys
56: Result:=VK_LShift;
//56: Result:=VK_RShift;
59: Result:=VK_LControl;
//59: Result:=VK_RControl;
//58: Result:=VK_Meta_L;
//58: Result:=VK_Meta_R;
55: Result:=VK_LMenu;
//55: Result:=VK_RMenu;
else
case KeyChar of
'a'..'z': Result:=VK_A+ord(KeyChar)-ord('a');
'A'..'Z': Result:=VK_A+ord(KeyChar)-ord('A');
'+': Result:=VK_ADD;
'-': Result:=VK_SUBTRACT;
' ': Result:=VK_SPACE;
#28: Result:=VK_LEFT;
#29: Result:=VK_RIGHT;
#30: Result:=VK_UP;
#31: Result:=VK_DOWN;
end;
end;
GetEventParameter(AEvent, kEventParamKeyMacCharCodes, typeChar, nil,
SizeOf(KeyChar), nil, @KeyChar);
GetEventParameter(AEvent, kEventParamKeyUnicodes, typeUnicodeText, nil,
6, @TextLen, @Buf[1]);
debugln('GetVKKeyCode Result=',dbgs(Result),' KeyCode='+dbgs(KeyCode),' KeyChar='+DbgStr(KeyChar),' TextLen='+dbgs(TextLen),
{$IFDEF VerboseKeyboard}
debugln('GetVKKeyCode Result=',dbgs(Result),'=',DbgsVKCode(Result),' KeyCode='+dbgs(KeyCode),' KeyChar='+DbgStr(KeyChar),' TextLen='+dbgs(TextLen),
' '+dbgs(Buf[1])+','+dbgs(Buf[2])+','+dbgs(Buf[3])+','+dbgs(Buf[4])+','+dbgs(Buf[5])+','+dbgs(Buf[6]));
{$ENDIF}
end;
function GetCharacterCode: word;
var
KeyChar: char;
Buf: array[1..6] of byte;
TextLen: UInt32;
begin
KeyChar:=#0;
FillChar(Buf,SizeOf(Buf),0);
GetEventParameter(AEvent, kEventParamKeyMacCharCodes, typeChar, nil,
SizeOf(KeyChar), nil, @KeyChar);
GetEventParameter(AEvent, kEventParamKeyUnicodes, typeUnicodeText, nil,
6, @TextLen, @Buf[1]);
Result:=ord(KeyChar);
debugln('GetCharacterCode Result=',dbgs(Result),' KeyChar='+DbgStr(KeyChar),
' '+dbgs(Buf[1])+','+dbgs(Buf[2])+','+dbgs(Buf[3])+','+dbgs(Buf[4])+','+dbgs(Buf[5])+','+dbgs(Buf[6]));
{$IFDEF VerboseKeyboard}
debugln('GetCharacterCode Result=',dbgs(Result),' KeyChar='+DbgStr(KeyChar));
{$ENDIF}
end;
function GetUTF8Character: TUTF8Char;
var
UTF16Buf: array[1..3] of word;
TextLen: UInt32;
CharLen: integer;
u: cardinal;
begin
// get the character as UTF16
GetEventParameter(AEvent, kEventParamKeyUnicodes, typeUnicodeText, nil,
6, @TextLen, @UTF16Buf[1]);
u:=UTF16CharacterToUnicode(PWideChar(@UTF16Buf[1]),CharLen);
if CharLen=0 then ;
Result:=UnicodeToUTF8(u);
{$IFDEF VerboseKeyboard}
debugln('GetUTF8Character Result=',dbgstr(Result),' unicode='+DbgS(u),
' '+hexStr(UTF16Buf[1],4)+','+hexStr(UTF16Buf[2],4)+','+hexStr(UTF16Buf[3],4));
debugln('GetUTF8Character "',Result,'"');
{$ENDIF}
end;
procedure HandleRawKeyDownEvent;
var
KeyMsg: TLMKeyDown;
CharMsg: TLMChar;
IsSysKey: Boolean;
UTF8Character: TUTF8Char;
begin
{$IFDEF VerboseKeyboard}
DebugLN('HandleRawKeyDownEvent Info^.LCLObject=',DbgSName(Info^.LCLObject));
{$ENDIF}
IsSysKey:=(GetCurrentKeyModifiers and optionKey)>0;
// create the LM_KEYDOWN message
// create the CN_KEYDOWN message
FillChar(KeyMsg, SizeOf(KeyMsg), 0);
KeyMsg.Msg := LM_KEYDOWN;
KeyMsg.Msg := CN_KEYDOWN;
KeyMsg.KeyData := GetCarbonMsgKeyState;
KeyMsg.CharCode := GetVKKeyCode;
// Msg is set in the Appropriate HandleKeyxxx procedure
if DeliverMessage(Info^.LCLObject, KeyMsg) = 0 then begin
Result := EventNotHandledErr;
if KeyMsg.CharCode=0 then
exit;
end
else begin
// the LCL does not want the event propagated
Result := noErr;
exit;
end;
if KeyMsg.CharCode<>0 then begin
// Msg is set in the Appropriate HandleKeyxxx procedure
if DeliverMessage(Info^.LCLObject, KeyMsg) = 0 then begin
Result := EventNotHandledErr;
if KeyMsg.CharCode=0 then
exit;
end
else begin
// the LCL does not want the event propagated
Result := noErr;
exit;
end;
end;
// send the UTF8 keypress
// try to get the UTF8 representation of the key
UTF8Character := GetUTF8Character;
if UTF8Character<>'' then begin
if TWinControl(Info^.LCLObject).IntfUTF8KeyPress(UTF8Character,1,IsSysKey)
then begin
// the LCL has handled the key
Result := noErr;
exit;
end;
end;
// create the LM_CHAR / LM_SYSCHAR message
FillChar(CharMsg, SizeOf(CharMsg), 0);
if (GetCurrentKeyModifiers and optionKey)>0 then
if IsSysKey then
CharMsg.Msg := LM_SYSCHAR
else
CharMsg.Msg := LM_CHAR;
CharMsg.KeyData := GetCarbonMsgKeyState;
CharMsg.CharCode := GetCharacterCode;
// Msg is set in the Appropriate HandleKeyxxx procedure
if DeliverMessage(Info^.LCLObject, CharMsg) = 0 then begin
Result := EventNotHandledErr;
end
else begin
// the LCL does not want the event propagated
Result := noErr;
if CharMsg.CharCode<>0 then begin
// Msg is set in the Appropriate HandleKeyxxx procedure
if DeliverMessage(Info^.LCLObject, CharMsg) = 0 then begin
Result := EventNotHandledErr;
end
else begin
// the LCL does not want the event propagated
Result := noErr;
end;
end;
end;
procedure HandleRawKeyUpEvent;
var
KeyMsg: TLMKeyUp;
begin
{$IFDEF VerboseKeyboard}
DebugLN('HandleRawKeyUpEvent Info^.LCLObject=',DbgSName(Info^.LCLObject));
{$ENDIF}
// create the CN_KEYUP message
FillChar(KeyMsg, SizeOf(KeyMsg), 0);
KeyMsg.Msg := CN_KEYUP;
KeyMsg.KeyData := GetCarbonMsgKeyState;
KeyMsg.CharCode := GetVKKeyCode;
if KeyMsg.CharCode<>0 then begin
// Msg is set in the Appropriate HandleKeyxxx procedure
if DeliverMessage(Info^.LCLObject, KeyMsg) = 0 then begin
Result := EventNotHandledErr;
if KeyMsg.CharCode=0 then
exit;
end
else begin
// the LCL does not want the event propagated
Result := noErr;
exit;
end;
end;
end;
@ -543,6 +769,7 @@ var
EventKind: UInt32;
Root: ControlRef;
begin
Result := EventNotHandledErr;
FillChar(Msg, SizeOf(Msg), 0);
GetRootControl(AWindowInfo^.Widget, Root);
@ -567,6 +794,8 @@ begin
EventKind := GetEventKind(AEvent);
case EventKind of
kEventRawKeyDown: HandleRawKeyDownEvent;
kEventRawKeyRepeat: HandleRawKeyDownEvent;
kEventRawKeyUp: HandleRawKeyUpEvent;
else
exit(EventNotHandledErr);
end;
@ -627,10 +856,14 @@ begin
KeySpecs[0].eventClass := kEventClassKeyboard;
KeySpecs[0].eventKind := kEventRawKeyDown;
KeySpecs[1].eventClass := kEventClassKeyboard;
KeySpecs[1].eventKind := kEventRawKeyRepeat;
KeySpecs[2].eventClass := kEventClassKeyboard;
KeySpecs[2].eventKind := kEventRawKeyUp;
InstallWindowEventHandler(AInfo^.Widget,
RegisterEventHandler(@CarbonPrivateWindow_KeyboardProc),
1, @KeySpecs[0], Pointer(AInfo), nil);
3, @KeySpecs[0], Pointer(AInfo), nil);
end;
procedure TCarbonPrivateWindow.UnregisterEvents;

293
lcl/lclproc.pas
View File

@ -168,6 +168,7 @@ function dbgObjMem(AnObject: TObject): string; overload;
function DbgS(const i1,i2,i3,i4: integer): string; overload;
function DbgS(const Shift: TShiftState): string; overload;
function DbgsVKCode(c: word): string;
// some string manipulation functions
function StripLN(const ALine: String): String;
@ -189,7 +190,7 @@ function ClassCase(const AClass: TClass; const ACase: array of TClass; const ADe
function UTF8CharacterLength(p: PChar): integer;
function UTF8Length(const s: string): integer;
function UTF8Length(p: PChar; Count: integer): integer;
function UTF8CharacterToUnicode(p: PChar; var CharLen: integer): Cardinal;
function UTF8CharacterToUnicode(p: PChar; out CharLen: integer): Cardinal;
function UnicodeToUTF8(u: cardinal): string;
function UTF8ToDoubleByteString(const s: string): string;
function UTF8ToDoubleByte(UTF8Str: PChar; Len: integer; DBStr: PByte): integer;
@ -200,6 +201,13 @@ function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar;
procedure UTF8FixBroken(P: PChar);
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string;
function UTF16CharacterLength(p: PWideChar): integer;
function UTF16Length(const s: widestring): integer;
function UTF16Length(p: PWideChar; WordCount: integer): integer;
function UTF16CharacterToUnicode(p: PWideChar; out CharLen: integer): Cardinal;
function UnicodeToUTF16(u: cardinal): widestring;
// identifier
function CreateFirstIdentifier(const Identifier: string): string;
function CreateNextIdentifier(const Identifier: string): string;
@ -410,38 +418,41 @@ begin
end;
end;
function GetCompleteText(sText: string; iSelStart: Integer; bCaseSensitive, bSearchAscending: Boolean; slTextList: TStrings): string;
function GetCompleteText(sText: string; iSelStart: Integer;
bCaseSensitive, bSearchAscending: Boolean; slTextList: TStrings): string;
function IsSamePrefix(sCompareText, sPrefix: string; iStart: Integer; var ResultText: string): Boolean;
var sTempText: string;
begin
Result := False;
sTempText := LeftStr(sCompareText, iStart);
if not bCaseSensitive then sTempText := UpperCase(sTempText);
if (sTempText = sPrefix) then
begin
ResultText := sCompareText;
Result := True;
end;//End if (sTempText = sPrefix)
end;//End function IsSamePrefix
function IsSamePrefix(sCompareText, sPrefix: string; iStart: Integer;
var ResultText: string): Boolean;
var sTempText: string;
begin
Result := False;
sTempText := LeftStr(sCompareText, iStart);
if not bCaseSensitive then sTempText := UpperCase(sTempText);
if (sTempText = sPrefix) then
begin
ResultText := sCompareText;
Result := True;
end;//End if (sTempText = sPrefix)
end;//End function IsSamePrefix
var i: Integer;
sPrefixText: string;
begin
Result := sText;//Default to return original text if no identical text are found
if (sText = '') then Exit;//Everything is compatible with nothing, Exit.
if (iSelStart = 0) then Exit;//Cursor at beginning
if (slTextList.Count = 0) then Exit;//No text list to search for idtenticals, Exit.
sPrefixText := LeftStr(sText, iSelStart);//Get text from beginning to cursor position.
if not bCaseSensitive then sPrefixText := UpperCase(sPrefixText);
if bSearchAscending then
Result := sText;//Default to return original text if no identical text are found
if (sText = '') then Exit;//Everything is compatible with nothing, Exit.
if (iSelStart = 0) then Exit;//Cursor at beginning
if (slTextList.Count = 0) then Exit;//No text list to search for idtenticals, Exit.
sPrefixText := LeftStr(sText, iSelStart);//Get text from beginning to cursor position.
if not bCaseSensitive then
sPrefixText := UpperCase(sPrefixText);
if bSearchAscending then
begin
for i:=0 to slTextList.Count-1 do
if IsSamePrefix(slTextList[i], sPrefixText, iSelStart, Result) then Break;
for i:=0 to slTextList.Count-1 do
if IsSamePrefix(slTextList[i], sPrefixText, iSelStart, Result) then Break;
end else
begin
for i:=slTextList.Count-1 downto 0 do
if IsSamePrefix(slTextList[i], sPrefixText, iSelStart, Result) then Break;
for i:=slTextList.Count-1 downto 0 do
if IsSamePrefix(slTextList[i], sPrefixText, iSelStart, Result) then Break;
end;//End if bSearchAscending
end;
@ -1329,6 +1340,166 @@ begin
Result:='['+Result+']';
end;
function DbgsVKCode(c: word): string;
begin
case c of
VK_UNKNOWN: Result:='VK_UNKNOWN';
VK_LBUTTON: Result:='VK_LBUTTON';
VK_RBUTTON: Result:='VK_RBUTTON';
VK_CANCEL: Result:='VK_CANCEL';
VK_MBUTTON: Result:='VK_MBUTTON';
VK_BACK: Result:='VK_BACK';
VK_TAB: Result:='VK_TAB';
VK_CLEAR: Result:='VK_CLEAR';
VK_RETURN: Result:='VK_RETURN';
VK_SHIFT: Result:='VK_SHIFT';
VK_CONTROL: Result:='VK_CONTROL';
VK_MENU: Result:='VK_MENU';
VK_PAUSE: Result:='VK_PAUSE';
VK_CAPITAL: Result:='VK_CAPITAL';
VK_KANA: Result:='VK_KANA';
VK_JUNJA: Result:='VK_JUNJA';
VK_FINAL: Result:='VK_FINAL';
VK_HANJA: Result:='VK_HANJA';
VK_ESCAPE: Result:='VK_ESCAPE';
VK_CONVERT: Result:='VK_CONVERT';
VK_NONCONVERT: Result:='VK_NONCONVERT';
VK_ACCEPT: Result:='VK_ACCEPT';
VK_MODECHANGE: Result:='VK_MODECHANGE';
VK_SPACE: Result:='VK_SPACE';
VK_PRIOR: Result:='VK_PRIOR';
VK_NEXT: Result:='VK_NEXT';
VK_END: Result:='VK_END';
VK_HOME: Result:='VK_HOME';
VK_LEFT: Result:='VK_LEFT';
VK_UP: Result:='VK_UP';
VK_RIGHT: Result:='VK_RIGHT';
VK_DOWN: Result:='VK_DOWN';
VK_SELECT: Result:='VK_SELECT';
VK_PRINT: Result:='VK_PRINT';
VK_EXECUTE: Result:='VK_EXECUTE';
VK_SNAPSHOT: Result:='VK_SNAPSHOT';
VK_INSERT: Result:='VK_INSERT';
VK_DELETE: Result:='VK_DELETE';
VK_HELP: Result:='VK_HELP';
VK_0: Result:='VK_0';
VK_1: Result:='VK_1';
VK_2: Result:='VK_2';
VK_3: Result:='VK_3';
VK_4: Result:='VK_4';
VK_5: Result:='VK_5';
VK_6: Result:='VK_6';
VK_7: Result:='VK_7';
VK_8: Result:='VK_8';
VK_9: Result:='VK_9';
VK_A: Result:='VK_A';
VK_B: Result:='VK_B';
VK_C: Result:='VK_C';
VK_D: Result:='VK_D';
VK_E: Result:='VK_E';
VK_F: Result:='VK_F';
VK_G: Result:='VK_G';
VK_H: Result:='VK_H';
VK_I: Result:='VK_I';
VK_J: Result:='VK_J';
VK_K: Result:='VK_K';
VK_L: Result:='VK_L';
VK_M: Result:='VK_M';
VK_N: Result:='VK_N';
VK_O: Result:='VK_O';
VK_P: Result:='VK_P';
VK_Q: Result:='VK_Q';
VK_R: Result:='VK_R';
VK_S: Result:='VK_S';
VK_T: Result:='VK_T';
VK_U: Result:='VK_U';
VK_V: Result:='VK_V';
VK_W: Result:='VK_W';
VK_X: Result:='VK_X';
VK_Y: Result:='VK_Y';
VK_Z: Result:='VK_Z';
VK_LWIN: Result:='VK_LWIN';
VK_RWIN: Result:='VK_RWIN';
VK_APPS: Result:='VK_APPS';
VK_SLEEP: Result:='VK_SLEEP';
VK_NUMPAD0: Result:='VK_NUMPAD0';
VK_NUMPAD1: Result:='VK_NUMPAD1';
VK_NUMPAD2: Result:='VK_NUMPAD2';
VK_NUMPAD3: Result:='VK_NUMPAD3';
VK_NUMPAD4: Result:='VK_NUMPAD4';
VK_NUMPAD5: Result:='VK_NUMPAD5';
VK_NUMPAD6: Result:='VK_NUMPAD6';
VK_NUMPAD7: Result:='VK_NUMPAD7';
VK_NUMPAD8: Result:='VK_NUMPAD8';
VK_NUMPAD9: Result:='VK_NUMPAD9';
VK_MULTIPLY: Result:='VK_MULTIPLY';
VK_ADD: Result:='VK_ADD';
VK_SEPARATOR: Result:='VK_SEPARATOR';
VK_SUBTRACT: Result:='VK_SUBTRACT';
VK_DECIMAL: Result:='VK_DECIMAL';
VK_DIVIDE: Result:='VK_DIVIDE';
VK_F1: Result:='VK_F1';
VK_F2: Result:='VK_F2';
VK_F3: Result:='VK_F3';
VK_F4: Result:='VK_F4';
VK_F5: Result:='VK_F5';
VK_F6: Result:='VK_F6';
VK_F7: Result:='VK_F7';
VK_F8: Result:='VK_F8';
VK_F9: Result:='VK_F9';
VK_F10: Result:='VK_F10';
VK_F11: Result:='VK_F11';
VK_F12: Result:='VK_F12';
VK_F13: Result:='VK_F13';
VK_F14: Result:='VK_F14';
VK_F15: Result:='VK_F15';
VK_F16: Result:='VK_F16';
VK_F17: Result:='VK_F17';
VK_F18: Result:='VK_F18';
VK_F19: Result:='VK_F19';
VK_F20: Result:='VK_F20';
VK_F21: Result:='VK_F21';
VK_F22: Result:='VK_F22';
VK_F23: Result:='VK_F23';
VK_F24: Result:='VK_F24';
VK_NUMLOCK: Result:='VK_NUMLOCK';
VK_SCROLL: Result:='VK_SCROLL';
VK_LSHIFT: Result:='VK_LSHIFT';
VK_RSHIFT: Result:='VK_RSHIFT';
VK_LCONTROL: Result:='VK_LCONTROL';
VK_RCONTROL: Result:='VK_RCONTROL';
VK_LMENU: Result:='VK_LMENU';
VK_RMENU: Result:='VK_RMENU';
VK_BROWSER_BACK: Result:='VK_BROWSER_BACK';
VK_BROWSER_FORWARD: Result:='VK_BROWSER_FORWARD';
VK_BROWSER_REFRESH: Result:='VK_BROWSER_REFRESH';
VK_BROWSER_STOP: Result:='VK_BROWSER_STOP';
VK_BROWSER_SEARCH: Result:='VK_BROWSER_SEARCH';
VK_BROWSER_FAVORITES: Result:='VK_BROWSER_FAVORITES';
VK_BROWSER_HOME: Result:='VK_BROWSER_HOME';
VK_VOLUME_MUTE: Result:='VK_VOLUME_MUTE';
VK_VOLUME_DOWN: Result:='VK_VOLUME_DOWN';
VK_VOLUME_UP: Result:='VK_VOLUME_UP';
VK_MEDIA_NEXT_TRACK: Result:='VK_MEDIA_NEXT_TRACK';
VK_MEDIA_PREV_TRACK: Result:='VK_MEDIA_PREV_TRACK';
VK_MEDIA_STOP: Result:='VK_MEDIA_STOP';
VK_MEDIA_PLAY_PAUSE: Result:='VK_MEDIA_PLAY_PAUSE';
VK_LAUNCH_MAIL: Result:='VK_LAUNCH_MAIL';
VK_LAUNCH_MEDIA_SELECT: Result:='VK_LAUNCH_MEDIA_SELECT';
VK_LAUNCH_APP1: Result:='VK_LAUNCH_APP1';
VK_LAUNCH_APP2: Result:='VK_LAUNCH_APP2';
else
Result:='VK_('+dbgs(c)+')';
end;
end;
function StripLN(const ALine: String): String;
var
idx: Integer;
@ -1544,7 +1715,7 @@ begin
end;
end;
function UTF8CharacterToUnicode(p: PChar; var CharLen: integer): Cardinal;
function UTF8CharacterToUnicode(p: PChar; out CharLen: integer): Cardinal;
begin
if p<>nil then begin
if ord(p^)<%11000000 then begin
@ -1802,6 +1973,76 @@ begin
SetLength(Result, Dest - PChar(Result));
end;
function UTF16CharacterLength(p: PWideChar): integer;
// returns length of UTF16 character in number of words
// The endianess of the machine will be taken.
begin
if p<>nil then begin
if ord(p[0])<$D800 then
Result:=1
else
Result:=2;
end else begin
Result:=0;
end;
end;
function UTF16Length(const s: widestring): integer;
begin
Result:=UTF16Length(PWideChar(s),length(s));
end;
function UTF16Length(p: PWideChar; WordCount: integer): integer;
var
CharLen: LongInt;
begin
Result:=0;
while (WordCount>0) do begin
inc(Result);
CharLen:=UTF16CharacterLength(p);
inc(p,CharLen);
dec(WordCount,CharLen);
end;
end;
function UTF16CharacterToUnicode(p: PWideChar; out CharLen: integer): Cardinal;
var
w1: cardinal;
w2: Cardinal;
begin
if p<>nil then begin
w1:=ord(p[0]);
if w1<$D800 then begin
// is 1 word character
Result:=w1;
CharLen:=1;
end else begin
// could be 2 word character
w2:=ord(p[1]);
if (w2>=$DC00) then begin
// is 2 word character
Result:=(w1-$D800) shl 10 + (w2-$DC00);
CharLen:=2;
end else begin
// invalid character
Result:=w1;
CharLen:=1;
end;
end;
end else begin
Result:=0;
CharLen:=0;
end;
end;
function UnicodeToUTF16(u: cardinal): widestring;
begin
if u<$D800 then
Result:=widechar(u)
else
Result:=widechar($D800+(u shr 10))+widechar($DC00+(u and $3ff));
end;
function CreateFirstIdentifier(const Identifier: string): string;
// example: Ident59 becomes Ident1
var