- Код: Выделить всё
unit ScrollingCredits;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources,Forms, Controls, Graphics, Dialogs,ExtCtrls;
type
{ TScrollingCredits }
TCreditEvent = procedure(Sender : TObject; CreditText : String) of object;
TScrollingCredits = class(TGraphicControl)
private
FAfterLastCredit: TNotifyEvent;
FAnimate: Boolean;
FBackgroundColor: TColor;
FBackgroundImage: TPicture;
FBorderColor: TColor;
FCredits: TStringList;
FFont: TFont;
FTimer: TTimer;
FBitmap: TBitmap;
YPos: Integer;
TPos: Integer;
FInterval: Cardinal;
FOnShowCredit: TCreditEvent;
FShowBorder: boolean;
FVisible: Boolean;
procedure SetAnimate(const AValue: Boolean);
procedure ResetAnimation;
procedure SetBackgroundColor(const AValue: TColor);
procedure SetBackgroundImage(const AValue: TPicture);
procedure SetBorderColor(const AValue: TColor);
procedure SetCredits(const AValue: TStringList);
procedure SetFont(const AValue: TFont);
procedure SetInterval(const AValue: Cardinal);
procedure SetPicture(const AValue: TPicture);
procedure SetShowBorder(const AValue: boolean);
procedure SetVisible(const AValue: Boolean);
procedure BackgroundImageChanged(Sender : TObject);
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure TimerFired(Sender : TObject);
procedure Reset;
{ Public declarations }
published
property Credits:TStringList read FCredits write SetCredits;
property CreditsFont: TFont read FFont write SetFont;
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
property BorderColor: TColor read FBorderColor write SetBorderColor;
property Animate: Boolean read FAnimate write SetAnimate;
property Interval: Cardinal read FInterval write SetInterval;
property OnShowCredit: TCreditEvent read FOnShowCredit write FOnShowCredit;
property AfterLastCredit: TNotifyEvent read FAfterLastCredit write FAfterLastCredit;
property Visible: Boolean read FVisible write SetVisible default True;
property BackgroundImage: TPicture read FBackgroundImage write SetBackgroundImage;
property ShowBorder: boolean read FShowBorder write SetShowBorder;
property OnClick;
property OnDblClick;
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
{$I scrollingcredits_icon.lrs}
RegisterComponents('Standard',[TScrollingCredits]);
end;
procedure TScrollingCredits.SetAnimate(const AValue: Boolean);
begin
if FAnimate=AValue then exit;
FAnimate:=AValue;
end;
procedure TScrollingCredits.SetBackgroundColor(const AValue: TColor);
begin
if FBackgroundColor=AValue then exit;
FBackgroundColor:=AValue;
end;
procedure TScrollingCredits.SetBackgroundImage(const AValue: TPicture);
begin
if FBackgroundImage=AValue then exit;
FBackgroundImage:=AValue;
end;
procedure TScrollingCredits.SetBorderColor(const AValue: TColor);
begin
if FBorderColor=AValue then exit;
FBorderColor:=AValue;
end;
procedure TScrollingCredits.SetCredits(const AValue: TStringList);
begin
if FCredits=AValue then exit;
FCredits:=AValue;
end;
procedure TScrollingCredits.SetFont(const AValue: TFont);
begin
if FFont=AValue then exit;
FFont:=AValue;
end;
procedure TScrollingCredits.SetInterval(const AValue: Cardinal);
begin
if FInterval=AValue then exit;
FInterval:=AValue;
end;
procedure TScrollingCredits.SetShowBorder(const AValue: boolean);
begin
if FShowBorder=AValue then exit;
FShowBorder:=AValue;
end;
procedure TScrollingCredits.SetVisible(const AValue: Boolean);
begin
if FVisible=AValue then exit;
FVisible:=AValue;
end;
constructor TScrollingCredits.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
Width := 305;
Height := 201;
FCredits := TStringList.Create;
FFont := TFont.Create;
FTimer := TTimer.Create(Self);
FBitmap := TBitmap.Create;
FCredits.Add('Test Component');
FFont.Color := clWhite;
FFont.Name := 'Tahoma';
FTimer.Interval := 50;
FTimer.Enabled := False;
//FTimer.OnTimer := TimerFired;
FBitmap.Width := Width;
FBitmap.Height := Height;
FBackgroundColor := clBlack;
FBorderColor := clWhite;
FAnimate := False;
FInterval := 50;
YPos := 4;
TPos := 0;
FVisible := True;
FBackgroundImage := TPicture.Create;
//FBackgroundImage.OnChange:=BackgroundImageChanged;
FShowBorder := True;
end;
destructor TScrollingCredits.Destroy;
begin
inherited Destroy;
end;
procedure TScrollingCredits.Paint;
begin
inherited Paint;
end;
procedure TScrollingCredits.TimerFired(Sender: TObject);
begin
end;
procedure TScrollingCredits.Reset;
begin
end;
{ TScrollingCredits }
end.
Я что то неправильно делаю но что не понимаю, в Delphi все работало, а здесь ругается.
