{
 /***************************************************************************
                         win32proc.pp  -  Misc Support Functions
                             -------------------



 ***************************************************************************/

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
unit win32proc;

{$mode objfpc}{$H+}
{$I win32defines.inc}

interface

uses
  Windows, Win32Extra, Classes, SysUtils,
  LMessages, LCLType, LCLProc, LCLMessageGlue,Controls, Forms, Menus, GraphType, IntfGraphics;

const
  LV_DISP_INFO_COUNT = 2;  
  
Type
  TEventType = (etNotify, etKey, etKeyPress, etMouseWheel, etMouseUpDown);

  TParentMsgHandlerProc = function(const AWinControl: TWinControl; Window: HWnd;
      Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam;
      var MsgResult: Windows.LResult; var WinProcess: Boolean): Boolean;

  PWin32WindowInfo = ^TWin32WindowInfo;
  TWin32WindowInfo = record
    Overlay: HWND;           // overlay, transparent window on top, used by designer
    UpDown: HWND;
    PopupMenu: TPopupMenu;
    DefWndProc: WNDPROC;
    ParentMsgHandler: TParentMsgHandlerProc;
    WinControl: TWinControl;
    PWinControl: TWinControl; // control to paint for
    AWinControl: TWinControl; // control associated with (for buddy controls)
    List: TStrings;
    StayOnTopList: TList;     // a list of windows that were normalized when showing modal
    needParentPaint: boolean; // has a tabpage as parent, and is winxp themed
    isTabPage: boolean;       // is window of tabpage
    isComboEdit: boolean;     // is buddy of combobox, the edit control
    isChildEdit: boolean;     // is buddy edit of a control
    ThemedCustomDraw: boolean;// controls needs themed drawing in wm_notify/nm_customdraw
    MaxLength: integer;
    DrawItemIndex: integer;   // in case of listbox, when handling WM_DRAWITEM
    DrawItemSelected: boolean;// whether this item is selected LB_GETSEL not uptodate yet
    MouseX, MouseY: smallint; // noticing spurious WM_MOUSEMOVE messages
    DispInfoTextA: array [0..LV_DISP_INFO_COUNT-1] of AnsiString; // buffer for ListView LVN_GETDISPINFO notification
    DispInfoTextW: array [0..LV_DISP_INFO_COUNT-1] of WideString; // it's recommended to keep buffer unchanged
    DispInfoIndex: Integer;                    // between 2 calls of LVN_GETDISPINFO  
    IMEComposed: Boolean;
    case integer of
      0: (spinValue: Double);
      1: (
        TrackValid: Boolean; // Set when we have a valid trackpos
        TrackPos: Integer    // keeps the thumb position while tracking
      );
  end;

function WM_To_String(WM_Message: Integer): string;
function WindowPosFlagsToString(Flags: UINT): string;
procedure EventTrace(Message: String; Data: TObject);
procedure AssertEx(const Message: String; const PassErr: Boolean;
  const Severity: Byte);
procedure AssertEx(const PassErr: Boolean; const Message: String);
procedure AssertEx(const Message: String);
function GetShiftState: TShiftState;
procedure CallEvent(const Target: TObject; Event: TNotifyEvent;
  const Data: Pointer; const EventType: TEventType);
function ObjectToHWND(const AObject: TObject): HWND;
function LCLControlSizeNeedsUpdate(Sender: TWinControl;
  SendSizeMsgOnDiff: boolean): boolean;
function GetLCLClientBoundsOffset(Sender: TObject; var ORect: TRect): boolean;
function GetLCLClientBoundsOffset(Handle: HWnd; var Rect: TRect): boolean;
procedure LCLBoundsToWin32Bounds(Sender: TObject;
  var Left, Top, Width, Height: Integer);
procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt);
procedure GetWin32ControlPos(Window, Parent: HWND; var Left, Top: integer);

procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer);
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;

function AllocWindowInfo(Window: HWND): PWin32WindowInfo;
function DisposeWindowInfo(Window: HWND): boolean;
function GetWin32WindowInfo(Window: HWND): PWin32WindowInfo;

procedure RemoveStayOnTopFlags(Window: HWND; ASystemTopAlso: Boolean = False);
procedure RestoreStayOnTopFlags(Window: HWND);

procedure AddToChangedMenus(Window: HWnd);
procedure RedrawMenus;
function MeasureTextForWnd(const AWindow: HWND; Text: string; var Width, Height: integer): boolean;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
function GetControlText(AHandle: HWND): string;

procedure FillRawImageDescriptionColors(var ADesc: TRawImageDescription);
procedure FillRawImageDescription(const ABitmapInfo: Windows.TBitmap; out ADesc: TRawImageDescription);

function GetBitmapOrder(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP):TRawImageLineOrder;
function GetBitmapBytes(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; ALineOrder: TRawImageLineOrder; out AData: Pointer; out ADataSize: PtrUInt): Boolean;
function IsAlphaBitmap(ABitmap: HBITMAP): Boolean;
function IsAlphaDC(ADC: HDC): Boolean;

procedure BlendRect(ADC: HDC; const ARect: TRect; Color: ColorRef);
function GetLastErrorText(AErrorCode: Cardinal): String;
function BitmapToRegion(hBmp: HBITMAP; cTransparentColor: COLORREF = 0; cTolerance: COLORREF  = $101010): HRGN;

function WndClassName(Wnd: HWND): String; inline;
function WndText(Wnd: HWND): String; inline;

{ String functions that may be moved to the RTL in the future }
function WideStrLCopy(dest, source: PWideChar; maxlen: SizeInt): PWideChar;
procedure UpdateWindowsVersion;

type 
  PStayOnTopWindowsInfo = ^TStayOnTopWindowsInfo;
  TStayOnTopWindowsInfo = record
    AppWindow: HWND;
    SystemTopAlso: Boolean;
    StayOnTopList: TList;
  end;
  
  TWindowsVersion = (
    wvUnknown,
    wv95,
    wvNT4,
    wv98,
    wvMe,
    wv2000,
    wvXP,
    wvServer2003,
    //wvServer2003R2,  // has the same major/minor as wvServer2003
    wvVista,
    //wvServer2008,    // has the same major/minor as wvVista
    wv7,
    wvLater
  );

var
  DefaultWindowInfo: TWin32WindowInfo;
  WindowInfoAtom: ATOM;
  ChangedMenus: TList; // list of HWNDs which menus needs to be redrawn
  UnicodeEnabledOS: Boolean = False;

  WindowsVersion: TWindowsVersion = wvUnknown;


implementation

uses
  LCLStrConsts, Dialogs, StdCtrls, ExtCtrls,
  LCLIntf; //remove this unit when GetWindowSize is moved to TWSWinControl

{$IFOPT C-}
// Uncomment for local trace
//  {$C+}
//  {$DEFINE ASSERT_IS_ON}
{$ENDIF}

var
  InRemoveStayOnTopFlags: Integer = 0;
{------------------------------------------------------------------------------
  function: WM_To_String
  Params: WM_Message - a WinDows message
  Returns: A WinDows-message name

  Converts a winDows message identIfier to a string
 ------------------------------------------------------------------------------}
