求ani格式说明与读取各帧的方法(50分)

如题

ani是什么动动。

读一下RxLIB2.5中的Anifile.pas和Animate.pas的原码,
一切都明白了。

Ani是Animate Icon文件, 每一帧都是一个Icon

能把那两个pas mail给我吗？我没有rxlib也不想要全部的rxlib

那能读ani文件吗？

你是要使用动画光标还是要制作动画光标?

如果只是使用, 可以用下面的例子:
const crMyCursor = 5;
procedure TForm1.FormCreate(Sender: TObject);
begin

Screen.Cursors[crMyCursor] := LoadCursorFromFile('C:/Windows/Cursors/Globe.Ani');
Cursor := crMyCursor;
end;


如果想做一个AniEditor的话,挺麻烦, 请参考: MSDN中的AniFile.c和AniEdit.c

{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1997, 1998 Master-Bank }
{ }
{*******************************************************}

unit AniFile;

{$I RX.INC}

interface

uses SysUtils, {$IFDEF WIN32} Windows, {$else
} WinTypes, WinProcs, {$ENDIF}
Classes, Graphics;

type
TFourCC = array[0..3] of Char;

PAniTag = ^TAniTag;
TAniTag = packed record
ckID: TFourCC;
ckSize: Longint;
end;


TAniHeader = packed record
cbSizeOf: Longint;
cSteps: Longint;
cFrames: Longint;
cReserved: array[0..3] of Longint;
jifRate: Longint;
{ 1 Jiffy = 1/60 sec }
fl: Longint;
end;


const
AF_ICON = $00000001;
AF_SEQUENCE = $00000002;

{ TIconFrame }

type
TIconFrame = class(TPersistent)
private
FIcon: TIcon;
FIsIcon: Boolean;
FTag: TAniTag;
FHotSpot: TPoint;
FJiffRate: Longint;
FSeq: Integer;
public
constructor Create(Index: Integer;
Jiff: Longint);
destructor Destroy;
override;
procedure Assign(Source: TPersistent);
override;
property JiffRate: Longint read FJiffRate;
property Seq: Integer read FSeq;
end;


{ TAnimatedCursorImage }

TANINAME = array[0..255] of Char;

TAnimatedCursorImage = class(TPersistent)
private
FHeader: TAniHeader;
FTitle: TANINAME;
FCreator: TANINAME;
FIcons: TList;
FOriginalColors: Word;
procedure NewImage;
procedure RiffReadError;
function ReadCreateIcon(Stream: TStream;
ASize: Longint;
var HotSpot: TPoint;
var IsIcon: Boolean): TIcon;
function GetIconCount: Integer;
function GetIcon(Index: Integer): TIcon;
function GetFrame(Index: Integer): TIconFrame;
function GetTitle: string;
function GetCreator: string;
function GetDefaultRate: Longint;
procedure ReadAniStream(Stream: TStream);
procedure ReadStream(Size: Longint;
Stream: TStream);
procedure WriteStream(Stream: TStream;
WriteSize: Boolean);
protected
procedure AssignTo(Dest: TPersistent);
override;
procedure Draw(ACanvas: TCanvas;
const ARect: TRect);
public
constructor Create;
destructor Destroy;
override;
procedure Assign(Source: TPersistent);
override;
procedure Clear;
procedure LoadFromStream(Stream: TStream);
virtual;
procedure SaveToStream(Stream: TStream);
virtual;
procedure LoadFromFile(const Filename: string);
virtual;
procedure AssignToBitmap(Bitmap: TBitmap;
BackColor: TColor;
DecreaseColors, Vertical: Boolean);
property DefaultRate: Longint read GetDefaultRate;
property IconCount: Integer read GetIconCount;
property Icons[Index: Integer]: TIcon read GetIcon;
property Frames[Index: Integer]: TIconFrame read GetFrame;
property Title: string read GetTitle;
property Creator: string read GetCreator;
property OriginalColors: Word read FOriginalColors;
end;


implementation

{ This implementation based on animated cursor editor source code
(ANIEDIT.C, copyright (C) Microsoft Corp., 1993-1996) }

uses Consts, VCLUtils, MaxMin, RxGraph, IcoList, ClipIcon;

