diff --git a/.gitattributes b/.gitattributes index 976126f1a7..45aa04eef0 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/components/macfiles/examples/Readme.txt b/components/macfiles/examples/Readme.txt new file mode 100644 index 0000000000..a78698242d --- /dev/null +++ b/components/macfiles/examples/Readme.txt @@ -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 + + diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 48786ed378..7cfaf90ac7 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -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 diff --git a/lcl/interfaces/carbon/carbonprivatewindow.inc b/lcl/interfaces/carbon/carbonprivatewindow.inc index c2f11430cf..06b1520f13 100644 --- a/lcl/interfaces/carbon/carbonprivatewindow.inc +++ b/lcl/interfaces/carbon/carbonprivatewindow.inc @@ -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; diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index bbd8a4211c..3c5a9926cf 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -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