animate.pas

灰鸽子1.23源码,,,,,,,

destructor TAnimatedImage.Destroy;
begin
  Destroying;
  FOnFrameChanged := nil;
  FOnStart := nil;
  FOnStop := nil;
  FGlyph.OnChange := nil;
  Active := False;
  FGlyph.Free;
  inherited Destroy;
end;

procedure TAnimatedImage.Loaded;
begin
  inherited Loaded;
  ResetImageBounds;
  UpdateInactive;
end;

function TAnimatedImage.GetPalette: HPALETTE;
begin
  Result := 0;
  if not FGlyph.Empty then Result := FGlyph.Palette;
end;

procedure TAnimatedImage.ImageChanged(Sender: TObject);
begin
  Lock;
  try
    FTransparentColor := FGlyph.TransparentColor and not PaletteMask;
  finally
    Unlock;
  end;
  DefineBitmapSize;
  PictureChanged;
end;

procedure TAnimatedImage.UpdateInactive;
begin
  if (not Active) and (FInactiveGlyph >= 0) and
    (FInactiveGlyph < FNumGlyphs) and (FGlyphNum <> FInactiveGlyph) then
  begin
    Lock;
    try
      FGlyphNum := FInactiveGlyph;
    finally
      Unlock;
    end;
  end;
end;

function TAnimatedImage.TransparentStored: Boolean;
begin
  Result := (FGlyph.Empty and (FTransparentColor <> clNone)) or
    ((FGlyph.TransparentColor and not PaletteMask) <>
    FTransparentColor);
end;

procedure TAnimatedImage.SetOpaque(Value: Boolean);
begin
  if Value <> FOpaque then begin
    Lock;
    try
      FOpaque := Value;
    finally
      Unlock;
    end;
    PictureChanged;
  end;
end;

procedure TAnimatedImage.SetTransparentColor(Value: TColor);
begin
  if Value <> TransparentColor then begin
    Lock;
    try
      FTransparentColor := Value;
    finally
      Unlock;
    end;
    PictureChanged;
  end;
end;

procedure TAnimatedImage.SetOrientation(Value: TGlyphOrientation);
begin
  if FOrientation <> Value then begin
    Lock;
    try
      FOrientation := Value;
    finally
      Unlock;
    end;
    ImageChanged(FGlyph);
  end;
end;

procedure TAnimatedImage.SetGlyph(Value: TBitmap);
begin
  Lock;
  try
    FGlyph.Assign(Value);
  finally
    Unlock;
  end;
end;

procedure TAnimatedImage.SetStretch(Value: Boolean);
begin
  if Value <> FStretch then begin
    Lock;
    try
      FStretch := Value;
    finally
      Unlock;
    end;
    PictureChanged;
    if Active then Repaint;
  end;
end;

procedure TAnimatedImage.SetCenter(Value: Boolean);
begin
  if Value <> FCenter then begin
    Lock;
    try
      FCenter := Value;
    finally
      Unlock;
    end;
    PictureChanged;
    if Active then Repaint;
  end;
end;

procedure TAnimatedImage.SetGlyphNum(Value: Integer);
begin
  if Value <> FGlyphNum then begin
    if (Value < FNumGlyphs) and (Value >= 0) then begin
      Lock;
      try
        FGlyphNum := Value;
      finally
        Unlock;
      end;
      UpdateInactive;
      FrameChanged;
      PictureChanged;
    end;
  end;
end;

procedure TAnimatedImage.SetInactiveGlyph(Value: Integer);
begin
  if Value < 0 then Value := -1;
  if Value <> FInactiveGlyph then begin
    if (Value < FNumGlyphs) or (csLoading in ComponentState) then begin
      Lock;
      try
        FInactiveGlyph := Value;
        UpdateInactive;
      finally
        Unlock;
      end;
      FrameChanged;
      PictureChanged;
    end;
  end;
end;

procedure TAnimatedImage.SetNumGlyphs(Value: Integer);
begin
  Lock;
  try
    FNumGlyphs := Value;
    if FInactiveGlyph >= FNumGlyphs then begin
      FInactiveGlyph := -1;
      FGlyphNum := 0;
    end
    else UpdateInactive;
    ResetImageBounds;
  finally
    Unlock;
  end;
  FrameChanged;
  PictureChanged;
end;

procedure TAnimatedImage.DefineBitmapSize;
begin
  Lock;
  try
    FNumGlyphs := 1;
    FGlyphNum := 0;
    FImageWidth := 0;
    FImageHeight := 0;
    if (FOrientation = goHorizontal) and (FGlyph.Height > 0) and
      (FGlyph.Width mod FGlyph.Height = 0) then
      FNumGlyphs := FGlyph.Width div FGlyph.Height
    else if (FOrientation = goVertical) and (FGlyph.Width > 0) and
      (FGlyph.Height mod FGlyph.Width = 0) then
      FNumGlyphs := FGlyph.Height div FGlyph.Width;
    ResetImageBounds;
  finally
    Unlock;
  end;
end;

procedure TAnimatedImage.ResetImageBounds;
begin
  if FNumGlyphs < 1 then FNumGlyphs := 1;
  if FOrientation = goHorizontal then begin
    FImageHeight := FGlyph.Height;
    FImageWidth := FGlyph.Width div FNumGlyphs;
  end
  else {if Orientation = goVertical then} begin
    FImageWidth := FGlyph.Width;
    FImageHeight := FGlyph.Height div FNumGlyphs;
  end;
