Delphi控件源码

开发平台：
Delphi

MsgFrm.pas：源码内容
							unit MsgFrm;
interface
uses
  Windows, Messages,SysUtils,Dialogs, Variants, Classes, Graphics, Forms, StdCtrls, ExtCtrls, ImgList, Controls,RealMessengerUnit,
  BusinessSkinForm;
type
  TMsgForm = class(TForm)
    lblMsg: TLabel;
    lblTitle: TLabel;
    Image1: TImage;
    ImageList1: TImageList;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormClick(Sender: TObject);
  protected
    procedure DrawBk;
    procedure CreateParams(var Params: TCreateParams); override;
  private
    iFlag:Integer;
    iTop:integer;
    AutoClose:boolean;
    Bmp: TBitmap;
    InDraw: Boolean;
    ThreadHandle:THandle;
  public
  end;
  TMsgKind = (mkInfo , mkError);
{显示右下角的提示窗口}
procedure ShowAlert(const title,Info: string;needAutoClose:boolean = true;MsgKind:TMsgKind = mkInfo);
var
  MsgFormList: TList;
implementation
{$R *.dfm}
{使提示窗口从屏幕下方滑出}
function ThreadFunc(Info: Pointer): Integer; stdcall;
var
  Form:TMsgForm;
begin
try
  Form:=TMsgForm(Info);
  with Form do
  begin
    while iFlag>=0 do
    begin
      iTop:=Top;
      if iFlag=0 then begin
        if Top>(Screen.WorkAreaHeight-Height) then begin
          Dec(iTop,15);
          Top:=iTop;
        end else begin
          Inc(iFlag);
        end;
      end
      else if iFlag=1 then begin
        if AutoClose then
        begin
          sleep(8000);
          Inc(iFlag);
        end
        else
          break;
      end
      else if iFlag=2 then begin
        if Top<Screen.WorkAreaHeight then begin
           Inc(iTop,15);
           Top:=iTop;
        end else begin
           iFlag:=-1;
        end;
      end;
      Sleep(30);
    end; //while
  end; //with
  if Form.AutoClose then Form.Close;
finally
  ExitThread(4);
end;
end;
procedure ShowAlert(const title,Info: string;needAutoClose:boolean = true;MsgKind:TMsgKind = mkInfo);
var
  MsgForm:TMsgForm;
  ThreadId: DWORD;
begin
  MsgForm:=TMsgForm.Create(nil);
  with MsgForm do
  begin
    AutoClose:=needAutoClose;
    ParentWindow:=GetDesktopWindow;
    Top := Screen.WorkAreaHeight+10;
    Left:= Screen.WorkAreaWidth-Width-3;
    Bmp := TBitmap.Create;
    Bmp.PixelFormat := pf24Bit;
    lblMsg.Caption := Info;
    lblTitle.Caption := title;
    ImageList1.GetIcon(Integer(MsgKind),Image1.Picture.Icon);
    //以下三行隐藏任务栏图标
    ShowWindow( Handle, SW_HIDE );
    SetWindowLong( Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOPMOST or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
    ShowWindow( Handle, SW_SHOW );
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOOWNERZORDER); // 窗体显示在任务栏后面
    DrawBk;
  end;
  MsgForm.ThreadHandle:=CreateThread(nil, 0, @ThreadFunc, MsgForm , 0, ThreadId);
  MsgFormList.Add(MsgForm);
end;
{设置窗口样式，无标题栏}
procedure TMsgForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_BORDER;
  Params.ExStyle := WS_EX_DLGMODALFRAME or WS_EX_TOPMOST;
end;
{处理EraseBkgnd}
procedure TMsgForm.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Bitblt(Msg.DC, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas.Handle, 0, 0,
    SRCCOPY);
  Msg.Result := 1; // 已处理
end;
{画渐变背影}
procedure TMsgForm.DrawBk;
type
  PRGBArray = ^TRGBArray;
  TRGBArray = array[Byte] of TRGBTriple;
var
  PLine: PRGBArray;
  x, y: Integer;
  ARect: TRect;
  RowInc: Integer;
  sr, sg, sb, er, eg, eb: Integer;
begin
  if InDraw then Exit;
  InDraw := True;
  Bmp.Width := ClientWidth;
  Bmp.Height := ClientHeight;
  sr := GetRValue(StartColor);
  sg := GetGValue(StartColor);
  sb := GetBValue(StartColor);
  er := GetRValue(EndColor);
  eg := GetGValue(EndColor);
  eb := GetBValue(EndColor);
  PLine := PRGBArray(Bmp.ScanLine[0]);
  for x := 0 to Bmp.Width - 1 do
  begin
    PLine[x].rgbtRed := sr + (er - sr) * x div Bmp.Width;
    PLine[x].rgbtGreen := sg + (eg - sg) * x div Bmp.Width;
    PLine[x].rgbtBlue := sb + (eb - sb) * x div Bmp.Width;
  end;
  RowInc := (Bmp.Width * 3 + 3) div 4 * 4;
  for y := 1 to Bmp.Height - 1 do
    Move(PLine^, Bmp.ScanLine[y]^, RowInc);
  ARect := Rect(0, 0, Width, Height);
  Frame3D(Bmp.Canvas, ARect, $777777, $777777, 1);
  InDraw := False;
  Refresh;
end;
{onClose事件}
procedure TMsgForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    Action:=caFree;
end;
{onDestroy事件}
procedure TMsgForm.FormDestroy(Sender: TObject);
begin
    TerminateThread(ThreadHandle,4);
    MsgFormList.Remove(Self);
end;
procedure TMsgForm.FormClick(Sender: TObject);
begin
  TerminateThread(ThreadHandle,4);
  while Top<(Screen.WorkAreaHeight) do
  begin
    Inc(iTop,15);
    Top:=iTop;
    Sleep(30);
  end;
  Close;
end;
end.

						