const
FOURCC_ACON = 'ACON';
FOURCC_RIFF = 'RIFF';
FOURCC_INFO = 'INFO';
FOURCC_INAM = 'INAM';
FOURCC_IART = 'IART';
FOURCC_LIST = 'LIST';
FOURCC_anih = 'anih';
FOURCC_rate = 'rate';
FOURCC_seq = 'seq ';
FOURCC_fram = 'fram';
FOURCC_icon = 'icon';

function PadUp(Value: Longint): Longint;
{ Up Value to nearest word boundary }
begin

Result := Value + (Value mod 2);
end;


procedure DecreaseBMPColors(Bmp: TBitmap;
Colors: Integer);
var
Stream: TStream;
begin

if (Bmp <> nil) and (Colors > 0) then
begin

Stream := BitmapToMemory(Bmp, Colors);
try
Bmp.LoadFromStream(Stream);
finally
Stream.Free;
end;

end;

end;


function GetDInColors(BitCount: Word): Integer;
begin

case BitCount of
1, 4, 8: Result := 1 shl BitCount;
else
Result := 0;
end;

end;


{ ReadTag, ReadChunk, SkipChunk. Some handy functions for reading RIFF files. }

function ReadTag(S: TStream;
pTag: PAniTag): Boolean;
begin

pTag^.ckID := #0#0#0#0;
pTag^.ckSize := 0;
Result := S.Read(pTag^, SizeOf(TAniTag)) = SizeOf(TAniTag);
end;


function ReadChunk(S: TStream;
pTag: PAniTag;
Data: Pointer): Boolean;
begin

Result := S.Read(Data^, pTag^.ckSize) = pTag^.ckSize;
if Result then

Result := S.Seek(pTag^.ckSize mod 2, soFromCurrent) <> -1;
end;


function ReadChunkN(S: TStream;
pTag: PAniTag;
Data: Pointer;
cbMax: Longint): Boolean;
var
cbRead: Longint;
begin

cbRead := pTag^.ckSize;
if cbMax < cbRead then
cbRead := cbMax;
Result := S.Read(Data^, cbRead) = cbRead;
if Result then
begin

cbRead := PadUp(pTag^.ckSize) - cbRead;
Result := S.Seek(cbRead, soFromCurrent) <> -1;
end;

end;


function SkipChunk(S: TStream;
pTag: PAniTag): Boolean;
begin

{ Round pTag^.ckSize up to nearest word boundary to maintain alignment }
Result := S.Seek(PadUp(pTag^.ckSize), soFromCurrent) <> -1;
end;


{ Icon and cursor types }

const
rc3_StockIcon = 0;
rc3_Icon = 1;
rc3_Cursor = 2;

type
PCursorOrIcon = ^TCursorOrIcon;
TCursorOrIcon = packed record
Reserved: Word;
wType: Word;
Count: Word;
end;


PIconRec = ^TIconRec;
TIconRec = packed record
Width: Byte;
Height: Byte;
Colors: Word;
xHotspot: Word;
yHotspot: Word;
DIBSize: Longint;
DIBOffset: Longint;
end;


{ TIconFrame }

constructor TIconFrame.Create(Index: Integer;
Jiff: Longint);
begin

inherited Create;
FSeq := Index;
FJiffRate := Jiff;
end;


destructor TIconFrame.Destroy;
begin

if FIcon <> nil then
FIcon.Free;
inherited Destroy;
end;


procedure TIconFrame.Assign(Source: TPersistent);
begin

if Source is TIconFrame then
begin

with TIconFrame(Source)do
begin

if Self.FIcon = nil then
Self.FIcon := TIcon.Create;
Self.FIcon.Assign(FIcon);
Self.FIsIcon := FIsIcon;
Move(FTag, Self.FTag, SizeOf(TAniTag));
Self.FHotSpot.X := FHotSpot.X;
Self.FHotSpot.Y := FHotSpot.Y;
Self.FJiffRate := FJiffRate;
Self.FSeq := FSeq;
end;

end
else
inherited Assign(Source);
end;


{ TAnimatedCursorImage }

constructor TAnimatedCursorImage.Create;
begin

