Delphi控件源码

开发平台：
Delphi

TrayAnimation.pas：源码内容
							unit TrayAnimation;
{ D5 and down don't support alpha-blending (transparent forms). }
{$IFDEF VER140} {$DEFINE DELPHI_6} {$ENDIF}
{$IFDEF VER150} {$DEFINE DELPHI_7} {$ENDIF}
{$IFDEF DELPHI_6} {$DEFINE DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_7} {$DEFINE DELPHI_6_UP} {$ENDIF}
interface
uses
  Windows, Classes, Graphics, Forms;
type
  TWindowFader = class(TThread)
  private
    BlendValue: Integer;
    procedure Fade;
  public
    FadeOut: Boolean;
    procedure Execute; override;
  end;
  TWindowImploder = class(TThread)
  private
    X, Y, W, H: Integer;
    procedure Implode;
  public
    Imploding: Boolean;
    procedure Execute; override;
  end;
  TWindowOutlineImploder = class(TThread)
  private
    X, Y, W, H: Integer;
    DesktopCanvas: TCanvas;
    procedure Implode;
  public
    Imploding: Boolean;
    constructor Create;
    destructor Destroy; override;
    procedure Execute; override;
  end;
  procedure FloatingRectangles(Minimizing, OverrideUserSettings: Boolean);
implementation
uses
  Math, ShellApi, Messages, Main;
{----------------- Stand-alone methods ----------------}
procedure FloatingRectangles(Minimizing, OverrideUserSettings: 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 OverrideUserSettings 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 := MainForm.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 Minimizing then
    DrawAnimatedRects(MainForm.Handle, IDANI_CAPTION, RectFrom, RectTo)
  else
    DrawAnimatedRects(MainForm.Handle, IDANI_CAPTION, RectTo, RectFrom);
  if ResetRegistry then
    SetAnimation(False);               // Disable window animation
end;
{-------------------- TWindowFader --------------------}
procedure TWindowFader.Execute;
begin
{$IFDEF DELPHI_6_UP}
  BlendValue := MainForm.AlphaBlendValue;
{$ENDIF}
  while not Terminated do
  begin
    if FadeOut then
      Dec(BlendValue, 25)
    else
      Inc(BlendValue, 25);
    Sleep(10);
//    Application.ProcessMessages;
    Synchronize(Fade);
    if (BlendValue <= 0) or (BlendValue >= 255) then
      Terminate;
  end;
end;
procedure TWindowFader.Fade;
begin
{$IFDEF DELPHI_6_UP}
  if (BlendValue >= 0) and (BlendValue <= 255) then
    MainForm.AlphaBlendValue := BlendValue;
{$ENDIF}
end;
{------------------ TWindowImploder -------------------}
procedure TWindowImploder.Execute;
const
  minW = 120;
  minH = 25;
  deltaGrowth = 0.2;
var
  maxW, maxH: Integer;
  deltaW, deltaH: Integer;
begin
  with MainForm do
  begin
    X := Left;
    Y := Top;
    W := Width;
    H := Height;
    if Imploding then
    begin
      // Store current form size
      StartX := Left;
      StartY := Top;
      StartW := Width;
      StartH := Height;
    end;
    // Remember previous form size
    maxW := StartW;
    maxH := StartH;
  end;
  while not Terminated do
  begin
    deltaW := Round((W-minW) * deltaGrowth);
    deltaH := Round((H-minH) * deltaGrowth);
    if deltaW = 0 then
      Inc(deltaW);
    if Odd(deltaW) then
      Inc(deltaW);
    if deltaH = 0 then
      Inc(deltaH);
    if Odd(deltaH) then
      Inc(deltaH);
    if Imploding then
    begin
      W := W - deltaW;
      H := H - deltaH;
      X := X + (deltaW div 2);
      Y := Y + (deltaH div 2);
    end
    else
    begin
      W := W + deltaW;
      H := H + deltaH;
      X := X - (deltaW div 2);
      Y := Y - (deltaH div 2);
    end;
    Sleep(10);
    if (Imploding and ((W <= minW) or (H <= minH) or (deltaW = 0))) or
       (not Imploding and ((W >= maxW) or (H >= maxH) or (deltaH = 0))) then
      Terminate;
    if not Terminated then
      Synchronize(Implode);
    Application.ProcessMessages;
  end;
  if not Imploding then
  begin
    with MainForm do
      SetWindowPos(Handle, 0, StartX, StartY, StartW, StartH, SWP_NOZORDER);
    Application.ProcessMessages;
  end;
end;
procedure TWindowImploder.Implode;
begin
  SetWindowPos(MainForm.Handle, 0, X, Y, W, H, SWP_NOZORDER);
end;
{--------------- TWindowOutlineImploder ---------------}
constructor TWindowOutlineImploder.Create;
begin
  inherited Create(False);
  DesktopCanvas := TCanvas.Create;
  with DesktopCanvas do
  begin
    Handle := GetDC(0);      // HDC of desktop
//    Handle := GetWindowDC(GetDesktopWindow);
    Pen.Mode := pmNotXor;
    Pen.Style := psDot;
    Pen.Width := 2;
    Pen.Color := clGray;
//    Brush.Color := clGray;
//    Brush.Style := bsDiagCross;
    Brush.Style := bsClear;
  end;
end;
destructor TWindowOutlineImploder.Destroy;
begin
//  ReleaseDC(GetDesktopWindow, DesktopCanvas.Handle);
  ReleaseDC(0, DesktopCanvas.Handle);
  DesktopCanvas.Handle := 0;
  DesktopCanvas.Free;
  DesktopCanvas := nil;
  inherited Destroy;
end;
procedure TWindowOutlineImploder.Execute;
const
  minW = 25;
  minH = 25;
  deltaGrowth = 0.25;
var
  maxW, maxH: Integer;
  deltaW, deltaH: Integer;
begin
  with MainForm do
  begin
    if Imploding then
    begin
      X := Left;
      Y := Top;
      W := Width;
      H := Height;
      // Store current form size
      StartX := Left;
      StartY := Top;
      StartW := Width;
      StartH := Height;
      CoolTrayIcon1.HideMainForm;
    end
    else
    begin
      X := StartX + ((StartW-minW) div 2);
      Y := StartY + ((StartH-minH) div 2);
      W := minW;
      H := minH;
    end;
    // Remember previous form size
    maxW := StartW;
    maxH := StartH;
  end;
  while not Terminated do
  begin
    deltaW := Round((W-minW) * deltaGrowth);
    deltaH := Round((H-minH) * deltaGrowth);
    if deltaW = 0 then
      Inc(deltaW);
    if Odd(deltaW) then
      Inc(deltaW);
    if deltaH = 0 then
      Inc(deltaH);
    if Odd(deltaH) then
      Inc(deltaH);
    if Imploding then
    begin
      W := W - deltaW;
      H := H - deltaH;
      X := X + (deltaW div 2);
      Y := Y + (deltaH div 2);
    end
    else
    begin
      W := W + deltaW;
      H := H + deltaH;
      X := X - (deltaW div 2);
      Y := Y - (deltaH div 2);
    end;
    Synchronize(Implode);
    if (Imploding and ((W <= minW) or (H <= minH) or (deltaW = 0))) or
       (not Imploding and ((W >= maxW) or (H >= maxH) or (deltaH = 0))) then
      Terminate;
  end;
end;
procedure TWindowOutlineImploder.Implode;
{var
  R: TRect;}
begin
  if not Terminated then
    if (DesktopCanvas <> nil) and (DesktopCanvas.Handle <> 0) then
    begin
//      R := Rect(X, Y, X+W, Y+H);
//      InvalidateRect(DesktopCanvas.Handle, @R, True);
//      PostMessage(DesktopCanvas.Handle, WM_SETREDRAW, 1, 0);
//      RedrawWindow(DesktopCanvas.Handle, 0, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ERASENOW);
//      UpdateWindow(DesktopCanvas.Handle);
      DesktopCanvas.Rectangle(X, Y, X+W, Y+H);
      Sleep(10);
      DesktopCanvas.Rectangle(X, Y, X+W, Y+H);
    end;
end;
end.

						