Delphi窗體上的滾動提示控件代碼

用Delphi編寫一個相對簡單的滾動提示控件，一共有兩個主文件，下面一一帖出代碼，懂Delphi的添油加醋，應該知道怎麼用吧，下面是ScrollHint.pas代碼：

001 unit ScrollHint; 002 interface 003 uses 004   Windows, Messages, SysUtils, Classes, Controls, 005   ExtCtrls, Graphics; 006 type 007   TScrollHint = class(TCustomControl) 008   private 009     { Private declarations } 010     FVal:LongInt; 011     FTimer:TTimer; 012     FScrollEnabled:Boolean; 013     FText:widestring; 014     FTempText:widestring; 015     function GetFont:TFont; 016     procedure SetFont(f:TFont); 017     procedure SetInterVal(AInterVal:LongInt); 018     procedure SetScrollEnabled(Enabled:Boolean); 019     procedure SetText(Text:widestring); 020     procedure TimesUp(Sender:TObject); 021   protected 022     { Protected declarations } 023     Procedure Paint; override; 024   public 025     { Public declarations } 026     constructor Create(AOwner: TComponent); override; 027     destructor Destroy; override; 028     procedure BeginScroll; 029     Procedure EndScroll; 030   published 031     { Published declarations } 032     property Font:TFont read GetFont write SetFont; 033     Property InterVal:LongInt read FVal write SetInterVal default 100; 034     property ScrollEnabled:Boolean read FScrollEnabled write SetScrollEnabled default False; 035     property Text:widestring read FText write SetText; 036   end; 037 procedure Register; 038 implementation 039 procedure Register; 040 begin 041   RegisterComponents('Samples', [TScrollHint]); 042 end; 043 function TScrollHint.GetFont:TFont; 044 begin 045   Result:=Canvas.Font; 046 end; 047 procedure TScrollHint.SetFont(f:TFont); 048 begin 049   Canvas.Font:=f; 050 end; 051 procedure TScrollHint.SetInterVal(AInterVal:LongInt); 052 begin 053   FVal:=AInterVal; 054   if Assigned(FTimer) then FTimer.Interval:=AInterVal; 055 end; 056 procedure TScrollHint.SetScrollEnabled(Enabled:Boolean); 057 begin 058   if Enabled then BeginScroll 059   else EndScroll; 060 end; 061 procedure TScrollHint.SetText(Text:widestring); 062 var 063   t:Boolean; 064 begin 065   t:=FScrollEnabled; 066   if t then FTimer.Enabled:=False; 067   FText:=Text; 068   FTempText:=Text; 069   Paint; 070   if t then FTimer.Enabled:=True; 071 end; 072 procedure TScrollHint.TimesUp(Sender:TObject); 073 var 074   head:widestring; 075 begin 076   Paint; 077   head:=Copy(FTempText,1,1); 078   FTempText:=Copy(FTempText,2,length(FTempText)-1)+head; 079 end; 080 Procedure TScrollHint.Paint; 081 begin 082   Canvas.TextOut(0,0,FTempText); 083 end; 084 constructor TScrollHint.Create(AOwner: TComponent); 085 begin 086   inherited Create(AOwner); 087   FVal:=100; 088   FTimer:=TTimer.Create(Parent); 089   FTimer.Interval:=FVal; 090   FTimer.Enabled:=False; 091   FTimer.OnTimer:=TimesUp; 092   FScrollEnabled:=False; 093 end; 094 destructor TScrollHint.Destroy; 095 begin 096   FTimer.Free; 097   FTimer:=nil; 098   inherited Destroy; 099 end; 100 procedure TScrollHint.BeginScroll; 101 begin 102   FTempText:=FText; 103   FScrollEnabled:=True; 104   FTimer.Enabled:=True; 105 end; 106 Procedure TScrollHint.EndScroll; 107 begin 108   FScrollEnabled:=False; 109   FTimer.Enabled:=False; 110 end; 111 end.

以下是Unit1.pas文件代碼：

vIEw source print? 01 unit Unit1; 02 interface 03 uses 04   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 05   Dialogs, StdCtrls,QExtCtrls, ExtCtrls, ScrollHint; 06 type 07   TForm1 = class(TForm) 08     ScrollHint1: TScrollHint; 09     Button1: TButton; 10     procedure Button1Click(Sender: TObject); 11   private 12     { Private declarations } 13   public 14     { Public declarations } 15   end; 16 var 17   Form1: TForm1; 18 implementation 19 {$R *.dfm} 20 procedure TForm1.Button1Click(Sender: TObject); 21 begin 22   if button1.Caption='開始' then 23     begin 24     button1.Caption:='停止'; 25     scrollhint1.BeginScroll; 26     end 27   else 28     begin 29     button1.Caption:='開始'; 30     scrollhint1.EndScroll; 31     end; 32 end; 33 end.