Title: How to use form's minimize button as a roller button
Question: How to use form's minimize button as a roller button and how to modifiy a system menu item
Answer:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
protected
FRolledUp: Boolean;
FOldHeight: Integer;
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup); message WM_INITMENUPOPUP;
procedure RollerButtonClick;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
MainUnit;
procedure TForm1.FormShow(Sender: TObject);
begin
FRolledUp := False;
end;
procedure TForm1.RollerButtonClick;
begin
if not FRolledUp then begin
if ClientHeight ClientHeight := 350;
FRolledUp := False;
end else begin
FOldHeight := ClientHeight;
ClientHeight := 0;
FRolledUp := True;
end;
end else begin
ClientHeight := FOldHeight;
FRolledUp := False;
end;
end;
procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
var
AMenuItemInfo: TMenuItemInfo;
AMenu: THandle;
C, I: Integer;
S: PChar;
Win95_98, Win95,
Win98_2k: Boolean;
procedure FindOSVersion;
var
Info: TOSVersionInfo;
begin
Info.dwOSVersionInfoSize := SizeOf(Info);
GetVersionEx(Info);
Win95_98 := Info.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;
Win95 := Win95_98 and (Info.dwMinorVersion = 0);
Win98_2k :=
(Info.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and (Info.dwMinorVersion 0) or
(Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and (Info.dwMajorVersion = 5);
end;
begin
if Lo(GetVersion) = 4 then begin
AMenu := GetSystemMenu(Handle, False);
C := GetMenuItemCount(AMenu);
FindOSVersion;
for I := 0 to C-1 do
if GetMenuItemID(AMenu, I) = 61472 then begin
GetMem(S, 1024);
with AMenuItemInfo do begin
if Win98_2k then
cbSize := SizeOf(AMenuItemInfo)
else begin
cbSize := 44;
AMenuItemInfo.hbmpItem := 0;
end;
fMask :=
MIIM_CHECKMARKS or MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
dwTypeData := S;
cch := 1024;
end;
if GetMenuItemInfo(AMenu, I, True, AMenuItemInfo) then begin
if not FRolledUp then
AMenuItemInfo.dwTypeData := '&Roll-up'
else AMenuItemInfo.dwTypeData := '&Roll-down';
SetMenuItemInfo(AMenu, I, True, AMenuItemInfo);
end;
end;
end;
end;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if (Msg.CmdType = SC_MINIMIZE) then RollerButtonClick
else DefaultHandler(Msg);
end;
end.