MG: broke actnlist <-> menus circle

git-svn-id: trunk@2370 -

lcl/lclproc.pas

@@ -33,6 +33,9 @@ uses
 
 Function DeleteAmpersands(var Str : String) : Longint;
 
+function ShortCutToShortCutText(ShortCut: TShortCut): string;
+function ShortCutTextToShortCut(const ShortCutText: string): TShortCut;
+
 
 implementation
 
@@ -64,6 +67,133 @@ begin
     SetLength(Str,DestPos-1);
 end;
 
+//-----------------------------------------------------------------------------
+// Keys and shortcuts
+
+type
+  TMenuKeyCap = (mkcBkSp, mkcTab, mkcEsc, mkcEnter, mkcSpace, mkcPgUp,
+    mkcPgDn, mkcEnd, mkcHome, mkcLeft, mkcUp, mkcRight, mkcDown, mkcIns,
+    mkcDel, mkcShift, mkcCtrl, mkcAlt);
+
+const
+  SmkcBkSp = 'BkSp';
+  SmkcTab = 'Tab';
+  SmkcEsc = 'Esc';
+  SmkcEnter = 'Enter';
+  SmkcSpace = 'Space';
+  SmkcPgUp = 'PgUp';
+  SmkcPgDn = 'PgDn';
+  SmkcEnd = 'End';
+  SmkcHome = 'Home';
+  SmkcLeft = 'Left';
+  SmkcUp = 'Up';
+  SmkcRight = 'Right';
+  SmkcDown = 'Down';
+  SmkcIns = 'Ins';
+  SmkcDel = 'Del';
+  SmkcShift = 'Shift+';
+  SmkcCtrl = 'Ctrl+';
+  SmkcAlt = 'Alt+';
+
+  MenuKeyCaps: array[TMenuKeyCap] of string = (
+    SmkcBkSp, SmkcTab, SmkcEsc, SmkcEnter, SmkcSpace, SmkcPgUp,
+    SmkcPgDn, SmkcEnd, SmkcHome, SmkcLeft, SmkcUp, SmkcRight,
+    SmkcDown, SmkcIns, SmkcDel, SmkcShift, SmkcCtrl, SmkcAlt);
+
+function GetSpecialShortCutName(ShortCut: TShortCut): string;
+{var
+  ScanCode: Integer;
+  KeyName: array[0..255] of Char;}
+begin
+  Result := '';
+  // ToDo:
+  {
+  ScanCode := MapVirtualKey(WordRec(ShortCut).Lo, 0) shl 16;
+  if ScanCode <> 0 then
+  begin
+    GetKeyNameText(ScanCode, KeyName, SizeOf(KeyName));
+    Result := KeyName;
+  end;
+  }
+end;
+
+function ShortCutToShortCutText(ShortCut: TShortCut): string;
+var
+  Name: string;
+begin
+  case WordRec(ShortCut).Lo of
+    $08, $09:
+      Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcBkSp) + WordRec(ShortCut).Lo - $08)];
+    $0D: Name := MenuKeyCaps[mkcEnter];
+    $1B: Name := MenuKeyCaps[mkcEsc];
+    $20..$28:
+      Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcSpace) + WordRec(ShortCut).Lo - $20)];
+    $2D..$2E:
+      Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcIns) + WordRec(ShortCut).Lo - $2D)];
+    $30..$39: Name := Chr(WordRec(ShortCut).Lo - $30 + Ord('0'));
+    $41..$5A: Name := Chr(WordRec(ShortCut).Lo - $41 + Ord('A'));
+    $60..$69: Name := Chr(WordRec(ShortCut).Lo - $60 + Ord('0'));
+    $70..$87: Name := 'F' + IntToStr(WordRec(ShortCut).Lo - $6F);
+  else
+    Name := GetSpecialShortCutName(ShortCut);
+  end;
+  if Name <> '' then
+  begin
+    Result := '';
+    if ShortCut and scShift <> 0 then Result := Result + MenuKeyCaps[mkcShift];
+    if ShortCut and scCtrl <> 0 then Result := Result + MenuKeyCaps[mkcCtrl];
+    if ShortCut and scAlt <> 0 then Result := Result + MenuKeyCaps[mkcAlt];
+    Result := Result + Name;
+  end
+  else Result := '';
+end;
+
+function ShortCutTextToShortCut(const ShortCutText: string): TShortCut;
+
+  function CompareFront(var StartPos: integer; const Front: string): Boolean;
+  begin
+    if (Front<>'') and (StartPos+length(Front)-1<=length(ShortCutText))
+    and (AnsiStrLIComp(@ShortCutText[StartPos], PChar(Front), Length(Front))= 0)
+    then begin
+      Result:=true;
+      inc(StartPos,length(Front));
+    end else
+      Result:=false;
+  end;
+
+var
+  Key: TShortCut;
+  Shift: TShortCut;
+  StartPos: integer;
+  Name: string;
+begin
+  Result := 0;
+  Shift := 0;
+  StartPos:=1;
+  while True do
+  begin
+    if CompareFront(StartPos, MenuKeyCaps[mkcShift]) then
+      Shift := Shift or scShift
+    else if CompareFront(StartPos, '^') then
+      Shift := Shift or scCtrl
+    else if CompareFront(StartPos, MenuKeyCaps[mkcCtrl]) then
+      Shift := Shift or scCtrl
+    else if CompareFront(StartPos, MenuKeyCaps[mkcAlt]) then
+      Shift := Shift or scAlt
+    else
+      Break;
+  end;
+  if ShortCutText = '' then Exit;
+  for Key := $08 to $255 do begin { Copy range from table in ShortCutToText }
+    Name:=ShortCutToShortCutText(Key);
+    if (Name<>'') and (length(Name)=length(ShortCutText)-StartPos+1)
+    and (AnsiStrLIComp(@ShortCutText[StartPos], PChar(Name), length(Name)) = 0)
+    then begin
+      Result := Key or Shift;
+      Exit;
+    end;
+  end;
+end;
 
 end.