unit unitLayeredWindow;

{-$DEFINE PNGIMAGE}
{$DEFINE GDIPLUS}

interface

uses Windows, Messages, Controls, Graphics, Classes
     {$IFDEF PNGIMAGE}, PngImage{$ENDIF}
     {$IFDEF GDIPLUS}, GDIPAPI{$ENDIF};

type
  TLayeredWindow = class
  private
    function getWindowRect: TRect;
    function getTopMost: Boolean;
    procedure setTopMost(const Value: Boolean);
  private
    hwnd : HWND;
    procedure SetHeight(const Value: Integer);
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
    function getHeight: Integer;
    function getLeft: Integer;
    function getTop: Integer;
    function getVisible: Boolean;
    function getWidth: Integer;
    property WindowRect : TRect read getWindowRect;
  public
    OnClick     : TNotifyEvent;
    OnDblClick  : TNotifyEvent;
    OnKeyDown   : TKeyEvent;
    OnKeyPress  : TKeyPressEvent;
    OnKeyUp     : TKeyEvent;
    (* Evento que se produce cuando se presiona un botón del mouse sobre la ventana *)
    OnMouseDown : TMouseEvent;
    (* Evento que se produce cuando se suelta un botón del mouse sobre la ventana *)
    OnMouseUp   : TMouseEvent;
    (* Evento que se produce cuando se mueve el mouse sobre la ventana *)
    OnMouseMove : TMouseMoveEvent;
    (* Crea una nueva ventana. Si se especifica owner, la nueva ventana quedará
       siempre encima de esa otra ventana.
       Es válido pasar el Handle de otro TLayeredWindow.
       Si no desea especificar un owner, pase un cero *)
    constructor Create (owner : HWND);
    (* Devuelve el HWND de la ventana *)
    property Handle : HWND read hwnd;
    (* Establece o devuelve la posición de la ventana respecto de la esquina
       superior izquierda de la pantalla *)
    property Left : Integer read getLeft write setLeft;
    property Top : Integer read getTop write setTop;
    (* Establece o devuelve el tamaño de la ventana *)
    property Width : Integer read getWidth write setWidth;
    property Height : Integer read getHeight write setHeight;
    (* Establece o devuelve si la ventana es visible o no *)
    property Visible : Boolean read getVisible write setVisible;

    property TopMost : Boolean read getTopMost write setTopMost;
    (* Actualiza la imagen mostrada con la del HDC especificado.
       La imagen debe ser de 32 bits, con transparencia pre-multiplicada
       y debe tener las mismas dimensiones que la ventana *)
    procedure Update (dc : HDC); overload;
    (* Actualiza la imagen mostrada con la del bitmap especificado.
       Es equivalente a llamar a Update con bmp.Canvas.Handle *)
    procedure Update (bmp : TBitmap); overload;
    {$IFDEF PNGIMAGE}
    (* Actualiza la imagen mostrada con la del PNG especificado.
       La rutina se encarga de convertir de ARGB a ARGB premultiplicado
       No se modifica el PNG *)
    procedure Update (png : TPngObject); overload;
    {$ENDIF}
    {$IFDEF GDIPLUS}
    (* Actualiza la imagen mostrada con la del TGpBitmap especificado.
       El bitmap debe ser de formato PixelFormat32bppPARGB, sí o sí *)
    procedure Update (bmp : GpBitmap); overload;
    {$ENDIF}
    destructor Destroy; override;
  end;

implementation

const
  layered_class = 'TLayeredWindow';

const
  WS_EX_LAYERED = $80000;
  AC_SRC_ALPHA = 1;
  ULW_ALPHA = 2;

var
  layered_windows : TList;

function UpdateLayeredWindow (hwnd : HWND; dstHDC : HDC; ppDst : PPoint; ASize : PSize; srcHDC : HDC; pptSrc : PPoint; crKey : COLORREF; var bf : _BLENDFUNCTION; dwFlag : DWORD) : BOOL; stdcall; external 'user32.dll' name 'UpdateLayeredWindow';

{ TLayeredWindow }

constructor TLayeredWindow.Create(owner: HWND);
const
  CW_USEDEFAULT : Integer = Integer(Windows.CW_USEDEFAULT);
begin
  hwnd := CreateWindowEx (WS_EX_TOOLWINDOW Or WS_EX_LAYERED, layered_class, nil, WS_POPUP, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, owner, 0, hInstance, nil);
  OnClick     := nil;
  OnDblClick  := nil;
  OnKeyDown   := nil;
  OnKeyPress  := nil;
  OnKeyUp     := nil;
  OnMouseDown := nil;
  OnMouseMove := nil;
  OnMouseUp   := nil;
  layered_windows.Add (self);