function WM_To_String(WM_Message: Integer): string;
begin
  case WM_Message of
    $0000: Result := 'WM_NULL';
    $0001: Result := 'WM_CREATE';
    $0002: Result := 'WM_DESTROY';
    $0003: Result := 'WM_MOVE';
    $0005: Result := 'WM_SIZE';
    $0006: Result := 'WM_ACTIVATE';
    $0007: Result := 'WM_SETFOCUS';
    $0008: Result := 'WM_KILLFOCUS';
    $000A: Result := 'WM_ENABLE';
    $000B: Result := 'WM_SETREDRAW';
    $000C: Result := 'WM_SETTEXT';
    $000D: Result := 'WM_GETTEXT';
    $000E: Result := 'WM_GETTEXTLENGTH';
    $000F: Result := 'WM_PAINT';
    $0010: Result := 'WM_CLOSE';
    $0011: Result := 'WM_QUERYENDSESSION';
    $0012: Result := 'WM_QUIT';
    $0013: Result := 'WM_QUERYOPEN';
    $0014: Result := 'WM_ERASEBKGND';
    $0015: Result := 'WM_SYSCOLORCHANGE';
    $0016: Result := 'WM_EndSESSION';
    $0017: Result := 'WM_SYSTEMERROR';
    $0018: Result := 'WM_SHOWWINDOW';
    $0019: Result := 'WM_CTLCOLOR';
    $001A: Result := 'WM_WININICHANGE or WM_SETTINGCHANGE';
    $001B: Result := 'WM_DEVMODECHANGE';
    $001C: Result := 'WM_ACTIVATEAPP';
    $001D: Result := 'WM_FONTCHANGE';
    $001E: Result := 'WM_TIMECHANGE';
    $001F: Result := 'WM_CANCELMODE';
    $0020: Result := 'WM_SETCURSOR';
    $0021: Result := 'WM_MOUSEACTIVATE';
    $0022: Result := 'WM_CHILDACTIVATE';
    $0023: Result := 'WM_QUEUESYNC';
    $0024: Result := 'WM_GETMINMAXINFO';
    $0026: Result := 'WM_PAINTICON';
    $0027: Result := 'WM_ICONERASEBKGND';
    $0028: Result := 'WM_NEXTDLGCTL';
    $002A: Result := 'WM_SPOOLERSTATUS';
    $002B: Result := 'WM_DRAWITEM';
    $002C: Result := 'WM_MEASUREITEM';
    $002D: Result := 'WM_DELETEITEM';
    $002E: Result := 'WM_VKEYTOITEM';
    $002F: Result := 'WM_CHARTOITEM';
    $0030: Result := 'WM_SETFONT';
    $0031: Result := 'WM_GETFONT';
    $0032: Result := 'WM_SETHOTKEY';
    $0033: Result := 'WM_GETHOTKEY';
    $0037: Result := 'WM_QUERYDRAGICON';
    $0039: Result := 'WM_COMPAREITEM';
    $003D: Result := 'WM_GETOBJECT';
    $0041: Result := 'WM_COMPACTING';
    $0044: Result := 'WM_COMMNOTIFY { obsolete in Win32}';
    $0046: Result := 'WM_WINDOWPOSCHANGING';
    $0047: Result := 'WM_WINDOWPOSCHANGED';
    $0048: Result := 'WM_POWER';
    $004A: Result := 'WM_COPYDATA';
    $004B: Result := 'WM_CANCELJOURNAL';
    $004E: Result := 'WM_NOTIFY';
    $0050: Result := 'WM_INPUTLANGCHANGEREQUEST';
    $0051: Result := 'WM_INPUTLANGCHANGE';
    $0052: Result := 'WM_TCARD';
    $0053: Result := 'WM_HELP';
    $0054: Result := 'WM_USERCHANGED';
    $0055: Result := 'WM_NOTIFYFORMAT';
    $007B: Result := 'WM_CONTEXTMENU';
    $007C: Result := 'WM_STYLECHANGING';
    $007D: Result := 'WM_STYLECHANGED';
    $007E: Result := 'WM_DISPLAYCHANGE';
    $007F: Result := 'WM_GETICON';
    $0080: Result := 'WM_SETICON';
    $0081: Result := 'WM_NCCREATE';
    $0082: Result := 'WM_NCDESTROY';
    $0083: Result := 'WM_NCCALCSIZE';
    $0084: Result := 'WM_NCHITTEST';
    $0085: Result := 'WM_NCPAINT';
    $0086: Result := 'WM_NCACTIVATE';
    $0087: Result := 'WM_GETDLGCODE';
    $0088: Result := 'WM_SYNCPAINT';
    $00A0: Result := 'WM_NCMOUSEMOVE';
    $00A1: Result := 'WM_NCLBUTTONDOWN';
    $00A2: Result := 'WM_NCLBUTTONUP';
    $00A3: Result := 'WM_NCLBUTTONDBLCLK';
    $00A4: Result := 'WM_NCRBUTTONDOWN';
    $00A5: Result := 'WM_NCRBUTTONUP';
    $00A6: Result := 'WM_NCRBUTTONDBLCLK';
    $00A7: Result := 'WM_NCMBUTTONDOWN';
    $00A8: Result := 'WM_NCMBUTTONUP';
    $00A9: Result := 'WM_NCMBUTTONDBLCLK';
    // edit control messages start (todo: add more if needed)
    $00B0: Result := 'EM_GETSEL';
    $00B1: Result := 'EM_SETSEL';
    $00B7: Result := 'EM_SCROLLCARET';
    $00C5: Result := 'EM_LIMITTEXT';
    $00CC: Result := 'EM_SETPASSWORDCHAR';
    $00CF: Result := 'EM_SETREADONLY';
    // edit control messages end
    // scrollbar control messages start
    $00E0: Result := 'SBM_SETPOS';
    $00E1: Result := 'SBM_GETPOS';
    $00E2: Result := 'SBM_SETRANGE';
    $00E3: Result := 'SBM_GETRANGE';
    $00E4: Result := 'SBM_ENABLE_ARROWS';
    $00E6: Result := 'SBM_SETRANGEREDRAW';
    $00E9: Result := 'SBM_SETSCROLLINFO';
    $00EA: Result := 'SBM_GETSCROLLINFO';
    $00EB: Result := 'SBM_GETSCROLLBARINFO';
    // scrollbar control messages end
    // button control messages start
    $00F0: Result := 'BM_GETCHECK';
    $00F1: Result := 'BM_SETCHECK';
    $00F2: Result := 'BM_GETSTATE';
    $00F3: Result := 'BM_SETSTATE';
    $00F4: Result := 'BM_SETSTYLE';
    $00F5: Result := 'BM_CLICK';
    $00F6: Result := 'BM_GETIMAGE';
    $00F7: Result := 'BM_SETIMAGE';
    $00F8: Result := 'BM_SETDONTCLICK';
    // button control messages end
    $0100: Result := 'WM_KEYFIRST or WM_KEYDOWN';
    $0101: Result := 'WM_KEYUP';
    $0102: Result := 'WM_CHAR';
    $0103: Result := 'WM_DEADCHAR';
    $0104: Result := 'WM_SYSKEYDOWN';
    $0105: Result := 'WM_SYSKEYUP';
    $0106: Result := 'WM_SYSCHAR';
    $0107: Result := 'WM_SYSDEADCHAR';
    $0108: Result := 'WM_KEYLAST';
    $010D: Result := 'WM_IME_STARTCOMPOSITION';
    $010E: Result := 'WM_IME_ENDCOMPOSITION';
    $010F: Result := 'WM_IME_COMPOSITION or WM_IME_KEYLAST';
    $0110: Result := 'WM_INITDIALOG';
    $0111: Result := 'WM_COMMAND';
    $0112: Result := 'WM_SYSCOMMAND';
    $0113: Result := 'WM_TIMER';
    $0114: Result := 'WM_HSCROLL';
    $0115: Result := 'WM_VSCROLL';
    $0116: Result := 'WM_INITMENU';
    $0117: Result := 'WM_INITMENUPOPUP';
    $011F: Result := 'WM_MENUSELECT';
    $0120: Result := 'WM_MENUCHAR';
    $0121: Result := 'WM_ENTERIDLE';
    $0122: Result := 'WM_MENURBUTTONUP';
    $0123: Result := 'WM_MENUDRAG';
    $0124: Result := 'WM_MENUGETOBJECT';
    $0125: Result := 'WM_UNINITMENUPOPUP';
    $0126: Result := 'WM_MENUCOMMAND';
    $0127: Result := 'WM_CHANGEUISTATE';
    $0128: Result := 'WM_UPDATEUISTATE';
    $0129: Result := 'WM_QUERYUISTATE';
    $0132: Result := 'WM_CTLCOLORMSGBOX';
    $0133: Result := 'WM_CTLCOLOREDIT';
    $0134: Result := 'WM_CTLCOLORLISTBOX';
    $0135: Result := 'WM_CTLCOLORBTN';
    $0136: Result := 'WM_CTLCOLORDLG';
    $0137: Result := 'WM_CTLCOLORSCROLLBAR';
    $0138: Result := 'WM_CTLCOLORSTATIC';
    $0140: Result := 'CB_GETEDITSEL';
    $0141: Result := 'CB_LIMITTEXT';
    $0142: Result := 'CB_SETEDITSEL';
    $0143: Result := 'CB_ADDSTRING';
    $0144: Result := 'CB_DELETESTRING';
    $0145: Result := 'CB_DIR';
    $0146: Result := 'CB_GETCOUNT';
    $0147: Result := 'CB_GETCURSEL';
    $0148: Result := 'CB_GETLBTEXT';
    $0149: Result := 'CB_GETLBTEXTLEN';
    $014A: Result := 'CB_INSERTSTRING';
    $014B: Result := 'CB_RESETCONTENT';
    $014C: Result := 'CB_FINDSTRING';
    $014D: Result := 'CB_SELECTSTRING';
    $014E: Result := 'CB_SETCURSEL';
    $014F: Result := 'CB_SHOWDROPDOWN';
    $0150: Result := 'CB_GETITEMDATA';
    $0151: Result := 'CB_SETITEMDATA';
    $0152: Result := 'CB_GETDROPPEDCONTROLRECT';
    $0153: Result := 'CB_SETITEMHEIGHT';
    $0154: Result := 'CB_GETITEMHEIGHT';
    $0155: Result := 'CB_SETEXTENDEDUI';
    $0156: Result := 'CB_GETEXTENDEDUI';
    $0157: Result := 'CB_GETDROPPEDSTATE';
    $0158: Result := 'CB_FINDSTRINGEXACT';
    $0159: Result := 'CB_SETLOCALE';
    $015A: Result := 'CB_GETLOCALE';
    $015B: Result := 'CB_GETTOPINDEX';
    $015C: Result := 'CB_SETTOPINDEX';
    $015D: Result := 'CB_GETHORIZONTALEXTENT';
    $015E: Result := 'CB_SETHORIZONTALEXTENT';
    $015F: Result := 'CB_GETDROPPEDWIDTH';
    $0160: Result := 'CB_SETDROPPEDWIDTH';
    $0161: Result := 'CB_INITSTORAGE';
    $0163: Result := 'CB_MULTIPLEADDSTRING';
    $0164: Result := 'CB_GETCOMBOBOXINFO';
    $0200: Result := 'WM_MOUSEFIRST or WM_MOUSEMOVE';
    $0201: Result := 'WM_LBUTTONDOWN';
    $0202: Result := 'WM_LBUTTONUP';
    $0203: Result := 'WM_LBUTTONDBLCLK';
    $0204: Result := 'WM_RBUTTONDOWN';
    $0205: Result := 'WM_RBUTTONUP';
    $0206: Result := 'WM_RBUTTONDBLCLK';
    $0207: Result := 'WM_MBUTTONDOWN';
    $0208: Result := 'WM_MBUTTONUP';
    $0209: Result := 'WM_MBUTTONDBLCLK';
    $020A: Result := 'WM_MOUSEWHEEL or WM_MOUSELAST';
    $0210: Result := 'WM_PARENTNOTIFY';
    $0211: Result := 'WM_ENTERMENULOOP';
    $0212: Result := 'WM_EXITMENULOOP';
    $0213: Result := 'WM_NEXTMENU';
    $0214: Result := 'WM_SIZING';
    $0215: Result := 'WM_CAPTURECHANGED';
    $0216: Result := 'WM_MOVING';
    $0218: Result := 'WM_POWERBROADCAST';
    $0219: Result := 'WM_DEVICECHANGE';
    $0220: Result := 'WM_MDICREATE';
    $0221: Result := 'WM_MDIDESTROY';
    $0222: Result := 'WM_MDIACTIVATE';
    $0223: Result := 'WM_MDIRESTORE';
    $0224: Result := 'WM_MDINEXT';
    $0225: Result := 'WM_MDIMAXIMIZE';
    $0226: Result := 'WM_MDITILE';
    $0227: Result := 'WM_MDICASCADE';
    $0228: Result := 'WM_MDIICONARRANGE';
    $0229: Result := 'WM_MDIGETACTIVE';
    $0230: Result := 'WM_MDISETMENU';
    $0231: Result := 'WM_ENTERSIZEMOVE';
    $0232: Result := 'WM_EXITSIZEMOVE';
    $0233: Result := 'WM_DROPFILES';
    $0234: Result := 'WM_MDIREFRESHMENU';
    $0281: Result := 'WM_IME_SETCONTEXT';
    $0282: Result := 'WM_IME_NOTIFY';
    $0283: Result := 'WM_IME_CONTROL';
    $0284: Result := 'WM_IME_COMPOSITIONFULL';
    $0285: Result := 'WM_IME_SELECT';
    $0286: Result := 'WM_IME_CHAR';
    $0288: Result := 'WM_IME_REQUEST';
    $0290: Result := 'WM_IME_KEYDOWN';
    $0291: Result := 'WM_IME_KEYUP';
    $02A1: Result := 'WM_MOUSEHOVER';
    $02A2: Result := 'WM_NCMOUSELEAVE';
    $02A3: Result := 'WM_MOUSELEAVE';
    $0300: Result := 'WM_CUT';
    $0301: Result := 'WM_COPY';
    $0302: Result := 'WM_PASTE';
    $0303: Result := 'WM_CLEAR';
    $0304: Result := 'WM_UNDO';
    $0305: Result := 'WM_RENDERFORMAT';
    $0306: Result := 'WM_RENDERALLFORMATS';
    $0307: Result := 'WM_DESTROYCLIPBOARD';
    $0308: Result := 'WM_DRAWCLIPBOARD';
    $0309: Result := 'WM_PAINTCLIPBOARD';
    $030A: Result := 'WM_VSCROLLCLIPBOARD';
    $030B: Result := 'WM_SIZECLIPBOARD';
    $030C: Result := 'WM_ASKCBFORMATNAME';
    $030D: Result := 'WM_CHANGECBCHAIN';
    $030E: Result := 'WM_HSCROLLCLIPBOARD';
    $030F: Result := 'WM_QUERYNEWPALETTE';
    $0310: Result := 'WM_PALETTEISCHANGING';
    $0311: Result := 'WM_PALETTECHANGED';
    $0312: Result := 'WM_HOTKEY';
    $0317: Result := 'WM_PRINT';
    $0318: Result := 'WM_PRINTCLIENT';
    $031F: Result := 'WM_DWMNCRENDERINGCHANGED';
    $0358: Result := 'WM_HANDHELDFIRST';
    $035F: Result := 'WM_HANDHELDLAST';
    $0380: Result := 'WM_PENWINFIRST';
    $038F: Result := 'WM_PENWINLAST';
    $0390: Result := 'WM_COALESCE_FIRST';
    $039F: Result := 'WM_COALESCE_LAST';
    $03E0: Result := 'WM_DDE_FIRST or WM_DDE_INITIATE';
    $03E1: Result := 'WM_DDE_TERMINATE';
    $03E2: Result := 'WM_DDE_ADVISE';
    $03E3: Result := 'WM_DDE_UNADVISE';
    $03E4: Result := 'WM_DDE_ACK';
    $03E5: Result := 'WM_DDE_DATA';
    $03E6: Result := 'WM_DDE_REQUEST';
    $03E7: Result := 'WM_DDE_POKE';
    $03E8: Result := 'WM_DDE_EXECUTE or WM_DDE_LAST';
    $0400: Result := 'WM_USER';
    // progress bar
    $0401: Result := 'PBM_SETRANGE';
    $0402: Result := 'PBM_SETPOS';
    $0403: Result := 'PBM_DELTAPOS';
    $0404: Result := 'PBM_SETSTEP';
    $0405: Result := 'PBM_STEPIT';
    $0406: Result := 'PBM_SETRANGE32';
    $0407: Result := 'PBM_GETRANGE';
    $0408: Result := 'PBM_GETPOS';
    $0409: Result := 'PBM_SETBARCOLOR';
    $040A: Result := 'PBM_SETMARQUEE';
    $040D: Result := 'PBM_GETSTEP';
    $040E: Result := 'PBM_GETBKCOLOR';
    $040F: Result := 'PBM_GETBARCOLOR';
    $0410: Result := 'PBM_SETSTATE';
    $0411: Result := 'PBM_GETSTATE';
    // misc
    $0469: Result := 'UDM_SETBUDDY';
    $046A: Result := 'UDM_GETBUDDY';
    $102C: Result := 'LVM_GETITEMSTATE';
    $8000: Result := 'WM_APP';
  else
    Result := 'Unknown(' + IntToStr(WM_Message) + ')';
  end; {Case}
