ufrmhintpopup.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

unit ufrmHintPopup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TB2Dock, TBXDkPanels, TBXAluminumTheme, TBX, ExtCtrls, StdCtrls;

type
  TfrmHintPopup = class(TForm)
    TBDock1: TTBDock;
    TBXDockablePanel1: TTBXDockablePanel;
    Image1: TImage;
    lbCaption: TTBXLabel;
    Timer1: TTimer;
    procedure TBXDockablePanel1Close(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  protected
    procedure CreateParams(var Params:TCreateParams);override;
  public
    { Public declarations }
    SLeft,STop:integer;
    OriginHeight:integer;
    procedure SetPos;
    procedure ShowFlow;
  end;

  TFlowShowThread=class(TTHread)
  private
    procedure UpTime;
  protected
    procedure execute;override;
  public
    Afrm:TfrmHintPopup;
    Top,Height:integer;
  end;

var
  RowMax,RowHeight,frmCount:integer;  

implementation

{$R *.dfm}

procedure TfrmHintPopup.TBXDockablePanel1Close(Sender: TObject);
begin
  close;
end;

procedure TfrmHintPopup.FormCreate(Sender: TObject);
begin
  //setforegroundwindow(handle);
  showwindow(handle,sw_hide);
  SetWindowPos(handle,HWND_TOPMOST,0,0,0,0,swp_NoSize);

  TBXSetTheme('Aluminum');
  SetPos;
  OriginHeight:=Height;
end;

procedure TfrmHintPopup.SetPos;
var
  r: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
  SLeft := r.Right - Self.Width;
  STop := r.Bottom - Self.Height;
end;

procedure TfrmHintPopup.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=cafree;
end;

procedure TfrmHintPopup.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WS_CAPTION or WS_POPUP;
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE;
  Params.WndParent :=GetDesktopWindow;
end;

{ TFlowShowThread }

procedure TFlowShowThread.execute;
begin
  repeat
    Synchronize(UpTime);
  until (Terminated) or (SleepEx(30,false)<0)
end;

procedure TFlowShowThread.UpTime;
begin
  Afrm.Height:=Afrm.Height+1;
  Afrm.Top:=Afrm.Top-1;
  if Afrm.Height>=Afrm.OriginHeight then
    Terminate;
end;

procedure TfrmHintPopup.ShowFlow;
begin
  show;
  with TFlowShowThread.Create(true) do
  begin
    Afrm:=self;
    Resume;
  end;
end;

end.