teform.pas

delphi2007界面效果控件源码

    begin
      MDIClients := TStringList.Create;
      MDIClientWndProcSubclass(ClientHandle);
      ClientHandleBak := ClientHandle;
    end;
    MDIClients.Add(ClassName);
  end
  else
  begin
    MDIClients.Delete(MDIClients.IndexOf(ClassName));
    if MDIClients.Count = 0 then
    begin
      MDIClients.Free;
      MDIClients := nil;
      RestoreMDIClientWndProc(ClientHandleBak);
    end;
  end;
end;

procedure TFormTransitions.ActivateHookMDIClientTrans(const Activate: Boolean);
begin
  if Activate then
  begin
    if OwnerForm.FormStyle = fsMdiChild then
      LockMDIClient :=
        Enabled and
        ((OwnerForm.WindowState = wsMaximized) or MaximizedChildren);
  end;
  ActivateHookMDIClient(Activate, 0);
end;

procedure TFormTransitions.ActivateHookMDIClientBkgrnd(const Activate: Boolean;
  ClientHandle: HWND);
begin
  if Activate
  then MDIClientBkOptions := BackgroundOptions
  else MDIClientBkOptions := nil;
  ActivateHookMDIClient(Activate, ClientHandle);
end;

function TFormTransitions.CanEnable: Boolean;
begin
  Result := (not(csDesigning in ComponentState)) and (OwnerForm.Parent = nil);
end;

procedure TFormTransitions.Loaded;
begin
  inherited Loaded;

  if OwnerForm.FormStyle = fsMDIForm then
    ActivateHookMDIClientBkgrnd(True, OwnerForm.ClientHandle);
    
  if Enabled and CanEnable
  then
  begin
    if OwnerForm.FormStyle = fsStayOnTop then
    begin
      OwnerForm.FormStyle := fsNormal;
      OwnerForm.FormStyle := fsStayOnTop;
    end;
  end
  else
  begin
    if(OwnerForm.FormStyle = fsMDIChild) and MDIClientLocked then
    begin
      UnlockWindow(Application.MainForm.ClientHandle, 0, True, LockData);
      MDIClientLocked := False;
    end;
  end;
end;

procedure TFormTransitions.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
  begin
    if(AComponent = FHideTransition) and
      Assigned(FHideTransition)      then
    begin
      if(FHideTransition = OldTransition) and Assigned(NewTransition)
      then FHideTransition := NewTransition
      else FHideTransition := nil;
    end;
    if(AComponent = FShowTransition) and
      Assigned(FShowTransition)      then
    begin
      if(FShowTransition = OldTransition) and Assigned(NewTransition)
      then FShowTransition := NewTransition
      else FShowTransition := nil;
    end;
    if(FAnimationData <> nil) and
      (
        (AComponent = FAnimationData.Control  ) or
        (AComponent = FAnimationData.Animation)
      ) then
      FreeAndNil(FAnimationData);
    if AComponent = FHideAnimation then
      FHideAnimation := nil;
    if AComponent = FShowAnimation then
      FShowAnimation := nil;
  end;
end;

function TFormTransitions.GetVersion: String;
begin
  Result := BilleniumEffectsVersion;
end;

procedure TFormTransitions.SetVersion(const Value: String);
begin
end;

var
  SaveSetWindowRgn: function(hWnd: HWND; hRgn: HRGN; bRedraw: BOOL): Integer; stdcall;
  HookedWnd: HWnd;
  LockedRgn: HRGN;

function HookedSetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: BOOL): Integer; stdcall;
begin
  if hWnd = HookedWnd
  then
  begin
    if LockedRgn <> 0 then
      DeleteObject(LockedRgn);
    LockedRgn := hRgn;
    Result    := 1;
  end
  else Result := SaveSetWindowRgn(hWnd, hRgn, bRedraw);
end;

function TFormTransitions.MainWndHook(var Message: TMessage): Boolean;
begin
  if(Message.Msg = WM_SYSCOMMAND) and (Message.WParam = SC_MINIMIZE) then
    IsMinimizing := True;
  Result := False;
end;