end;

function WindowPosFlagsToString(Flags: UINT): string;
var
  FlagsStr: string;
begin
  FlagsStr := '';
  if (Flags and SWP_DRAWFRAME) <> 0 then
    FlagsStr := FlagsStr + '|SWP_DRAWFRAME';
  if (Flags and SWP_HIDEWINDOW) <> 0 then
    FlagsStr := FlagsStr + '|SWP_HIDEWINDOW';
  if (Flags and SWP_NOACTIVATE) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOACTIVATE';
  if (Flags and SWP_NOCOPYBITS) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOCOPYBITS';
  if (Flags and SWP_NOMOVE) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOMOVE';
  if (Flags and SWP_NOOWNERZORDER) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOOWNERZORDER';
  if (Flags and SWP_NOREDRAW) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOREDRAW';
  if (Flags and SWP_NOSENDCHANGING) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOSENDCHANGING';
  if (Flags and SWP_NOSIZE) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOSIZE';
  if (Flags and SWP_NOZORDER) <> 0 then
    FlagsStr := FlagsStr + '|SWP_NOZORDER';
  if (Flags and SWP_SHOWWINDOW) <> 0 then
    FlagsStr := FlagsStr + '|SWP_SHOWWINDOW';
  if Length(FlagsStr) > 0 then
    FlagsStr := Copy(FlagsStr, 2, Length(FlagsStr)-1);
  Result := FlagsStr;
