teform.pas

delphi2007界面效果控件源码

unit teForm;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teBkgrnd, FormCont, Windows, Messages, Forms,
  Graphics, Controls, teFormAn, teVclScr;

type
  TTEFormTransitionsOnAfterShowEvent = procedure(Sender: TObject;
    const FirstTime: Boolean) of object;

  {$ifndef TE_NOHLP}
  TTECustomForm = class(TCustomForm);
  TTELockData = record
    UseRegion: Boolean;
    Region: HRGN;
    Key: COLORREF;
    Alpha: Byte;
    Flags: DWord;
  end;
  {$endif TE_NOHLP}

  TFormTransitions = class(TComponent)
  private
    FBackgroundOptions: TFCBackgroundOptions;
    FDestroyTransitions: Boolean;
    FEnabled: Boolean;
    FHideTransReversed: Boolean;
    FirstTimeShowed: Boolean;
    FOwnerForm: TTECustomForm;
    FShowTransition: TTransitionEffect;
    FAnimationData: TTEFormAnimationData;
    WasVisible,
    IsMinimizing: Boolean; // Make sure hiding effects do not execute when minimizing
    WindowProcBak: TWndMethod;
    FShowAnimation: TTEFormAnimation;
    FHideAnimation: TTEFormAnimation;
    FHideTransition: TTransitionEffect;
    ClientHandleBak: HWND;
    FOnAfterShow: TTEFormTransitionsOnAfterShowEvent;

    ShowEffectWaiting: Boolean;

    procedure SetBackgroundOptions(Value: TFCBackgroundOptions);
    procedure SetShowTransition(const Value: TTransitionEffect);
    function  GetVersion: String;
    procedure SetVersion(const Value: String);

    procedure ActivateHookForm(const Activate: Boolean);
    procedure ActivateHookMDIClient(const Activate: Boolean; ClientHandle: HWND);
    procedure ActivateHookMDIClientTrans(const Activate: Boolean);
    procedure ActivateHookMDIClientBkgrnd(const Activate: Boolean;
      ClientHandle: HWND);
    function  MainWndHook(var Message: TMessage): Boolean;
    procedure NewWindowProc(var Message: TMessage);
    procedure SetHideAnimation(const Value: TTEFormAnimation);
    procedure SetShowAnimation(const Value: TTEFormAnimation);
    procedure SetHideTransition(const Value: TTransitionEffect);
  protected
    Device: TTEVCLScreenTrDevice;
    LockData: TTELockData;

    function  CanEnable: Boolean;
    function  GetPalette: HPalette;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property OwnerForm: TTECustomForm read FOwnerForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   PrepareAnimation(AnAnimationData: TTEFormAnimationData);
  published
    property BackgroundOptions: TFCBackgroundOptions read FBackgroundOptions write SetBackgroundOptions;
    property DestroyTransitions: Boolean read FDestroyTransitions write FDestroyTransitions default True;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property HideAnimation: TTEFormAnimation read FHideAnimation write SetHideAnimation default nil;
    property HideTransition: TTransitionEffect read FHideTransition write SetHideTransition default nil;
    property HideTransReversed: Boolean read FHideTransReversed write FHideTransReversed default True;
    property ShowAnimation: TTEFormAnimation read FShowAnimation write SetShowAnimation default nil;
    property ShowTransition: TTransitionEffect read FShowTransition write SetShowTransition default nil;
    property Version: String read GetVersion write SetVersion stored False;
    property OnAfterShow: TTEFormTransitionsOnAfterShowEvent read FOnAfterShow write FOnAfterShow;
  end;

var
  TENoFormTransitionsInAero: Boolean;

implementation

uses FlatSB, teRender;

resourcestring
  rsOnlyOne      = 'Only one FormTransitions component is allowed per form';
  rsEmbeddedForm = 'A FormTransitions component is not necessary in a TFCEmbeddedForm';

const
  WS_EX_LAYERED = $00080000;
type
  TTEWinControl          = class(TWinControl);
  TTEFormAnimationHack   = class(TTEFormAnimation);
  TTransitionEffectHack  = class(TTransitionEffect);
  TTEVCLScreenTrDeviceHack = class(TTEVCLScreenTrDevice);
var
  SaveMDIClientWndProc: Pointer = nil;
  MDIClientLocked     : Boolean = False;
  NestedFormTransition: Boolean = False;
  LockMDIClient       : Boolean = False;
  MDIClientBkOptions  : TFCBackgroundOptions = nil;
  MDIClients          : TStringList = nil;

procedure LockWindow(Window: HWnd; CheckRegion: Boolean; var Data: TTELockData);
const
  LWA_ALPHA = $00000002;