inherited Create;
FIcons := TList.Create;
end;


destructor TAnimatedCursorImage.Destroy;
begin

NewImage;
FIcons.Free;
inherited Destroy;
end;


procedure TAnimatedCursorImage.Clear;
begin

NewImage;
end;


procedure TAnimatedCursorImage.NewImage;
var
I: Integer;
begin

for I := 0 to FIcons.Count - 1do
TIconFrame(FIcons).Free;
FIcons.Clear;
FillChar(FTitle, SizeOf(FTitle), 0);
FillChar(FCreator, SizeOf(FCreator), 0);
FillChar(FHeader, SizeOf(FHeader), 0);
FOriginalColors := 0;
end;


procedure TAnimatedCursorImage.RiffReadError;
begin

raise EReadError.Create(ResStr(SReadError));
end;


function TAnimatedCursorImage.GetTitle: string;
begin

Result := StrPas(FTitle);
end;


function TAnimatedCursorImage.GetCreator: string;
begin

Result := StrPas(FCreator);
end;


function TAnimatedCursorImage.GetIconCount: Integer;
begin

Result := FIcons.Count;
end;


function TAnimatedCursorImage.GetIcon(Index: Integer): TIcon;
begin

Result := TIconFrame(FIcons[Index]).FIcon;
end;


function TAnimatedCursorImage.GetFrame(Index: Integer): TIconFrame;
begin

Result := TIconFrame(FIcons[Index]);
end;


function TAnimatedCursorImage.GetDefaultRate: Longint;
begin

Result := Max(0, Min((FHeader.jifRate * 100) div 6, High(Result)));
end;


procedure TAnimatedCursorImage.Assign(Source: TPersistent);
var
I: Integer;
Frame: TIconFrame;
begin

if Source = nil then
begin

Clear;
end
else
if Source is TAnimatedCursorImage then
begin

NewImage;
try
with TAnimatedCursorImage(Source)do
begin

Move(FHeader, Self.FHeader, SizeOf(FHeader));
Self.FTitle := FTitle;
Self.FCreator := FCreator;
Self.FOriginalColors := FOriginalColors;
for I := 0 to FIcons.Count - 1do
begin

Frame := TIconFrame.Create(-1, FHeader.jifRate);
try
Frame.Assign(TIconFrame(FIcons));
Self.FIcons.Add(Frame);
except
Frame.Free;
raise;
end;

end;

end;

except
NewImage;
raise;
end;

end
else
inherited Assign(Source);
end;


procedure TAnimatedCursorImage.AssignTo(Dest: TPersistent);
var
I: Integer;
begin

if Dest is TIcon then
begin

if IconCount > 0 then
Dest.Assign(Icons[0])
else
Dest.Assign(nil);
end
else
if Dest is TBitmap then
begin

if IconCount > 0 then

AssignToBitmap(TBitmap(Dest), TBitmap(Dest).Canvas.Brush.Color,
True, False)
else
Dest.Assign(nil);
end
else
if Dest is TIconList then
begin

TIconList(Dest).begin
Update;
try
TIconList(Dest).Clear;
for I := 0 to IconCount - 1do
TIconList(Dest).Add(Icons);
finally
TIconList(Dest).EndUpdate;
end;

end
else
inherited AssignTo(Dest);
end;


function TAnimatedCursorImage.ReadCreateIcon(Stream: TStream;
ASize: Longint;
var HotSpot: TPoint;
var IsIcon: Boolean): TIcon;
type
PIconRecArray = ^TIconRecArray;
TIconRecArray = array[0..300] of TIconRec;
var
List: PIconRecArray;
Mem: TMemoryStream;
HeaderLen, I: Integer;
BI: PBitmapInfoHeader;
begin

Result := nil;
Mem := TMemoryStream.Create;
try
Mem.SetSize(ASize);
Mem.CopyFrom(Stream, Mem.Size);
HotSpot := Point(0, 0);
IsIcon := PCursorOrIcon(Mem.Memory)^.wType = RC3_ICON;
if PCursorOrIcon(Mem.Memory)^.wType = RC3_CURSOR then

PCursorOrIcon(Mem.Memory)^.wType := RC3_ICON;
if PCursorOrIcon(Mem.Memory)^.wType = RC3_ICON then
begin

