دوستان این هم سورس کامل
لطفا اگه مشکلی می بینید خواهشا عرض کنید
unit AVF_AnimationCaption;
interface
uses
SysUtils, Classes, ExtCtrls, Forms, Controls ,StrUtils ,Dialogs;
type
TRightToLeftMode=(LeftMode,RightMode);
type
TAnimationCaption = class(TComponent)
private
FAnmationString,tempStr:string;
FActive:Boolean;
ObjectTimer:TTimer;
FForm:TCustomForm;
FInterval:Integer;
StrFirstCaption:string;
FSpace:Byte;
FRightToLeft:TRightToLeftMode;
{ Private declarations }
procedure RunAnimation(Sender:TObject);
protected
procedure FSetAnimationText(const Value:string);
procedure SetActive(const Value:Boolean);
procedure SetInterval(const Value:Integer);
procedure SetSpace(const Value:byte);
procedure SetRightToLeftMode(const value:TRightToLeftMode);
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent );override;
destructor Destroy;override;
published
property AnimationText:string read FAnmationString write FSetAnimationText;
property Active:Boolean read FActive write SetActive default True;
property Interval:Integer read FInterval write SetInterval default 200;
property Space:Byte read FSpace write SetSpace default 3;
property RightToLeftMode:TRightToLeftMode read FRightToLeft write SetRightToLeftMode default LeftMode;
{ Published declarations }
end;
{$R AVF_AnimationCaption.res}
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('AVF', [TAnimationCaption]);
end;
{ TComponent1 }
constructor TAnimationCaption.Create(AOwner: TComponent);
begin
inherited;
if (not Assigned(FForm)) then
FForm:=GetParentForm(TControl(AOwner));
FInterval:=200;
FSpace:=3;
FAnmationString:=FForm.Caption;
StrFirstCaption:=FForm.Caption;
ObjectTimer:=TTimer.Create(Self);
ObjectTimer.OnTimer:=RunAnimation;
ObjectTimer.Interval:=FInterval;
tempStr:=FAnmationString+DupeString(' ',3);
FActive:=True;
end;
destructor TAnimationCaption.Destroy;
begin
if (FActive) then FActive:=False;
FreeAndNil(ObjectTimer);
if not (csDestroying in FForm.ComponentState) then
FForm.Caption:=StrFirstCaption;
inherited;
end;
procedure TAnimationCaption.FSetAnimationText(const Value: string);
begin
FAnmationString:=Value;
tempStr:=FAnmationString+DupeString(' ',FSpace);
end;
procedure TAnimationCaption.RunAnimation(Sender: TObject);
var
s:string;
begin
if (not FActive) then Exit;
if (FRightToLeft=LeftMode) then
begin
s:=LeftStr(tempStr,1);
tempStr:=MidStr(tempStr,2,Length(tempStr)-1)+s;
end
else
begin
s:=RightStr(tempStr,1);
tempStr:=s+MidStr(tempStr,1,Length(tempStr)-1);
end;
FForm.Caption:=tempStr;
end;
procedure TAnimationCaption.SetActive(const Value:Boolean);
begin
FActive:=Value;
ObjectTimer.Enabled:=FActive;
end;
procedure TAnimationCaption.SetInterval(const Value: Integer);
begin
FInterval:=Value;
ObjectTimer.Interval:=FInterval;
end;
procedure TAnimationCaption.SetRightToLeftMode(const value: TRightToLeftMode);
begin
FRightToLeft:=value;
end;
procedure TAnimationCaption.SetSpace(const Value: byte);
begin
if (Value<2) then
FSpace:=2
else
FSpace:=Value;
tempStr:=FAnmationString+DupeString(' ',FSpace);
end;
.end
پاسخ با نقل قول
نقل قول: کامپوننت Animation Caption
نوشته شده توسط hossein.kh
