Implementation of "Network Ants" and "Flashget" floating window

Recently, some netizens have asked how to implement "network ant" and "flashget" floating window with Delphi, and the author has finished the relevant skills used as follows:

1. Suspend window Delphi's TForm.FormStyle has a fsstayontop property, but only for its programs itself, that is Window. This is the parent window that should be the window is Tapplication. To make the floating window independent display on the front end of the screen, set its parent window to "Desktop" when the window is created. FORM2: = TFORM2.CREATEPARENTED (GETDESKTOPWINDOW);

2. Allow the Client Region to drag the window This will be able to capture the WM_NCHITTEST message of the window, turn the client-hittest (htclient) hittest (htcaption).

3. Translucent Windows2000 / XP adds the WS_EX_LAYERED attribute to the window and sets the details of this property by apisetlayeredwindowattributes (); This window properties have been supported by the Forms unit of Delphi 6. property AlphaBlend default False; // whether translucent property AlphaBlendValue default 255; // transparency 0..255 property TransparentColor default False; // whether color penetration property TransparentColorValue default 0; // Color penetration (* this function WINDOWS2000 / XP support, don't try this effect in Win9X)

4. Receive mice from the shell, which will use the iDropTarget interface of the ActiveX unit and expand your FORM class. TFORM2 = Class (TFORM, IDROPTARGET) .... End; and after the window has a handle, register with registerdragdrop () becomes DragDrop accepting target.

The following is the code implemented:

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 support 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 IDropTarget.DragOver = IDropTarget_DragOver; // solve IDropTarget.DragOver and TForm.DragOver conflict function DragLeave: HResult; stdcall; function Drop (const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect : Longint; stdcall; public constructor create (Aowner: tComponent); Override; End; Var frmdropbin: Tfrmdropbin;

Procedure Showdropbin (Sender: TMenuItem);

IMPLEMentation

{$ R * .dfm}

Type // Although Delphi's Windows unit defines setlayeredWindowAttributes (); (external 'user32.dll') // But in order to be compatible with Win9x, it cannot be called directly. TsetlayeredWindowAttributes = Function (hwnd: Thandle; CRKEY: ColorRef; Balpha: Byte; DWFLAGS: DWORD): Boolean; stdcall;

VAR User32Modh: hmodule; setlayeredWindowAttributes: tsetlayeredwindowattributes = nil;

Procedure Showdropbin (Sender: TMenuItem); Begin if Assigned (frmdropbin) THENFRMDROPBIN.CREATEPARENTED (GETDESKTOPWINDOW); END;

Constructor tfrmdropbin.create (Aowner: Tcomponent); Begin inherited create (aowner); width: = 32; Height: = 32;

procedure TfrmDropBin.CreateParams (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 TfrmDropBin.CreateWnd; begin inherited CreateWnd; Visible: = True; // create semi-transparent for the 2000 / XP, penetrating effect if Assigned (SetLayeredWindowAttributes) then begin SetWindowLong (Handle, GWL_EXSTYLE, GetWindowLong (Handle, GWL_EXSTYLE) or WS_EX_LAYERED); SetLayeredWindowAttributes (Handle, clWhite, 128, LWA_ALPHA or LWA_COLORKEY); END; // Set to accept drag olecheck (RegisterDragdrop (Handle, Self));

Procedure tfrmdropbin.destroyWnd; Begin if HandleAlOcated the revokedragdrop (Handle); inherited destroywnd;

Function TFRMDROPBIN.DRAGENTER (Const DataObj: iDataObject; pt: tpoint; var dweffect: long; begin // // can also determine whether to accept drag, modify DWEFFECT can get different effects ... // dweffect: = DROPEFFECT_COPY; Result: = S_OK; END;

Function tfrmdropbin.idroptarget_dragover (pt: tpoint; var dweffect: long): hResult; stdcall; begin dweffect: = dropeffect_copy; result: = s_ok; end;

Function tfrmdropbin.dragleave: hResult; stdcall; begin result: = s_ok;

function TfrmDropBin.Drop (const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; drag processing contents begin // // dataobj included ... // dwEffect: = DROPEFFECT_NONE Result: = S_OK; END;

Procedure tfrmdropbin.doclose (var Action: tclosection); begin action: = cafree; frmdropbin: = nil; end;

procedure TfrmDropBin.WMNCHitTest (var Msg: TWMNCHitTest); begin // drag the window DefaultHandler (Msg) via Client zone; if Msg.Result = HTCLIENT then Msg.Result: = HTCAPTION; end; initialization OleInitialize (nil); // is Compatible with Win9x User32Modh: = getModuleHandle ('user32.dll'); if User32Modh <> 0 Then @setlayeredWindowAttributes: = getProcaddress (user32modh, 'setlayeredWindowAttributes ";

Finalization oleuninitialize; end.

Author Homepage: http://oopsware.delphibbs.com/

----- End of file ------