{ determinate original icon color }
HeaderLen := PCursorOrIcon(Mem.Memory)^.Count * SizeOf(TIconRec);
GetMem(List, HeaderLen);
try
Mem.Position := SizeOf(TCursorOrIcon);
Mem.Read(List^, HeaderLen);
for I := 0 to PCursorOrIcon(Mem.Memory)^.Count - 1do

with List^do
begin

GetMem(BI, DIBSize);
try
Mem.Seek(DIBOffset, soFrombegin
ning);
Mem.Read(BI^, DIBSize);
FOriginalColors := Max(GetDInColors(BI^.biBitCount), FOriginalColors);
HotSpot := Point(xHotspot, yHotspot);
finally
FreeMem(BI, DIBSize)
end;

end;

finally
FreeMem(List, HeaderLen);
end;

{ return to start of stream }
Mem.Position := 0;
Result := TIcon.Create;
try
Result.LoadFromStream(Mem);
if IsIcon then

HotSpot := Point(Result.Width div 2, Result.Height div 2);
except
Result.Free;
Result := nil;
end;

end;

finally
Mem.Free;
end;

end;


{ Loads an animatied cursor from a RIFF file. The RIFF file format for
animated cursors looks like this:

RIFF('ACON'
LIST('INFO'
INAM(<name>)
IART(<artist>))
anih(<anihdr>)
[rate(<rateinfo>)]
['seq '( <seq_info>)]
LIST('fram' icon(<icon_file>)))
}

procedure TAnimatedCursorImage.ReadAniStream(Stream: TStream);
var
iFrame, iRate, iSeq, I: Integer;
Tag: TAniTag;
Frame: TIconFrame;
cbChunk, cbRead, Temp: Longint;
Icon: TIcon;
bFound, IsIcon: Boolean;
HotSpot: TPoint;
begin

