Thema: Delphi Send to tray

Einzelnen Beitrag anzeigen

Benutzerbild von toms
toms
(CodeLib-Manager)

Registriert seit: 10. Jun 2002
4.648 Beiträge
 
Delphi XE Professional
 
#6

Re: Send to tray

  Alt 17. Jul 2003, 19:40
Zitat:
1. ... das Progg nicht beim verkleinern in den Tray geht sondern normal unten in die Taskleiste?
Nit dieser Funktion kannst du deine App animiert ins Tray minimieren.

Delphi-Quellcode:
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;
Thomas
  Mit Zitat antworten Zitat