scrollhint.pas

Delphi7编程80例(完全版)

unit ScrollHint;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls,
  ExtCtrls, Graphics;

type
  TScrollHint = class(TCustomControl)
  private
    { Private declarations }
    FVal:LongInt;
    FTimer:TTimer;
    FScrollEnabled:Boolean;
    FText:widestring;
    FTempText:widestring;
    Captured: Boolean;
    procedure WmMouseMove (var Msg:TWMMouse); message wm_MouseMove;
    function GetFont:TFont;
    procedure SetFont(f:TFont);
    procedure SetInterVal(AInterVal:LongInt);
    procedure SetScrollEnabled(Enabled:Boolean);
    procedure SetText(Text:widestring);
    procedure TimesUp(Sender:TObject);
  protected
    { Protected declarations }
    Procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginScroll;
    Procedure EndScroll;
  published
    { Published declarations }
    property Font:TFont read GetFont write SetFont;
    Property InterVal:LongInt read FVal write SetInterVal default 100;
    property ScrollEnabled:Boolean read FScrollEnabled write SetScrollEnabled default False;
    property Text:widestring read FText write SetText;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TScrollHint]);
end;


function TScrollHint.GetFont:TFont;
begin
  Result:=Canvas.Font;
end;

procedure TScrollHint.SetFont(f:TFont);
begin
  Canvas.Font:=f;
end;

procedure TScrollHint.SetInterVal(AInterVal:LongInt);
begin
  FVal:=AInterVal;
  if Assigned(FTimer) then FTimer.Interval:=AInterVal;
end;

procedure TScrollHint.SetScrollEnabled(Enabled:Boolean);
begin
  if Enabled then BeginScroll
  else EndScroll;
end;

procedure TScrollHint.SetText(Text:widestring);
var
  t:Boolean;
begin
  t:=FScrollEnabled;
  if t then FTimer.Enabled:=False;
  FText:=Text;
  FTempText:=Text;
  Paint;
  if t then FTimer.Enabled:=True;
end;

procedure TScrollHint.TimesUp(Sender:TObject);
var
  head:widestring;
begin
  Paint;
  head:=Copy(FTempText,1,1);
  FTempText:=Copy(FTempText,2,length(FTempText)-1)+head;
end;

Procedure TScrollHint.Paint;
begin
  Canvas.TextOut(0,0,FTempText);
end;

procedure TScrollHint.WmMouseMove (var Msg:TWMMouse);
begin
  inherited;
  if not ScrollEnabled then exit;
  if not Captured then
    begin
    SetCapture(Handle);
    Captured:=True;
    FTimer.Enabled:=False;
    end
  else
    if (Msg.XPos < 0) or (Msg.XPos > Width)
        or (Msg.YPos < 0) or (Msg.YPos > Height) then
      begin
      Captured:=False;
      ReleaseCapture;
      FTimer.Enabled:=True;
      end;
end;


constructor TScrollHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FVal:=100;
  FTimer:=TTimer.Create(Parent);
  FTimer.Interval:=FVal;
  FTimer.Enabled:=False;
  FTimer.OnTimer:=TimesUp;
  FScrollEnabled:=False;
  Captured:=False;
end;

destructor TScrollHint.Destroy;
begin
  FTimer.Free;
  FTimer:=nil;
  inherited Destroy;
end;

procedure TScrollHint.BeginScroll;
begin
  FTempText:=FText;
  FScrollEnabled:=True;
  FTimer.Enabled:=True;
end;

Procedure TScrollHint.EndScroll;
begin
  FScrollEnabled:=False;
  FTimer.Enabled:=False;
end;

end.