cdibanimcontainer.pas

Delphi控件

  Owner := AOwner;
end;

destructor TDIBSnapShotControls.Destroy;
begin
  inherited;
end;

function TDIBSnapShotControls.GetItem(Index: Integer): TDIBSnapShotControl;
begin
  Result := TDIBSnapShotControl(inherited GetItem(Index));
end;

function TDIBSnapShotControls.Insert(Index: Integer): TDIBSnapShotControl;
begin
  Result := TDIBSnapShotControl(inherited Insert(Index));
end;

procedure TDIBSnapShotControls.SetItem(Index: Integer; const Value: TDIBSnapShotControl);
begin
  inherited SetItem(Index, Value);
end;

{ TDIBContainerSnapShot }

procedure TDIBContainerSnapShot.AssignTo(Dest: TPersistent);
begin
  if Dest is TDIBContainerSnapShot then with TDIBContainerSnapShot(Dest) do
      Controls.Assign(Self.Controls)
  else
    inherited;
end;

constructor TDIBContainerSnapShot.Create(Collection: TCollection);
begin
  inherited;
  if Collection <> nil then
    Owner := TDIBContainerSnapShots(Collection).Owner;
  FControls := TDIBSnapShotControls.Create(Owner);
  FDisplayName := 'Snapshot #' + IntToStr(ID);
end;

destructor TDIBContainerSnapShot.Destroy;
begin
  FControls.Free;
  inherited;
end;

function TDIBContainerSnapShot.FindControl(Control: TControl): TDIBSnapShotControl;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Controls.Count - 1 do
    if Controls[I].Control = Control then
    begin
      Result := Controls[I];
      Break;
    end;
end;

function TDIBContainerSnapShot.GetDisplayName: string;
begin
  Result := FDisplayName;
end;

procedure TDIBContainerSnapShot.MakeSnapShot;
var
  I: Integer;
begin
  if Owner = nil then Exit;
  Controls.Clear;
  if Owner is TControl then with Controls.Add do
    begin
      Control := TControl(Owner);
      Properties.MakeSnapShot(Control);
    end;

  with TWinControl(Owner) do
    for I := 0 to ControlCount - 1 do
      with Self.Controls.Add do
      begin
        Control := TWinControl(Owner).Controls[I];
        MakeSnapShot;
      end;
end;

procedure TDIBContainerSnapShot.MorphTo(Dest: TDIBContainerSnapShot; Position: Byte;
  PausedControls: TList);
var
  I: Integer;
  DestControl: TDIBSnapShotControl;
begin
  for I := 0 to Controls.Count - 1 do
  begin
    if (PausedControls = nil) or (PausedControls.IndexOf(Controls[I].Control) = -1) then
    begin
      DestControl := Dest.FindControl(Controls[I].Control);
      if DestControl <> nil then Controls[I].MorphTo(DestControl, Position);
    end;
  end;
end;

procedure TDIBContainerSnapShot.Notification(AComponent: TComponent);
var
  I: Integer;
begin
  for I := Controls.Count - 1 downto 0 do
    if Controls[I].Control = AComponent then
      Controls[I].Free;

  if Controls.Count = 0 then Free;
end;

procedure TDIBContainerSnapShot.SetControls(const Value: TDIBSnapShotControls);
begin
  FControls.Assign(Value);
end;

{ TDIBContainerSnapShots }

function TDIBContainerSnapShots.Add: TDIBContainerSnapShot;
begin
  Result := TDIBContainerSnapShot(inherited Add);
  //  Result.MakeSnapShot;
end;

constructor TDIBContainerSnapShots.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TDIBContainerSnapShot);
  Owner := AOwner;
end;

destructor TDIBContainerSnapShots.Destroy;
begin
  inherited;
end;

function TDIBContainerSnapShots.GetItem(Index: Integer): TDIBContainerSnapShot;
begin
  Result := TDIBContainerSnapShot(inherited GetItem(Index));
end;

