Форум программистов [Powered by Invision Power Board]

Код

program DesktopPaint;

uses
  windows,messages;

const sWndClassName='TransparentDrawingSurface';
      sWndName='DesktopPaint';
      TransparentColor=$00010101;
      PictureColor=$0000FF00;
      WH_MOUSE_LL=14;

type MSLLHOOKSTRUCT=record
                    pt:TPoint;
                    mouseData,
                    flags,
                    time:DWORD;
                    dwExtraInfo:pointer;
                    end;

var hHook:THANDLE;SurfaseWnd:HWND;

procedure Paint(wnd:HWND;color:COLORREF;pt:TSmallPoint);
var dc:HDC;OriginalPen:HPEN;OriginalBrush:HBRUSH;
begin
dc:=GetDC(wnd);
OriginalPen:=SelectObject(dc,GetStockObject(NULL_PEN));
OriginalBrush:=SelectObject(dc,CreateSolidBrush(color));
ellipse(dc,pt.x-10,pt.y-10,pt.x+10,pt.y+10);
SelectObject(dc,OriginalPen);
DeleteObject(SelectObject(dc,OriginalBrush));
ReleaseDC(wnd,dc);
end;

function MouseHook(nCode:integer;msg:cardinal;var info:MSLLHOOKSTRUCT):integer;stdcall;
var buttons:integer;pt:TSmallPoint;
begin
result:=CallNextHookEx(0,nCode,integer(msg),integer(@info));
if nCode=HC_ACTION
   then begin
        buttons:=0;
        if Hi(GetAsyncKeyState(VK_LBUTTON))<>0
           then buttons:=MK_LBUTTON;
        if Hi(GetAsyncKeyState(VK_RBUTTON))<>0
           then buttons:=buttons or MK_RBUTTON;
        pt.x:=info.pt.X;
        pt.y:=info.pt.Y;
        SendMessage(SurfaseWnd,WM_MOUSEMOVE,buttons,integer(pt));
        end;
end;

procedure Hook;
begin
hHook:=SetWindowsHookEx(WH_MOUSE_LL,@MouseHook,hInstance,0);
end;

procedure Unhook;
begin
UnhookWindowsHookEx(hHook);
end;

function WndProc(wnd:HWND;msg:cardinal;wParam,lParam:integer):integer;stdcall;
begin
result:=DefWindowProc(wnd,msg,wParam,lParam);
case msg of
  WM_NCCREATE:begin
              SurfaseWnd:=wnd;
              SetLayeredWindowAttributes(wnd,TransparentColor,0,LWA_COLORKEY);
              Hook;
              end;
 WM_NCDESTROY:begin
              Unhook;
              PostQuitMessage(0);
              end;
 WM_MOUSEMOVE:if (wParam and MK_LBUTTON)=0
                 then if (wParam and MK_RBUTTON)<>0
                         then Paint(wnd,TransparentColor,TSmallPoint(lParam))
                         else 
                 else Paint(wnd,PictureColor,TSmallPoint(lParam));
end;
end;

function CreateSurfaceWnd:boolean;
var cls:WNDCLASS;
begin
ZeroMemory(@cls,SizeOf(cls));
with cls do begin
            lpfnWndProc:=@WndProc;
            lpszClassName:=sWndClassName;
            hbrBackground:=CreateSolidBrush(TransparentColor);
            hCursor:=LoadCursor(0,IDC_ARROW);
            end;
result:=(RegisterClass(cls)<>0) and
        (CreateWindowEx(WS_EX_LAYERED or WS_EX_TOPMOST,
                        sWndClassName,sWndName,
                        WS_POPUP or WS_MAXIMIZE or WS_VISIBLE,
                        0,0,0,0,0,0,0,nil)<>0)
end;

var msg:TMSG;
begin
if CreateSurfaceWnd
  then while GetMessage(msg,0,0,0) do
        DispatchMessage(msg);
end.