end;


{------------------------------------------------------------------------------
  procedure: EventTrace
  Params: Message - Event name
          Data    - Object which fired this event
  Returns: Nothing

  Displays a trace about an event
 ------------------------------------------------------------------------------}
procedure EventTrace(Message: String; Data: TObject);
begin
  if Data = nil then
    Assert(False, Format('Trace:Event [%S] fired', [Message]))
  else
    Assert(False, Format('Trace:Event [%S] fired for %S',[Message, Data.Classname]));
end;

{------------------------------------------------------------------------------
  function: AssertEx
  Params: Message  - Message sent
          PassErr  - Pass error to a catching procedure (default: False)
          Severity - How severe is the error on a scale from 0 to 3
                     (default: 0)
  Returns: Nothing

  An expanded, better version of Assert
 ------------------------------------------------------------------------------}
procedure AssertEx(const Message: String; const PassErr: Boolean; const Severity: Byte);
begin
  Case Severity Of
    0:
    begin
      Assert(PassErr, Message);
    end;
    1:
    begin
      Assert(PassErr, Format('Trace:%S', [Message]));
    end;
    2:
    begin
      Case IsConsole Of
        True:
        begin
          WriteLn(rsWin32Warning, Message);
        end;
        False:
        begin
          MessageBox(0, PChar(Message), PChar(rsWin32Warning), MB_OK);
        end;
      end;
    end;
    3:
    begin
      Case IsConsole Of
        True:
        begin
          WriteLn(rsWin32Error, Message);
        end;
        False:
        begin
          MessageBox(0, PChar(Message), nil, MB_OK);
        end;
      end;
    end;
  end;
end;

procedure AssertEx(const PassErr: Boolean; const Message: String);
begin
  AssertEx(Message, PassErr, 0);
end;

procedure AssertEx(const Message: String);
begin
  AssertEx(Message, False, 0);
end;

{------------------------------------------------------------------------------
  function: GetShiftState
  Params: None
  Returns: A shift state

  Creates a TShiftState set based on the status when the function was called.
 ------------------------------------------------------------------------------}
function GetShiftState: TShiftState;
begin
  Result := [];
  // NOTE: it may be better to use GetAsyncKeyState
  // if GetKeyState AND $8000 <> 0 then down (e.g. shift)
  // if GetKeyState AND 1 <> 0, then toggled on (e.g. num lock)
  if (GetKeyState(VK_SHIFT) and $8000) <> 0 then
    Result := Result + [ssShift];
  if (GetKeyState(VK_CAPITAL) and 1) <> 0 then
    Result := Result + [ssCaps];
  if (GetKeyState(VK_CONTROL) and $8000) <> 0 then
    Result := Result + [ssCtrl];
  if (GetKeyState(VK_MENU) and $8000) <> 0 then
    Result := Result + [ssAlt];
  if (GetKeyState(VK_NUMLOCK) and 1) <> 0 then
    Result := Result + [ssNum];
  //TODO: ssSuper
  if (GetKeyState(VK_SCROLL) and 1) <> 0 then
    Result := Result + [ssScroll];
  // GetKeyState takes mouse button swap into account (GetAsyncKeyState doesn't),
  // so no need to test GetSystemMetrics(SM_SWAPBUTTON)
  if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
    Result := Result + [ssLeft];
  if (GetKeyState(VK_MBUTTON) and $8000) <> 0 then
    Result := Result + [ssMiddle];
  if (GetKeyState(VK_RBUTTON) and $8000) <> 0 then
    Result := Result + [ssRight];
  //TODO: ssAltGr
end;

{------------------------------------------------------------------------------
  procedure: GetWin32KeyInfo
  Params:  Event      - Requested info
           KeyCode    - the ASCII key code of the eventkey
           VirtualKey - the virtual key code of the eventkey
           SysKey     - True if the key is a syskey
           ExtEnded   - True if the key is an extended key
           Toggle     - True if the key is a toggle key and its value is on
  Returns: Nothing

  GetWin32KeyInfo returns information about the given key event
 ------------------------------------------------------------------------------}
{
procedure GetWin32KeyInfo(const Event: Integer; var KeyCode, VirtualKey: Integer; var SysKey, Extended, Toggle: Boolean);
const
  MVK_UNIFY_SIDES = 1;
begin
  Assert(False, 'TRACE:Using function GetWin32KeyInfo which isn''t implemented yet');
  KeyCode := Word(Event);
  VirtualKey := MapVirtualKey(KeyCode, MVK_UNIFY_SIDES);
  SysKey := (VirtualKey = VK_SHIFT) Or (VirtualKey = VK_CONTROL) Or (VirtualKey = VK_MENU);
  ExtEnded := (SysKey) Or (VirtualKey = VK_INSERT) Or (VirtualKey = VK_HOME) Or (VirtualKey = VK_LEFT) Or (VirtualKey = VK_UP) Or (VirtualKey = VK_RIGHT) Or (VirtualKey = VK_DOWN) Or (VirtualKey = VK_PRIOR) Or (VirtualKey = VK_NEXT) Or (VirtualKey = VK_END) Or (VirtualKey = VK_DIVIDE);
  Toggle := Lo(GetKeyState(VirtualKey)) = 1;
end;
}

{-----------------------------------------------------------------------------
  procedure: CallEvent
  Params: Target    - the object for which the event will be called
          Event     - event to call
          Data      - misc data
          EventType - the type of event
  Returns: Nothing

  Calls an event
-------------------------------------------------------------------------------}
procedure CallEvent(const Target: TObject; Event: TNotifyEvent; const Data: Pointer; const EventType: TEventType);
begin
  if Assigned(Target) And Assigned(Event) then
  begin
    Case EventType Of
      etNotify:
      begin
        Event(Target);
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------
  function: ObjectToHWND
  Params: AObject - An LCL Object
  Returns: The Window handle of the given object

  Returns the Window handle of the given object, 0 if no object available
 ------------------------------------------------------------------------------}
function ObjectToHWND(const AObject: TObject): HWND;
var
  Handle: HWND;
begin
  Handle := 0;
  if not assigned(AObject) then
    Assert (False, 'TRACE:[ObjectToHWND] Object not assigned')
  else
  if (AObject is TWinControl) then
  begin
    if TWinControl(AObject).HandleAllocated then
      Handle := TWinControl(AObject).Handle
  end
  else
  if (AObject is TMenuItem) then
  begin
    if TMenuItem(AObject).HandleAllocated then
      Handle := TMenuItem(AObject).Handle
  end
  else
  if (AObject is TMenu) then
  begin
    if TMenu(AObject).HandleAllocated then
      Handle := TMenu(AObject).Items.Handle
  end
  else
  if (AObject is TCommonDialog) then
  begin
    {if TCommonDialog(AObject).HandleAllocated then }
    Handle := TCommonDialog(AObject).Handle
  end
  else
    Assert(False, Format('Trace:[ObjectToHWND] Message received With unhandled class-type <%s>', [AObject.ClassName]));

  Result := Handle;
  if Handle = 0 then
    Assert(False, 'Trace:[ObjectToHWND]****** Warning: handle = 0 *******');
end;

(***********************************************************************
  Widget member functions
************************************************************************)

{-------------------------------------------------------------------------------
  function LCLBoundsNeedsUpdate(Sender: TWinControl;
    SendSizeMsgOnDiff: boolean): boolean;

  Returns true if LCL bounds and win32 bounds differ for the control.
-------------------------------------------------------------------------------}
function LCLControlSizeNeedsUpdate(Sender: TWinControl;
  SendSizeMsgOnDiff: boolean): boolean;
var
  LMessage: TLMSize;
  IntfWidth, IntfHeight: integer;
begin
  Result := False;
  LCLIntf.GetWindowSize(Sender.Handle, IntfWidth, IntfHeight);
  if (Sender.Width = IntfWidth) and (Sender.Height = IntfHeight) and (not Sender.ClientRectNeedsInterfaceUpdate) then
    Exit;
  Result := True;
  if SendSizeMsgOnDiff then
  begin
    //writeln('LCLBoundsNeedsUpdate B ',TheWinControl.Name,':',TheWinControl.ClassName,' Sending WM_SIZE');
    Sender.InvalidateClientRectCache(True);
    // send message directly to LCL, some controls not subclassed -> message
    // never reaches LCL
    with LMessage do
    begin
      Msg := LM_SIZE;
      SizeType := SIZE_RESTORED or Size_SourceIsInterface;
      Width := IntfWidth;
      Height := IntfHeight;
    end;
    DeliverMessage(Sender, LMessage);
  end;