procedure TFormTransitions.NewWindowProc(var Message: TMessage);

  procedure PrepareShowingEffects;
  var
    Locked: Boolean;
  begin
    if IsCompositionEnabled then
    begin
      if Assigned(FShowTransition) or
         Assigned(FShowAnimation ) or
         Assigned(FHideTransition) or
         Assigned(FHideAnimation ) or
         Assigned(FAnimationData )
      then DisableDwmTransitions(OwnerForm.Handle)
      else
      begin
        WindowProcBak(Message);
        exit;
      end;
    end;

    ShowEffectWaiting  := False;
    LockedRgn          := 0;
    HookedWnd          := 0;
    LockData.UseRegion := True;

    if(OwnerForm.FormStyle = fsMDIChild) and MDIClientLocked
    then
    begin
      if GetMaximizedMDIChild(OwnerForm) then
      begin
        SetWindowLong(Application.MainForm.ClientHandle, GWL_EXSTYLE,
          GetWindowLong(Application.MainForm.ClientHandle,
            GWL_EXSTYLE) and not WS_EX_CLIENTEDGE);
        SetWindowPos(Application.MainForm.ClientHandle, 0, 0, 0, 0, 0,
          SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
      end;
    end
    else
    begin
      LockWindow(OwnerForm.Handle, OwnerForm.WindowState <> wsMaximized, LockData);
      if LockData.UseRegion then
        LockedRgn := LockData.Region;
    end;
    Locked := True;
    try
      with OwnerForm do
      begin
        if(FormStyle = fsStayOnTop) and
          (
            (
              (
                HorzScrollBar.Visible and
                (HorzScrollBar.Style = ssRegular)
              ) and
              not
                (
                  VertScrollBar.Visible and
                  (VertScrollBar.Style <> ssRegular)
                )
            ) or
            (
              (
                VertScrollBar.Visible and
                (VertScrollBar.Style = ssRegular)
              ) and
              not
                (
                  HorzScrollBar.Visible and
                  (HorzScrollBar.Style <> ssRegular)
                )
            )
          ) then
          UninitializeFlatSB(Handle);
      end;

      if OwnerForm.FormStyle = fsMDIForm then
        NestedFormTransition := True;
      try
        TEVclScrPrepared := True;
        try
          SaveSetWindowRgn := nil;
          if LockData.UseRegion then
          begin
            HookedWnd := OwnerForm.Handle;
            HookAPICall('user32', 'SetWindowRgn', @Windows.SetWindowRgn,
              @HookedSetWindowRgn, @SaveSetWindowRgn, True);
          end;
          try
            WindowProcBak(Message);
            ShowEffectWaiting :=
              SendMessage(OwnerForm.Handle, CM_BEWAIT, 0, BE_ID) = BE_ID;
          finally
            if(not ShowEffectWaiting) and LockData.UseRegion then
              UnhookAPICall(@Windows.SetWindowRgn, @HookedSetWindowRgn,
                @SaveSetWindowRgn, True);
          end;
          if not(ShowEffectWaiting or IsWindowVisible(OwnerForm.Handle)) then
            Abort;
        finally
          TEVclScrPrepared := False;
        end;
      finally
        if OwnerForm.FormStyle = fsMDIForm then
          NestedFormTransition := False;
      end;
    except
      on E: Exception do
      begin
        if Locked then
        begin
          if(OwnerForm.FormStyle = fsMDIChild) and MDIClientLocked
          then
          begin
            UnlockWindow(Application.MainForm.ClientHandle, 0, True, LockData);
            MDIClientLocked := False;
          end
          else UnlockWindow(OwnerForm.Handle, LockedRgn, False, LockData);
        end;
        if not(E is EAbort) then
          raise;
      end;
    end;
  end;

  procedure ShowEffects;
  var
    SaveNeverRendering,
    CanDestroyAnimationData: Boolean;
    R: TRect;
    TransitionToUse: TTransitionEffect;
    AnimationDataToUse: TTEFormAnimationData;
    Device: TTEVCLScreenTrDeviceHack;

    procedure DoUnlock;
    begin
      if(OwnerForm.FormStyle = fsMDIChild) and MDIClientLocked
      then
      begin
        UnlockWindow(Application.MainForm.ClientHandle, 0, True, LockData);
        MDIClientLocked := False;
      end
      else LockedRgn := UnlockWindow(OwnerForm.Handle, LockedRgn,
                          OwnerForm.FormStyle = fsMDIChild, LockData);
      if(LockedRgn <> 0) and (not MDIClientLocked) then
        TTEVCLScreenTrDeviceHack(Device).ClipRgn := LockedRgn;
    end;

  var
    UsingLayerTransition: Boolean;
  begin
    Application.ProcessMessages; // Allow control to repaint
    UnhookAPICall(@Windows.SetWindowRgn, @HookedSetWindowRgn, @SaveSetWindowRgn,
      True);
    AnimationDataToUse := nil;
    SaveNeverRendering := False;
    if FAnimationData <> nil
    then AnimationDataToUse := FAnimationData
    else if(FShowAnimation <> nil) and FShowAnimation.Enabled then
      AnimationDataToUse := FShowAnimation.CreateAnimationData(OwnerForm);
    try
      TransitionToUse := nil;
      if(FShowTransition <> nil) and
        (not TTEVCLScreenTrDeviceHack.TransitionIsDisabled(FShowTransition, False)) and
        (
          (not IsWindowLayered(OwnerForm.Handle))            or
          (LockData.UseRegion or (LockData.Flags = 0)) or
          IsCompositionEnabled
        )
      then TransitionToUse := FShowTransition
      else
      begin
        if LockData.UseRegion and
           (
             Assigned(AnimationDataToUse) or
             FlickerFreeTransition.FlickerFreeWhenDisabled
           ) then
        begin
          TransitionToUse := TFlickerFreeTransition.Create(nil);
          TransitionToUse.FlickerFreeWhenDisabled := True;
          TFlickerFreeTransition(TransitionToUse).Fake :=
            Assigned(AnimationDataToUse);
          if FShowTransition <> nil then
          begin
            // OnStart, OnEnd events are not fired because they are only related to the original transition
            TransitionToUse.OnAfterTransition  := FShowTransition.OnAfterTransition;
            TransitionToUse.OnBeforeTransition := FShowTransition.OnBeforeTransition;
          end;
        end;
      end;
      try
        if OwnerForm.Visible then
        begin
          Device := TTEVCLScreenTrDeviceHack(TTEVCLScreenTrDevice.Create);
          Device.LayerAlpha := LockData.Alpha;
          Device.LayerKey   := LockData.Key;
          Device.LayerFlags := LockData.Flags;
          try
            try
              Device.Transition := TransitionToUse;
            except
              Device.Free;
              Device := nil;
              raise;
            end;

            try
              if Assigned(TransitionToUse) then
                SaveNeverRendering := TransitionToUse.NeverRendering;

              if(OwnerForm.FormStyle = fsMDIChild) and MaximizedChildren
              then
              begin
                GetClientRect(Application.MainForm.ClientHandle, R);
                Device.ClientCoordinates := True;
              end
              else
              begin
                Device.ClientCoordinates := False;
                R := OwnerForm.BoundsRect;
              end;

              UsingLayerTransition := False;
              try
                if Assigned(TransitionToUse) then
                begin
                  TransitionToUse.NeverRendering := True;

                  TTEVCLScreenTrDeviceHack(Device).OpeningForm := True;
                  try
                    Device.Prepare(OwnerForm, R);
                  finally
                    TTEVCLScreenTrDeviceHack(Device).OpeningForm := False;
                  end;
                end;

                if LockData.UseRegion
                then DoUnlock
                else
                begin
                  TTEVCLScreenTrDeviceHack(Device).ClipRgn := LockData.Region;
                  UsingLayerTransition :=
                    Assigned(Device.DelegateTransition) and
                    Device.DelegateTransition.ClassNameIs('TLayeredBlendTransition');
                end;

                if Device.Prepared or (not LockData.UseRegion) then
                begin
                  if(AnimationDataToUse <> nil) and AnimationDataToUse.Animation.Enabled then
                  begin
                    TTEFormAnimationHack(AnimationDataToUse.Animation).ExecuteShowing(
                      not(TransitionToUse is TFlickerFreeTransition),
                      AnimationDataToUse, CanDestroyAnimationData);
                    if(not CanDestroyAnimationData) and (FAnimationData = nil) then
                      FAnimationData := AnimationDataToUse;
                  end;
                end;

                if not UsingLayerTransition then
                  DoUnlock;

                // Although the transition could be disabled, we want to fire
                // its OnBeforeTransition and OnAfterTransition events
                if Assigned(TransitionToUse) then
                begin
                  Device.Execute;

                  // Fixes a problem with VCLSkin
                  SendMessage(OwnerForm.Handle, WM_NCPAINT, 0, 0);
                end;
              finally
                if UsingLayerTransition then
                  DoUnlock;
                if Assigned(TransitionToUse) then
                  TransitionToUse.NeverRendering := SaveNeverRendering;
              end;
            finally
              Device.UnPrepare;
            end;
          finally
            Device.Free;
          end;
        end;
      finally
        if FShowTransition = nil then
          TransitionToUse.Free;
      end;
    finally
      if(AnimationDataToUse <> nil)            and
        (AnimationDataToUse <> FAnimationData) then
        AnimationDataToUse.Free;
      ShowEffectWaiting := False;
    end;
  end;

  procedure HideEffects(ExecuteTransition, ExecuteAnimation: Boolean);
  var
    AnimationDataToUse: TTEFormAnimationData;
  begin