end;

procedure TAnimatedImage.AdjustSize;
begin
  if not (csReading in ComponentState) then begin
    if AutoSize and (FImageWidth > 0) and (FImageHeight > 0) then
      SetBounds(Left, Top, FImageWidth, FImageHeight);
  end;
end;

procedure TAnimatedImage.DoPaintImage;
var
  BmpIndex: Integer;
  SrcRect, DstRect: TRect;
  {Origin: TPoint;}
begin
  if (not Active) and (FInactiveGlyph >= 0) and
    (FInactiveGlyph < FNumGlyphs) then BmpIndex := FInactiveGlyph
  else BmpIndex := FGlyphNum;
  { copy image from parent and back-level controls }
  if not FOpaque then CopyParentImage(Self, Canvas);
  if (FImageWidth > 0) and (FImageHeight > 0) then begin
    if Orientation = goHorizontal then
      SrcRect := Bounds(BmpIndex * FImageWidth, 0, FImageWidth, FImageHeight)
    else {if Orientation = goVertical then}
      SrcRect := Bounds(0, BmpIndex * FImageHeight, FImageWidth, FImageHeight);
    if Stretch then DstRect := ClientRect
    else if Center then
      DstRect := Bounds((ClientWidth - FImageWidth) div 2,
        (ClientHeight - FImageHeight) div 2, FImageWidth, FImageHeight)
    else
      DstRect := Rect(0, 0, FImageWidth, FImageHeight);
    with DstRect do
      StretchBitmapRectTransparent(Canvas, Left, Top, Right - Left,
        Bottom - Top, SrcRect, FGlyph, FTransparentColor);
  end;
end;

procedure TAnimatedImage.Paint;
begin
  PaintImage;
  if (not Opaque) or FGlyph.Empty then
    PaintDesignRect;
end;

procedure TAnimatedImage.TimerExpired(Sender: TObject);
begin
{$IFDEF RX_D3}
  if csPaintCopy in ControlState then Exit;
{$ENDIF}
  if Visible and (FNumGlyphs > 1) and (Parent <> nil) and
    Parent.HandleAllocated then
  begin
    Lock;
    try
      if FGlyphNum < FNumGlyphs - 1 then Inc(FGlyphNum)
      else FGlyphNum := 0;
      if (FGlyphNum = FInactiveGlyph) and (FNumGlyphs > 1) then begin
        if FGlyphNum < FNumGlyphs - 1 then Inc(FGlyphNum)
        else FGlyphNum := 0;
      end;
{$IFDEF RX_D3}
      Canvas.Lock;
      try
        FTimerRepaint := True;
        if AsyncDrawing and Assigned(FOnFrameChanged) then
          FTimer.Synchronize(FrameChanged)
        else FrameChanged;
        DoPaintControl;
      finally
        FTimerRepaint := False;
        Canvas.Unlock;
      end;
{$ELSE}
      FTimerRepaint := True;
      try
        FrameChanged;
        Repaint;
      finally
        FTimerRepaint := False;
      end;
{$ENDIF}
    finally
      Unlock;
    end;
  end;
end;

procedure TAnimatedImage.FrameChanged;
begin
  if Assigned(FOnFrameChanged) then FOnFrameChanged(Self);
end;

procedure TAnimatedImage.Stop;
begin
  if not (csReading in ComponentState) then
    if Assigned(FOnStop) then FOnStop(Self);
end;

procedure TAnimatedImage.Start;
begin
  if not (csReading in ComponentState) then
    if Assigned(FOnStart) then FOnStart(Self);
end;

{$IFNDEF RX_D4}
procedure TAnimatedImage.SetAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then begin
    FAutoSize := Value;
    PictureChanged;
  end;
end;
{$ENDIF}

{$IFDEF RX_D4}
function TAnimatedImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  if not (csDesigning in ComponentState) and (FImageWidth > 0) and
    (FImageHeight > 0) then
  begin
    if Align in [alNone, alLeft, alRight] then
      NewWidth := FImageWidth;
    if Align in [alNone, alTop, alBottom] then
      NewHeight := FImageHeight;
  end;
end;
{$ENDIF}

procedure TAnimatedImage.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

function TAnimatedImage.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TAnimatedImage.SetActive(Value: Boolean);
begin
  if FActive <> Value then begin
    if Value then begin
      FTimer.OnTimer := TimerExpired;
      FTimer.Enabled := True;
      FActive := FTimer.Enabled;
      Start;
    end
    else begin
      FTimer.Enabled := False;
      FTimer.OnTimer := nil;
      FActive := False;
      UpdateInactive;
      FrameChanged;
      Stop;
      PictureChanged;
    end;
  end;
end;

{$IFDEF RX_D3}
procedure TAnimatedImage.SetAsyncDrawing(Value: Boolean);
begin
  if FAsyncDrawing <> Value then begin
    Lock;
    try
      if Value then HookBitmap;
      if Assigned(FTimer) then FTimer.SyncEvent := not Value;
      FAsyncDrawing := Value;
    finally
      Unlock;
    end;
  end;
end;
{$ENDIF}

procedure TAnimatedImage.WMSize(var Message: TWMSize);
begin
  inherited;
{$IFNDEF RX_D4}
  AdjustSize;
{$ENDIF}
end;

end.