end;

{-------------------------------------------------------------------------------
  function GetLCLClientOriginOffset(Sender: TObject;
    var LeftOffset, TopOffset: integer): boolean;

  Returns the difference between the client origin of a win32 handle
  and the definition of the LCL counterpart.
  For example:
    TGroupBox's client area is the area inside the groupbox frame.
    Hence, the LeftOffset is the frame width and the TopOffset is the caption
    height.
  It is used in GetClientBounds to define LCL bounds from win32 bounds.
-------------------------------------------------------------------------------}
function GetLCLClientBoundsOffset(Sender: TObject; var ORect: TRect): boolean;
var
  TM: TextMetricA;
  DC: HDC;
  Handle: HWND;
  TheWinControl: TWinControl;
  ARect: TRect;
begin
  Result := False;
  if (Sender = nil) or (not (Sender is TWinControl)) then exit;
  TheWinControl := TWinControl(Sender);
  if not TheWinControl.HandleAllocated then exit;
  Handle := TheWinControl.Handle;
  FillChar(ORect, SizeOf(ORect), 0);
  if TheWinControl is TScrollingWinControl then
    with TScrollingWinControl(TheWinControl) do
    begin
      if HorzScrollBar <> nil then
      begin
        // left and right bounds are shifted by scroll position
        ORect.Left := -HorzScrollBar.Position;
        ORect.Right := -HorzScrollBar.Position;
      end;
      if VertScrollBar <> nil then
      begin
        // top and bottom bounds are shifted by scroll position
        ORect.Top := -VertScrollBar.Position;
        ORect.Bottom := -VertScrollBar.Position;
      end;
    end;
  if (TheWinControl is TCustomGroupBox) then
  begin
    // The client area of a groupbox under winapi is the whole size, including
    // the frame. The LCL defines the client area without the frame.
    // -> Adjust the position
    // add the upper frame with the caption
    DC := Windows.GetDC(Handle);
    GetTextMetrics(DC, TM);
    ORect.Top := TM.TMHeight;
    Windows.ReleaseDC(Handle, DC);
    // add the left, right and bottom frame borders
    ORect.Left := 2;
    ORect.Right := -2;
    ORect.Bottom := -2;
  end else
  if TheWinControl is TCustomNoteBook then
  begin
    // Can't use complete client rect in win32 interface, top part contains the tabs
    Windows.GetClientRect(Handle, @ARect);
    ORect := ARect;
    Windows.SendMessage(Handle, TCM_AdjustRect, 0, LPARAM(@ORect));
    Dec(ORect.Right, ARect.Right);
    Dec(ORect.Bottom, ARect.Bottom);
  end;
{
  if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE) <> 0 then
  begin
    Dec(LeftOffset, Windows.GetSystemMetrics(SM_CXEDGE));
    Dec(TopOffset, Windows.GetSystemMetrics(SM_CYEDGE));
  end;
}
  Result := True;
end;

function GetLCLClientBoundsOffset(Handle: HWnd; var Rect: TRect): boolean;
var
  OwnerObject: TObject;
begin
  OwnerObject := GetWin32WindowInfo(Handle)^.WinControl;
  Result := GetLCLClientBoundsOffset(OwnerObject, Rect);
end;

procedure LCLBoundsToWin32Bounds(Sender: TObject;
  var Left, Top, Width, Height: Integer);
var
  ORect: TRect;
begin
  if (Sender=nil) or (not (Sender is TWinControl)) then exit;
  if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit;
  inc(Left, ORect.Left);
  inc(Top, ORect.Top);
end;

procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt);
var
  ORect: TRect;
begin
  if (Sender=nil) or (not (Sender is TWinControl)) then exit;
  if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit;
  dec(Left, ORect.Left);
  dec(Top, ORect.Top);
end;

procedure GetWin32ControlPos(Window, Parent: HWND; var Left, Top: integer);
var
  parRect, winRect: Windows.TRect;
begin
  Windows.GetWindowRect(Window, winRect);
  Windows.GetWindowRect(Parent, parRect);
  Left := winRect.Left - parRect.Left;
  Top := winRect.Top - parRect.Top;
end;

{
  Updates the window style of the window indicated by Handle.
  The new style is the Style parameter.
  Only the bits set in the StyleMask are changed,
  the other bits remain untouched.
  if the bits in the StyleMask are not used in the Style,
  there are cleared.
}
procedure UpdateWindowStyle(Handle: HWnd; Style: integer; StyleMask: integer);
var
  CurrentStyle,
  NewStyle : PtrInt;
begin
  CurrentStyle := GetWindowLong(Handle, GWL_STYLE);
  NewStyle := (Style and StyleMask) or (CurrentStyle and (not StyleMask));
  SetWindowLong(Handle, GWL_STYLE, NewStyle);
end;

function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
begin
  Result := WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
  case Style of
  bsSizeable, bsSizeToolWin:
    Result := Result or (WS_OVERLAPPED or WS_THICKFRAME or WS_CAPTION);
  bsSingle, bsToolWindow:
    Result := Result or (WS_OVERLAPPED or WS_BORDER or WS_CAPTION);
  bsDialog:
    Result := Result or (WS_POPUP or WS_BORDER or WS_CAPTION);
  bsNone:
    Result := Result or WS_POPUP;
  end;
end;

function BorderStyleToWin32FlagsEx(Style: TFormBorderStyle): DWORD;
begin
  Result := 0;
  case Style of
    bsDialog:
      Result := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE;
    bsToolWindow, bsSizeToolWin:
      Result := WS_EX_TOOLWINDOW;
  end;
end;

function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;
{$NOTE Belongs in Win32WSForms, but is needed in windowproc}
begin
  if csDesigning in AForm.ComponentState then
    Result := bsSizeable
  else
    Result := AForm.BorderStyle;
end;

function AllocWindowInfo(Window: HWND): PWin32WindowInfo;
var
  WindowInfo: PWin32WindowInfo;
begin
  New(WindowInfo);
  FillChar(WindowInfo^, sizeof(WindowInfo^), 0);
  WindowInfo^.DrawItemIndex := -1;
  Windows.SetProp(Window, PChar(PtrUInt(WindowInfoAtom)), PtrUInt(WindowInfo));
  Result := WindowInfo;
end;

function DisposeWindowInfo(Window: HWND): boolean;
var
  WindowInfo: PWin32WindowInfo;
begin
  WindowInfo := PWin32WindowInfo(Windows.GetProp(Window, PChar(PtrUInt(WindowInfoAtom))));
  Result := Windows.RemoveProp(Window, PChar(PtrUInt(WindowInfoAtom)))<>0;
  if Result then
  begin
    WindowInfo^.StayOnTopList.Free;
    Dispose(WindowInfo);
  end;
end;

function GetWin32WindowInfo(Window: HWND): PWin32WindowInfo;
begin
  Result := PWin32WindowInfo(Windows.GetProp(Window, PChar(PtrUInt(WindowInfoAtom))));
  if Result = nil then
    Result := @DefaultWindowInfo;
end;

function EnumStayOnTopRemove(Handle: HWND; Param: LPARAM): WINBOOL; stdcall;
var
  AStyle: DWord;
  StayOnTopWindowsInfo: PStayOnTopWindowsInfo absolute Param;
  lWindowInfo: PWin32WindowInfo;
  lWinControl: TWinControl;
begin
  Result := True;
  AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
  if (AStyle and WS_EX_TOPMOST) <> 0 then // if stay on top then
  begin
    // Don't remove system-wide stay on top, unless desired
    if not StayOnTopWindowsInfo^.SystemTopAlso then
    begin
      lWindowInfo := GetWin32WindowInfo(Handle);
      if (lWindowInfo <> nil) then
      begin
        lWinControl := lWindowInfo^.WinControl;
        if (lWinControl <> nil) and (lWinControl is TCustomForm)
        and (TCustomForm(lWinControl).FormStyle = fsSystemStayOnTop) then
        Exit;
      end;
    end;

    StayOnTopWindowsInfo^.StayOnTopList.Add(Pointer(Handle));
    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING);
  end;
end;

procedure RemoveStayOnTopFlags(Window: HWND; ASystemTopAlso: Boolean = False);
var
  StayOnTopWindowsInfo: PStayOnTopWindowsInfo;
  WindowInfo: PWin32WindowInfo;