function TDIBContainerSnapShots.Insert(Index: Integer): TDIBContainerSnapShot;
begin
  Result := TDIBContainerSnapShot(inherited Insert(Index));
end;


procedure TDIBContainerSnapShots.SetItem(Index: Integer;
  const Value: TDIBContainerSnapShot);
begin
  inherited SetItem(Index, Value);
end;

{ TCustomDIBAnimContainer }

procedure TCustomDIBAnimContainer.AnimateToSnapShot(Index: Integer;
  MilliSeconds: Cardinal);
var
  Interval: Integer;
begin
  if (FTimer.Enabled) then Stop;

  if Assigned(OnAnimStart) then OnAnimStart(Self);

  FEndSnapShot := SnapShots[Index];

  FTempSnapShots.Clear;
  FTempSnapShots.Add;
  FTempSnapShots[0].MakeSnapShot;

  FCurrentPosition := 0;
  FPositionInc := 1;
  Interval := Milliseconds div 255;
  if Interval < cMaxAnimSpeed then
  begin
    Interval := cMaxAnimSpeed;
    FPositionInc := cMaxAnimSpeed / (Milliseconds / 255);
  end;
  FTimer.Interval := Interval;
  FTimer.Enabled := True;
end;

procedure TCustomDIBAnimContainer.AssignTo(Dest: TPersistent);
begin
  if Dest is TCustomDIBAnimContainer then with TCustomDIBAnimContainer(Dest) do
      SnapShots.Assign(Self.SnapShots);
  inherited;
end;

constructor TCustomDIBAnimContainer.Create(AOwner: TComponent);
begin
  inherited;
  FSnapShots := TDIBContainerSnapShots.Create(Self);
  FTempSnapShots := TDIBContainerSnapShots.Create(Self);
  FTimer := TDIBTimer.Create(Self);
  FPausedControls := TList.Create;
  FTimer.OnTimer := DoAnimateSnapShot;
end;

destructor TCustomDIBAnimContainer.Destroy;
begin
  FTimer.Free;
  FPausedControls.Free;
  FTempSnapShots.Free;
  FSnapShots.Free;
  inherited;
end;

procedure TCustomDIBAnimContainer.DoAnimateSnapShot(Sender: TObject);
begin
  FCurrentPosition := FCurrentPosition + FPositionInc;
  if Trunc(FCurrentPosition) > 255 then FCurrentPosition := 255;
  if Assigned(OnFrame) then OnFrame(Self, Trunc(FCurrentPosition));
  FTempSnapShots[0].MorphTo(FEndSnapShot, Trunc(FCurrentPosition), FPausedControls);
  if FCurrentPosition = 255 then Stop;
end;

function TCustomDIBAnimContainer.GetIsAnimating: Boolean;
begin
  Result := FTimer.Enabled;
end;

procedure TCustomDIBAnimContainer.GoToSnapShot(Index: Integer);
begin
  SnapShots[Index].MorphTo(SnapShots[Index], 255, nil);
end;

procedure TCustomDIBAnimContainer.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  inherited;
  if (Operation = opRemove) and (AComponent is TControl) then
    for I := SnapShots.Count - 1 downto 0 do
    begin
      SnapShots[I].Notification(AComponent);
    end;
end;

procedure TCustomDIBAnimContainer.PauseControl(Control: TControl);
begin
  if PausedControls.IndexOf(Control) = -1 then PausedControls.Add(Control);
end;

procedure TCustomDIBAnimContainer.SetSnapShots(const Value: TDIBContainerSnapShots);
begin
  FSnapShots.Assign(Value);
end;

procedure TCustomDIBAnimContainer.Stop;
begin
  FTimer.Enabled := False;
  if Assigned(OnAnimEnd) then OnAnimEnd(Self);
end;

procedure TCustomDIBAnimContainer.UnpauseControl(Control: TControl);
var
  I: Integer;
  TempControl: TDIBSnapShotControl;
