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

MG: broke actnlist <-> menus circle

Browse Source 
git-svn-id: trunk@3563 -
This commit is contained in:
lazarus 2002-10-26 10:21:01 +00:00
parent 9da629f572
commit 29fd697de5
4 changed files with 18 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/actnlist.pas
View File

@ -26,7 +26,7 @@ unit ActnList;
interface
uses
Classes, SysUtils, ImgList;
Classes, SysUtils, LCLProc, ImgList;
type
@ -290,7 +290,7 @@ implementation
uses
Forms, Menus;
Forms;
const
SInvalidActionRegistration = 'Invalid action registration';

2
lcl/include/shortcutlist.inc
View File

@ -21,7 +21,7 @@ var
p: Pointer;
begin
Result := inherited Add(S);
ShortCut:=TextToShortCut(S);
ShortCut:=ShortCutTextToShortCut(S);
p:=Pointer(Cardinal(ShortCut));
Objects[Result] := TObject(p);
end;

7
lcl/lcltype.pp
View File

@ -1637,6 +1637,10 @@ const
// key mapping
type
TShortCut = Low(Word)..High(Word); {should be moved to classes}
Function Char2VK(C : Char) : Word;
function MapIrregularVirtualKey(vk: word): word;
@ -1679,6 +1683,9 @@ end.
{
$Log$
Revision 1.24 2002/10/26 10:21:01 lazarus
MG: broke actnlist <-> menus circle
Revision 1.23 2002/10/24 10:05:51 lazarus
MG: broke graphics.pp <-> clipbrd.pp circle

122
lcl/menus.pp
View File

@ -45,13 +45,11 @@ interface
{$endif}
uses
Classes, SysUtils, LCLLinux, LCLType, VCLGlobals, LMessages,
Classes, SysUtils, LCLLinux, LCLType, LCLProc, VCLGlobals, LMessages,
ActnList, Graphics, ImgList;
type
TShortCut = Low(Word)..High(Word); {should be moved to classes}
TMenu = class;
EMenuError = class(Exception);
@ -292,7 +290,7 @@ function ShortCut(const Key: Word; const Shift : TShiftState) : TShortCut;
procedure ShortCutToKey(const ShortCut : TShortCut; var Key: Word;
var Shift : TShiftState);
function TextToShortCut(Text: string): TShortCut;
function TextToShortCut(const ShortCutText: string): TShortCut;
function ShortCutToText(ShortCut: TShortCut): string;
@ -312,121 +310,14 @@ begin
CommandPool[Result] := True;
end;
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 GetSpecialName(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));
GetSpecialName := KeyName;
end;
}
end;
function ShortCutToText(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 := GetSpecialName(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 := '';
Result:=ShortCutToShortCutText(ShortCut);
end;
function TextToShortCut(Text: string): TShortCut;
{ If the front of Text is equal to Front then remove the matching piece
from Text and return True, otherwise return False }
function CompareFront(var Text: string; const Front: string): Boolean;
begin
Result := False;
if (Length(Text) >= Length(Front)) and
(AnsiStrLIComp(PChar(Text), PChar(Front), Length(Front)) = 0) then
begin
Result := True;
Delete(Text, 1, Length(Front));
end;
end;
var
Key: TShortCut;
Shift: TShortCut;
function TextToShortCut(const ShortCutText: string): TShortCut;
begin
Result := 0;
Shift := 0;
while True do
begin
if CompareFront(Text, MenuKeyCaps[mkcShift]) then Shift := Shift or scShift
else if CompareFront(Text, '^') then Shift := Shift or scCtrl
else if CompareFront(Text, MenuKeyCaps[mkcCtrl]) then Shift := Shift or scCtrl
else if CompareFront(Text, MenuKeyCaps[mkcAlt]) then Shift := Shift or scAlt
else Break;
end;
if Text = '' then Exit;
for Key := $08 to $255 do { Copy range from table in ShortCutToText }
if AnsiCompareText(Text, ShortCutToText(Key)) = 0 then
begin
Result := Key or Shift;
Exit;
end;
Result:=ShortCutTextToShortCut(ShortCutText);
end;
{$I menubar.inc}
@ -464,6 +355,9 @@ end.
{
$Log$
Revision 1.31 2002/10/26 10:21:01 lazarus
MG: broke actnlist <-> menus circle
Revision 1.30 2002/10/24 09:37:39 lazarus
MG: broke menus.pp <-> controls.pp circle