begin
  // WriteLn('RemoveStayOnTopFlags 1');
  if InRemoveStayOnTopFlags = 0 then
  begin
    New(StayOnTopWindowsInfo);
    StayOnTopWindowsInfo^.AppWindow := Window;
    StayOnTopWindowsInfo^.SystemTopAlso := ASystemTopAlso;
    StayOnTopWindowsInfo^.StayOnTopList := TList.Create;
    WindowInfo := GetWin32WindowInfo(Window);
    WindowInfo^.StayOnTopList := StayOnTopWindowsInfo^.StayOnTopList;
    EnumThreadWindows(GetWindowThreadProcessId(Window, nil),
      @EnumStayOnTopRemove, LPARAM(StayOnTopWindowsInfo));
    Dispose(StayOnTopWindowsInfo);
  end;
  inc(InRemoveStayOnTopFlags);
  // WriteLn('RemoveStayOnTopFlags 2');
end;

procedure RestoreStayOnTopFlags(Window: HWND);
var
  WindowInfo: PWin32WindowInfo;
  I: integer;
begin
  // WriteLn('RestoreStayOnTopFlags 1');
  if InRemoveStayOnTopFlags = 1 then
  begin
    WindowInfo := GetWin32WindowInfo(Window);
    if WindowInfo^.StayOnTopList <> nil then
    begin
      for I := 0 to WindowInfo^.StayOnTopList.Count - 1 do
        SetWindowPos(HWND(WindowInfo^.StayOnTopList.Items[I]),
          HWND_TOPMOST, 0, 0, 0, 0,
          SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING);
      FreeAndNil(WindowInfo^.StayOnTopList);
    end;
  end;
  if InRemoveStayOnTopFlags > 0 then
    dec(InRemoveStayOnTopFlags);
  // WriteLn('RestoreStayOnTopFlags 2');
end;


{-------------------------------------------------------------------------------
  procedure AddToChangedMenus(Window: HWnd);

  Adds Window to the list of windows which need to redraw the main menu.
-------------------------------------------------------------------------------}
procedure AddToChangedMenus(Window: HWnd);
begin
  if ChangedMenus.IndexOf(Pointer(Window)) = -1 then // Window handle is not yet in the list
    ChangedMenus.Add(Pointer(Window));
end;

{------------------------------------------------------------------------------
  Method: RedrawMenus
  Params:  None
  Returns: Nothing

  Redraws all changed menus
 ------------------------------------------------------------------------------}
procedure RedrawMenus;
var
  I: integer;
begin
  for I := 0 to ChangedMenus.Count - 1 do
    DrawMenuBar(HWND(ChangedMenus[I]));
  ChangedMenus.Clear;
end;

function MeasureTextForWnd(const AWindow: HWND; Text: string; var Width,
  Height: integer): boolean;
var
  textSize: Windows.SIZE;
  canvasHandle: HDC;
  oldFontHandle, newFontHandle: HFONT;
begin
  canvasHandle := Windows.GetDC(AWindow);
  newFontHandle := HFONT(SendMessage(AWindow, WM_GETFONT, 0, 0));
  oldFontHandle := SelectObject(canvasHandle, newFontHandle);
  DeleteAmpersands(Text);

  Result := LCLIntf.GetTextExtentPoint32(canvasHandle, PChar(Text), Length(Text), textSize);

  if Result then
  begin
    Width := textSize.cx;
    Height := textSize.cy;
  end;
  SelectObject(canvasHandle, oldFontHandle);
  Windows.ReleaseDC(AWindow, canvasHandle);
end;

function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
begin
  Result := MeasureTextForWnd(AWinControl.Handle, Text, Width, Height);
end;

function GetControlText(AHandle: HWND): string;
var
  TextLen: dword;
{$ifdef WindowsUnicodeSupport}
  AnsiBuffer: string;
  WideBuffer: WideString;
{$endif}  
begin
{$ifdef WindowsUnicodeSupport}
  if UnicodeEnabledOS then
  begin
    TextLen := Windows.GetWindowTextLengthW(AHandle);
    SetLength(WideBuffer, TextLen);
    if TextLen > 0 // Never give Windows the chance to write to System.emptychar
    then TextLen := Windows.GetWindowTextW(AHandle, PWideChar(WideBuffer), TextLen + 1);
    SetLength(WideBuffer, TextLen);
    Result := UTF16ToUTF8(WideBuffer);
  end
  else
  begin
    TextLen := Windows.GetWindowTextLength(AHandle);
    SetLength(AnsiBuffer, TextLen);
    if TextLen > 0 // Never give Windows the chance to write to System.emptychar
    then TextLen := Windows.GetWindowText(AHandle, PChar(AnsiBuffer), TextLen + 1);
    SetLength(AnsiBuffer, TextLen);
    Result := AnsiToUtf8(AnsiBuffer);
  end;

 {$else}
  TextLen := GetWindowTextLength(AHandle);
  SetLength(Result, TextLen);
  GetWindowText(AHandle, PChar(Result), TextLen + 1);

 {$endif}
end;

procedure FillRawImageDescriptionColors(var ADesc: TRawImageDescription);
begin
  case ADesc.BitsPerPixel of
    1,4,8:
      begin
        // palette mode, no offsets
        ADesc.Format := ricfGray;
        ADesc.RedPrec := ADesc.BitsPerPixel;
        ADesc.GreenPrec := 0;
        ADesc.BluePrec := 0;
        ADesc.RedShift := 0;
        ADesc.GreenShift := 0;
        ADesc.BlueShift := 0;
      end;
    16:
      begin
        // 5-5-5 mode
        ADesc.RedPrec := 5;
        ADesc.GreenPrec := 5;
        ADesc.BluePrec := 5;
        ADesc.RedShift := 10;
        ADesc.GreenShift := 5;
        ADesc.BlueShift := 0;
        ADesc.Depth := 15;
      end;
    24:
      begin
        // 8-8-8 mode
        ADesc.RedPrec := 8;
        ADesc.GreenPrec := 8;
        ADesc.BluePrec := 8;
        ADesc.RedShift := 16;
        ADesc.GreenShift := 8;
        ADesc.BlueShift := 0;
      end;
  else    //  32:
    // 8-8-8-8 mode, high byte can be native alpha or custom 1bit maskalpha
    ADesc.AlphaPrec := 8;
    ADesc.RedPrec := 8;
    ADesc.GreenPrec := 8;
    ADesc.BluePrec := 8;
    ADesc.AlphaShift := 24;
    ADesc.RedShift := 16;
    ADesc.GreenShift := 8;
    ADesc.BlueShift := 0;
    ADesc.Depth := 32;
  end;
end;

procedure FillRawImageDescription(const ABitmapInfo: Windows.TBitmap; out ADesc: TRawImageDescription);
begin
  ADesc.Format := ricfRGBA;

  ADesc.Depth := ABitmapInfo.bmBitsPixel;             // used bits per pixel
  ADesc.Width := ABitmapInfo.bmWidth;
  ADesc.Height := ABitmapInfo.bmHeight;
  ADesc.BitOrder := riboReversedBits;
  ADesc.ByteOrder := riboLSBFirst;
  ADesc.LineOrder := riloTopToBottom;
  ADesc.BitsPerPixel := ABitmapInfo.bmBitsPixel;      // bits per pixel. can be greater than Depth.
  ADesc.LineEnd := rileDWordBoundary;

  if ABitmapInfo.bmBitsPixel <= 8
  then begin
    // each pixel is an index in the palette
    // TODO, ColorCount
    ADesc.PaletteColorCount := 0;
  end
  else ADesc.PaletteColorCount := 0;


  FillRawImageDescriptionColors(ADesc);

  ADesc.MaskBitsPerPixel := 1;
  ADesc.MaskShift := 0;
  ADesc.MaskLineEnd := rileWordBoundary; // CreateBitmap requires word boundary
  ADesc.MaskBitOrder := riboReversedBits;
end;

function GetBitmapOrder(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP): TRawImageLineOrder;
  procedure DbgLog(const AFunc: String);
  begin
    DebugLn('GetBitmapOrder - GetDIBits ', AFunc, ' failed: ', GetLastErrorText(Windows.GetLastError));
  end;

var
  SrcPixel: PCardinal absolute AWinBmp.bmBits;
  OrgPixel, TstPixel: Cardinal;
  Scanline: Pointer;
  DC: HDC;
  Info: record
    Header: Windows.TBitmapInfoHeader;
    Colors: array[Byte] of Cardinal; // reserve extra color for colormasks
  end;
  
  FullScanLine: Boolean; // win9x requires a full scanline to be retrieved
                         // others won't fail when one pixel is requested
