dxfading.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 644 行 · 第 1/2 页

  if State = fsFadeIn then
    AInterval := FadeInAnimationFrameDelay
  else
    AInterval := FadeOutAnimationFrameDelay;
  FFadingDelayCount := Max(AInterval div dxMinFadingInterval, 1);
  FFadingDelayIndex := 0;
end;

procedure TdxFadingElement.DoFade;
begin
  FFadingDelayIndex := (FFadingDelayIndex + 1) mod FadingDelayCount;
  if FFadingDelayIndex = 0 then
  begin
    if Stage >= AnimationFrameCount then
      Finalize
    else
    begin
      Inc(FStage);
      FadingWorkImage := FFadeOutImage.MakeComposition(FFadeInImage, GetStageAlpha);
    end;
  end;
end;

procedure TdxFadingElement.ValidateStageParams;
begin
  if FFadeInAnimationFrameCount <= 0 then
    FFadeInAnimationFrameCount := dxFadeInDefaultAnimationFrameCount
  else
    FFadeInAnimationFrameCount := Min(FFadeInAnimationFrameCount, dxMaxAnimationFrameCount);
    
  if FFadeOutAnimationFrameCount <= 0 then
    FFadeOutAnimationFrameCount := dxFadeOutDefaultAnimationFrameCount
  else
    FFadeOutAnimationFrameCount := Min(FFadeOutAnimationFrameCount, dxMaxAnimationFrameCount);

  if FFadeInAnimationFrameDelay < dxMinFadingInterval then
    FFadeInAnimationFrameDelay := dxFadeInDefaultAnimationFrameDelay
  else
    FFadeInAnimationFrameDelay := Min(FFadeInAnimationFrameDelay, dxMaxAnimationFrameDelay);

  if FFadeOutAnimationFrameDelay < dxMinFadingInterval then
    FFadeOutAnimationFrameDelay := dxFadeOutDefaultAnimationFrameDelay
  else
    FFadeOutAnimationFrameDelay := Min(dxMaxAnimationFrameDelay, FFadeOutAnimationFrameDelay);

  CalculateIntervals;
end;

function TdxFadingElement.GetAnimationFrameCount: Integer;
begin
  if State = fsFadeIn then
    Result := FadeInAnimationFrameCount
  else
    Result := FadeOutAnimationFrameCount;
end;

procedure TdxFadingElement.SetFadingWorkImage(AImage: TdxGPImage);
var
  ATemp: TdxGPImage;
begin
  ATemp := FFadingWorkImage;
  try
    FFadingWorkImage := AImage;
    if AImage <> nil then
      FFadingObject.DrawFadeImage;
  finally
    ATemp.Free;
  end;
end;

procedure TdxFadingElement.SetState(const Value: TdxFadingState);
begin
  if FState <> Value then
  begin
    FStage := GetInvertedStage;
    FState := Value;
    CalculateIntervals;
  end;
end;

function TdxFadingElement.DrawImage(DC: HDC; const R: TRect): Boolean;
begin
  Result := Assigned(FadingWorkImage);
  if Result then
    FadingWorkImage.Draw(DC, R);
end;

function TdxFadingElement.GetFadeWorkImage(out AImage: TdxGPImage): Boolean;
begin
  AImage := FadingWorkImage;
  Result := AImage <> nil;
end;

{ TdxFadingList }

procedure TdxFadingList.Clear;
begin
  while Count > 0 do
    Items[0].Free;
  inherited Clear;
end;

function TdxFadingList.GetItems(Index: Integer): TdxFadingElement;
begin
  Result := TdxFadingElement(inherited Items[Index]);
end;

{ TdxFader }

constructor TdxFader.Create;
begin
  inherited Create;
  FState := fasDefault;
  FList := TdxFadingList.Create;
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.Interval := dxMinFadingInterval;
  FTimer.OnTimer := DoTimer;
  FMaxAnimationCount := 10;
end;

destructor TdxFader.Destroy;
begin
  Clear;
  FreeAndNil(FTimer);
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure TdxFader.Clear;
begin
  FList.Clear;
end;

function TdxFader.Contains(AObject: TObject): Boolean;
var
  AFadingElement: TdxFadingElement;
begin
  Result := Find(AObject, AFadingElement);
end;

procedure TdxFader.FadeIn(AObject: TObject);
begin
  DoFade(AObject, fsFadeIn);
end;

procedure TdxFader.FadeOut(AObject: TObject);
begin
  DoFade(AObject, fsFadeOut);
end;

procedure TdxFader.AddFadingElement(AObject: TObject; AState: TdxFadingState);
var
  AFadeInAnimationFrameCount: Integer;
  AFadeInAnimationFrameDelay: Integer;
  AFadeOutAnimationFrameCount: Integer;
  AFadeOutAnimationFrameDelay: Integer;
  AFadingObject: IdxFadingObject;
  ATemp1, ATemp2: TcxBitmap;