begin
  Data.UseRegion := TEWinVersion < teWin2000;

  if CheckRegion then
  begin
    Data.Region := CreateRectRgn(0, 0, 0, 0);
    if GetWindowRgn(Window, Data.Region) = ERROR then
    begin
      DeleteObject(Data.Region);
      Data.Region := 0;
    end;
  end;

  if Data.UseRegion
  then SetWindowRgn(Window, CreateRectRgn(0, 0, 0, 0), False)
  else
  begin
    if IsWindowLayered(Window)
    then
    begin
      GetLayeredWindowAttributes(Window, Data.Key, Data.Alpha, Data.Flags);
      if(Data.Flags and LWA_ALPHA) = 0 then
        Data.Alpha := 255;
    end
    else
    begin
      Data.Key   := 0;
      Data.Alpha := 255;
      Data.Flags := 0;
      SetWindowLong(Window, GWL_EXSTYLE, GetWindowLong(Window, GWL_EXSTYLE) or WS_EX_LAYERED);
    end;
    teRender.SetLayeredWindowAttributes(Window, Data.Key, 0, Data.Flags or LWA_ALPHA);
  end;
end;

function UnlockWindow(Window: HWnd; Rgn: HRGN; CheckRegion: Boolean;
  Data: TTELockData): HRGN;
var
  OSRgn,
  RgnCopy: HRGN;
begin
  Result := 0;
  if Data.UseRegion
  then
  begin
    SetWindowRgn(Window, 0, IsCompositionEnabled);
    if Rgn <> 0 then
    begin
      Result := Rgn;
      OSRgn := CreateRectRgn(0, 0, 0, 0);
      try
        GetWindowRgn(Window, OSRgn);
        if not EqualRgn(OSRgn, Rgn) then // check if it is a XP theme region
        begin
          RgnCopy := CreateRectRgn(0, 0, 0, 0);
          CombineRgn(RgnCopy, Rgn, 0, RGN_COPY);
          SetWindowRgn(Window, RgnCopy, False);
        end;
      finally
        DeleteObject(OSRgn);
      end;
    end;

    if CheckRegion and (Result = 0) then
    begin
      SendMessage(Window, WM_NCPAINT, 0, 0); // Fix a problem with XP themes

      Result := CreateRectRgn(0, 0, 0, 0);
      if GetWindowRgn(Window, Result) = ERROR then
      begin
        DeleteObject(Result);
        Result := 0;
      end;
    end;
  end
  else
  begin
    if Data.Flags = 0
    then SetWindowLong(Window, GWL_EXSTYLE,
           GetWindowLong(Window, GWL_EXSTYLE) and not WS_EX_LAYERED)
    else teRender.SetLayeredWindowAttributes(Window, Data.Key, Data.Alpha, Data.Flags);

    Result := CreateRectRgn(0, 0, 0, 0);
    if GetWindowRgn(Window, Result) = ERROR then
    begin
      DeleteObject(Result);
      Result := 0;
    end;
  end;
end;

function MaximizedChildren: Boolean;
var
  I: Integer;
begin
  Result := False;

  if Application.MainForm = nil then
    Exit;

  for I := 0 to Application.MainForm.MDIChildCount - 1 do
    if Application.MainForm.MDIChildren[I].WindowState = wsMaximized then
    begin
      Result := True;
      Exit;
    end;
end;

function MDIClientWndProc(Wnd: HWND;
  Msg, WParam, LParam: Longint): Longint; stdcall;

  function CallDefWndProc: Longint;
  begin
    Result := CallWindowProc(SaveMDIClientWndProc, Wnd, Msg, WParam, LParam);
  end;

var
  DC: HDC;
  PS: TPaintStruct;
  R: TRect;
  LockData: TTELockData;
begin
  Result := 0;
  case Msg of
    WM_MDICREATE:
    begin
      try
        if(Application.MainForm <> nil)                and
          IsWindowVisible(Application.MainForm.Handle) and
          (not NestedFormTransition)                   and
          (not TEVclScrPrepared)                       and
          LockMDIClient
        then
        begin
          LockWindow(Application.MainForm.ClientHandle, False, LockData);
          MDIClientLocked := True;
        end
        else MDIClientLocked := False;
      finally
        LockMDIClient := False;
      end;
      Result := CallDefWndProc;
    end;
    WM_ERASEBKGND:
    begin
      if MDIClientBkOptions.IsActive
      then Result := 1
      else Result := CallDefWndProc;
    end;
    WM_PAINT:
    begin
      if MDIClientBkOptions.IsActive
      then
      begin
        DC := WParam;
        if DC = 0
        then
        begin
          DC := BeginPaint(Application.MainForm.ClientHandle, PS);
          try
            if IsRectEmpty(PS.rcPaint) then
              GetClientRect(Application.MainForm.ClientHandle, PS.rcPaint);
            MDIClientBkOptions.DrawBackGround(DC, nil, PS.rcPaint);
          finally
            if WParam = 0 then
              EndPaint(Application.MainForm.ClientHandle, PS);
          end;
        end
        else
        begin
          GetClientRect(Application.MainForm.ClientHandle, R);
          MDIClientBkOptions.DrawBackGround(DC, nil, R);
        end;
      end
      else Result := CallDefWndProc;
    end;
    WM_SIZE,
    WM_VSCROLL,
    WM_HSCROLL:
    begin
      Result := CallDefWndProc;
      if(not(csDestroying in MDIClientBkOptions.Control.ComponentState)) and
         MDIClientBkOptions.IsActive                                     and
        (MDIClientBkOptions.PictureMode <> fcpmTile)                     then
        InvalidateRect(Application.MainForm.ClientHandle, nil, True);
    end

    else Result := CallDefWndProc;
  end;