begin
  if AWinBmp.bmBits = nil
  then begin
    // no DIBsection so always bottom-up
    Exit(riloBottomToTop);
  end;

  // try to figure out the orientation of the given bitmap.
  // Unfortunately MS doesn't provide a direct function for this.
  // So modify the first pixel to see if it changes. This pixel is always part
  // of the first scanline of the given bitmap.
  // When we request the data through GetDIBits as bottom-up, windows adjusts
  // the data when it is a top-down. So if the pixel doesn't change the bitmap
  // was internally a top-down image.
  
  FullScanLine := Win32Platform = VER_PLATFORM_WIN32_WINDOWS;
  if FullScanLine
  then ScanLine := GetMem(AWinBmp.bmWidthBytes);

  FillChar(Info.Header, sizeof(Windows.TBitmapInfoHeader), 0);
  Info.Header.biSize := sizeof(Windows.TBitmapInfoHeader);
  DC := Windows.GetDC(0);
  if Windows.GetDIBits(DC, ABitmap, 0, 1, nil, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS) = 0
  then begin
    DbgLog('Getinfo');
    // failed ???
    Windows.ReleaseDC(0, DC);
    Exit(riloBottomToTop);
  end;

  // Get only 1 pixel (or full scanline for win9x)
  OrgPixel := 0;
  if FullScanLine
  then begin
    if Windows.GetDIBits(DC, ABitmap, 0, 1, ScanLine, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS) = 0
    then DbgLog('OrgPixel')
    else OrgPixel := PCardinal(ScanLine)^;
  end
  else begin
    Info.Header.biWidth := 1;
    if Windows.GetDIBits(DC, ABitmap, 0, 1, @OrgPixel, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS) = 0
    then DbgLog('OrgPixel');
  end;

  // modify pixel
  SrcPixel^ := not SrcPixel^;
  
  // get test
  TstPixel := 0;
  if FullScanLine
  then begin
    if Windows.GetDIBits(DC, ABitmap, 0, 1, ScanLine, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS) = 0
    then DbgLog('TstPixel')
    else TstPixel := PCardinal(ScanLine)^;
  end
  else begin
    if Windows.GetDIBits(DC, ABitmap, 0, 1, @TstPixel, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS) = 0
    then DbgLog('TstPixel');
  end;

  if OrgPixel = TstPixel
  then Result := riloTopToBottom
  else Result := riloBottomToTop;

  // restore pixel & cleanup
  SrcPixel^ := not SrcPixel^;
  Windows.ReleaseDC(0, DC);
  if FullScanLine
  then FreeMem(Scanline);
end;

function GetBitmapBytes(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; ALineOrder: TRawImageLineOrder; out AData: Pointer; out ADataSize: PtrUInt): Boolean;
var
  DC: HDC;
  Info: record
    Header: Windows.TBitmapInfoHeader;
    Colors: array[Byte] of TRGBQuad; // reserve extra colors for palette (256 max)
  end;
  H: Cardinal;
  R: TRect;
  SrcData: PByte;
  SrcSize: PtrUInt;
  SrcLineBytes: Cardinal;
  SrcLineOrder: TRawImageLineOrder;
  StartScan: Integer;
begin
  SrcLineOrder := GetBitmapOrder(AWinBmp, ABitmap);
  SrcLineBytes := (AWinBmp.bmWidthBytes + 3) and not 3;

  if AWinBmp.bmBits <> nil
  then begin
    // this is bitmapsection data :) we can just copy the bits

    // We cannot trust windows with bmWidthBytes. Use SrcLineBytes which takes
    // DWORD alignment into consideration
    with AWinBmp do
      Result := CopyImageData(bmWidth, bmHeight, SrcLineBytes, bmBitsPixel, bmBits, ARect, SrcLineOrder, ALineOrder, ALineEnd, AData, ADataSize);
    Exit;
  end;

  // retrieve the data though GetDIBits

  // initialize bitmapinfo structure
  Info.Header.biSize := sizeof(Info.Header);
  Info.Header.biPlanes := 1;
  Info.Header.biBitCount := AWinBmp.bmBitsPixel;
  Info.Header.biCompression := BI_RGB;
  Info.Header.biSizeImage := 0;

  Info.Header.biWidth := AWinBmp.bmWidth;
  H := ARect.Bottom - ARect.Top;
  // request a top-down DIB
  if AWinBmp.bmHeight > 0
  then begin
    Info.Header.biHeight := -AWinBmp.bmHeight;
    StartScan := AWinBmp.bmHeight - ARect.Bottom;
  end
  else begin
    Info.Header.biHeight := AWinBmp.bmHeight;
    StartScan := ARect.Top;
  end;
  // adjust height
  if StartScan < 0
  then begin
    Inc(H, StartScan);
    StartScan := 0;
  end;

  // alloc buffer
  SrcSize := SrcLineBytes * H;
  GetMem(SrcData, SrcSize);

  DC := Windows.GetDC(0);
  Result := Windows.GetDIBits(DC, ABitmap, StartScan, H, SrcData, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS) <> 0;
  Windows.ReleaseDC(0, DC);
  
  // since we only got the needed scanlines, adjust top and bottom
  R.Left := ARect.Left;
  R.Top := 0;
  R.Right := ARect.Right;
  R.Bottom := H;

  with Info.Header do
    Result := Result and CopyImageData(biWidth, H, SrcLineBytes, biBitCount, SrcData, R, riloTopToBottom, ALineOrder, ALineEnd, AData, ADataSize);

  FreeMem(SrcData);
end;

function IsAlphaBitmap(ABitmap: HBITMAP): Boolean;
var
  Info: Windows.BITMAP;
begin
  FillChar(Info, SizeOf(Info), 0);
  Result := (GetObject(ABitmap, SizeOf(Info), @Info) <> 0)
        and (Info.bmBitsPixel = 32);
end;

function IsAlphaDC(ADC: HDC): Boolean;
begin
  Result := (GetObjectType(ADC) = OBJ_MEMDC)
        and IsAlphaBitmap(GetCurrentObject(ADC, OBJ_BITMAP));
end;

procedure BlendRect(ADC: HDC; const ARect: TRect; Color: ColorRef);
var
  bmp, oldBmp: HBitmap;
  MemDC: HDC;
  Blend: TBlendFunction;
  Pixel: TRGBAQuad;
  Brush: HBrush;
begin
  if IsRectEmpty(ARect) then Exit;

  Pixel.Blue := Color shr 16;
  Pixel.Green := Color shr 8;
  Pixel.Red := Color;

  bmp := CreateBitmap(1, 1, 1, 32, @Pixel);
  MemDC := CreateCompatibleDC(ADC);
  OldBmp := SelectObject(MemDC, Bmp);

  Blend.BlendOp := AC_SRC_OVER;
  Blend.BlendFlags := 0;
  Blend.SourceConstantAlpha := 128;
  Blend.AlphaFormat := 0;

  AlphaBlend(ADC, ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, MemDC, 0, 0, 1, 1, Blend);

  SelectObject(MemDC, OldBmp);
  DeleteDC(MemDC);
  DeleteObject(Bmp);

  Brush := CreateSolidBrush(Color);
  FrameRect(ADC, ARect, Brush);
  DeleteObject(Brush);
end;

function GetLastErrorText(AErrorCode: Cardinal): String;
var
  r: cardinal;
  tmp: PChar;
begin
  tmp := nil;
  r := Windows.FormatMessage(
    FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
    nil, AErrorCode, LANG_NEUTRAL, @tmp, 0, nil);

  if r = 0 then Exit('');

  Result := tmp;
  SetLength(Result, Length(Result)-2);

  if tmp <> nil
  then LocalFree(HLOCAL(tmp));
end;