end;

destructor TLayeredWindow.Destroy;
begin
  layered_windows.Remove (self);
  DestroyWindow (hwnd);
  inherited;
end;

function MouseButton (msg : UINT) : TMouseButton;
begin
  Result := mbLeft;
  Case msg of
  WM_LBUTTONDOWN, WM_LBUTTONUP:
    Result := mbLeft;
  WM_RBUTTONDOWN, WM_RBUTTONUP:
    Result := mbRight;
  WM_MBUTTONDOWN, WM_MBUTTONUP:
    Result := mbMiddle;
  end;
end;

function ShiftState (param : WPARAM) : TShiftState;
begin
  Result := [];
  If (param And MK_CONTROL) = MK_CONTROL Then
    Result := Result + [ssCtrl];
  If (param And MK_SHIFT) = MK_SHIFT Then
    Result := Result + [ssShift];
  If (param And MK_LBUTTON) = MK_LBUTTON Then
    Result := Result + [ssLeft];
  If (param And MK_RBUTTON) = MK_RBUTTON Then
    Result := Result + [ssRight];
  If (param And MK_MBUTTON) = MK_MBUTTON Then
    Result := Result + [ssMiddle];
  If (GetAsyncKeyState (VK_MENU) And $8000) = $8000 Then
    Result := Result + [ssAlt];
end;

function layered_WindowProc (hwnd : HWND; uMsg : UINT; wParam : WPARAM; lParam : LPARAM) : Cardinal; stdcall;
var
  i : Integer;
  window : TLayeredWindow;
begin
  For i := 0 To layered_windows.Count-1 do
  begin
    window := layered_windows[i];
    If window.hwnd = hwnd Then
    begin
      If (uMsg = WM_LBUTTONDBLCLK) Then
      begin
        If @window.OnDblClick <> nil then
          window.OnDblClick (window);
      end;
      If (uMsg = WM_LBUTTONDOWN) Or (uMsg = WM_RBUTTONDOWN) Or (uMsg = WM_MBUTTONDOWN) Then
      begin
        If @window.OnMouseDown <> nil Then
          window.OnMouseDown (window, MouseButton(uMsg), ShiftState(wParam), LOWORD(lParam), HIWORD(lParam));
      end;
      If (uMsg = WM_LBUTTONUP) Or (uMsg = WM_RBUTTONUP) Or (uMsg = WM_MBUTTONUP) Then
      begin
        If @window.OnMouseUp <> nil Then
          window.OnMouseUp (window, MouseButton(uMsg), ShiftState(wParam), LOWORD(lParam), HIWORD(lParam));
      end;
      If (uMsg = WM_LBUTTONUP) Then
      begin
        If @window.OnClick <> nil Then
          window.OnClick (window);
      end;
      If (uMsg = WM_MOUSEMOVE) Then
      begin
        If @window.OnMouseMove <> nil Then
          window.OnMouseMove (window, ShiftState(wParam), LOWORD(lParam), HIWORD(lParam));
      end;
      If (uMsg = WM_KEYDOWN) Then
      begin
        If @window.OnKeyDown <> nil Then
          window.OnKeyDown (window, PWORD(@wParam)^, []); 
      end;
      If (uMsg = WM_KEYUP) Then
      begin
        If @window.OnKeyUp <> nil Then
          window.OnKeyUp (window, PWORD(@wParam)^, []);
      end;
      If (uMsg = WM_CHAR) Then
      begin
        If @window.OnKeyPress <> nil Then
          window.OnKeyPress (window, PChar(@wParam)^);
      end;
    end;
  end;
  Result := DefWindowProc (hwnd, uMsg, wParam, lParam);
end;

procedure RegisterLayeredWindowClass;
var
  cls : WNDCLASSEX;
begin
  FillChar (cls, sizeof(cls), 0);
  cls.cbSize := sizeof (cls);
  cls.style := CS_DBLCLKS;
  cls.lpfnWndProc := @layered_WindowProc;
  cls.cbClsExtra := 0;
  cls.cbWndExtra := 0;
  cls.hInstance := hInstance;
  cls.hIcon := 0;
  cls.hCursor := LoadCursor (0, IDC_ARROW);
  cls.hbrBackground := 0;
  cls.lpszMenuName := nil;
  cls.lpszClassName := layered_class;
  cls.hIconSm := 0;
  RegisterClassEx (cls);
end;

procedure UnregisterLayeredWindowClass;
begin
  Windows.UnregisterClass (layered_class, hInstance);
end;

function TLayeredWindow.getHeight: Integer;
begin
  Result := WindowRect.Bottom - WindowRect.Top;
end;

function TLayeredWindow.getLeft: Integer;
begin
  Result := WindowRect.Left;
