網絡螞蟻和FlashGet的懸浮窗口的實現

　　最近有網友問道如何用 Delphi 實現網絡螞蟻和FlashGet的懸浮窗口筆者對使用到的相關技巧做了整理如下:

　　懸浮窗口

　　Delphi 的 TFormFormStyle 具有 fsStayOnTop 屬性但只是對其程序本身而言的也就是說只在此應用程序本身的窗口中是前端顯示的其他的程序的窗口仍然可以覆蓋此類型的窗口這是應為此窗口的父窗口是 TApplication 要讓懸浮窗口獨立的顯示在屏幕前端應在創建窗口時將其父窗口設置為桌面

　　Form := TFormCreateParented(GetDesktopWindow);

　　允許 Client 區域拖動窗口

　　這只要捕獲窗口的 WM_NCHITTEST 消息將客戶區HitTest(HTCLIENT)變成標題欄的HitTest(HTCAPTION)就可以了

　　半透明

　　Windows/XP 給窗口增加了WS_EX_LAYERED 屬性並通過 API　SetLayeredWindowAttributes(); 來設置此屬性的詳細信息Delphi 的 Forms 單元已經支持此窗口屬性

    property AlphaBlend default False;       // 是否使用半透明效果
    property AlphaBlendValue default ;   // 透明度
    property TransparentColor default False;   // 是否使用穿透色
    property TransparentColorValue default ;  // 穿透色
    (*此功能僅 Windows/XP 支持不要在 Winx 嘗試此特效)

　　接收來自 Shell 的鼠標拖拽

　　這將使用到 ActiveX 單元的 IDropTarget 接口並擴展你的 Form 類

      TForm = class(TForm IDropTarget)
      
      end;

　　並在窗口擁有句柄後用 RegisterDragDrop() 注冊成為 DragDrop 接受目標

　　以下是實現的代碼:

unit DropBin;

interface

uses
  Windows Messages SysUtils Variants Classes Graphics Controls Forms
  Dialogs Menus ExtCtrls ActiveX ComObj;

type
  TfrmDropBin = class(TForm IDropTarget)
  private
    procedure WMNCHitTest(var Msg:TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure DoClose(var Action: TCloseAction); override;
    // DragDrop 支持
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function IDropTarget_DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function IDropTargetDragOver = IDropTarget_DragOver;  // 解決 IDropTargetDragOver 與 TFormDragOver 沖突問題
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  frmDropBin: TfrmDropBin;

procedure ShowDropBin(Sender: TMenuItem);

implementation

{$R *dfm}

type
  // 雖然 Delphi 的 Windows 單元定義了 SetLayeredWindowAttributes(); ( external Userdll )
  // 但為了兼容 Winx 不能直接調用
  TSetLayeredWindowAttributes = function (Hwnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;

var
  UserModH: HMODULE;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes = nil;

procedure ShowDropBin(Sender: TMenuItem);
begin
  if Assigned(frmDropBin) then frmDropBinClose
  else begin
    frmDropBin := TfrmDropBinCreateParented(GetDesktopWindow);
  end;
end;

constructor TfrmDropBinCreate(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := ;
  Height := ;
end;

procedure TfrmDropBinCreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := WS_POPUP or WS_CLIPSIBLINGS {or WS_BORDER};
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
  end;
end;

procedure TfrmDropBinCreateWnd;
begin
  inherited CreateWnd;
  Visible := True;
  // 為 /XP 創建半透明穿透效果
  if Assigned(SetLayeredWindowAttributes) then begin
    SetWindowLong(Handle GWL_EXSTYLE GetWindowLong(Handle GWL_EXSTYLE) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(Handle clWhite LWA_ALPHA or LWA_COLORKEY);
  end;
  // 設置為接受拖拽
  OleCheck(RegisterDragDrop(Handle Self));
end;

procedure TfrmDropBinDestroyWnd;
begin
  if HandleAllocated then RevokeDragDrop(Handle);
  inherited DestroyWnd;
end;

function TfrmDropBinDragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
  //
  // 也可以在此判斷是否接受拖拽修改 dwEffect 可以得到不同的效果
  //
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TfrmDropBinIDropTarget_DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TfrmDropBinDragLeave: HResult; stdcall;
begin
  Result := S_OK;
end;

function TfrmDropBinDrop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
  //
  // 處理 dataObj 中包含的拖拽內容
  //
  dwEffect := DROPEFFECT_NONE;
  Result := S_OK;
end;

procedure TfrmDropBinDoClose(var Action: TCloseAction);
begin
  Action := caFree;
  frmDropBin := nil;
end;

procedure TfrmDropBinWMNCHitTest(var Msg:TWMNCHitTest);
begin
  // 通過 Client 區拖動窗口
  DefaultHandler(Msg);
  if MsgResult = HTCLIENT then
  MsgResult:= HTCAPTION;
end;

initialization
  OleInitialize(nil);
  // 為兼容 Winx
  UserModH := GetModuleHandle(Userdll);
  if UserModH <> then @SetLayeredWindowAttributes := GetProcAddress(UserModH SetLayeredWindowAttributes);

finalization
  OleUninitialize;
 
end

From:http://tw.wingwit.com/Article/program/Delphi/201311/25040.html