frmpopup.pas

一个基于Socket的在线更新程序

unit frmPopup;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TPopupForm = class(TForm)
    Timer1: TTimer;
    lblTitle: TLabel;
    lblText: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblTextMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblTextMouseEnter(Sender: TObject);
    procedure lblTextMouseLeave(Sender: TObject);
  private
    FBackground: TBitmap;
    FStartTime: Cardinal;
    FQuickHide: Boolean;
    FOnLink: TNotifyEvent;
  protected
    procedure Paint(); override;
    procedure CreateParams(var Param: TCreateParams); override;
    procedure WMPRINTCLIENT(var Msg: TMessage); message WM_PRINTCLIENT;
  public
    AnimateTime: Integer;
    StayTime: Integer;
    ClickHide: Boolean;
    property OnLink: TNotifyEvent read FOnLink write FOnLink;
  end;

implementation

{$R *.dfm}
{$R other.res}

function GetWorkAreaRect() : TRect;
begin
{$WARNINGS OFF}
    SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
{$WARNINGS ON}
end;

procedure RefreshControl(Control: TControl); { Refresh Self and SubControls }
var
  i: Integer;
begin
  if Control is TWinControl then
    for i := 0 to TWinControl(Control).ControlCount - 1 do
      RefreshControl(TWinControl(Control).Controls[i]);

  Control.Invalidate;
end;

{ TfrmMSNPopForm }

procedure TPopupForm.Paint;
var
  Buf: TBitmap;
begin
  Buf := TBitmap.Create();
  Buf.Width := ClientWidth;
  Buf.Height := ClientHeight;
  Buf.Canvas.Draw(0, 0, FBackground);

  BitBlt(Canvas.Handle, 0, 0, Width, Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);

  Buf.Free();
end;

procedure TPopupForm.FormCreate(Sender: TObject);
begin
  FBackground := TBitmap.Create();
  FBackground.LoadFromResourceName(hInstance, 'POPUPFORM');
  FQuickHide := false;
  Width := FBackground.Width;
  Height := FBackground.Height;
  Left := GetWorkAreaRect().Right - Width - 18;
  Top := GetWorkAreaRect().Bottom - Height;

  lblTitle.Left := 10;
  lblTitle.Top := 5;
  lblTitle.Width := ClientWidth - 30;
  lblTitle.Height := 18;
  lblTitle.Font.Charset:= GB2312_CHARSET;
  lblTitle.Font.Name:= '宋体';
  lblTitle.Font.Size:= 9;

  lblText.Left := 10;
  lblText.Top := 40;
  lblText.Width := ClientWidth - 20;
  lblText.Height := ClientHeight - 50;
  lblText.Font.Charset:= GB2312_CHARSET;
  lblText.Font.Name:= '宋体';
  lblText.Font.Size:= 9;
end;

procedure TPopupForm.FormDestroy(Sender: TObject);
begin
  FBackground.Free();
  FBackground := nil;
end;

procedure TPopupForm.CreateParams(var Param: TCreateParams);
begin
  inherited;
  Param.WndParent := GetDesktopWindow;
  Param.Style := WS_POPUP;
end;

procedure TPopupForm.FormShow(Sender: TObject);
begin
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or
    SWP_NOACTIVATE);
  AnimateWindow(Handle, AnimateTime, AW_SLIDE or AW_VER_NEGATIVE);
  RefreshControl(Self);
  FStartTime := GetTickCount();
end;

procedure TPopupForm.WMPRINTCLIENT(var Msg: TMessage);
begin
  PaintTo(HDC(Msg.WParam), 0, 0);
end;

procedure TPopupForm.FormHide(Sender: TObject);
begin
  if not FQuickHide then
  begin
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or
      SWP_NOACTIVATE);
    AnimateWindow(Handle, AnimateTime, AW_SLIDE or AW_VER_POSITIVE or AW_HIDE);
    RefreshControl(Self);
  end
  else
    FQuickHide := false;
end;

procedure TPopupForm.Timer1Timer(Sender: TObject);
var
  PastTime: Integer;
begin
  PastTime := GetTickCount() - FStartTime;
  if (PastTime >= StayTime) or (PastTime < 0) then
  begin
    Timer1.Enabled := false;
    Hide();
  end;
end;

procedure TPopupForm.FormClick(Sender: TObject);
begin
  if ClickHide then
  begin
    Timer1.Enabled := false;
    Hide();
  end;
end;

procedure TPopupForm.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    if ((X >= 162) and (X <= 175) and (Y >= 6) and (Y <= 19)) then
    begin
      FQuickHide := true;
      Timer1.Enabled := false;
      Hide();
    end;
  end;
end;

procedure TPopupForm.lblTextMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnLink) then
    FOnLink(Sender)
  else
  begin
    Timer1.Enabled := false;
    Hide();
  end;
end;

procedure TPopupForm.lblTextMouseEnter(Sender: TObject);
begin
  if Assigned(FOnLink) then
  begin
    lblText.Cursor:= crHandPoint;
    lblText.Font.Color:= clBlue;
    lblText.Font.Style:= Font.Style + [fsUnderline];
  end;
end;

procedure TPopupForm.lblTextMouseLeave(Sender: TObject);
begin
  if Assigned(FOnLink) then
  begin
    lblText.Cursor:= crDefault;
    lblText.Font.Color:= clDefault;
    lblText.Font.Style:= Font.Style - [fsUnderline];
  end;
end;

end.