{
{
FILE: APPBAR.PAS by Eric Janssen (e.janssen@libertel.nl)
DESCRIPTION: Encapsuling of SHAppBarMessage
}
unit AppBar;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellApi;
const
WM_APPBAR = WM_USER +1;
type
TEdge = (abeLeft, abeTop, abeRight, abeBottom);
TQuerySizeEvent = procedure(Sender: TObject; Edge: TEdge; var Width, Height: Integer) of object;
TAppBar = class(TComponent)
private
{ Private declarations }
m_ABD: TAppBarData;
m_WndProc: TWndMethod;
m_Edge: TEdge;
m_QuerySize: TQuerySizeEvent;
procedure SetEdge(const Value: TEdge);
procedure WndProc(var Msg: TMessage);
protected
{ Protected declarations }
procedure ABRegister; virtual;
procedure ABUnregister; virtual;
procedure ABSetPos; virtual;
procedure ABPosChanged; virtual;
procedure ABFullScreenApp(Enabled: Boolean); virtual;
procedure ABSetAutoHide(Enabled: Boolean); virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
{ Published declarations }
property Edge: TEdge read m_Edge write SetEdge;
property QuerySize: TQuerySizeEvent read m_QuerySize write m_QuerySize;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Libertel', [TAppBar]);
end;
//------------------------------------------------------------------------------
procedure TAppBar.ABRegister;
begin
// check if we are not in the Delphi IDE
if not (csDesigning in ComponentState) then
begin
// make sure we get the notification messages
m_WndProc:= TWinControl(Owner).WindowProc;
TWinControl(Owner).WindowProc:= WndProc;
m_ABD.cbSize:= SizeOf(TAppBarData);
m_ABD.hWnd:= TWinControl(Owner).Handle;
m_ABD.uCallbackMessage:= WM_APPBAR;
// register the application bar within the system
if SHAppBarMessage(ABM_NEW, m_ABD) = 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
// make it a toolwindow with no caption
if SetWindowLong(m_ABD.hWnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW or WS_EX_DLGMODALFRAME) = 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
if SetWindowLong(m_ABD.hWnd, GWL_STYLE, 0) = 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
SetWindowPos(m_ABD.hWnd, m_ABD.hWnd, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOSIZE or SWP_SHOWWINDOW);
end;
end;
//------------------------------------------------------------------------------
procedure TAppBar.ABSetPos;
var Height, Width: Integer;
begin
if not (csDesigning in ComponentState) then
begin
// default size
Width:= TWinControl(Owner).Width;
Height:= TWinControl(Owner).Height;
// request the new size
if Assigned(m_QuerySize) then
m_QuerySize(Self, m_Edge, Width, Height);
m_ABD.rc.Right:= GetSystemMetrics(SM_CXSCREEN);
m_ABD.rc.Bottom:= GetSystemMetrics(SM_CYSCREEN);
if (m_ABD.uEdge = ABE_LEFT) or (m_ABD.uEdge = ABE_RIGHT) then
begin
if m_ABD.uEdge = ABE_LEFT then m_ABD.rc.Left:= 0
else m_ABD.rc.Left:= GetSystemMetrics(SM_CXSCREEN) - Width;
m_ABD.rc.Top:= 0;
end else
begin
if m_ABD.uEdge = ABE_TOP then m_ABD.rc.Top:= 0
else m_ABD.rc.Top:= GetSystemMetrics(SM_CYSCREEN) - Height;
m_ABD.rc.Left:= 0;
end;
// query the new position
if SHAppBarMessage(ABM_QUERYPOS, m_ABD) = 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
// calculate the size
case m_ABD.uEdge of
ABE_LEFT:
m_ABD.rc.Right:= m_ABD.rc.Left + Width;
ABE_RIGHT:
m_ABD.rc.Left:= m_ABD.rc.Right - Width;
ABE_TOP:
m_ABD.rc.Bottom:= m_ABD.rc.Top + Height;
ABE_BOTTOM:
m_ABD.rc.Top:= m_ABD.rc.Bottom - Height;
end;
// set the new size
if SHAppBarMessage(ABM_SETPOS, m_ABD) = 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
// move the form
MoveWindow(m_ABD.hWnd, m_ABD.rc.Left, m_ABD.rc.Top,
m_ABD.rc.Right - m_ABD.rc.Left,
m_ABD.rc.Bottom - m_ABD.rc.Top, TRUE);
end;
end;
//------------------------------------------------------------------------------
procedure TAppBar.ABUnregister;
begin
// check if the form is not being destroyed and not in the Delphi IDE
if not (csDesigning in ComponentState) then
begin
if not (csDestroying in ComponentState) then
TWinControl(Owner).WindowProc:= m_WndProc;
// remove the application bar
if SHAppBarMessage(ABM_REMOVE, m_ABD) = 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
end;
end;
//------------------------------------------------------------------------------
constructor TAppBar.Create(AOwner: TComponent);
var I: Cardinal;
begin
inherited Create(AOwner);
// check if we have an owner
if Assigned(AOwner) then
begin
// we could turn everything with a handle into a application-bar, but for
// for Delphi we only use descendants of TCustomForm
if (AOwner is TCustomForm) then
begin
// make sure we are the only one
for I:=0 to AOwner.ComponentCount -1 do
begin
if (AOwner.Components[I] is TAppBar) and (AOwner.Components[I] <> Self) then
raise Exception.Create('Ooops, you need only *ONE* of these');
end;
end else
raise Exception.Create('Sorry, can''t do this only with TCustomForms');
end else
raise Exception.Create('Sorry, can''t do this without an owner');
end;
//------------------------------------------------------------------------------
destructor TAppBar.Destroy;
begin
ABUnregister();
inherited Destroy();
end;
//------------------------------------------------------------------------------
procedure TAppBar.Loaded;
begin
inherited Loaded();
ABRegister();
ABSetPos();
end;
//------------------------------------------------------------------------------
procedure TAppBar.SetEdge(const Value: TEdge);
begin
if (m_Edge <> Value) then
begin
m_Edge:= Value;
case m_Edge of
abeLeft:
m_ABD.uEdge:= ABE_LEFT;
abeTop:
m_ABD.uEdge:= ABE_TOP;
abeBottom:
m_ABD.uEdge:= ABE_BOTTOM;
abeRight:
m_ABD.uEdge:= ABE_RIGHT;
end;
ABSetPos();
end;
end;
//------------------------------------------------------------------------------
procedure TAppBar.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_APPBAR) then
begin
case Msg.wParam of
ABN_STATECHANGE, ABN_POSCHANGED:
ABPosChanged();
ABN_FULLSCREENAPP:
ABFullScreenApp(Msg.lParam <> 0);
end;
end;
if (Msg.Msg = WM_WINDOWPOSCHANGED) then
begin
SHAppBarMessage(ABM_WINDOWPOSCHANGED, m_ABD);
end;
if (Msg.Msg = WM_ACTIVATE) then
begin
SHAppBarMessage(ABM_ACTIVATE, m_ABD);
end;
// call the original WndProc
if Assigned(m_WndProc) then
m_WndProc(Msg);
end;
//------------------------------------------------------------------------------
procedure TAppBar.ABPosChanged;
var rc, rcWindow: TRect;
Height, Width: Integer;
begin
rc.Top:= 0;
rc.Left:= 0;
rc.Right:= GetSystemMetrics(SM_CXSCREEN);
rc.Bottom:= GetSystemMetrics(SM_CYSCREEN);
GetWindowRect(m_ABD.hWnd, rcWindow);
Height:= rcWindow.Top - rcWindow.Bottom;
Width:= rcWindow.Right - rcWindow.Left;
case m_ABD.uEdge of
ABE_TOP:
rc.Bottom:= rc.Top + Height;
ABE_BOTTOM:
rc.Top:= rc.Bottom - Height;
ABE_LEFT:
rc.Right:= rc.Left + Width;
ABE_RIGHT:
rc.Left:= rc.Right - Width;
end;
ABSetPos();
end;
//------------------------------------------------------------------------------
procedure TAppBar.ABFullScreenApp(Enabled: Boolean);
var State: Integer;
Flags: HWND;
begin
State:= SHAppBarMessage(ABM_GETSTATE, m_ABD);
if Enabled then
begin
if (State and ABS_ALWAYSONTOP) <> 0 then
Flags:= HWND_TOPMOST
else
Flags:= HWND_BOTTOM;
SetWindowPos(m_ABD.hWnd, Flags, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
end else
begin
if (State and ABS_ALWAYSONTOP) <> 0 then
SetWindowPos(m_ABD.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
end;
end;
//------------------------------------------------------------------------------
procedure TAppBar.ABSetAutoHide(Enabled: Boolean);
begin
if not (csDesigning in ComponentState) then
begin
if Enabled then m_ABD.lParam:= -1
else m_ABD.lParam:= 0;
if SHAppBarMessage(ABM_SETAUTOHIDEBAR, m_ABD) <> 0 then
raise Exception.Create(SysErrorMessage(GetLastError()));
end;
end;
//------------------------------------------------------------------------------
end.
|