end;

procedure MDIClientWndProcSubclass(ClientHandle: HWND);
begin
  Assert(SaveMDIClientWndProc = nil);

  if ClientHandle = 0 then
    ClientHandle := Application.MainForm.ClientHandle;
  Assert(ClientHandle <> 0);

  SaveMDIClientWndProc :=
    Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(@MDIClientWndProc));
end;

procedure RestoreMDIClientWndProc(ClientHandle: HWND);
begin
  if ClientHandle <> 0 then
    SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(@SaveMDIClientWndProc));
  SaveMDIClientWndProc := nil;
end;

{ TFormTransitions }

constructor TFormTransitions.Create(AOwner: TComponent);
var
  i: Integer;
begin
  if Assigned(AOwner) then
  begin
    if AOwner is TFCEmbeddedForm then
      raise Exception.Create(rsEmbeddedForm);

    for i := 0 to AOwner.ComponentCount - 1 do
      if AOwner.Components[i] is TFormTransitions then
        raise Exception.Create(rsOnlyOne);
  end;

  inherited Create(AOwner);

  FBackgroundOptions  := TFCBackgroundOptions.Create;
  FDestroyTransitions := True;
  FEnabled            := True;
  FHideTransReversed  := True;
  FirstTimeShowed     := True;
  FHideAnimation      := nil;
  FHideTransition     := nil;
  FShowAnimation      := nil;
  FShowTransition     := nil;
  FAnimationData      := nil;
  Device              := nil;
  ClientHandleBak     := 0;

  if Assigned(AOwner) and (AOwner is TCustomForm)
  then
  begin
    FOwnerForm := TTECustomForm(AOwner);
    ActivateHookForm(True);
    if OwnerForm.FormStyle = fsMDIChild then
      ActivateHookMDIClientTrans(True);

    if csDesigning in Componentstate then
      BackgroundOptions.Control := OwnerForm;
  end
  else FOwnerForm := nil;
end;

destructor TFormTransitions.Destroy;
begin
  ActivateHookForm(False);
  if Assigned(OwnerForm) then
  begin
    if OwnerForm.FormStyle = fsMDIChild
    then ActivateHookMDIClientTrans(False)
    else
    begin
      if OwnerForm.FormStyle = fsMDIForm then
        ActivateHookMDIClientBkgrnd(False, 0);
    end;
  end;

  if DestroyTransitions then
  begin
    if Assigned(FHideAnimation) then
      FHideAnimation.Free;
    if Assigned(FHideTransition) then
      FHideTransition.Free;
    if Assigned(FShowAnimation) then
      FShowAnimation.Free;
    if Assigned(FShowTransition) then
      FShowTransition.Free;
  end;

  FBackgroundOptions.Free;
  FAnimationData    .Free;

  inherited;
end;

procedure TFormTransitions.ActivateHookForm(const Activate: Boolean);
begin
  if Activate
  then
  begin
    if(not Assigned(WindowProcBak)) then
    begin
      WasVisible    := OwnerForm.Visible;
      IsMinimizing  := False;
      WindowProcBak := OwnerForm.WindowProc;
      OwnerForm.WindowProc := NewWindowProc;
      Application.HookMainWindow(MainWndHook);
    end;
  end
  else
  begin
    if Assigned(Owner) and Assigned(WindowProcBak) then
      OwnerForm.WindowProc := WindowProcBak;
    WindowProcBak := nil;
    Application.UnhookMainWindow(MainWndHook);
  end;
end;

procedure TFormTransitions.ActivateHookMDIClient(const Activate: Boolean;
  ClientHandle: HWND);
begin
  if csDesigning in OwnerForm.ComponentState then
    exit;

  if Activate
  then
  begin
    if MDIClients = nil then