begin
  I := FPausedControls.IndexOf(Control);
  if I >= 0 then
  begin
    FPausedControls.Delete(I);
    TempControl := FTempSnapShots[0].FindControl(Control);
    if TempControl <> nil then TempControl.MakeSnapShot;
  end;
end;

{ TCustomDIBImageAnimContainer }

constructor TCustomDIBImageAnimContainer.Create(AOwner: TComponent);
begin
  inherited;
  FIndexImage := TDIBImageLink.Create(Self);
  FIndexImage.OnImageChanged := DoImageChanged;
end;

destructor TCustomDIBImageAnimContainer.Destroy;
begin
  FIndexImage.Free;
  inherited;
end;

procedure TCustomDIBImageAnimContainer.Paint;
var
  X, Y: Integer;
  R: TRect;
  TheDIB: TMemoryDIB;
begin
  if not FIndexImage.GetImage(TheDIB) then 
  begin
    inherited;
    exit;
  end;

  if TileMethod <> tmTile then
    if (TheDIB.Width <> Width) or (TheDIB.Height <> Height) then
      inherited;

  if TheDIB.Height > 0 then 
  begin
    case TileMethod of
      tmCenter:
        begin
          TheDIB.Draw(Width div 2 - (TheDIB.Width div 2),
            Height div 2 - (TheDIB.Height div 2),
            TheDIB.Width, TheDIB.Height, DIB, 0, 0);
        end;
      tmTile:
        begin
          Y := 0;
          while Y < Height do 
          begin
            X := 0;
            while X < Width do 
            begin
              if IntersectRect(R, UpdateRect,
                Rect(X, Y, X + TheDIB.Width, Y + TheDIB.Height)) then
                TheDIB.Draw(X, Y, TheDIB.Width, TheDIB.Height, DIB, 0, 0);
              Inc(X, TheDIB.Width);
            end;
            Inc(Y, TheDIB.Height);
          end;
        end;
    end;
  end;
end;

procedure TCustomDIBImageAnimContainer.SetTileMethod(const Value: TTileMethod);
begin
  FTileMethod := Value;
  invalidate;
end;

procedure TCustomDIBImageAnimContainer.WndProc(var Message: TMessage);
begin
  if (csDestroying in ComponentState) or
    (TileMethod <> tmTile) or
    (Message.msg <> WM_EraseBkGnd) then
    inherited;
end;

procedure TCustomDIBImageAnimContainer.ImageChanged(ID: Integer;
  Operation: TDIBOperation);
begin
  case Operation of
    doRemove:
      if ID = IndexImage.DIBIndex then
        IndexImage.DIBIndex := -1
      else
        if ID < IndexImage.DIBIndex then
          IndexImage.DIBIndex := IndexImage.DIBIndex - 1;
      doChange: if ID = IndexImage.DIBIndex then Invalidate;
  end;
end;

function TCustomDIBImageAnimContainer.GetDIBImageList: TCustomDIBImageList;
begin
  Result := FIndexImage.DIBImageList;
end;

procedure TCustomDIBImageAnimContainer.SetDIBImageList(const Value: TCustomDIBImageList);
begin
  FIndexImage.DIBImageList := Value;
end;

procedure TCustomDIBImageAnimContainer.DoImageChanged(Sender: TObject;
  ID: Integer; Operation: TDIBOperation);
begin
  ImageChanged(ID, Operation);
end;



initialization
  DIBPropertyMap := TDIBPropertyMap.Create;
  AddPropertyMorpher(TypeInfo(Byte), @MorphInteger, '');
  AddPropertyMorpher(TypeInfo(Char), @MorphInteger, '');
  AddPropertyMorpher(TypeInfo(Integer), @MorphInteger, '');
  AddPropertyMorpher(TypeInfo(Extended), @MorphAngle, '');
  AddPropertyMorpher(TypeInfo(TColor), @MorphColor, '');
  AddPropertyMorpher(TypeInfo(Extended), @MorphExtended, '');
  AddPropertyMorpher(TypeInfo(Real), @MorphExtended, '');

finalization
  DIBPropertyMap.Free;
end.