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

lcl, win32: cleanup

Browse Source 
git-svn-id: trunk@26732 -
This commit is contained in:
paul 2010-07-19 05:43:57 +00:00
parent 424162b12c
commit 47c3b8be53
4 changed files with 30 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/include/popupmenu.inc
View File

@ -64,22 +64,22 @@ begin
inherited Destroy;
end;
procedure TPopupMenu.PopUp();
procedure TPopupMenu.PopUp;
var
MousePos: TPoint;
begin
GetCursorPos(MousePos);
PopUp(MousePos.x,MousePos.y);
PopUp(MousePos.x, MousePos.y);
end;
procedure TPopupMenu.PopUp(X,Y : Integer);
procedure TPopupMenu.PopUp(X, Y: Integer);
begin
if ActivePopupMenu <> nil then ActivePopupMenu.Close;
FPopupPoint := Point(X, Y);
ReleaseCapture;
DoPopup(Self);
if Items.Count=0 then exit;
ActivePopupMenu:=Self;
if Items.Count = 0 then exit;
ActivePopupMenu := Self;
Items.InitiateActions;
DestroyHandle;
CreateHandle;

30
lcl/interfaces/win32/win32proc.pp
View File

@ -117,7 +117,6 @@ procedure RedrawMenus;
function MeasureTextForWnd(const AWindow: HWND; Text: string; var Width, Height: integer): boolean;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
function GetControlText(AHandle: HWND): string;
procedure SetMenuFlag(const Menu: HMenu; Flag: Cardinal; Value: boolean);
procedure FillRawImageDescriptionColors(var ADesc: TRawImageDescription);
procedure FillRawImageDescription(const ABitmapInfo: Windows.TBitmap; out ADesc: TRawImageDescription);
@ -1172,35 +1171,6 @@ begin
ChangedMenus.Clear;
end;
{------------------------------------------------------------------------------
Method: SetMenuFlags
Returns: Nothing
Change the menu flags for handle of TMenuItem or TMenu,
added for BidiMode Menus
------------------------------------------------------------------------------}
procedure SetMenuFlag(const Menu: HMenu; Flag: Cardinal; Value: boolean);
var
MenuInfo: MENUITEMINFO;
MenuItemInfoSize: DWORD;
const
W95_MENUITEMINFO_SIZE = 44;
begin
if (Win32MajorVersion = 4) and (Win32MinorVersion = 0) then
MenuItemInfoSize := W95_MENUITEMINFO_SIZE
else
MenuItemInfoSize := sizeof(MENUITEMINFO);
FillChar(MenuInfo, SizeOf(MenuInfo), 0);
MenuInfo.cbSize := MenuItemInfoSize;
MenuInfo.fMask := MIIM_TYPE;
GetMenuItemInfo(Menu, 0, True, @MenuInfo);
if Value then
MenuInfo.fType := MenuInfo.fType or Flag
else
MenuInfo.fType := MenuInfo.fType and not Flag;
SetMenuItemInfo(Menu, 0, True, @MenuInfo);
end;
function MeasureTextForWnd(const AWindow: HWND; Text: string; var Width,
Height: integer): boolean;
var

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

@ -1155,9 +1155,9 @@ function ChangeMenuFlag(const AMenuItem: TMenuItem; Flag: Cardinal; Value: boole
var
MenuInfo: MENUITEMINFO;
begin
FillChar(MenuInfo, SizeOf(MenuInfo), 0);
MenuInfo.cbSize := menuiteminfosize;
MenuInfo.fMask := MIIM_TYPE;
MenuInfo.dwTypeData := nil; // don't retrieve caption
GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
if Value then
MenuInfo.fType := MenuInfo.fType or Flag
@ -1168,6 +1168,28 @@ begin
TriggerFormUpdate(AMenuItem);
end;
{------------------------------------------------------------------------------
Method: SetMenuFlag
Returns: Nothing
Change the menu flags for handle of TMenuItem or TMenu,
added for BidiMode Menus
------------------------------------------------------------------------------}
procedure SetMenuFlag(const Menu: HMenu; Flag: Cardinal; Value: boolean);
var
MenuInfo: MENUITEMINFO;
begin
FillChar(MenuInfo, SizeOf(MenuInfo), 0);
MenuInfo.cbSize := menuiteminfosize;
MenuInfo.fMask := MIIM_TYPE;
GetMenuItemInfo(Menu, 0, True, @MenuInfo);
if Value then
MenuInfo.fType := MenuInfo.fType or Flag
else
MenuInfo.fType := MenuInfo.fType and not Flag;
SetMenuItemInfo(Menu, 0, True, @MenuInfo);
end;
{ TWin32WSMenuItem }
procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String);

4
lcl/menus.pp
View File

@ -341,7 +341,7 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DestroyHandle; virtual;
function FindItem(AValue: PtrInt; Kind: TFindItemKind) : TMenuItem;
function FindItem(AValue: PtrInt; Kind: TFindItemKind): TMenuItem;
function GetHelpContext(AValue: PtrInt; ByCommand: Boolean): THelpContext;
function IsShortcut(var Message: TLMKey): boolean;
function HandleAllocated: Boolean;
@ -402,7 +402,7 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure PopUp();
procedure PopUp;
procedure PopUp(X, Y: Integer); virtual;
property PopupComponent: TComponent read FPopupComponent write FPopupComponent;
property PopupPoint: TPoint read FPopupPoint;