lincopopupmsg.~pas

弹出式提示

{*******************************************************}
{                                                       }
{       Linco TLincoPopupMsg 
{                                                       }
{       Copyright (c) 2004 Lincosoftware of China       }
{       http://lincosoft.go.nease.net                   }
{       mail me: [e-mail]                       }
{                                                       }
{*******************************************************}
unit LincoPopupMsg;

interface

uses
  SysUtils, Classes, PopupFrm, Forms, ExtCtrls;

const
  PIXPERCHANGE = 20;
type
  TPopupMsgState = (pmsScrollingDown,pmsScrollingUp);
  TLincoPopupMsg = class(TComponent)
  private
    { Private declarations }
    FMsgDlg: TFormPopup;
    FState: TPopupMsgState;
    FTimer: TTimer;
    procedure FSetInterval(AValue: integer);
    function FGetInterval: integer;
  protected
    { Protected declarations }
    procedure Timer(Sender: TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure Hide;
    procedure PopupMsg(AValue: string);
    procedure RollUpMsg(AValue: string);
    procedure RollDown;
  published
    { Published declarations }
    property Interval: integer read FGetInterval write FSetInterval;
  end;

procedure Register;

implementation

constructor TLincoPopupMsg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMsgDlg := TFormPopup.Create(nil);
  FMsgDlg.Left := Screen.WorkAreaWidth - FMsgDlg.Width;
  FMsgDlg.Show;
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := false;
  FTimer.OnTimer := Timer;
  Hide;
  Interval := 200;
end;

destructor TLincoPopupMsg.Destroy;
begin
  FMsgDlg.Hide;
  FMsgDlg.Free;
  FTimer.Free;
  inherited;
end;

procedure TLincoPopupMsg.FSetInterval(AValue: integer);
begin
  FTimer.Interval := AValue;
end;

function TLincoPopupMsg.FGetInterval: integer;
begin
  result := FTimer.Interval;
end;

procedure TLincoPopupMsg.Timer(Sender: TObject);
begin
  if pmsScrollingDown = FState then
    if FMsgDlg.Top < Screen.Height then
      FMsgDlg.Top := FMsgDlg.Top  + PIXPERCHANGE{ TODO : a }
    else
    begin
      FTimer.Enabled := false;
    end
  else if pmsScrollingUp = FState then
    if FMsgDlg.Top > Screen.Height - FMsgDlg.Height then
      FMsgDlg.Top := FMsgDlg.Top  - PIXPERCHANGE{ TODO : a }
    else
    begin
      FTimer.Enabled := false;
    end
end;

procedure TLincoPopupMsg.Hide;
begin
  FMsgDlg.Top := Screen.Height;
end;

procedure TLincoPopupMsg.PopupMsg(AValue: string);
begin
  FMsgDlg.Msg := AValue;
  FMsgDlg.Top := Screen.WorkAreaHeight - FMsgDlg.Height;
  FMsgDlg.Show;
end;

procedure TLincoPopupMsg.RollUpMsg(AValue: string);
begin
  FMsgDlg.Msg := AValue;
  FState := pmsScrollingUp;
  FTimer.Enabled := true;
end;

procedure TLincoPopupMsg.RollDown;
begin
  FState := pmsScrollingDown;
  FTimer.Enabled := true;
end;

procedure Register;
begin
  RegisterComponents('Linco', [TLincoPopupMsg]);
end;

end.