(*
   BitmapToRegion :	Create a region from the "non-transparent" pixels of a bitma
   Author :		Jean-Edouard Lachand-Robert (http://www.geocities.com/Paris/LeftBank/1160/resume.htm), June 1998

   hBmp :               Source bitmap
   cTransparentColor :	Color base for the "transparent" pixels (default is black)
   cTolerance :		Color tolerance for the "transparent" pixels

   A pixel is assumed to be transparent if the value of each of its 3 components (blue, green and red) is
   greater or equal to the corresponding value in cTransparentColor and is lower or equal to the
   corresponding value in cTransparentColor + cTolerance
*)

function BitmapToRegion(hBmp: HBITMAP; cTransparentColor: COLORREF = 0; cTolerance: COLORREF  = $101010): HRGN;

const
  ALLOC_UNIT = 100;

var
  AWidth, AHeight: Integer;

  maxRects: DWORD;
  hData: THANDLE;
  pData: PRGNDATA;
  lr, lg, lb, hr, hg, hb: Byte;
  x, y, x0: Integer;
  pr: PRect;
  h: HRGN;

  WinBmp: Windows.TBitmap;
  P, Data: PRGBAQuad;
  RS: PtrUInt;
  ARawImage, DstRawImage: TRawImage;
  SourceImage, DestImage: TLazIntfImage;

  procedure FillDescription(out ADesc: TRawImageDescription);
  begin
    ADesc.Init;
    ADesc.Format := ricfRGBA;
    ADesc.PaletteColorCount := 0;
    ADesc.MaskBitsPerPixel := 0;
    ADesc.Depth := 32;
    ADesc.Width := AWidth;
    ADesc.Height := AHeight;
    ADesc.BitOrder := riboBitsInOrder;
    ADesc.ByteOrder := riboMSBFirst;
    ADesc.LineOrder := riloTopToBottom;
    ADesc.BitsPerPixel := 32;
    ADesc.LineEnd := rileDWordBoundary;
    ADesc.RedPrec := 8; // red precision. bits for red
    ADesc.RedShift := 8;
    ADesc.GreenPrec := 8;
    ADesc.GreenShift := 16;
    ADesc.BluePrec := 8;
    ADesc.BlueShift := 24;
    ADesc.AlphaPrec := 8;
    ADesc.AlphaShift := 0;
  end;
begin
  Result := 0;
  
  if Windows.GetObject(hBmp, sizeof(WinBmp), @WinBmp) = 0 then
    Exit;
    
  if not RawImage_FromBitmap(ARawImage, hBmp, 0) then
    Exit;
    
  AWidth := ARawImage.Description.Width;
  AHeight := ARawImage.Description.Height;

  SourceImage := TLazIntfImage.Create(ARawImage, True);

  DstRawImage.Init;
  FillDescription(DstRawImage.Description);
  DstRawImage.DataSize := AWidth * AHeight * SizeOf(TRGBAQuad);
  Data := AllocMem(DstRawImage.DataSize);
  DstRawImage.Data := PByte(Data);

  DestImage := TLazIntfImage.Create(DstRawImage, False);
  DestImage.CopyPixels(SourceImage);
  SourceImage.Free;
  DestImage.Free;

  RS := GetBytesPerLine(AWidth, 32, rileDWordBoundary);

  // For better performances, we will use the ExtCreateRegion() function to create the
  // region. This function take a RGNDATA structure on entry. We will add rectangles by
  // amount of ALLOC_UNIT number in this structure
  maxRects := ALLOC_UNIT;
  hData := GlobalAlloc(GMEM_MOVEABLE, sizeof(RGNDATAHEADER) + (sizeof(TRECT) * maxRects));
  pData := GlobalLock(hData);
  pData^.rdh.dwSize := sizeof(RGNDATAHEADER);
  pData^.rdh.iType := RDH_RECTANGLES;
  pData^.rdh.nCount := 0;
  pData^.rdh.nRgnSize := 0;
  Windows.SetRect(pData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);

  // Keep on hand highest and lowest values for the "transparent" pixel
  lr := GetRValue(cTransparentColor);
  lg := GetGValue(cTransparentColor);
  lb := GetBValue(cTransparentColor);
  hr := min($ff, lr + GetRValue(cTolerance));
  hg := min($ff, lg + GetGValue(cTolerance));
  hb := min($ff, lb + GetBValue(cTolerance));
  
  P := Data;

  // Scan each bitmap row from bottom to top (the bitmap is inverted vertically)
  for y := 0 to AHeight - 1 do
  begin
    // Scan each bitmap pixel from left to righ
    x := 0;
    while (x < AWidth) do
    begin
      // Search for a continuous range of "non transparent pixels"
      x0 := x;
      while (x < AWidth) do
      begin
        with P[x] do
          if (Red >= lr) and (Red <= hr) then
          begin
            if (Green >= lg) and (Green <= hg) then
            begin
              if (Blue >= lb) and (Blue <= hb) then
                break; //This pixel is "transparent"
            end;
          end;
        inc(x);
      end;
      
      if (x > x0) then
      begin
        // Add the pixels (x0, y) to (x, y+1) as a new rectangle in the region
        if (pData^.rdh.nCount >= maxRects) then
        begin
          GlobalUnlock(hData);
          maxRects := maxRects + ALLOC_UNIT;
          hData := GlobalReAlloc(hData, sizeof(RGNDATAHEADER) + (sizeof(TRECT) * maxRects), GMEM_MOVEABLE);
          pData := GlobalLock(hData);
        end;
        pr := PRect(PChar(pData^.Buffer));
        SetRect(pr[pData^.rdh.nCount], x0, y, x, y+1);
        if (x0 < pData^.rdh.rcBound.left) then
          pData^.rdh.rcBound.left := x0;
        if (y < pData^.rdh.rcBound.top) then
          pData^.rdh.rcBound.top := y;
        if (x > pData^.rdh.rcBound.right) then
          pData^.rdh.rcBound.right := x;
        if (y+1 > pData^.rdh.rcBound.bottom) then
        pData^.rdh.rcBound.bottom := y+1;
        inc(pData^.rdh.nCount);

        // On Windows98, ExtCreateRegion() may fail if the number of rectangles is to
        // large (ie: > 4000). Therefore, we have to create the region by multiple steps
        if (pData^.rdh.nCount = 2000) then
        begin
          h := Windows.ExtCreateRegion(nil, sizeof(RGNDATAHEADER) + (sizeof(TRECT) * maxRects), pData^);
          if (Result <> 0) then
          begin
            Windows.CombineRgn(Result, Result, h, RGN_OR);
            Windows.DeleteObject(h);
          end
          else
            Result := h;

          pData^.rdh.nCount := 0;
          Windows.SetRect(pData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
        end;
      end;
      inc(x);
    end;
    // Go to next row (remember, the bitmap is inverted vertically
    P := PRGBAQuad(PByte(P) + RS);
  end;
  // Create or extend the region with the remaining rectangle
  h := Windows.ExtCreateRegion(nil, sizeof(RGNDATAHEADER) + (sizeof(TRECT) * maxRects), pData^);
  if (Result <> 0) then
  begin
    Windows.CombineRgn(Result, Result, h, RGN_OR);
    Windows.DeleteObject(h);
  end
  else
    Result := h;

  FreeMem(Data);
end;

{ Exactly equal to StrLCopy but for PWideChars
  Copyes a widestring up to a maximal length, in WideChars }
function WideStrLCopy(dest, source: PWideChar; maxlen: SizeInt): PWideChar;
var
  counter: SizeInt;
begin
  counter := 0;

  while (Source[counter] <> #0)  and (counter < MaxLen) do
  begin
    Dest[counter] := Source[counter];
    Inc(counter);
  end;

  { terminate the string }
  Dest[counter] := #0;
  Result := Dest;
end;

function WndClassName(Wnd: HWND): String; inline;
var
  winClassName: array[0..19] of char;
begin
  GetClassName(Wnd, @winClassName, 20);
  Result := winClassName;
end;

function WndText(Wnd: HWND): String; inline;
var
  winText: array[0..255] of char;
begin
  GetWindowText(Wnd, @winText, 256);
  Result := winText;
end;


procedure UpdateWindowsVersion;
begin
  case Win32MajorVersion of
    0..3:;
    4: begin
     if Win32Platform = VER_PLATFORM_WIN32_NT
     then WindowsVersion := wvNT4
     else
       case Win32MinorVersion of
         10: WindowsVersion := wv98;
         90: WindowsVersion := wvME;
       else
         WindowsVersion :=wv95;
       end;
    end;
    5: begin
     case Win32MinorVersion of
       0: WindowsVersion := wv2000;
       1: WindowsVersion := wvXP;
     else
       // XP64 has also a 5.2 version
       // we could detect that based on arch and versioninfo.Producttype
       WindowsVersion := wvServer2003;
     end;
    end;
    6: begin
     case Win32MinorVersion of
       0: WindowsVersion := wvVista;
       1: WindowsVersion := wv7;
     else
       WindowsVersion := wvLater;
     end;
    end;
  else
    WindowsVersion := wvLater;
  end;
end;

procedure DoInitialization;
begin
  FillChar(DefaultWindowInfo, sizeof(DefaultWindowInfo), 0);
  DefaultWindowInfo.DrawItemIndex := -1;
  WindowInfoAtom := Windows.GlobalAddAtom('WindowInfo');
  ChangedMenus := TList.Create;

  {$ifdef WindowsUnicodeSupport}
  UnicodeEnabledOS := (Win32Platform = VER_PLATFORM_WIN32_NT);
  {$endif}
  if WindowsVersion = wvUnknown then
    UpdateWindowsVersion;
end;

{$IFDEF ASSERT_IS_ON}
  {$UNDEF ASSERT_IS_ON}
  {$C-}
{$ENDIF}

initialization
  DoInitialization;

finalization
  Windows.GlobalDeleteAtom(WindowInfoAtom);
  WindowInfoAtom := 0;
  ChangedMenus.Free;

end.
