paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-12 09:00:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed Win64 in behalf of Micha

Browse Source 
git-svn-id: trunk@10119 -
This commit is contained in:
florian 2006-10-28 14:59:28 +00:00
parent 0be210dffc
commit 107c5e7c0b
1 changed files with 34 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -1,8 +1,8 @@
{ $Id$} { $Id$}
{ {
***************************************************************************** *****************************************************************************
* Win32WSMenus.pp * * Win32WSMenus.pp *
* --------------- * * --------------- *
* * * *
* * * *
***************************************************************************** *****************************************************************************
@ -28,7 +28,7 @@ interface
uses uses
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// I M P O R T A N T // I M P O R T A N T
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// To get as little as posible circles, // To get as little as posible circles,
// uncomment only when needed for registration // uncomment only when needed for registration
@ -82,7 +82,7 @@ type
class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override; class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
end; end;
function MenuItemLength(const aMenuItem: TMenuItem; const aHDC: HDC): integer; function MenuItemLength(const aMenuItem: TMenuItem; const aHDC: HDC): integer;
function MenuItemHeight(const aMenuItem: TMenuItem; const aHDC: HDC): integer; function MenuItemHeight(const aMenuItem: TMenuItem; const aHDC: HDC): integer;
procedure DrawMenuItem(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); procedure DrawMenuItem(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
@ -95,7 +95,7 @@ uses strutils;
{ helper routines } { helper routines }
const const
SpaceBetweenIcons = 5; SpaceBetweenIcons = 5;
// define the size of the MENUITEMINFO structure used by older Windows // define the size of the MENUITEMINFO structure used by older Windows
@ -103,6 +103,9 @@ const
// Since W98 the size is 48 (hbmpItem was added) // Since W98 the size is 48 (hbmpItem was added)
W95_MENUITEMINFO_SIZE = 44; W95_MENUITEMINFO_SIZE = 44;
var
menuiteminfosize : DWORD = 0;
type type
TCaptionFlags = (cfBold, cfUnderline); TCaptionFlags = (cfBold, cfUnderline);
TCaptionFlagsSet = set of TCaptionFlags; TCaptionFlagsSet = set of TCaptionFlags;
@ -139,7 +142,7 @@ var MenuItemIndex: integer;
begin begin
Result := MakeLResult(0, 0); Result := MakeLResult(0, 0);
MenuItemIndex := -1; MenuItemIndex := -1;
ItemInfo.cbSize := W95_MENUITEMINFO_SIZE; ItemInfo.cbSize := menuiteminfosize;
ItemInfo.fMask := MIIM_DATA; ItemInfo.fMask := MIIM_DATA;
if not GetMenuItemInfo(AMenuHandle, 0, true, @ItemInfo) then Exit; if not GetMenuItemInfo(AMenuHandle, 0, true, @ItemInfo) then Exit;
FirstMenuItem := TMenuItem(ItemInfo.dwItemData); FirstMenuItem := TMenuItem(ItemInfo.dwItemData);
@ -149,7 +152,7 @@ begin
begin begin
SiblingMenuItem := FirstMenuItem.Parent.Items[i]; SiblingMenuItem := FirstMenuItem.Parent.Items[i];
HotKeyIndex := SearchMenuItemHotKeyIndex('&', SiblingMenuItem.Caption); HotKeyIndex := SearchMenuItemHotKeyIndex('&', SiblingMenuItem.Caption);
if (HotKeyIndex > 0) and if (HotKeyIndex > 0) and
(Upcase(ACharCode) = Upcase(SiblingMenuItem.Caption[HotKeyIndex])) then (Upcase(ACharCode) = Upcase(SiblingMenuItem.Caption[HotKeyIndex])) then
MenuItemIndex := i; MenuItemIndex := i;
inc(i); inc(i);
@ -177,13 +180,13 @@ begin
else else
lf.lfWeight:= lf.lfWeight + 100; lf.lfWeight:= lf.lfWeight + 100;
end; end;
Result := CreateFont(lf.lfHeight, lf.lfWidth, Result := CreateFont(lf.lfHeight, lf.lfWidth,
lf.lfEscapement, lf.lfOrientation, lf.lfWeight, lf.lfEscapement, lf.lfOrientation, lf.lfWeight,
lf.lfItalic, lf.lfUnderline, lf.lfStrikeOut, lf.lfCharSet, lf.lfItalic, lf.lfUnderline, lf.lfStrikeOut, lf.lfCharSet,
lf.lfOutPrecision, lf.lfClipPrecision, lf.lfQuality, lf.lfOutPrecision, lf.lfClipPrecision, lf.lfQuality,
lf.lfPitchAndFamily, lf.lfFaceName); lf.lfPitchAndFamily, lf.lfFaceName);
end; end;
(* Get the menu item caption including shortcut *) (* Get the menu item caption including shortcut *)
function CompleteMenuItemCaption(const aMenuItem: TMenuItem): string; function CompleteMenuItemCaption(const aMenuItem: TMenuItem): string;
begin begin
@ -191,7 +194,7 @@ begin
if aMenuItem.shortCut <> scNone then if aMenuItem.shortCut <> scNone then
Result := Result + ShortCutToText(aMenuItem.shortCut); Result := Result + ShortCutToText(aMenuItem.shortCut);
end; end;
(* Get the maximum length of the given string in pixels *) (* Get the maximum length of the given string in pixels *)
function StringLength(const aCaption: String; const aHDC: HDC; const aDecoration:TCaptionFlagsSet): integer; function StringLength(const aCaption: String; const aHDC: HDC; const aDecoration:TCaptionFlagsSet): integer;
var oldFont: HFONT; var oldFont: HFONT;
@ -207,7 +210,7 @@ begin
DeleteObject(newFont); DeleteObject(newFont);
Result := TmpRect.right - TmpRect.left; Result := TmpRect.right - TmpRect.left;
end; end;
(* Get the maximum height of the given string in pixels *) (* Get the maximum height of the given string in pixels *)
function StringHeight(const aCaption: String; const aHDC: HDC; const aDecoration: TCaptionFlagsSet): integer; function StringHeight(const aCaption: String; const aHDC: HDC; const aDecoration: TCaptionFlagsSet): integer;
var oldFont: HFONT; var oldFont: HFONT;
@ -223,7 +226,7 @@ begin
DeleteObject(newFont); DeleteObject(newFont);
Result := TmpRect.bottom - TmpRect.top; Result := TmpRect.bottom - TmpRect.top;
end; end;
function LeftIconPosition: integer; function LeftIconPosition: integer;
begin begin
Result := GetSystemMetrics(SM_CXMENUCHECK); Result := GetSystemMetrics(SM_CXMENUCHECK);
@ -397,7 +400,7 @@ begin
TmpLength := aRect.right - aRect.left; TmpLength := aRect.right - aRect.left;
TmpHeight := aRect.bottom - aRect.top; TmpHeight := aRect.bottom - aRect.top;
DrawText(aHDC, pChar(shortCutText), length(shortCutText), @aRect, DT_CALCRECT); DrawText(aHDC, pChar(shortCutText), length(shortCutText), @aRect, DT_CALCRECT);
OffsetRect(aRect, TmpLength - (aRect.right - aRect.left) - GetSystemMetrics(SM_CXMENUCHECK), topPosition(TmpHeight, aRect.bottom - aRect.top)); OffsetRect(aRect, TmpLength - (aRect.right - aRect.left) - GetSystemMetrics(SM_CXMENUCHECK), topPosition(TmpHeight, aRect.bottom - aRect.top));
DrawText(aHDC, pChar(shortCutText), length(shortCutText), @aRect, 0); DrawText(aHDC, pChar(shortCutText), length(shortCutText), @aRect, 0);
SelectObject(aHDC, oldFont); SelectObject(aHDC, oldFont);
DeleteObject(newFont); DeleteObject(newFont);
@ -436,7 +439,7 @@ begin
lMenu := AMenuItem.GetParentMenu; lMenu := AMenuItem.GetParentMenu;
if (lMenu<>nil) and (lMenu.Parent<>nil) if (lMenu<>nil) and (lMenu.Parent<>nil)
and (lMenu.Parent is TCustomForm) and (lMenu.Parent is TCustomForm)
and TCustomForm(lMenu.Parent).HandleAllocated and TCustomForm(lMenu.Parent).HandleAllocated
and not (csDestroying in lMenu.Parent.ComponentState) then and not (csDestroying in lMenu.Parent.ComponentState) then
AddToChangedMenus(TCustomForm(lMenu.Parent).Handle); AddToChangedMenus(TCustomForm(lMenu.Parent).Handle);
end; end;
@ -445,7 +448,7 @@ function ChangeMenuFlag(const AMenuItem: TMenuItem; Flag: Integer; Value: boolea
var var
MenuInfo: MENUITEMINFO; MenuInfo: MENUITEMINFO;
begin begin
MenuInfo.cbSize := W95_MENUITEMINFO_SIZE; MenuInfo.cbSize := menuiteminfosize;
MenuInfo.fMask := MIIM_TYPE; MenuInfo.fMask := MIIM_TYPE;
MenuInfo.dwTypeData := nil; // don't retrieve caption MenuInfo.dwTypeData := nil; // don't retrieve caption
GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo); GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
@ -461,12 +464,12 @@ end;
{ TWin32WSMenuItem } { TWin32WSMenuItem }
procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String); procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String);
var var
MenuInfo: MENUITEMINFO; MenuInfo: MENUITEMINFO;
begin begin
with MenuInfo do with MenuInfo do
begin begin
cbsize := W95_MENUITEMINFO_SIZE; cbsize := menuiteminfosize;
if ACaption <> '-' then if ACaption <> '-' then
begin begin
fType := MFT_STRING; fType := MFT_STRING;
@ -479,7 +482,7 @@ begin
SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo); SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
with MenuInfo do with MenuInfo do
begin begin
cbsize := W95_MENUITEMINFO_SIZE; cbsize := menuiteminfosize;
fMask := MIIM_TYPE; fMask := MIIM_TYPE;
fType := MFT_OWNERDRAW; fType := MFT_OWNERDRAW;
dwTypeData:=LPSTR(ACaption); dwTypeData:=LPSTR(ACaption);
@ -490,7 +493,7 @@ begin
end; end;
class procedure TWin32WSMenuItem.AttachMenu(const AMenuItem: TMenuItem); class procedure TWin32WSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
var var
MenuInfo: MENUITEMINFO; MenuInfo: MENUITEMINFO;
ParentMenuHandle: HMenu; ParentMenuHandle: HMenu;
ParentOfParent: HMenu; ParentOfParent: HMenu;
@ -503,7 +506,7 @@ begin
begin begin
ParentOfParent := AMenuItem.Parent.Parent.Handle; ParentOfParent := AMenuItem.Parent.Parent.Handle;
with MenuInfo do begin with MenuInfo do begin
cbSize := W95_MENUITEMINFO_SIZE; cbSize := menuiteminfosize;
fMask:=MIIM_SUBMENU; fMask:=MIIM_SUBMENU;
end; end;
GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command,
@ -517,13 +520,13 @@ begin
end; end;
with MenuInfo do begin with MenuInfo do begin
cbsize := W95_MENUITEMINFO_SIZE; cbsize := menuiteminfosize;
if AMenuItem.Enabled then fState:=MFS_ENABLED else fstate:=MFS_GRAYED; if AMenuItem.Enabled then fState:=MFS_ENABLED else fstate:=MFS_GRAYED;
if AMenuItem.Checked then fState:=fState or MFS_CHECKED; if AMenuItem.Checked then fState:=fState or MFS_CHECKED;
fMask:=MIIM_ID or MIIM_DATA or MIIM_STATE or MIIM_TYPE; fMask:=MIIM_ID or MIIM_DATA or MIIM_STATE or MIIM_TYPE;
wID:=AMenuItem.Command; {value may only be 16 bit wide!} wID:=AMenuItem.Command; {value may only be 16 bit wide!}
dwItemData:=PtrInt(AMenuItem); dwItemData:=PtrInt(AMenuItem);
if (AMenuItem.Count > 0) then if (AMenuItem.Count > 0) then
begin begin
fMask := fMask or MIIM_SUBMENU; fMask := fMask or MIIM_SUBMENU;
hSubMenu := AMenuItem.Handle; hSubMenu := AMenuItem.Handle;
@ -563,7 +566,7 @@ class procedure TWin32WSMenuItem.SetCaption(const AMenuItem: TMenuItem; const AC
begin begin
UpdateCaption(AMenuItem, aCaption); UpdateCaption(AMenuItem, aCaption);
end; end;
class procedure TWin32WSMenuItem.SetShortCut(const AMenuItem: TMenuItem; class procedure TWin32WSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
const OldShortCut, NewShortCut: TShortCut); const OldShortCut, NewShortCut: TShortCut);
begin begin
@ -612,8 +615,12 @@ begin
TrackPopupMenuEx(MenuHandle, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON, TrackPopupMenuEx(MenuHandle, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
X, Y, AppHandle, Nil); X, Y, AppHandle, Nil);
end; end;
initialization initialization
if (Win32MajorVersion=4) and (Win32MinorVersion=0) then
menuiteminfosize:=W95_MENUITEMINFO_SIZE
else
menuiteminfosize:=sizeof(TMenuItemInfo);
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// I M P O R T A N T // I M P O R T A N T