1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:

{
  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.