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
| unit Utest;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
ShellAPI, Dialogs, StdCtrls;
const
wm_AppBarMessage = wm_User;
type
TFrmAppBar = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Déclarations privées }
AppData: _AppBarData; //Appbars structure
function GetRequestRect: TRect;
procedure WMAppBarMessage(var Msg: TMessage); message wm_AppBarMessage;
procedure WMWindowPosChanged(var Msg: TWMWindowPosMsg); message WM_WindowPosChanged;
procedure WMMoving(var Msg: TMessage); message WM_Moving;
procedure WMExitSizeMove(var Msg: TMessage); message WM_ExitSizeMove;
property RequestRect: TRect read GetRequestRect;
public
{ Déclarations publiques }
procedure CreateParams(var Params: TCreateParams); override;
end;
var
FrmAppBar : TFrmAppBar;
implementation
{$R *.dfm}
procedure TFrmAppBar.FormCreate(Sender: TObject);
var
HndAppBar: hwnd;
begin
// fill the AppBarData data structure
AppData.cbSize := sizeof(AppData);
AppData.hWnd := Handle;
AppData.uCallBackMessage := wm_AppBarMessage;
// always start along bottom edge
AppData.uEdge := ABE_BOTTOM;
AppData.rc := RequestRect;
AppData.lParam := 0;
SHAppBarMessage(ABM_NEW, AppData);
end;
procedure TFrmAppBar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SHAppBarMessage(ABM_REMOVE,AppData); //Remove it on close
end;
procedure TFrmAppBar.FormActivate(Sender: TObject);
begin
SHAppBarMessage(ABM_ACTIVATE,AppData);
end;
procedure TFrmAppBar.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
SHAppBarMessage(ABM_QUERYPOS, AppData);
AppData.rc.Top := AppData.rc.Bottom - Height;
SHAppBarMessage(ABM_SETPOS, AppData);
SetBounds(AppData.rc.Left, AppData.rc.Top, AppData.rc.Right-AppData.rc.Left, AppData.rc.Bottom-AppData.rc.Top);
end;
procedure TFrmAppBar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if Params.ExStyle and WS_EX_TOOLWINDOW = 0 then
Params.ExStyle := Params.ExStyle + WS_EX_TOOLWINDOW;
end;
function TFrmAppBar.GetRequestRect: TRect;
begin
// set the requested Rect
Result.Left := 0;
Result.Top := Screen.Height - 50;
Result.Right := Screen.Width;
Result.Bottom := Screen.Height;
case AppData.uEdge of
ABE_TOP: begin
Result.Left := 0;
Result.Top := 0;
Result.Right := Screen.Width;
Result.Bottom := 50;
end;
ABE_LEFT: begin
Result.Left := 0;
Result.Top := 0;
Result.Right := 50;
Result.Bottom := Screen.Height;
end;
ABE_RIGHT: begin
Result.Left := Screen.Width-50;
Result.Top := 0;
Result.Right := Screen.Width;
Result.Bottom := Screen.Height;
end;
end;
end;
procedure TFrmAppBar.WMAppBarMessage(var Msg: TMessage);
begin
// hide when fullscreen apps are displayed
if Msg.wParam = ABN_FULLSCREENAPP then
if Msg.lParam <> 0 then Hide else Show;
if Msg.wParam = ABN_POSCHANGED then
begin
// fill the AppBarData data structure
AppData.rc := RequestRect;
SHAppBarMessage(ABM_QUERYPOS, AppData);
case AppData.uEdge of
ABE_TOP: AppData.rc.Bottom := AppData.rc.Top + 50;
ABE_LEFT: AppData.rc.Right := AppData.rc.Left + 50;
ABE_RIGHT: AppData.rc.Left := AppData.rc.Right - 50;
ABE_BOTTOM: AppData.rc.Top := AppData.rc.Bottom - 50;
end;
SHAppBarMessage(ABM_SETPOS, AppData);
SetBounds(AppData.rc.Left, AppData.rc.Top, AppData.rc.Right-AppData.rc.Left, AppData.rc.Bottom-AppData.rc.Top);
end;
end;
procedure TFrmAppBar.WMWindowPosChanged(var Msg: TWMWindowPosMsg);
begin
// must send this message to maintain correct Z-order
SHAppBarMessage(ABM_WINDOWPOSCHANGED, AppData);
inherited;
end;
procedure TFrmAppBar.WMMoving(var Msg: TMessage);
var
P: TPoint;
begin
GetCursorPos(P);
if (P.Y < Screen.Height/Screen.Width*P.X) and (P.Y < -(Screen.Height/Screen.Width*P.X)+Screen.Height) then
begin
AppData.uEdge := ABE_TOP;
AppData.rc := RequestRect;
SHAppBarMessage(ABM_QUERYPOS, AppData);
AppData.rc.Bottom := AppData.rc.Top + 50;
PRect(Msg.lParam)^ := AppData.rc;
end;
if (P.Y >= Screen.Height/Screen.Width*P.X) and (P.Y < -(Screen.Height/Screen.Width*P.X)+Screen.Height) then
begin
AppData.uEdge := ABE_LEFT;
AppData.rc := RequestRect;
SHAppBarMessage(ABM_QUERYPOS, AppData);
AppData.rc.Right := AppData.rc.Left + 50;
PRect(Msg.lParam)^ := AppData.rc;
end;
if (P.Y >= Screen.Height/Screen.Width*P.X) and (P.Y >= -(Screen.Height/Screen.Width*P.X)+Screen.Height) then
begin
AppData.uEdge := ABE_BOTTOM;
AppData.rc := RequestRect;
SHAppBarMessage(ABM_QUERYPOS, AppData);
AppData.rc.Top := AppData.rc.Bottom - 50;
PRect(Msg.lParam)^ := AppData.rc;
end;
if (P.Y < Screen.Height/Screen.Width*P.X) and (P.Y >= -(Screen.Height/Screen.Width*P.X)+Screen.Height) then
begin
AppData.uEdge := ABE_RIGHT;
AppData.rc := RequestRect;
SHAppBarMessage(ABM_QUERYPOS, AppData);
AppData.rc.Left := AppData.rc.Right - 50;
PRect(Msg.lParam)^ := AppData.rc;
end;
inherited;
end;
procedure TFrmAppBar.WMExitSizeMove(var Msg: TMessage);
begin
SetBounds(AppData.rc.Left, AppData.rc.Top, AppData.rc.Right-AppData.rc.Left, AppData.rc.Bottom-AppData.rc.Top);
SHAppBarMessage(ABM_SETPOS, AppData);
inherited;
end;
end. |