teform.pas

delphi2007界面效果控件源码

    if ExecuteTransition       and
      (FHideTransition <> nil) and
      (Device <> nil)          and
      Device.Prepared
    then
    begin
      try
        WindowProcBak(Message);
        try
          Device.Execute;
        finally
          if FHideTransReversed then
            FHideTransition.Reversed := not FHideTransition.Reversed;
        end;
      finally
        Device.UnPrepare;
        TTEVCLScreenTrDeviceHack(Device).ClosingForm := False;
      end;
    end
    else WindowProcBak(Message);

    if ExecuteAnimation then
    begin
      AnimationDataToUse := nil;
      if FAnimationData <> nil
      then AnimationDataToUse := FAnimationData
      else if(FHideAnimation <> nil) and FHideAnimation.Enabled and FHideAnimation.HidingEnabled then
        AnimationDataToUse := FHideAnimation.CreateAnimationData(OwnerForm);
      try
        if(AnimationDataToUse <> nil)                 and
           AnimationDataToUse.Animation.Enabled       and
           AnimationDataToUse.Animation.HidingEnabled then
        begin
          // Allow destop to repaint
          Application.ProcessMessages;
          Sleep(100);

          TTEFormAnimationHack(AnimationDataToUse.Animation).ExecuteHiding(
            AnimationDataToUse);
        end;
      finally
        if AnimationDataToUse <> nil then
          AnimationDataToUse.Free;
        FAnimationData := nil; // No more needed in any case
      end;
    end;
  end;

  function LayeredWindowsUnder(Window: HWND): Boolean;
  var
    R,
    R2,
    R3: TRect;
  begin
    Result := False;

    if Window = 0 then Exit;

    GetWindowRect(Window, R);

    // Check if covered by top level windows 'over' in the z-order
    while(Window <> 0) and not Result do
    begin
      Window := GetWindow(Window, GW_HWNDNEXT);
      if(Window <> 0)           and
        IsWindowVisible(Window) and
        (not IsIconic(Window))  and
        IsWindowLayered(Window) then
      begin
        GetWindowRect(Window, R2);
        Result := IntersectRect(R3, R, R2);
      end;
    end;
  end;

  procedure PrepareHidingTransition;
  begin
    if(not(csDesigning in Componentstate))                                        and
      (FHideTransition <> nil)                                                    and
      (not TTEVCLScreenTrDeviceHack.TransitionIsDisabled(FHideTransition, False)) and
      ((TWMWindowPosMsg(Message).WindowPos.Flags and SWP_HIDEWINDOW) <> 0)        and
      (TEWinVersion >= teWin2000)                                                 and
      (
        (not IsWindowLayered(OwnerForm.Handle)) or
        IsCompositionEnabled
      )                                                                            then
    begin
      Device := TTEVCLScreenTrDeviceHack(TTEVCLScreenTrDevice.Create);
      try
        with TTEVCLScreenTrDeviceHack(Device) do
        begin
          LayerAlpha := LockData.Alpha;
          LayerKey   := LockData.Key;
          LayerFlags := LockData.Flags;
          Transition := FHideTransition;
        end;
        if FHideTransReversed then
          FHideTransition.Reversed := not FHideTransition.Reversed;
      except
        Device.Free;
        Device := nil;
        raise;
      end;
      TTEVCLScreenTrDeviceHack(Device).ClosingForm := True;
      Device.ClientCoordinates := False;

      if IsCompositionEnabled
      then
      begin
        if IsWindowLayered(OwnerForm.Handle)
        then
        begin
          GetLayeredWindowAttributes(OwnerForm.Handle, LockData.Key,
            LockData.Alpha, LockData.Flags);
          if(LockData.Flags and LWA_ALPHA) = 0 then
            LockData.Alpha := 255;
        end
        else
        begin
          LockData.Key   := 0;
          LockData.Alpha := 255;
          LockData.Flags := 0;
          SetWindowLong(OwnerForm.Handle, GWL_EXSTYLE,
            GetWindowLong(OwnerForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
          OwnerForm.Update;
        end;

        teRender.SetLayeredWindowAttributes(OwnerForm.Handle, LockData.Key,
          LockData.Alpha, LockData.Flags or LWA_ALPHA);
        Device.Prepare(OwnerForm, OwnerForm.BoundsRect);
        HideEffects(True, False);
      end
      else Device.Prepare(OwnerForm, OwnerForm.BoundsRect);
    end;
  end;

var
  R: TRect;
  Rgn: HRGN;
  DC: HDC;
  PS: TPaintStruct;
  WasVisibleBak: Boolean;
begin
  case Message.Msg of
    WM_WINDOWPOSCHANGING:
    begin
      if Enabled and (Device = nil) and (not IsMinimizing) then
        PrepareHidingTransition;
      WindowProcBak(Message);
    end;
    WM_WINDOWPOSCHANGED:
    begin
      if((TWMWindowPosMsg(Message).WindowPos.Flags and SWP_HIDEWINDOW) <> 0) and
         Enabled                                                             and
        (not(csDesigning in ComponentState))
      then
      begin
        if not IsMinimizing
        then HideEffects(Assigned(Device), True)
        else IsMinimizing := False;
      end
      else WindowProcBak(Message);
      WasVisible := OwnerForm.Visible;
    end;
    CM_SHOWINGCHANGED:
    begin
      WasVisibleBak := WasVisible;
      if not WasVisible then
        BackgroundOptions.Control := OwnerForm;

      if(not(csDesigning in Componentstate)) and
         Enabled                             and
         CanEnable                           and
        (not NestedFormTransition)           and
        (not WasVisible)                     and
        (not TEVclScrPrepared)
      then
      begin
        PrepareShowingEffects;
        if not ShowEffectWaiting then
        begin
          ShowEffects;
          PostMessage(OwnerForm.Handle, CM_BEFORMSHOWN, 0, BE_ID);
        end;
      end
      else
      begin
        WindowProcBak(Message);
        if(not(csDesigning in Componentstate)) and
          (not WasVisibleBak)                  then
        begin
          if Assigned(ShowTransition) then
          begin
            if Assigned(ShowTransition.OnBeforeTransition) then
              ShowTransition.OnBeforeTransition(Self);
            if Assigned(ShowTransition.OnAfterTransition) then
              ShowTransition.OnAfterTransition(Self);
          end;

          PostMessage(OwnerForm.Handle, CM_BEFORMSHOWN, 0, BE_ID);
        end;
      end;
    end;

    CM_BEFORMSHOWN:
    begin
      if Message.LParam = BE_ID
      then
      begin
        if Assigned(FOnAfterShow) then
          FOnAfterShow(Self, FirstTimeShowed);
        FirstTimeShowed := False;
      end;
    end;

    CM_BERUN:
    begin
      // If message comes from Billenium Effects
      if Message.LParam = BE_ID
      then
      begin
        if ShowEffectWaiting then
        begin
          ShowEffects;
          PostMessage(OwnerForm.Handle, CM_BEFORMSHOWN, 0, BE_ID);
        end;
      end
      else WindowProcBak(Message);
    end;

    CM_BEWAIT:
    begin
      // If message goes to Billenium Effects
      if Message.WParam = BE_ID
      then
      begin
        if(not(csDesigning in Componentstate)) and
           Enabled                             and
           CanEnable
        then Message.Result := BE_ID // Hi, Billenium Effects here
        else WindowProcBak(Message);
      end
      else WindowProcBak(Message);
    end;

    CM_PARENTFONTCHANGED:
    begin
      WindowProcBak(Message);
      BackgroundOptions.Control := OwnerForm;
    end;

    CM_TEGETBKGNDOPTIONS:
      Message.Result := Longint(BackgroundOptions);

    WM_ERASEBKGND:
    begin
      if MDIClientLocked then
      begin
        Message.Result := 1;
        exit;
      end;
      if(OwnerForm.FormStyle <> fsMDIForm) and BackgroundOptions.IsActive
      then
      begin
        {$ifdef D7UP}
        if BEParentBackgroundPainted(OwnerForm.Handle) then
          BackgroundOptions.DrawBackGround(TWmEraseBkgnd(Message).DC, nil,
            Rect(0, 0, 0, 0));
        {$endif D7UP}
        Message.Result := 1;
      end
      else WindowProcBak(Message);
    end;

    WM_PAINT:
    begin
      if(OwnerForm.FormStyle <> fsMDIForm) and BackgroundOptions.IsActive
      then
      begin
        DC := TWMPaint(Message).DC;
        if DC = 0
        then
        begin
          DC := BeginPaint((Owner as TWinControl).Handle, PS);
          try
            if IsRectEmpty(PS.rcPaint) then
              PS.rcPaint := (Owner as TWinControl).ClientRect;

            BackgroundOptions.DrawBackGround(DC, nil, PS.rcPaint);
            if not(csDesigning in OwnerForm.ComponentState) then
              OwnerForm.Paint;
            TTEWinControl(Owner).PaintControls(DC, nil);
          finally
            if TWMPaint(Message).DC = 0 then
              EndPaint((Owner as TWinControl).Handle, PS);
          end;
        end
        else
        begin
          Rgn := CreateRectRgn(0, 0, 0, 0);
          GetClipRgn(DC, Rgn);
          GetRgnBox(Rgn, R);
          DeleteObject(Rgn);
          DPToLP(DC, R, 2);

          BackgroundOptions.DrawBackGround(DC, nil, R);
          if not(csDesigning in OwnerForm.ComponentState) then
            OwnerForm.Paint;
          TTEWinControl(Owner).PaintControls(DC, nil);
        end;
      end
      else WindowProcBak(Message);
    end;

    WM_MOVE:
    begin
      WindowProcBak(Message);
      if(not(csDestroying in ComponentState)) and
        BackgroundOptions.IsActive            and
        (BackgroundOptions.ParentPicture      or
         BackgroundOptions.ParentBkgrndForm   or
         not BackgroundOptions.Opaque) then
        BackgroundOptions.ControlChanged(Self);
    end;

    WM_SIZE,
    WM_VSCROLL,
    WM_HSCROLL:
    begin
      WindowProcBak(Message);
      if(not(csDestroying in ComponentState)) and
        BackgroundOptions.IsActive then
        BackgroundOptions.ControlChanged(Self);
    end;

    else WindowProcBak(Message);
  end;
{if ShowEffectWaiting and IsWindowVisible(OwnerForm.Handle) then
begin
  ShowEffectWaiting := False;
  ShowEffects;
end;}
end;

function TFormTransitions.GetPalette: HPalette;
begin
  Result := BackgroundOptions.GetPalette;
end;

procedure TFormTransitions.SetBackgroundOptions(
  Value: TFCBackgroundOptions);
begin
  BackgroundOptions.Assign(Value);
end;

procedure TFormTransitions.PrepareAnimation(
  AnAnimationData: TTEFormAnimationData);
begin
  FAnimationData.Free;
  FAnimationData := AnAnimationData;
end;

procedure TFormTransitions.SetHideAnimation(
  const Value: TTEFormAnimation);
begin
  if Value <> FHideAnimation then
  begin
    if DestroyTransitions                   and
      (not (csDesigning in ComponentState)) and
       Assigned(FHideAnimation)             then
      FHideAnimation.Free;

    FHideAnimation := Value;

    if Assigned(FHideAnimation) and
       Assigned(FHideAnimation.AnimationList) then
      DestroyTransitions := False;
  end;
end;

procedure TFormTransitions.SetHideTransition(
  const Value: TTransitionEffect);
begin
  if Value <> FHideTransition then
  begin
    if DestroyTransitions                   and
      (not (csDesigning in ComponentState)) and
       Assigned(FHideTransition)            then
      FHideTransition.Free;

    FHideTransition := Value;

    if Assigned(FHideTransition) and
       Assigned(FHideTransition.TransitionList) then
      DestroyTransitions := False;
  end;
end;

procedure TFormTransitions.SetShowAnimation(
  const Value: TTEFormAnimation);
begin
  if Value <> FShowAnimation then
  begin
    if DestroyTransitions                   and
      (not (csDesigning in ComponentState)) and
       Assigned(FShowAnimation)             then
      FShowAnimation.Free;

    FShowAnimation := Value;

    if Assigned(FShowAnimation) and
       Assigned(FShowAnimation.AnimationList) then
      DestroyTransitions := False;
  end;
end;

procedure TFormTransitions.SetShowTransition(const Value: TTransitionEffect);
begin
  if Value <> FShowTransition then
  begin
    if DestroyTransitions                   and
      (not (csDesigning in ComponentState)) and
       Assigned(FShowTransition)            then
      FShowTransition.Free;

    FShowTransition := Value;

    if Assigned(FShowTransition) and
       Assigned(FShowTransition.TransitionList) then
      DestroyTransitions := False;
  end;
end;

initialization
  TENoFormTransitionsInAero := False;
end.