Animate

[Thomas Beier]

wie kann mann die Komponente Animate das ein viereck ist als dreieck schreiben.

unit Animate;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, StdCtrls, ExtCtrls;

type
TAnimated = class(TGraphicControl)
private
FBitMap : TBitmap;
FFrameCount : integer;
FFrame : Integer;
Timer : TTimer;
FInterval : integer;
FLoop : boolean;
FReverse : boolean;
FPlay : boolean;
FTransparentColor : TColor;
FOnChangeFrame : TNotifyEvent;
procedure SetFrame(Value : Integer);
procedure SetInterval(Value : integer);
procedure SetBitMap(Value : TBitMap);
procedure SetPlay(Onn : boolean);
procedure SetTransparentColor(Value : TColor);
protected
procedure Paint; override;
procedure TimeHit(Sender : TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Interval : integer read FInterval write SetInterval;
{Note: FrameCount must precede Frame in order for initialization to be correct}
property FrameCount : integer read FFrameCount write FFrameCount default 1;
property Frame : Integer read FFrame write SetFrame;
property BitMap : TBitMap read FBitMap write SetBitMap;
property Play : boolean read FPlay write SetPlay;
property Reverse: boolean read FReverse write FReverse;
property Loop: boolean read FLoop write FLoop default True;
property TransparentColor : TColor read FTransparentColor
write SetTransparentColor default clsilver;
property Height default 30;
property Width default 30;
property Enabled default true;
property OnChangeFrame: TNotifyEvent read FOnChangeFrame
write FOnChangeFrame;
property OnDblClick;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Visible;
property ShowHint;
end;

procedure Register;

implementation

constructor TAnimated.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 30;
Height := 30;
FBitMap := TBitMap.Create;
FrameCount := 1;
ControlStyle := ControlStyle +[csOpaque];
FLoop := True;
FTransparentColor := clSilver;
end;

destructor TAnimated.Destroy;
begin
Timer.Free;
FBitMap.Free;
inherited Destroy;
end;

procedure TAnimated.SetBitMap(Value : TBitMap);
begin
FBitMap.Assign(Value);
Height := FBitMap.Height;
if Height = 0 then Height := 30; {so something will display}
end;

procedure TAnimated.SetInterval(Value : Integer);
begin
if Value <> FInterval then
begin
Timer.Free;
Timer := Nil;
if FPlay and (Value > 0) then
begin
Timer := TTimer.Create(Self);
Timer.Interval := Value;
Timer.OnTimer := TimeHit;
end;
FInterval := Value;
end;
end;

procedure TAnimated.SetPlay(Onn : boolean);
begin
if Onn <> FPlay then
begin
FPlay := Onn;
if not Onn then
begin
Timer.Free;
Timer := Nil;
end
else if FInterval > 0 then
begin
Timer := TTimer.Create(Self);
Timer.Interval := FInterval;
Timer.OnTimer := TimeHit;
end;
end;
end;

procedure TAnimated.SetFrame(Value : Integer);
var
Temp : Integer;
begin
if Value < 0 then
Temp := FFrameCount - 1
else
Temp := Value Mod FFrameCount;
if Temp <> FFrame then
begin
FFrame := Temp;
if Assigned(FOnChangeFrame) then FOnChangeFrame(Self);
Invalidate;
end;
end;

procedure TAnimated.SetTransparentColor(Value : TColor);
begin
if Value <> FTransparentColor then
begin
FTransparentColor := Value;
Invalidate;
end;
end;

procedure TAnimated.TimeHit(Sender : TObject);
procedure ChkStop;
begin
if not FLoop then
begin
FPlay := False;
Timer.Free;
Timer := Nil;
end;

[Jens Schumann]

Hallo Thomas,<br>bitte nutze die HTML-Tags um Deinen Soucre zu formatieren. So ist er nicht zu lesen