uses
ShellApi;
procedure MinimizeToTray(AForm: TForm; bMinimizing, bOverrideUserSettings: Boolean);
var
RectFrom, RectTo: TRect;
GotRectTo: Boolean;
abd: TAppBarData;
HTaskbar, HTrayWnd: HWND;
ResetRegistry: Boolean;
ai: TAnimationInfo;
procedure SetAnimation(Animation: Boolean);
begin
FillChar(ai, SizeOf(ai), 0);
ai.cbSize := SizeOf(ai);
if Animation then
ai.iMinAnimate := 1
else
ai.iMinAnimate := 0;
SystemParametersInfo(SPI_SETANIMATION, 0, @ai, SPIF_SENDCHANGE);
end;
begin
// Check if user wants window animation
ResetRegistry := False;
if bOverrideUserSettings then
begin
FillChar(ai, SizeOf(ai), 0);
ai.cbSize := SizeOf(ai);
SystemParametersInfo(SPI_GETANIMATION, 0, @ai, SPIF_SENDCHANGE);
if ai.iMinAnimate = 0 then
begin
// Temporarily enable window animation
ResetRegistry := True;
SetAnimation(True);
end;
end;
RectFrom := AForm.BoundsRect;
GotRectTo := False;
// Get the traybar's bounding rectangle
HTaskbar := FindWindow('Shell_TrayWnd', nil);
if HTaskbar <> 0 then
begin
HTrayWnd := FindWindowEx(HTaskbar, 0, 'TrayNotifyWnd', nil);
if HTrayWnd <> 0 then
if GetWindowRect(HTrayWnd, RectTo) then
GotRectTo := True;
end;
// If that fails, invent a rectangle in the corner where the traybar is
if not GotRectTo then
begin
FillChar(abd, SizeOf(abd), 0);
abd.cbSize := SizeOf(abd);
if SHAppBarMessage(ABM_GETTASKBARPOS, abd) = 0 then Exit;
with Screen, abd.rc do
if (Top > 0) or (Left > 0) then
RectTo := Rect(Width-32, Height-32, Width, Height)
else if (Bottom < Height) then
RectTo := Rect(Width-32, 0, Width, 32)
else if (Right < Width) then
RectTo := Rect(0, Height-32, 32, Height);
end;
if bMinimizing then
DrawAnimatedRects(AForm.Handle, IDANI_CAPTION, RectFrom, RectTo)
else
DrawAnimatedRects(AForm.Handle, IDANI_CAPTION, RectTo, RectFrom);
if ResetRegistry then
SetAnimation(False); // Disable window animation
end;
// Beispielaufruf:
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Hide;
FloatingRectangles(Form1, True, True);
end;