unit unitLayeredWindow;

// Use PngImage.pas (TPNGObject component)
{-$DEFINE PNGIMAGE}
// Use GDIPlus.pas
{$DEFINE GDIPLUS}
// Use GDIPObj.pas
{$DEFINE GDIPOBJ}

interface

{$IFDEF GDIPOBJ}
{$IFNDEF GDIPLUS}
{$DEFINE GDIPLUS}
{$ENDIF}
{$ENDIF}

uses Windows, Messages, Controls, Graphics, Classes
     {$IFDEF PNGIMAGE}, PngImage{$ENDIF}
     {$IFDEF GDIPLUS}, GDIPAPI{$ENDIF}
     {$IFDEF GDIPOBJ}, GDIPOBJ{$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;
    (* Event called when a mouse button is pressed on the window *)
    OnMouseDown : TMouseEvent;
    (* Event called when the mouse button is released *)
    OnMouseUp   : TMouseEvent;
    (* Event called when mouse cursor is moved over the window *)
    OnMouseMove : TMouseMoveEvent;
    (* Creates a new window. If an owner is specified, the new window
       will always appear over the owner window.
       You can pass the Handle from another TLayeredWindow.
       If you don't want to specify an owner, pass zero *)
    constructor Create (owner : HWND);
    (* Returns the window handle *)
    property Handle : HWND read hwnd;
    (* Get or set window position in screen coordinates *)
    property Left : Integer read getLeft write setLeft;
    property Top : Integer read getTop write setTop;
    (* Get or set window size *)
    property Width : Integer read getWidth write setWidth;
    property Height : Integer read getHeight write setHeight;
    (* Get or set window visible *)
    property Visible : Boolean read getVisible write setVisible;

    property TopMost : Boolean read getTopMost write setTopMost;
    (* Updates the shown image with the one from bitmap associated with HDC.
       Image must be 32 bits per pixel, pre-multiplied alpha,
       same dimensions than the layered window *)
    procedure Update (dc : HDC); overload;
    (* Updates the shown image with the one in the TBitmap.
       It's equivalent to calling Update (bmp.Canvas.Handle) *)
    procedure Update (bmp : TBitmap); overload;
    {$IFDEF PNGIMAGE}
    (* Updates shown image with the one in the PNG.
       No need to convert to pre-multiplied alpha
       The PNG remains unmodified after calling this function *)
    procedure Update (png : TPngObject); overload;
    {$ENDIF}
    {$IFDEF GDIPLUS}
    (* Updates the image with the one from the GpBitmap.
       The bitmap SHOULD have pixel format PixelFormat32bppPARGB *)
    procedure Update (bmp : GpBitmap); overload;
    {$ENDIF}
    {$IFDEF GDIPOBJ}
    (* Updates the image with the one from the TGpBitmap.
       The bitmap SHOULD have pixel format PixelFormat32bppPARGB *)
    procedure Update (bmp : TGpBitmap); 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}

{$IFDEF GDIPOBJ}
procedure TLayeredWindow.Update(bmp: TGpBitmap);
var
  bd : TBitmapData;
  gdibmp : TBitmap;
  y : Integer;
  rect : TGpRect;
begin
  FillChar (bd, sizeof(bd), 0);
  rect.X := 0;
  rect.Y := 0;
  rect.Width  := bmp.GetWidth;
  rect.Height := bmp.GetHeight;
  bmp.LockBits (rect, 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;
  bmp.UnlockBits (bd);
end;
{$ENDIF}

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