end;

function TLayeredWindow.getTop: Integer;
begin
  Result := WindowRect.Top;
end;

function TLayeredWindow.getTopMost: Boolean;
begin
  Result := (GetWindowLong (hwnd, GWL_STYLE) And WS_EX_TOPMOST) = WS_EX_TOPMOST;
end;

function TLayeredWindow.getVisible: Boolean;
begin
  Result := IsWindowVisible (hwnd);
end;

function TLayeredWindow.getWidth: Integer;
begin
  Result := WindowRect.Right - WindowRect.Left;
end;

function TLayeredWindow.getWindowRect: TRect;
begin
  Windows.GetWindowRect (hwnd, Result);
end;

procedure TLayeredWindow.SetHeight(const Value: Integer);
begin
  SetWindowPos (hwnd, 0, 0, 0, Width, Value, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOMOVE);
end;

procedure TLayeredWindow.SetLeft(const Value: Integer);
begin
  SetWindowPos (hwnd, 0, Value, Top, 0, 0, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOSIZE);
end;

procedure TLayeredWindow.SetTop(const Value: Integer);
begin
  SetWindowPos (hwnd, 0, Left, Value, 0, 0, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOSIZE);
end;

procedure TLayeredWindow.setTopMost(const Value: Boolean);
begin
  If Value Then
    SetWindowPos (hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
  Else
    SetWindowPos (hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE);
end;

procedure TLayeredWindow.SetVisible(const Value: Boolean);
begin
  If Value Then
    ShowWindow (hwnd, SW_SHOWNA)
  Else
    ShowWindow (hwnd, SW_HIDE);
end;

procedure TLayeredWindow.SetWidth(const Value: Integer);
begin
  SetWindowPos (hwnd, 0, 0, 0, Value, Height, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOMOVE);
end;

procedure TLayeredWindow.Update(bmp: TBitmap);
begin
  Update (bmp.Canvas.Handle);
end;

{$IFDEF PNGIMAGE}
procedure TLayeredWindow.Update(png: TPngObject);
var
  bmp : TBitmap;
  x, y : Integer;
  ps, pa, pd : PByteArray;
begin
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf32bit;
  bmp.Width := png.Width;
  bmp.Height := png.Height;
  For y := 0 To bmp.Height-1 do
  begin
    ps := png.Scanline[y];
    pa := png.AlphaScanline[y];
    pd := bmp.Scanline[y];
    For x := 0 To bmp.Width-1 do
    begin
      pd[x*4  ] := ps[x*3  ] * pa[x] div 255;
      pd[x*4+1] := ps[x*3+1] * pa[x] div 255;
      pd[x*4+2] := ps[x*3+2] * pa[x] div 255;
      pd[x*4+3] := pa[x    ];
    end;
  end;
  Update (bmp);
  bmp.Destroy;
end;
{$ENDIF}

procedure TLayeredWindow.Update(dc: HDC);
var
  my_dc : HDC;
  dpt, spt : TPoint;
  dsz : TSize;
  bf : TBlendFunction;
begin
  dpt := Point (Left, Top);
  spt := Point (0, 0);
  dsz := TSize (Point (Width, Height));

  bf.BlendOp := AC_SRC_OVER;
  bf.BlendFlags := 0;
  bf.SourceConstantAlpha := $FF;
  bf.AlphaFormat := AC_SRC_ALPHA;

  my_dc := GetDC (hwnd);

  UpdateLayeredWindow (hwnd, my_dc, @dpt, @dsz, dc, @spt, 0, bf, ULW_ALPHA);

  ReleaseDC (hwnd, my_dc);
end;

{$IFDEF GDIPLUS}
procedure TLayeredWindow.Update(bmp: GpBitmap);
var
  bd : TBitmapData;
  gdibmp : TBitmap;
  y : Integer;
begin
  FillChar (bd, sizeof(bd), 0);
  GdipBitmapLockBits (bmp, nil, ImageLockModeRead, PixelFormat32bppPARGB, @bd);
  gdibmp := TBitmap.Create;
  gdibmp.PixelFormat := pf32bit;
  gdibmp.Width := bd.Width;
  gdibmp.Height := bd.Height;
  For y := 0 To bd.Height-1 do
    Move (PChar(bd.Scan0)[y*bd.Stride], gdibmp.Scanline[y]^, bd.Width*4);
  Update (gdibmp.Canvas.Handle);
  gdibmp.Destroy;
  GdipBitmapUnlockBits (bmp, @bd);
end;
{$ENDIF}

initialization
  RegisterLayeredWindowClass;
  layered_windows := TList.Create;
finalization
  layered_windows.Destroy;
  UnregisterLayeredWindowClass;
end.