Title: How to add menu items to the form's system menu
Question: To add system menu items to your form's system menu you would do a lot of code, intercept a system message and other boring tasks.
With this component you can learn how to do this and, most of all, use it, because it's ready for use, and it's free with source.
Answer:
See how! Use it! Attached is an example.
unit cSysM32;
interface
uses
WinTypes, WinProcs, Messages, Classes, Forms, graphics, Dialogs;
const
Checks: array[Boolean] of LongInt = (MF_UNCHECKED, MF_CHECKED);
type
TClickEvent = procedure(Sender: TObject) of object;
TSysMenuCommand = class(TComponent)
private
FSysMenuHandle: HMENU;
FOwnerFormHandle: HWND;
FCommand: Word;
FCaption: string;
FBitmapChecked : TBitmap;
FBitmapUnchecked: TBitmap;
FChecked: Boolean;
FWantSeparator: Boolean;
FAutoToggle: Boolean;
FOnClick: TClickEvent;
procedure SetCaption(S: string);
procedure SetChecked(Value: Boolean);
procedure SetWantSeparator(Value: Boolean);
procedure SetFBitmapChecked(B: TBitmap);
procedure SetFBitmapUnchecked(B: TBitmap);
function GetMenuItemPos: Integer;
protected
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SysCommand; virtual;
published
property Command: Word read FCommand;
property Caption: string read FCaption write SetCaption;
property BitmapChecked: TBitmap read FBitmapChecked write SetFBitmapChecked;
property BitmapUnchecked: TBitmap read FBitmapUnchecked write SetFBitmapUnchecked;
property Checked: Boolean read FChecked write SetChecked default False;
property WantSeparator: Boolean read FWantSeparator write SetWantSeparator
default True;
property AutoToggle: Boolean read FAutoToggle write FAutoToggle default False;
property OnClick: TClickEvent read FOnClick write FOnClick;
end;
TSysMenuCommandList = class(TComponent)
protected
AppOnMsg: TMessageEvent;
SysMenuList: TList;
procedure OnSysMessage(var Msg: TMsg; var Handled: Boolean);
private
function Add(Item: TSysMenuCommand): Word;
procedure Remove(Item: TSysMenuCommand);
function CallItem(CommandID: Word): boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
procedure Register;
var
SysMenuCommandList: TSysMenuCommandList;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TSysMenuCommand]);
end;
procedure TSysMenuCommand.SetFBitmapChecked(B: TBitmap);
begin
FBitmapChecked.Assign(B);
if FBitmapCheckednil then
begin
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapChecked.Handle,FBitmapChecked.Handle);
if FBitmapUncheckednil then
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapUnchecked.Handle,FBitmapChecked.Handle);
end;
end;
procedure TSysMenuCommand.SetFBitmapUnchecked(B: TBitmap);
begin
FBitmapUnchecked.Assign(B);
if FBitmapUncheckednil then
begin
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapUnchecked.Handle,FBitmapUnchecked.Handle);
if FBitmapCheckednil then
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapUnchecked.Handle,FBitmapChecked.Handle);
end;
end;
procedure TSysMenuCommand.Loaded;
begin
inherited;
if FBitmapCheckednil then
begin
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapChecked.Handle,FBitmapChecked.Handle);
if FBitmapUncheckednil then
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapUnchecked.Handle,FBitmapChecked.Handle);
end;
if FBitmapUncheckednil then
begin
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapUnchecked.Handle,FBitmapUnchecked.Handle);
if FBitmapCheckednil then
SetMenuItemBitmaps(FSysMenuHandle, GetMenuItemPos, MF_BYPOSITION, FBitmapUnchecked.Handle,FBitmapChecked.Handle);
end;
end;
constructor TSysMenuCommand.Create(AOwner: TComponent);
{var
I : Integer;}
begin
if not Assigned(SysMenuCommandList) then
SysMenuCommandList:=TSysMenuCommandList.Create(nil);
inherited Create(AOwner);
FCommand:=SysMenuCommandList.Add(Self);
FCaption := '';
FBitmapChecked:=TBitmap.Create;
FBitmapUnchecked:=TBitmap.Create;
FOwnerFormHandle := (AOwner as TForm).Handle;
FSysMenuHandle := GetSystemMenu(FOwnerFormHandle, False);
FWantSeparator := True;
AppendMenu(FSysMenuHandle, MF_STRING, FCommand, PChar(FCaption));
end;
destructor TSysMenuCommand.Destroy;
begin
FBitmapChecked.Free;
FBitmapUnchecked.Free;
DeleteMenu(FSysMenuHandle, FCommand, MF_BYCOMMAND);
SysMenuCommandList.Remove(Self);
inherited Destroy;
end;
procedure TSysMenuCommand.SetCaption(S: string);
begin
if S FCaption then
if ModifyMenu(FSysMenuHandle, FCommand, MF_BYCOMMAND or
MF_STRING or Checks[FChecked], FCommand, PChar(S)) then
FCaption := S;
end;
procedure TSysMenuCommand.SetChecked(Value: Boolean);
begin
if Value FChecked then
begin
CheckMenuItem(FSysMenuHandle, FCommand,Checks[Value] or MF_BYCOMMAND);
FChecked:=Value;
end;
end;
function TSysMenuCommand.GetMenuItemPos: Integer;
var
I: Integer;
begin
Result := - 1;
for I := 0 to (GetMenuItemCount(FSysMenuHandle) - 1) do
if GetMenuItemID(FSysMenuHandle, I) = FCommand then
begin
Result := I;
Break;
end;
end;
procedure TSysMenuCommand.SetWantSeparator(Value: Boolean);
var
MenuPosition: Integer;
Success: Boolean;
begin
if Value FWantSeparator then
begin
Success := False;
if Value then
begin
MenuPosition := GetMenuItemPos;
if MenuPosition - 1 then
Success := InsertMenu(FSysMenuHandle, MenuPosition, MF_SEPARATOR or mf_ByPosition,
FCommand - 1, nil)
end
else
Success := DeleteMenu(FSysMenuHandle, FCommand - 1, MF_BYCOMMAND);
FWantSeparator := Value;
end;
end;
procedure TSysMenuCommand.SysCommand;
begin
if Assigned(FOnClick) then
FOnClick(Self);
if FAutoToggle then
Checked := not Checked;
end;
{------------------------------------------------}
constructor TSysMenuCommandList.Create;
begin
SysMenuList:=TList.Create;
if not (csDesigning in ComponentState) then
begin
if Assigned(Application) then
AppOnMsg:=Application.OnMessage;
Application.OnMessage:=OnSysMessage;
end;
end;
destructor TSysMenuCommandList.Destroy;
begin
if not (csDesigning in ComponentState) then
Application.OnMessage:=AppOnMsg;
SysMenuList.Free;
inherited Destroy;
end;
procedure TSysMenuCommandList.OnSysMessage(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.wParam)WM_USER then
Handled:=CallItem(Msg.wParam);
if not Handled then
if Assigned(AppOnMsg) then
AppOnMsg(Msg,Handled);
end;
function TSysMenuCommandList.Add(Item: TSysMenuCommand): Word;
begin
SysMenuList.Add(Item);
result:=WM_USER + SysMenuList.Count;
end;
procedure TSysMenuCommandList.Remove(Item: TSysMenuCommand);
var
i: integer;
begin
for i:= SysMenuList.Count-1 downto 0 do
if TSysMenuCommand(SysMenuList[i]).FCommand=Item.FCommand then
begin
SysMenuList.Delete(i);
break;
end;
end;
function TSysMenuCommandList.CallItem(CommandID: Word): boolean;
var
i: integer;
begin
result:=false;
for i:= SysMenuList.Count-1 downto 0 do
if TSysMenuCommand(SysMenuList[i]).FCommand=CommandID then
begin
TSysMenuCommand(SysMenuList[i]).SysCommand;
result:=true;
break;
end;
end;
initialization
SysMenuCommandList:=nil;
finalization
if Assigned(SysMenuCommandList) then
SysMenuCommandList.Free;
end.