begin
  ATemp1 := nil;
  ATemp2 := nil;
  Supports(AObject, IdxFadingObject, AFadingObject);
  AFadeInAnimationFrameCount := dxFadeInDefaultAnimationFrameCount;
  AFadeInAnimationFrameDelay := dxFadeInDefaultAnimationFrameDelay;
  AFadeOutAnimationFrameCount := dxFadeOutDefaultAnimationFrameCount;
  AFadeOutAnimationFrameDelay := dxFadeOutDefaultAnimationFrameDelay;
  AFadingObject.GetFadingParams(ATemp1, ATemp2, AFadeInAnimationFrameCount,
    AFadeInAnimationFrameDelay, AFadeOutAnimationFrameCount, AFadeOutAnimationFrameDelay);
  try
    if (ATemp1 <> nil) and (ATemp2 <> nil) and not (ATemp1.Empty or ATemp2.Empty) then
    begin
      FList.Add(TdxFadingElement.Create(Self, AObject, AState, ATemp1, ATemp2,
        AFadeInAnimationFrameCount, AFadeInAnimationFrameDelay, AFadeOutAnimationFrameCount,
        AFadeOutAnimationFrameDelay));
      ValidateQueue;
    end;
  finally
    ATemp1.Free;
    ATemp2.Free;
  end;
end;

procedure TdxFader.DoFade(AObject: TObject; AState: TdxFadingState);
var
  AElement: TdxFadingElement;
  AIntf: IdxFadingObject;
begin
  if IsReady and Supports(AObject, IdxFadingObject, AIntf) and AIntf.CanFade then
  begin
    if Find(AObject, AElement) then
      AElement.State := AState
    else
      AddFadingElement(AObject, AState);
  end;
end;

procedure TdxFader.DoTimer(Sender: TObject);
var
  I: Integer;
begin
  for I := FList.Count - 1 downto 0 do
    FList.Items[I].DoFade;
end;

function TdxFader.GetSystemAnimationState: Boolean;
begin
  SystemParametersInfo(SPI_GETMENUANIMATION, 0, @Result, 0);
end;

procedure TdxFader.RemoveFadingElement(AElement: TdxFadingElement);
begin
  FList.Remove(AElement);
  ValidateQueue;
end;

function TdxFader.Find(AObject: TObject; out AFadingElement: TdxFadingElement): Boolean;
var
  I: Integer;
begin
  AFadingElement := nil;
  for I := 0 to FList.Count - 1 do
    if FList[I].Element = AObject then
    begin
      AFadingElement := FList[I];
      Break;
    end;
  Result := AFadingElement <> nil;
end;

procedure TdxFader.Remove(AObject: TObject; ADestroying: Boolean = True);
var
  AElement: TdxFadingElement;
begin
  if Find(AObject, AElement) then
  begin
    if ADestroying then
      AElement.Free
    else
      AElement.Finalize;
  end;
end;

function TdxFader.GetActive: Boolean;
begin
  if State = fasDefault then
    Result := GetSystemAnimationState
  else
    Result := State = fasEnabled;
end;

function TdxFader.GetIsReady: Boolean;
begin
  Result := Active and CheckGdiPlus and
    (GetDeviceCaps(cxScreenCanvas.Handle, BITSPIXEL) > 16);
end;

procedure TdxFader.SetMaxAnimationCount(Value: Integer);
begin
  Value := Min(Max(0, Value), dxMaxAnimationCount);
  if FMaxAnimationCount <> Value then
  begin
    FMaxAnimationCount := Value;
    ValidateQueue;
  end;
end;

procedure TdxFader.ValidateQueue;
begin
  while FList.Count > MaxAnimationCount do
    FList[0].Finalize;
  FTimer.Enabled := FList.Count > 0;  
end;

{ TdxFadingObjectHelper }

function TdxFadingObjectHelper.GetIsEmpty: Boolean;
begin
  Result := FFadingElementData = nil;
end;

function TdxFadingObjectHelper.CanFade: Boolean;
begin
  Result := False;
end;

procedure TdxFadingObjectHelper.DrawFadeImage;
begin
end;

procedure TdxFadingObjectHelper.FadingBegin(AData: IdxFadingElementData);
begin
  FFadingElementData := AData;
end;

procedure TdxFadingObjectHelper.FadingEnd;
begin
  FFadingElementData := nil;
end;

procedure TdxFadingObjectHelper.GetFadingParams(out AFadeOutImage: TcxBitmap;
  out AFadeInImage: TcxBitmap; var AFadeInAnimationFrameCount: Integer;
  var AFadeInAnimationFrameDelay: Integer; var AFadeOutAnimationFrameCount: Integer;
  var AFadeOutAnimationFrameDelay: Integer);
begin
end;

procedure TdxFadingObjectHelper.DrawImage(DC: HDC; const R: TRect);
begin
  if FFadingElementData <> nil then
    FFadingElementData.DrawImage(DC, R);
end;

initialization
  Fader := TdxFader.Create;

finalization
  FreeAndNil(Fader);

end.