From 194923c172167eb3fc33807ec8009b255f86337e Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Mon, 8 Oct 2012 09:10:06 +0000 Subject: Plugin is not adapted until someone can compile it and tell others how to do the same git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../lib/TntUnicodeControls/Source/TntMenus.pas | 1146 -------------------- 1 file changed, 1146 deletions(-) delete mode 100644 plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas (limited to 'plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas') diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas deleted file mode 100644 index 577764661c..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntMenus.pas +++ /dev/null @@ -1,1146 +0,0 @@ - -{*****************************************************************************} -{ } -{ Tnt Delphi Unicode Controls } -{ http://www.tntware.com/delphicontrols/unicode/ } -{ Version: 2.3.0 } -{ } -{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) } -{ } -{*****************************************************************************} - -unit TntMenus; - -{$INCLUDE TntCompilers.inc} - -interface - -uses - Windows, Classes, Menus, Graphics, Messages; - -type -{TNT-WARN TMenuItem} - TTntMenuItem = class(TMenuItem{TNT-ALLOW TMenuItem}) - private - FIgnoreMenuChanged: Boolean; - FCaption: WideString; - FHint: WideString; - FKeyboardLayout: HKL; - function GetCaption: WideString; - procedure SetInheritedCaption(const Value: AnsiString); - procedure SetCaption(const Value: WideString); - function IsCaptionStored: Boolean; - procedure UpdateMenuString(ParentMenu: TMenu); - function GetAlignmentDrawStyle: Word; - function MeasureItemTextWidth(ACanvas: TCanvas; const Text: WideString): Integer; - function GetHint: WideString; - procedure SetInheritedHint(const Value: AnsiString); - procedure SetHint(const Value: WideString); - function IsHintStored: Boolean; - protected - procedure DefineProperties(Filer: TFiler); override; - function GetActionLinkClass: TMenuActionLinkClass; override; - procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; - procedure MenuChanged(Rebuild: Boolean); override; - procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; - State: TOwnerDrawState; TopLevel: Boolean); override; - procedure DoDrawText(ACanvas: TCanvas; const ACaption: WideString; - var Rect: TRect; Selected: Boolean; Flags: Integer); - procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer); override; - public - procedure InitiateAction; override; - procedure Loaded; override; - function Find(ACaption: WideString): TMenuItem{TNT-ALLOW TMenuItem}; - published - property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored; - property Hint: WideString read GetHint write SetHint stored IsHintStored; - end; - -{TNT-WARN TMainMenu} - TTntMainMenu = class(TMainMenu{TNT-ALLOW TMainMenu}) - protected - procedure DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean); override; - public - {$IFDEF COMPILER_9_UP} - function CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem}; override; - {$ENDIF} - end; - -{TNT-WARN TPopupMenu} - TTntPopupMenu = class(TPopupMenu{TNT-ALLOW TPopupMenu}) - protected - procedure DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean); override; - public - constructor Create(AOwner: TComponent); override; - {$IFDEF COMPILER_9_UP} - function CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem}; override; - {$ENDIF} - destructor Destroy; override; - procedure Popup(X, Y: Integer); override; - end; - -{TNT-WARN NewSubMenu} -function WideNewSubMenu(const ACaption: WideString; hCtx: THelpContext; - const AName: TComponentName; const Items: array of TTntMenuItem; - AEnabled: Boolean): TTntMenuItem; -{TNT-WARN NewItem} -function WideNewItem(const ACaption: WideString; AShortCut: TShortCut; - AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext; - const AName: TComponentName): TTntMenuItem; - -function MessageToShortCut(Msg: TWMKeyDown): TShortCut; - -{TNT-WARN ShortCutToText} -function WideShortCutToText(WordShortCut: Word): WideString; -{TNT-WARN TextToShortCut} -function WideTextToShortCut(Text: WideString): TShortCut; -{TNT-WARN GetHotKey} -function WideGetHotkey(const Text: WideString): WideString; -{TNT-WARN StripHotkey} -function WideStripHotkey(const Text: WideString): WideString; -{TNT-WARN AnsiSameCaption} -function WideSameCaption(const Text1, Text2: WideString): Boolean; - -function WideGetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString; -function WideGetMenuItemHint(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString; - -procedure NoOwnerDrawTopLevelItems(Menu: TMainMenu{TNT-ALLOW TMainMenu}); - -procedure FixMenuBiDiProblem(Menu: TMenu); - -function MenuItemHasBitmap(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): Boolean; - -type - TTntPopupList = class(TPopupList) - private - SavedPopupList: TPopupList; - protected - procedure WndProc(var Message: TMessage); override; - end; - -var - TntPopupList: TTntPopupList; - -implementation - -uses - Forms, SysUtils, Consts, ActnList, ImgList, TntControls, TntGraphics, - TntActnList, TntClasses, TntForms, TntSysUtils, TntWindows; - -function WideNewSubMenu(const ACaption: WideString; hCtx: THelpContext; - const AName: TComponentName; const Items: array of TTntMenuItem; - AEnabled: Boolean): TTntMenuItem; -var - I: Integer; -begin - Result := TTntMenuItem.Create(nil); - for I := Low(Items) to High(Items) do - Result.Add(Items[I]); - Result.Caption := ACaption; - Result.HelpContext := hCtx; - Result.Name := AName; - Result.Enabled := AEnabled; -end; - -function WideNewItem(const ACaption: WideString; AShortCut: TShortCut; - AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext; - const AName: TComponentName): TTntMenuItem; -begin - Result := TTntMenuItem.Create(nil); - with Result do - begin - Caption := ACaption; - ShortCut := AShortCut; - OnClick := AOnClick; - HelpContext := hCtx; - Checked := AChecked; - Enabled := AEnabled; - Name := AName; - end; -end; - -function MessageToShortCut(Msg: TWMKeyDown): TShortCut; -var - ShiftState: TShiftState; -begin - ShiftState := Forms.KeyDataToShiftState(TWMKeyDown(Msg).KeyData); - Result := Menus.ShortCut(TWMKeyDown(Msg).CharCode, ShiftState); -end; - -function WideGetSpecialName(WordShortCut: Word): WideString; -var - ScanCode: Integer; - KeyName: array[0..255] of WideChar; -begin - Assert(Win32PlatformIsUnicode); - Result := ''; - ScanCode := MapVirtualKeyW(WordRec(WordShortCut).Lo, 0) shl 16; - if ScanCode <> 0 then - begin - GetKeyNameTextW(ScanCode, KeyName, SizeOf(KeyName)); - Result := KeyName; - end; -end; - -function WideGetKeyboardChar(Key: Word): WideChar; -var - LatinNumChar: WideChar; -begin - Assert(Win32PlatformIsUnicode); - Result := WideChar(MapVirtualKeyW(Key, 2)); - if (Key in [$30..$39]) then - begin - // Check to see if "0" - "9" can be used if all that differs is shift state - LatinNumChar := WideChar(Key - $30 + Ord('0')); - if (Result <> LatinNumChar) - and (Byte(Key) = WordRec(VkKeyScanW(LatinNumChar)).Lo) then // .Hi would be the shift state - Result := LatinNumChar; - end; -end; - -function WideShortCutToText(WordShortCut: Word): WideString; -var - Name: WideString; -begin - if (not Win32PlatformIsUnicode) - or (WordRec(WordShortCut).Lo in [$08..$09 {BKSP, TAB}, $0D {ENTER}, $1B {ESC}, $20..$28 {Misc Nav}, - $2D..$2E {INS, DEL}, $70..$87 {F1 - F24}]) - then - Result := ShortCutToText{TNT-ALLOW ShortCutToText}(WordShortCut) - else begin - case WordRec(WordShortCut).Lo of - $30..$39: Name := WideGetKeyboardChar(WordRec(WordShortCut).Lo); {1-9,0} - $41..$5A: Name := WideGetKeyboardChar(WordRec(WordShortCut).Lo); {A-Z} - $60..$69: Name := WideGetKeyboardChar(WordRec(WordShortCut).Lo); {numpad 1-9,0} - else - Name := WideGetSpecialName(WordShortCut); - end; - if Name <> '' then - begin - Result := ''; - if WordShortCut and scShift <> 0 then Result := Result + SmkcShift; - if WordShortCut and scCtrl <> 0 then Result := Result + SmkcCtrl; - if WordShortCut and scAlt <> 0 then Result := Result + SmkcAlt; - Result := Result + Name; - end - else Result := ''; - end; -end; - -{ This function is *very* slow. Use sparingly. Return 0 if no VK code was - found for the text } - -function WideTextToShortCut(Text: WideString): 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: WideString; const Front: WideString): Boolean; - begin - Result := (Pos(Front, Text) = 1); - if Result then - Delete(Text, 1, Length(Front)); - end; - -var - Key: TShortCut; - Shift: TShortCut; -begin - Result := 0; - Shift := 0; - while True do - begin - if CompareFront(Text, SmkcShift) then Shift := Shift or scShift - else if CompareFront(Text, '^') then Shift := Shift or scCtrl - else if CompareFront(Text, SmkcCtrl) then Shift := Shift or scCtrl - else if CompareFront(Text, SmkcAlt) 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 WideSameText(Text, WideShortCutToText(Key)) then - begin - Result := Key or Shift; - Exit; - end; -end; - -function WideGetHotkeyPos(const Text: WideString): Integer; -var - I, L: Integer; -begin - Result := 0; - I := 1; - L := Length(Text); - while I <= L do - begin - if (Text[I] = cHotkeyPrefix) and (L - I >= 1) then - begin - Inc(I); - if Text[I] <> cHotkeyPrefix then - Result := I; // this might not be the last - end; - Inc(I); - end; -end; - -function WideGetHotkey(const Text: WideString): WideString; -var - I: Integer; -begin - I := WideGetHotkeyPos(Text); - if I = 0 then - Result := '' - else - Result := Text[I]; -end; - -function WideStripHotkey(const Text: WideString): WideString; -var - I: Integer; -begin - Result := Text; - I := 1; - while I <= Length(Result) do - begin - if Result[I] = cHotkeyPrefix then - if SysLocale.FarEast - and ((I > 1) and (Length(Result) - I >= 2) - and (Result[I - 1] = '(') and (Result[I + 2] = ')')) then begin - Delete(Result, I - 1, 4); - Dec(I, 2); - end else - Delete(Result, I, 1); - Inc(I); - end; -end; - -function WideSameCaption(const Text1, Text2: WideString): Boolean; -begin - Result := WideSameText(WideStripHotkey(Text1), WideStripHotkey(Text2)); -end; - -function WideSameCaptionStr(const Text1, Text2: WideString): Boolean; -begin - Result := WideSameStr(WideStripHotkey(Text1), WideStripHotkey(Text2)); -end; - -function WideGetMenuItemCaption(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString; -begin - if MenuItem is TTntMenuItem then - Result := TTntMenuItem(MenuItem).Caption - else - Result := MenuItem.Caption; -end; - -function WideGetMenuItemHint(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): WideString; -begin - if MenuItem is TTntMenuItem then - Result := TTntMenuItem(MenuItem).Hint - else - Result := MenuItem.Hint; -end; - -procedure NoOwnerDrawTopLevelItems(Menu: TMainMenu{TNT-ALLOW TMainMenu}); -{If top-level items are created as owner-drawn, they will not appear as raised -buttons when the mouse hovers over them. The VCL will often create top-level -items as owner-drawn even when they don't need to be (owner-drawn state can be -set on an item-by-item basis). This routine turns off the owner-drawn flag for -top-level items if it appears unnecessary} - - function ItemHasValidImage(Item: TMenuItem{TNT-ALLOW TMenuItem}): boolean; - var - Images: TCustomImageList; - begin - Assert(Item <> nil, 'TNT Internal Error: ItemHasValidImage: item = nil'); - Images := Item.GetImageList; - Result := (Assigned(Images) and (Item.ImageIndex >= 0) and (Item.ImageIndex < Images.Count)) - or (MenuItemHasBitmap(Item) and (not Item.Bitmap.Empty)) - end; - -var - HM: HMenu; - i: integer; - Info: TMenuItemInfoA; - Item: TMenuItem{TNT-ALLOW TMenuItem}; - Win98Plus: boolean; -begin - if Assigned(Menu) then begin - Win98Plus:= (Win32MajorVersion > 4) - or((Win32MajorVersion = 4) and (Win32MinorVersion > 0)); - if not Win98Plus then - Exit; {exit if Windows 95 or NT 4.0} - HM:= Menu.Handle; - Info.cbSize:= sizeof(Info); - for i := 0 to GetMenuItemCount(HM) - 1 do begin - Info.fMask:= MIIM_FTYPE or MIIM_ID; - if not GetMenuItemInfo(HM, i, true, Info) then - Break; - if Info.fType and MFT_OWNERDRAW <> 0 then begin - Item:= Menu.FindItem(Info.wID, fkCommand); - if not Assigned(Item) then - continue; - if Assigned(Item.OnDrawItem) - or Assigned(Item.OnAdvancedDrawItem) - or ItemHasValidImage(Item) then - Continue; - Info.fMask:= MIIM_FTYPE or MIIM_STRING; - Info.fType:= (Info.fType and not MFT_OWNERDRAW) or MFT_STRING; - if Win32PlatformIsUnicode and (Item is TTntMenuItem) then begin - // Unicode - TMenuItemInfoW(Info).dwTypeData:= PWideChar(TTntMenuItem(Item).Caption); - SetMenuItemInfoW(HM, i, true, TMenuItemInfoW(Info)); - end else begin - // Ansi - Info.dwTypeData:= PAnsiChar(Item.Caption); - SetMenuItemInfoA(HM, i, true, Info); - end; - end; - end; - end; -end; - -{ TTntMenuItem's utility procs } - -procedure SyncHotKeyPosition(const Source: WideString; var Dest: WideString); -var - I: Integer; - FarEastHotString: WideString; -begin - if (AnsiString(Source) <> AnsiString(Dest)) - and WideSameCaptionStr(AnsiString(Source), AnsiString(Dest)) then begin - // when reduced to ansi, the only difference is hot key positions - Dest := WideStripHotkey(Dest); - I := 1; - while I <= Length(Source) do - begin - if Source[I] = cHotkeyPrefix then begin - if SysLocale.FarEast - and ((I > 1) and (Length(Source) - I >= 2) - and (Source[I - 1] = '(') and (Source[I + 2] = ')')) then begin - FarEastHotString := Copy(Source, I - 1, 4); - Dec(I); - Insert(FarEastHotString, Dest, I); - Inc(I, 3); - end else begin - Insert(cHotkeyPrefix, Dest, I); - Inc(I); - end; - end; - Inc(I); - end; - // test work - if AnsiString(Source) <> AnsiString(Dest) then - raise ETntInternalError.CreateFmt('Internal Error: SyncHotKeyPosition Failed ("%s" <> "%s").', - [AnsiString(Source), AnsiString(Dest)]); - end; -end; - -procedure UpdateMenuItems(Items: TMenuItem{TNT-ALLOW TMenuItem}; ParentMenu: TMenu); -var - i: integer; -begin - if (Items.ComponentState * [csReading, csDestroying] = []) then begin - for i := Items.Count - 1 downto 0 do - UpdateMenuItems(Items[i], ParentMenu); - if Items is TTntMenuItem then - TTntMenuItem(Items).UpdateMenuString(ParentMenu); - end; -end; - -procedure FixMenuBiDiProblem(Menu: TMenu); -var - i: integer; -begin - // TMenu sometimes sets bidi on first visible item which can convert caption to ansi - if (SysLocale.MiddleEast) - and (Menu <> nil) - and (Menu.Items.Count > 0) then - begin - for i := 0 to Menu.Items.Count - 1 do begin - if Menu.Items[i].Visible then begin - if (Menu.Items[i] is TTntMenuItem) then - (Menu.Items[i] as TTntMenuItem).UpdateMenuString(Menu); - break; // found first visible menu item! - end; - end; - end; -end; - - -{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6 -type - THackMenuItem = class(TComponent) - protected - FxxxxCaption: Ansistring; - FxxxxHandle: HMENU; - FxxxxChecked: Boolean; - FxxxxEnabled: Boolean; - FxxxxDefault: Boolean; - FxxxxAutoHotkeys: TMenuItemAutoFlag; - FxxxxAutoLineReduction: TMenuItemAutoFlag; - FxxxxRadioItem: Boolean; - FxxxxVisible: Boolean; - FxxxxGroupIndex: Byte; - FxxxxImageIndex: TImageIndex; - FxxxxActionLink: TMenuActionLink{TNT-ALLOW TMenuActionLink}; - FxxxxBreak: TMenuBreak; - FBitmap: TBitmap; - FxxxxCommand: Word; - FxxxxHelpContext: THelpContext; - FxxxxHint: AnsiString; - FxxxxItems: TList; - FxxxxShortCut: TShortCut; - FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem}; - FMerged: TMenuItem{TNT-ALLOW TMenuItem}; - FMergedWith: TMenuItem{TNT-ALLOW TMenuItem}; - end; -{$ENDIF} -{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7 -type - THackMenuItem = class(TComponent) - protected - FxxxxCaption: AnsiString; - FxxxxHandle: HMENU; - FxxxxChecked: Boolean; - FxxxxEnabled: Boolean; - FxxxxDefault: Boolean; - FxxxxAutoHotkeys: TMenuItemAutoFlag; - FxxxxAutoLineReduction: TMenuItemAutoFlag; - FxxxxRadioItem: Boolean; - FxxxxVisible: Boolean; - FxxxxGroupIndex: Byte; - FxxxxImageIndex: TImageIndex; - FxxxxActionLink: TMenuActionLink{TNT-ALLOW TMenuActionLink}; - FxxxxBreak: TMenuBreak; - FBitmap: TBitmap; - FxxxxCommand: Word; - FxxxxHelpContext: THelpContext; - FxxxxHint: AnsiString; - FxxxxItems: TList; - FxxxxShortCut: TShortCut; - FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem}; - FMerged: TMenuItem{TNT-ALLOW TMenuItem}; - FMergedWith: TMenuItem{TNT-ALLOW TMenuItem}; - end; -{$ENDIF} -{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9 -type - THackMenuItem = class(TComponent) - protected - FxxxxCaption: AnsiString; - FxxxxHandle: HMENU; - FxxxxChecked: Boolean; - FxxxxEnabled: Boolean; - FxxxxDefault: Boolean; - FxxxxAutoHotkeys: TMenuItemAutoFlag; - FxxxxAutoLineReduction: TMenuItemAutoFlag; - FxxxxRadioItem: Boolean; - FxxxxVisible: Boolean; - FxxxxGroupIndex: Byte; - FxxxxImageIndex: TImageIndex; - FxxxxActionLink: TMenuActionLink{TNT-ALLOW TMenuActionLink}; - FxxxxBreak: TMenuBreak; - FBitmap: TBitmap; - FxxxxCommand: Word; - FxxxxHelpContext: THelpContext; - FxxxxHint: AnsiString; - FxxxxItems: TList; - FxxxxShortCut: TShortCut; - FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem}; - FMerged: TMenuItem{TNT-ALLOW TMenuItem}; - FMergedWith: TMenuItem{TNT-ALLOW TMenuItem}; - end; -{$ENDIF} -{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10 -type - THackMenuItem = class(TComponent) - protected - FxxxxCaption: AnsiString; - FxxxxHandle: HMENU; - FxxxxChecked: Boolean; - FxxxxEnabled: Boolean; - FxxxxDefault: Boolean; - FxxxxAutoHotkeys: TMenuItemAutoFlag; - FxxxxAutoLineReduction: TMenuItemAutoFlag; - FxxxxRadioItem: Boolean; - FxxxxVisible: Boolean; - FxxxxGroupIndex: Byte; - FxxxxImageIndex: TImageIndex; - FxxxxActionLink: TMenuActionLink{TNT-ALLOW TMenuActionLink}; - FxxxxBreak: TMenuBreak; - FBitmap: TBitmap; - FxxxxCommand: Word; - FxxxxHelpContext: THelpContext; - FxxxxHint: AnsiString; - FxxxxItems: TList; - FxxxxShortCut: TShortCut; - FxxxxParent: TMenuItem{TNT-ALLOW TMenuItem}; - FMerged: TMenuItem{TNT-ALLOW TMenuItem}; - FMergedWith: TMenuItem{TNT-ALLOW TMenuItem}; - end; -{$ENDIF} - -function MenuItemHasBitmap(MenuItem: TMenuItem{TNT-ALLOW TMenuItem}): Boolean; -begin - Result := Assigned(THackMenuItem(MenuItem).FBitmap); -end; - -{ TTntMenuItem } - -procedure TTntMenuItem.DefineProperties(Filer: TFiler); -begin - inherited; - TntPersistent_AfterInherited_DefineProperties(Filer, Self); -end; - -type TAccessActionlink = class(TActionLink); - -procedure TTntMenuItem.InitiateAction; -begin - if GetKeyboardLayout(0) <> FKeyboardLayout then - MenuChanged(False); - inherited; -end; - -function TTntMenuItem.IsCaptionStored: Boolean; -begin - Result := (ActionLink = nil) or (not TAccessActionlink(ActionLink).IsCaptionLinked); -end; - -procedure TTntMenuItem.SetInheritedCaption(const Value: AnsiString); -begin - inherited Caption := Value; -end; - -function TTntMenuItem.GetCaption: WideString; -begin - if (AnsiString(FCaption) <> inherited Caption) - and WideSameCaptionStr(AnsiString(FCaption), inherited Caption) then - begin - // only difference is hotkey position, update caption with new hotkey position - SyncHotKeyPosition(inherited Caption, FCaption); - end; - Result := GetSyncedWideString(FCaption, (inherited Caption)); -end; - -procedure TTntMenuItem.SetCaption(const Value: WideString); -begin - GetCaption; // auto adjust for hot key changes - SetSyncedWideString(Value, FCaption, (inherited Caption), SetInheritedCaption); -end; - -function TTntMenuItem.GetHint: WideString; -begin - Result := GetSyncedWideString(FHint, inherited Hint); -end; - -procedure TTntMenuItem.SetInheritedHint(const Value: AnsiString); -begin - inherited Hint := Value; -end; - -procedure TTntMenuItem.SetHint(const Value: WideString); -begin - SetSyncedWideString(Value, FHint, inherited Hint, SetInheritedHint); -end; - -function TTntMenuItem.IsHintStored: Boolean; -begin - Result := (ActionLink = nil) or not TAccessActionlink(ActionLink).IsHintLinked; -end; - -procedure TTntMenuItem.Loaded; -begin - inherited; - UpdateMenuString(GetParentMenu); -end; - -procedure TTntMenuItem.MenuChanged(Rebuild: Boolean); -begin - if (not FIgnoreMenuChanged) then begin - inherited; - UpdateMenuItems(Self, GetParentMenu); - FixMenuBiDiProblem(GetParentMenu); - end; -end; - -procedure TTntMenuItem.UpdateMenuString(ParentMenu: TMenu); -var - ParentHandle: THandle; - - function NativeMenuTypeIsString: Boolean; - var - MenuItemInfo: TMenuItemInfoW; - Buffer: array[0..79] of WideChar; - begin - MenuItemInfo.cbSize := 44; // Required for Windows NT 4.0 - MenuItemInfo.fMask := MIIM_TYPE; - MenuItemInfo.dwTypeData := Buffer; // ?? - MenuItemInfo.cch := Length(Buffer); // ?? - Result := GetMenuItemInfoW(ParentHandle, Command, False, MenuItemInfo) - and ((MenuItemInfo.fType and (MFT_BITMAP or MFT_SEPARATOR or MFT_OWNERDRAW)) = 0) - end; - - function NativeMenuString: WideString; - var - Len: Integer; - begin - Assert(Win32PlatformIsUnicode); - Len := GetMenuStringW(ParentHandle, Command, nil, 0, MF_BYCOMMAND); - if Len = 0 then - Result := '' - else begin - SetLength(Result, Len + 1); - Len := GetMenuStringW(ParentHandle, Command, PWideChar(Result), Len + 1, MF_BYCOMMAND); - SetLength(Result, Len); - end; - end; - - procedure SetMenuString(const Value: WideString); - var - MenuItemInfo: TMenuItemInfoW; - Buffer: array[0..79] of WideChar; - begin - MenuItemInfo.cbSize := 44; // Required for Windows NT 4.0 - MenuItemInfo.fMask := MIIM_TYPE; - MenuItemInfo.dwTypeData := Buffer; // ?? - MenuItemInfo.cch := Length(Buffer); // ?? - if GetMenuItemInfoW(ParentHandle, Command, False, MenuItemInfo) - and ((MenuItemInfo.fType and (MFT_BITMAP or MFT_SEPARATOR or MFT_OWNERDRAW)) = 0) then - begin - MenuItemInfo.dwTypeData := PWideChar(Value); - MenuItemInfo.cch := Length(Value); - Win32Check(SetMenuItemInfoW(ParentHandle, Command, False, MenuItemInfo)); - end; - end; - - function SameEvent(A, B: TMenuMeasureItemEvent): Boolean; - begin - Result := @A = @B; - end; - -var - MenuCaption: WideString; -begin - FKeyboardLayout := GetKeyboardLayout(0); - if Parent = nil then - ParentHandle := 0 - else if (THackMenuItem(Self.Parent).FMergedWith <> nil) then - ParentHandle := THackMenuItem(Self.Parent).FMergedWith.Handle - else - ParentHandle := Parent.Handle; - - if (Win32PlatformIsUnicode) - and (Parent <> nil) and (ParentMenu <> nil) - and (ComponentState * [csReading, csDestroying] = []) - and (Visible) - and (NativeMenuTypeIsString) then begin - MenuCaption := Caption; - if (Count = 0) - and ((ShortCut <> scNone) - and ((Parent = nil) or (Parent.Parent <> nil) or not (Parent.Owner is TMainMenu{TNT-ALLOW TMainMenu}))) then - MenuCaption := MenuCaption + #9 + WideShortCutToText(ShortCut); - if (NativeMenuString <> MenuCaption) then - begin - SetMenuString(MenuCaption); - if ((Parent = ParentMenu.Items) or (THackMenuItem(Self.Parent).FMergedWith <> nil)) - and (ParentMenu is TMainMenu{TNT-ALLOW TMainMenu}) - and (ParentMenu.WindowHandle <> 0) then - DrawMenuBar(ParentMenu.WindowHandle) {top level menu bar items} - end; - end; -end; - -function TTntMenuItem.GetAlignmentDrawStyle: Word; -const - Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER); -var - ParentMenu: TMenu; - Alignment: TPopupAlignment; -begin - ParentMenu := GetParentMenu; - if ParentMenu is TMenu then - Alignment := paLeft - else if ParentMenu is TPopupMenu{TNT-ALLOW TPopupMenu} then - Alignment := TPopupMenu{TNT-ALLOW TPopupMenu}(ParentMenu).Alignment - else - Alignment := paLeft; - Result := Alignments[Alignment]; -end; - -procedure TTntMenuItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; - State: TOwnerDrawState; TopLevel: Boolean); - - procedure DrawMenuText(BiDi: Boolean); - var - ImageList: TCustomImageList; - DrawImage, DrawGlyph: Boolean; - GlyphRect, SaveRect: TRect; - DrawStyle: Longint; - Selected: Boolean; - Win98Plus: Boolean; - Win2K: Boolean; - begin - ImageList := GetImageList; - Selected := odSelected in State; - Win98Plus := (Win32MajorVersion > 4) or - ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)); - Win2K := (Win32MajorVersion > 4) and (Win32Platform = VER_PLATFORM_WIN32_NT); - with ACanvas do - begin - GlyphRect.Left := ARect.Left + 1; - DrawImage := (ImageList <> nil) and ((ImageIndex > -1) and - (ImageIndex < ImageList.Count) or Checked and ((not MenuItemHasBitmap(Self)) or - Bitmap.Empty)); - if DrawImage or MenuItemHasBitmap(Self) and not Bitmap.Empty then - begin - DrawGlyph := True; - if DrawImage then - GlyphRect.Right := GlyphRect.Left + ImageList.Width - else begin - { Need to add BitmapWidth/Height properties for TMenuItem if we're to - support them. Right now let's hardcode them to 16x16. } - GlyphRect.Right := GlyphRect.Left + 16; - end; - { Draw background pattern brush if selected } - if Checked then - begin - Inc(GlyphRect.Right); - if not Selected then - Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight); - Inc(GlyphRect.Left); - end; - if Checked then - Dec(GlyphRect.Right); - end else begin - if (ImageList <> nil) and (not TopLevel) then - GlyphRect.Right := GlyphRect.Left + ImageList.Width - else - GlyphRect.Right := GlyphRect.Left; - DrawGlyph := False; - end; - if BiDi then begin - SaveRect := GlyphRect; - GlyphRect.Left := ARect.Right - (SaveRect.Right - ARect.Left); - GlyphRect.Right := ARect.Right - (SaveRect.Left - ARect.Left); - end; - with GlyphRect do begin - Dec(Left); - Inc(Right, 2); - end; - if Selected then begin - if DrawGlyph then begin - if BiDi then - ARect.Right := GlyphRect.Left - 1 - else - ARect.Left := GlyphRect.Right + 1; - end; - if not (Win98Plus and TopLevel) then - Brush.Color := clHighlight; - end; - if TopLevel and Win98Plus and (not Selected) - {$IFDEF COMPILER_7_UP} - and (not Win32PlatformIsXP) - {$ENDIF} - then - OffsetRect(ARect, 0, -1); - if not (Selected and DrawGlyph) then begin - if BiDi then - ARect.Right := GlyphRect.Left - 1 - else - ARect.Left := GlyphRect.Right + 1; - end; - Inc(ARect.Left, 2); - Dec(ARect.Right, 1); - DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or GetAlignmentDrawStyle; - if Win2K and (odNoAccel in State) then - DrawStyle := DrawStyle or DT_HIDEPREFIX; - { Calculate vertical layout } - SaveRect := ARect; - if odDefault in State then - Font.Style := [fsBold]; - DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle or DT_CALCRECT or DT_NOCLIP); - if BiDi then begin - { the DT_CALCRECT does not take into account alignment } - ARect.Left := SaveRect.Left; - ARect.Right := SaveRect.Right; - end; - OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2); - if TopLevel and Selected and Win98Plus - {$IFDEF COMPILER_7_UP} - and (not Win32PlatformIsXP) - {$ENDIF} - then - OffsetRect(ARect, 1, 0); - DoDrawText(ACanvas, Caption, ARect, Selected, DrawStyle); - if (ShortCut <> scNone) and not TopLevel then - begin - if BiDi then begin - ARect.Left := 10; - ARect.Right := ARect.Left + WideCanvasTextWidth(ACanvas, WideShortCutToText(ShortCut)); - end else begin - ARect.Left := ARect.Right; - ARect.Right := SaveRect.Right - 10; - end; - DoDrawText(ACanvas, WideShortCutToText(ShortCut), ARect, Selected, DT_RIGHT); - end; - end; - end; - -var - ParentMenu: TMenu; - SaveCaption: WideString; - SaveShortCut: TShortCut; -begin - ParentMenu := GetParentMenu; - if (not Win32PlatformIsUnicode) - or (Self.IsLine) - or ( (ParentMenu <> nil) and (ParentMenu.OwnerDraw or (GetImageList <> nil)) - and (Assigned(OnAdvancedDrawItem) or Assigned(OnDrawItem)) ) then - inherited - else begin - SaveCaption := Caption; - SaveShortCut := ShortCut; - try - FIgnoreMenuChanged := True; - try - Caption := ''; - ShortCut := scNone; - finally - FIgnoreMenuChanged := False; - end; - inherited; - finally - FIgnoreMenuChanged := True; - try - Caption := SaveCaption; - ShortCut := SaveShortcut; - finally - FIgnoreMenuChanged := False; - end; - end; - DrawMenuText((ParentMenu <> nil) and (ParentMenu.IsRightToLeft)) - end; -end; - -procedure TTntMenuItem.DoDrawText(ACanvas: TCanvas; const ACaption: WideString; - var Rect: TRect; Selected: Boolean; Flags: Longint); -var - Text: WideString; - ParentMenu: TMenu; -begin - if (not Win32PlatformIsUnicode) - or (IsLine) then - inherited DoDrawText(ACanvas, ACaption, Rect, Selected, Flags) - else begin - ParentMenu := GetParentMenu; - if (ParentMenu <> nil) and (ParentMenu.IsRightToLeft) then - begin - if Flags and DT_LEFT = DT_LEFT then - Flags := Flags and (not DT_LEFT) or DT_RIGHT - else if Flags and DT_RIGHT = DT_RIGHT then - Flags := Flags and (not DT_RIGHT) or DT_LEFT; - Flags := Flags or DT_RTLREADING; - end; - Text := ACaption; - if (Flags and DT_CALCRECT <> 0) and ((Text = '') or - (Text[1] = cHotkeyPrefix) and (Text[2] = #0)) then Text := Text + ' '; - with ACanvas do - begin - Brush.Style := bsClear; - if Default then - Font.Style := Font.Style + [fsBold]; - if not Enabled then - begin - if not Selected then - begin - OffsetRect(Rect, 1, 1); - Font.Color := clBtnHighlight; - Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags); - OffsetRect(Rect, -1, -1); - end; - if Selected and (ColorToRGB(clHighlight) = ColorToRGB(clBtnShadow)) then - Font.Color := clBtnHighlight else - Font.Color := clBtnShadow; - end; - Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), Rect, Flags); - end; - end; -end; - -function TTntMenuItem.MeasureItemTextWidth(ACanvas: TCanvas; const Text: WideString): Integer; -var - R: TRect; -begin - FillChar(R, SizeOf(R), 0); - DoDrawText(ACanvas, Text, R, False, - GetAlignmentDrawStyle or DT_EXPANDTABS or DT_SINGLELINE or DT_NOCLIP or DT_CALCRECT); - Result := R.Right - R.Left; -end; - -procedure TTntMenuItem.MeasureItem(ACanvas: TCanvas; var Width, Height: Integer); -var - SaveMeasureItemEvent: TMenuMeasureItemEvent; -begin - if (not Win32PlatformIsUnicode) - or (Self.IsLine) then - inherited - else begin - SaveMeasureItemEvent := inherited OnMeasureItem; - try - inherited OnMeasureItem := nil; - inherited; - Inc(Width, MeasureItemTextWidth(ACanvas, Caption)); - Dec(Width, MeasureItemTextWidth(ACanvas, inherited Caption)); - if ShortCut <> scNone then begin - Inc(Width, MeasureItemTextWidth(ACanvas, WideShortCutToText(ShortCut))); - Dec(Width, MeasureItemTextWidth(ACanvas, ShortCutToText{TNT-ALLOW ShortCutToText}(ShortCut))); - end; - finally - inherited OnMeasureItem := SaveMeasureItemEvent; - end; - if Assigned(OnMeasureItem) then OnMeasureItem(Self, ACanvas, Width, Height); - end; -end; - -function TTntMenuItem.Find(ACaption: WideString): TMenuItem{TNT-ALLOW TMenuItem}; -var - I: Integer; -begin - Result := nil; - ACaption := WideStripHotkey(ACaption); - for I := 0 to Count - 1 do - if WideSameText(ACaption, WideStripHotkey(WideGetMenuItemCaption(Items[I]))) then - begin - Result := Items[I]; - System.Break; - end; -end; - -function TTntMenuItem.GetActionLinkClass: TMenuActionLinkClass; -begin - Result := TTntMenuActionLink; -end; - -procedure TTntMenuItem.ActionChange(Sender: TObject; CheckDefaults: Boolean); -begin - if (Sender is TCustomAction{TNT-ALLOW TCustomAction}) and Supports(Sender, ITntAction) then begin - if not CheckDefaults or (Caption = '') then - Caption := TntAction_GetCaption(TCustomAction{TNT-ALLOW TCustomAction}(Sender)); - if not CheckDefaults or (Hint = '') then - Hint := TntAction_GetHint(TCustomAction{TNT-ALLOW TCustomAction}(Sender)); - end; - inherited; -end; - -{ TTntMainMenu } - -{$IFDEF COMPILER_9_UP} -function TTntMainMenu.CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem}; -begin - Result := TTntMenuItem.Create(Self); -end; -{$ENDIF} - -procedure TTntMainMenu.DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean); -begin - inherited; - UpdateMenuItems(Items, Self); - if (THackMenuItem(Items).FMerged <> nil) then begin - UpdateMenuItems(THackMenuItem(Items).FMerged, Self); - end; -end; - -{ TTntPopupMenu } - -constructor TTntPopupMenu.Create(AOwner: TComponent); -begin - inherited; - PopupList.Remove(Self); - if TntPopupList <> nil then - TntPopupList.Add(Self); -end; - -{$IFDEF COMPILER_9_UP} -function TTntPopupMenu.CreateMenuItem: TMenuItem{TNT-ALLOW TMenuItem}; -begin - Result := TTntMenuItem.Create(Self); -end; -{$ENDIF} - -destructor TTntPopupMenu.Destroy; -begin - if TntPopupList <> nil then - TntPopupList.Remove(Self); - PopupList.Add(Self); - inherited; -end; - -procedure TTntPopupMenu.DoChange(Source: TMenuItem{TNT-ALLOW TMenuItem}; Rebuild: Boolean); -begin - inherited; - UpdateMenuItems(Items, Self); -end; - -procedure TTntPopupMenu.Popup(X, Y: Integer); -begin - Menus.PopupList := TntPopupList; - try - inherited; - finally - Menus.PopupList := TntPopupList.SavedPopupList; - end; -end; - -{ TTntPopupList } - -procedure TTntPopupList.WndProc(var Message: TMessage); -var - I, Item: Integer; - MenuItem: TMenuItem{TNT-ALLOW TMenuItem}; - FindKind: TFindItemKind; -begin - case Message.Msg of - WM_ENTERMENULOOP: - begin - Menus.PopupList := SavedPopupList; - for i := 0 to Count - 1 do - FixMenuBiDiProblem(Items[i]); - end; - WM_MENUSELECT: - with TWMMenuSelect(Message) do - begin - FindKind := fkCommand; - if MenuFlag and MF_POPUP <> 0 then FindKind := fkHandle; - for I := 0 to Count - 1 do - begin - if FindKind = fkHandle then - begin - if Menu <> 0 then - Item := Integer(GetSubMenu(Menu, IDItem)) else - Item := -1; - end - else - Item := IDItem; - MenuItem := TPopupMenu{TNT-ALLOW TPopupMenu}(Items[I]).FindItem(Item, FindKind); - if MenuItem <> nil then - begin - TntApplication.Hint := WideGetLongHint(WideGetMenuItemHint(MenuItem)); - Exit; - end; - end; - TntApplication.Hint := ''; - end; - end; - inherited; -end; - -initialization - TntPopupList := TTntPopupList.Create; - TntPopupList.SavedPopupList := Menus.PopupList; - -finalization - FreeAndNil(TntPopupList); - -end. -- cgit v1.2.3