iFrame := 0;
iRate := 0;
iSeq := 0;
{ Make sure it's a RIFF ANI file }
if not ReadTag(Stream, @Tag) or (Tag.ckID <> FOURCC_RIFF) then

RiffReadError;
if (Stream.Read(Tag.ckID, SizeOf(Tag.ckID)) < SizeOf(Tag.ckID)) or
(Tag.ckID <> FOURCC_ACON) then
RiffReadError;
NewImage;
{ look for 'anih', 'rate', 'seq ', and 'icon' chunks }
while ReadTag(Stream, @Tag)do
begin

if Tag.ckID = FOURCC_anih then
begin

if not ReadChunk(Stream, @Tag, @FHeader) then
Break;
if ((FHeader.fl and AF_ICON) <> AF_ICON) or
(FHeader.cFrames = 0) then
RiffReadError;
for I := 0 to FHeader.cSteps - 1do
begin

Frame := TIconFrame.Create(I, FHeader.jifRate);
FIcons.Add(Frame);
end;

end
else
if Tag.ckID = FOURCC_rate then
begin

{ If we find a rate chunk, read it into its preallocated space }
if not ReadChunkN(Stream, @Tag, @Temp, SizeOf(Longint)) then

Break;
if iRate < FIcons.Count then

TIconFrame(FIcons[iRate]).FJiffRate := Temp;
Inc(iRate);
end
else
if Tag.ckID = FOURCC_seq then
begin

{ If we find a seq chunk, read it into its preallocated space }
if not ReadChunkN(Stream, @Tag, @Temp, SizeOf(Longint)) then

Break;
if iSeq < FIcons.Count then

TIconFrame(FIcons[iSeq]).FSeq := Temp;
Inc(iSeq);
end
else
if Tag.ckID = FOURCC_LIST then
begin

cbChunk := PadUp(Tag.ckSize);
{ See if this list is the 'fram' list of icon chunks }
cbRead := Stream.Read(Tag.ckID, SizeOf(Tag.ckID));
if cbRead < SizeOf(Tag.ckID) then
Break;
Dec(cbChunk, cbRead);
if (Tag.ckID = FOURCC_fram) then
begin

while (cbChunk >= SizeOf(Tag))do
begin

if not ReadTag(Stream, @Tag) then
Break;
Dec(cbChunk, SizeOf(Tag));
if (Tag.ckID = FOURCC_icon) then
begin

{ Ok, load the icon/cursor bits }
Icon := ReadCreateIcon(Stream, Tag.ckSize, HotSpot, IsIcon);
if Icon = nil then
Break;
bFound := False;
for I := 0 to FIcons.Count - 1do
begin

if TIconFrame(FIcons).FSeq = iFrame then
begin

TIconFrame(FIcons).FIcon := Icon;
TIconFrame(FIcons).FTag := Tag;
TIconFrame(FIcons).FHotSpot := HotSpot;
TIconFrame(FIcons).FIsIcon := IsIcon;
bFound := True;
end;

end;

if not bFound then
begin

Frame := TIconFrame.Create(-1, FHeader.jifRate);
Frame.FIcon := Icon;
Frame.FIsIcon := IsIcon;
Frame.FTag := Tag;
Frame.FHotSpot := HotSpot;
FIcons.Add(Frame);
end;

Inc(iFrame);
end
else
begin

{ Unknown chunk in fram list, just ignore it }
SkipChunk(Stream, @Tag);
end;

Dec(cbChunk, PadUp(Tag.ckSize));
end;

end
else
if (Tag.ckID = FOURCC_INFO) then
begin

{ now look for INAM and IART chunks }
while (cbChunk >= SizeOf(Tag))do
begin

if not ReadTag(Stream, @Tag) then
Break;
Dec(cbChunk, SizeOf(Tag));
if Tag.ckID = FOURCC_INAM then
begin

if (cbChunk < Tag.ckSize) or not
ReadChunkN(Stream, @Tag, @FTitle, SizeOf(TANINAME) - 1) then

Break;
Dec(cbChunk, PadUp(Tag.ckSize));
end
else
if Tag.ckID = FOURCC_IART then
begin

if (cbChunk < Tag.ckSize) or not
ReadChunkN(Stream, @Tag, @FCreator, SizeOf(TANINAME) - 1) then

Break;
Dec(cbChunk, PadUp(Tag.ckSize));
end
else
begin

if not SkipChunk(Stream, @Tag) then
Break;
Dec(cbChunk, PadUp(Tag.ckSize));
end;

end;

end
else
begin

{ Not the fram list or the INFO list. Skip the rest of this
chunk. (Don't forget that we have already skipped one dword) }
Tag.ckSize := cbChunk;
SkipChunk(Stream, @Tag);
end;

end
else
begin
{ We're not interested in this chunk, skip it. }
if not SkipChunk(Stream, @Tag) then
Break;
end;

end;

{ while }
{ Update the frame count incase we coalesced some frames while reading
in the file. }
for I := FIcons.Count - 1do
wnto 0do
begin

if TIconFrame(FIcons).FIcon = nil then
begin

TIconFrame(FIcons).Free;
FIcons.Delete(I);
end;

end;

FHeader.cFrames := FIcons.Count;
if FHeader.cFrames = 0 then
RiffReadError;
end;


procedure TAnimatedCursorImage.ReadStream(Size: Longint;
Stream: TStream);
var
Data: TMemoryStream;
begin

Data := TMemoryStream.Create;
try
Data.SetSize(Size);
Stream.ReadBuffer(Data.Memory^, Size);
if Size > 0 then
begin

Data.Position := 0;
ReadAniStream(Data);
end;

finally
Data.Free;
end;

end;


procedure TAnimatedCursorImage.WriteStream(Stream: TStream;
WriteSize: Boolean);
begin

NotImplemented;
end;


procedure TAnimatedCursorImage.LoadFromStream(Stream: TStream);
begin

ReadStream(Stream.Size - Stream.Position, Stream);
end;


procedure TAnimatedCursorImage.SaveToStream(Stream: TStream);
begin

WriteStream(Stream, False);
end;


procedure TAnimatedCursorImage.LoadFromFile(const Filename: string);
var
Stream: TStream;
begin

Stream := TFileStream.Create(Filename, fmOpenRead + fmShareDenyNone);
try
try
LoadFromStream(Stream);
except
NewImage;
raise;
end;

finally
Stream.Free;
end;

end;


procedure TAnimatedCursorImage.Draw(ACanvas: TCanvas;
const ARect: TRect);
begin

if FIcons.Count > 0 then

DrawRealSizeIcon(ACanvas, Icons[0], ARect.Left, ARect.Top);
end;


procedure TAnimatedCursorImage.AssignToBitmap(Bitmap: TBitmap;
BackColor: TColor;
DecreaseColors, Vertical: Boolean);
var
I: Integer;
Temp: TBitmap;
begin

Temp := TBitmap.Create;
try
if FIcons.Count > 0 then
begin

with Tempdo
begin

Monochrome := False;
Canvas.Brush.Color := BackColor;
if Vertical then
begin

Width := Icons[0].Width;
Height := Icons[0].Height * FIcons.Count;
end
else
begin

Width := Icons[0].Width * FIcons.Count;
Height := Icons[0].Height;
end;

Canvas.FillRect(Bounds(0, 0, Width, Height));
for I := 0 to FIcons.Count - 1do
begin

if Icons <> nil then

Canvas.Draw(Icons.Width * I * Ord(not Vertical),
Icons.Height * I * Ord(Vertical), Icons);
end;

end;

if DecreaseColors then

DecreaseBMPColors(Temp, Max(OriginalColors, 16));
end;

Bitmap.Assign(Temp);
finally
Temp.Free;
end;

end;


end.

{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1995, 1996 AO ROSNO }
{ Copyright (c) 1997, 1998 Master-Bank }
{ }
{*******************************************************}

unit Animate;

interface

{$I RX.INC}

uses Messages, {$IFDEF WIN32} Windows, {$else
} WinTypes, WinProcs, {$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Menus, RxTimer;

type

{ TRxImageControl }

TRxImageControl = class(TGraphicControl)
private
FDrawing: Boolean;
FPaintBuffered: Boolean;
{$IFDEF RX_D3}
FLock: TRTLCriticalSection;
{$ENDIF}
procedure WMPaint(var Message: TWMPaint);
message WM_PAINT;
protected
FGraphic: TGraphic;
functiondo
PaletteChange: Boolean;
{$IFNDEF RX_D4}
procedure AdjustSize;
virtual;
abstract;
{$ENDIF}
proceduredo
PaintImage;
virtual;
abstract;
proceduredo
PaintControl;
procedure PaintDesignRect;
procedure PaintImage;
procedure PictureChanged;
procedure Lock;
procedure Unlock;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
end;


{ TAnimatedImage }

TGlyphOrientation = (goHorizontal, goVertical);

TAnimatedImage = class(TRxImageControl)
private
FActive: Boolean;
FGlyph: TBitmap;
FImageWidth: Integer;
FImageHeight: Integer;
FInactiveGlyph: Integer;
FOrientation: TGlyphOrientation;
FTimer: TRxTimer;
FNumGlyphs: Integer;
FGlyphNum: Integer;
FCenter: Boolean;
FStretch: Boolean;
FTransparentColor: TColor;
FOpaque: Boolean;
FTimerRepaint: Boolean;
FOnFrameChanged: TNotifyEvent;
FOnStart: TNotifyEvent;
FOnStop: TNotifyEvent;
{$IFDEF RX_D3}
FAsyncDrawing: Boolean;
{$ENDIF}
{$IFNDEF RX_D4}
FAutoSize: Boolean;
procedure SetAutoSize(Value: Boolean);
{$ENDIF}
procedure DefineBitmapSize;
procedure ResetImageBounds;
function GetInterval: Cardinal;
procedure SetInterval(Value: Cardinal);
procedure SetActive(Value: Boolean);
{$IFDEF RX_D3}
procedure SetAsyncDrawing(Value: Boolean);
{$ENDIF}
procedure SetCenter(Value: Boolean);
procedure SetOrientation(Value: TGlyphOrientation);
procedure SetGlyph(Value: TBitmap);
procedure SetGlyphNum(Value: Integer);
procedure SetInactiveGlyph(Value: Integer);
procedure SetNumGlyphs(Value: Integer);
procedure SetStretch(Value: Boolean);
procedure SetTransparentColor(Value: TColor);
procedure SetOpaque(Value: Boolean);
procedure ImageChanged(Sender: TObject);
procedure UpdateInactive;
procedure TimerExpired(Sender: TObject);
function TransparentStored: Boolean;
procedure WMSize(var Message: TWMSize);
message WM_SIZE;
protected
{$IFDEF RX_D4}
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
override;
{$ENDIF}
function GetPalette: HPALETTE;
override;
procedure AdjustSize;
override;
procedure Loaded;
override;
procedure Paint;
override;
proceduredo
PaintImage;
override;
procedure FrameChanged;
dynamic;
procedure Start;
dynamic;
procedure Stop;
dynamic;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property Align;
{$IFDEF RX_D4}
property Anchors;
property Constraints;
property DragKind;
property AutoSize default True;
{$else
}
property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
{$ENDIF}
{$IFDEF RX_D3}
property AsyncDrawing: Boolean read FAsyncDrawing write SetAsyncDrawing default False;
{$ENDIF}
property Active: Boolean read FActive write SetActive default False;
property Center: Boolean read FCenter write SetCenter default False;
property Orientation: TGlyphOrientation read FOrientation write SetOrientation
default goHorizontal;
property Glyph: TBitmap read FGlyph write SetGlyph;
property GlyphNum: Integer read FGlyphNum write SetGlyphNum default 0;
property Interval: Cardinal read GetInterval write SetInterval default 100;
property NumGlyphs: Integer read FNumGlyphs write SetNumGlyphs default 1;
property InactiveGlyph: Integer read FInactiveGlyph write SetInactiveGlyph default -1;
property TransparentColor: TColor read FTransparentColor write SetTransparentColor
stored TransparentStored;
property Opaque: Boolean read FOpaque write SetOpaque default False;
property Color;
property Cursor;
property DragCursor;
property DragMode;
property ParentColor default True;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Stretch: Boolean read FStretch write SetStretch default True;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnDragOver;
property OnDragDrop;
property OnEndDrag;
{$IFDEF WIN32}
property OnStartDrag;
{$ENDIF}
{$IFDEF RX_D4}
property OnEndDock;
property OnStartDock;
{$ENDIF}
property OnFrameChanged: TNotifyEvent read FOnFrameChanged write FOnFrameChanged;
property OnStart: TNotifyEvent read FOnStart write FOnStart;
property OnStop: TNotifyEvent read FOnStop write FOnStop;
end;


{$IFDEF RX_D3}
procedure HookBitmap;
{$ENDIF}

implementation

uses RxConst, {$IFDEF RX_D3} RxHook, {$ENDIF} VCLUtils;

{$IFDEF RX_D3}

{ THackBitmap }

type
THackBitmap = class(TBitmap)
protected
procedure Draw(ACanvas: TCanvas;
const Rect: TRect);
override;
end;


procedure THackBitmap.Draw(ACanvas: TCanvas;
const Rect: TRect);
begin

if not Empty then
Canvas.Lock;
try
inherited Draw(ACanvas, Rect);
finally
if not Empty then
Canvas.Unlock;
end;

end;


type
THack = class(TBitmap);

var
Hooked: Boolean = False;

procedure HookBitmap;
var
Index: Integer;
begin

if Hooked then
Exit;
Index := FindVirtualMethodIndex(THack, @THack.Draw);
SetVirtualMethodAddress(TBitmap, Index, @THackBitmap.Draw);
Hooked := True;
end;


{$ENDIF RX_D3}

{ TRxImageControl }

constructor TRxImageControl.Create(AOwner: TComponent);
begin

inherited Create(AOwner);
{$IFDEF RX_D3}
InitializeCriticalSection(FLock);
{$ENDIF}
ControlStyle := ControlStyle + [csClickEvents, csCaptureMouse, csOpaque,
{$IFDEF WIN32} csReplicatable, {$ENDIF} csDoubleClicks];
Height := 105;
Width := 105;
ParentColor := True;
end;


destructor TRxImageControl.Destroy;
begin

{$IFDEF RX_D3}
DeleteCriticalSection(FLock);
{$ENDIF}
inherited Destroy;
end;


procedure TRxImageControl.Lock;
begin

{$IFDEF RX_D3}
EnterCriticalSection(FLock);
{$ENDIF}
end;


procedure TRxImageControl.Unlock;
begin

{$IFDEF RX_D3}
LeaveCriticalSection(FLock);
{$ENDIF}
end;


procedure TRxImageControl.PaintImage;
var
Save: Boolean;
begin

with Canvasdo
begin

Brush.Color := Color;
FillRect(Bounds(0, 0, ClientWidth, ClientHeight));
end;

Save := FDrawing;
FDrawing := True;
try
do
PaintImage;
finally
FDrawing := Save;
end;

end;


procedure TRxImageControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
begin

if FPaintBuffered then

inherited
else
if Message.DC <> 0 then
begin

{$IFDEF RX_D3}
Canvas.Lock;
try
{$ENDIF}
DC := Message.DC;
MemDC := GetDC(0);
MemBitmap := CreateCompatibleBitmap(MemDC, ClientWidth, ClientHeight);
ReleaseDC(0, MemDC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
FPaintBuffered := True;
try
Message.DC := MemDC;
WMPaint(Message);
Message.DC := 0;
finally
FPaintBuffered := False;
end;

BitBlt(DC, 0, 0, ClientWidth, ClientHeight, MemDC, 0, 0, SRCCOPY);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;

{$IFDEF RX_D3}
finally
Canvas.Unlock;
end;

{$ENDIF}
end;

end;


procedure TRxImageControl.PaintDesignRect;
begin

if csDesigning in ComponentState then

with Canvasdo
begin

Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;

end;


procedure TRxImageControl.DoPaintControl;
var
DC: HDC;
begin

{$IFDEF RX_D3}
if GetCurrentThreadID = MainThreadID then
begin

Repaint;
Exit;
end;

{$ENDIF}
DC := GetDC(Parent.Handle);
try
IntersectClipRect(DC, Left, Top, Left + Width, Top + Height);
MoveWindowOrg(DC, Left, Top);
Perform(WM_PAINT, DC, 0);
finally
ReleaseDC(Parent.Handle, DC);
end;

end;


function TRxImageControl.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin

Result := False;
Tmp := FGraphic;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil)
{$IFDEF RX_D3} and (Tmp.PaletteModified) {$ENDIF} then

begin

if (GetPalette <> 0) then
begin

ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and ParentForm.HandleAllocated then

begin

if FDrawing then

ParentForm.Perform(WM_QUERYNEWPALETTE, 0, 0)
else

PostMessage(ParentForm.Handle, WM_QUERYNEWPALETTE, 0, 0);
Result := True;
{$IFDEF RX_D3}
Tmp.PaletteModified := False;
{$ENDIF}
end;

end
{$IFDEF RX_D3}
else
begin

Tmp.PaletteModified := False;
end;

{$ENDIF}
end;

end;


procedure TRxImageControl.PictureChanged;
begin

if not (csDestroying in ComponentState) then
begin

AdjustSize;
if (FGraphic <> nil) then

ifdo
PaletteChange and FDrawing then
Update;
if not FDrawing then
Invalidate;
end;

end;


{ TAnimatedImage }

constructor TAnimatedImage.Create(AOwner: TComponent);
begin

inherited Create(AOwner);
FTimer := TRxTimer.Create(Self);
with FTimerdo
begin

Enabled := False;
Interval := 100;
end;

AutoSize := True;
FGlyph := TBitmap.Create;
FGraphic := FGlyph;
FGlyph.OnChange := ImageChanged;
FNumGlyphs := 1;
FInactiveGlyph := -1;
FTransparentColor := clNone;
FOrientation := goHorizontal;
FStretch := True;
end;


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 DstRectdo

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;
do
PaintControl;
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.

eYes: 想做Ani文件有现成的AniEditor软件, 找一个来用就行了.

To huaizhang:
1.我不是在程序中把cusor改用ani
2.我不是做ani editor
3.我只是想做个animate button, 用ani当它的face,button up和down时显示不同
的静止帧, 当mouse move over 时让它动起来。（当然用gif也可以， 不过我硬盘
上ani比gif多而已，而且ani的图象比较小巧精制，做button正好）

Good thinking, eYes!

接受答案了.