Стартовый пул

LCLExtensions/include/carbon/delphicompat.inc

@@ -0,0 +1,82 @@
+
+{
+  Carbon Interface
+
+  Dummy implementation. Not tested. 
+  Waiting for someone with a Mac to implement it
+}
+
+type
+  TTimerList = class
+  end;
+
+var
+  FTimerList: TTimerList;
+  
+function CF_UNICODETEXT: TClipboardFormat;
+begin
+  //todo
+  Result := TClipboardFormat(0);
+end;
+
+{
+  Only a few functions are necessary to compile VirtualTreeView:
+  BitBlt
+  GetCurrentObject
+  Set/KillTimer (Look at Qt/Gtk implementation)
+}
+
+{$define HAS_GETCURRENTOBJECT}
+{.$define HAS_MAPMODEFUNCTIONS}
+{.$define HAS_GETTEXTEXTENTEXPOINT}
+{.$define HAS_GETDOUBLECLICKTIME}
+{.$define HAS_GETTEXTALIGN}
+{.$define HAS_GETWINDOWDC}
+{.$define HAS_INVERTRECT}
+{.$define HAS_OFFSETRGN}
+{.$define HAS_REDRAWWINDOW}
+{.$define HAS_SCROLLWINDOW}
+{.$define HAS_SETBRUSHORGEX}
+
+
+{$i ../generic/stubs.inc}
+{$i ../generic/independentfunctions.inc}
+{$i ../generic/unicodefunctions.inc}
+
+
+function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
+  YSrc: Integer; Rop: DWORD): Boolean;
+begin
+  Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc,
+    Width, Height, 0, 0, 0, Rop);
+end;
+
+function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
+var
+  CarbonDC: TCarbonDeviceContext absolute hdc;
+begin
+  Result := 0;
+  with CarbonDC do
+  begin
+    case uObjectType of
+      OBJ_BITMAP:
+        begin
+           if CarbonDC is TCarbonBitmapContext then
+             Result := HGDIOBJ(TCarbonBitmapContext(CarbonDC).Bitmap);
+        end;   
+      OBJ_BRUSH: Result := HGDIOBJ(CurrentBrush);
+      OBJ_FONT: Result := HGDIOBJ(CurrentFont);
+      OBJ_PEN: Result := HGDIOBJ(CurrentPen);
+    end;
+  end;
+end;
+
+function KillTimer(hWnd: THandle; nIDEvent: UINT_PTR):Boolean;
+begin
+  Result := LCLIntf.KillTimer(hWnd, nIDEvent);
+end;
+
+function SetTimer(hWnd: THandle; nIDEvent: UINT_PTR; uElapse: LongWord; lpTimerFunc: TTimerNotify): UINT_PTR;
+begin
+  Result := LCLIntf.SetTimer(hWnd, nIDEvent, uElapse, nil{lpTimerFunc});
+end;

LCLExtensions/include/carbon/lclext.inc

@@ -0,0 +1,24 @@
+
+
+function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
+begin
+  //todo
+  Result := 0;
+end;
+
+function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
+begin
+  //todo: see if is possible todo it faster
+  Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
+   Mask, 0, 0,  SRCCOPY);
+end;
+
+function OptimalPixelFormat: TPixelFormat;
+begin
+  Result := pfDevice;
+end;
+
+function OSSupportsUTF16: Boolean;
+begin
+  Result := False;
+end;

LCLExtensions/include/carbon/uses.inc

@@ -0,0 +1 @@
+  InterfaceBase, LCLIntf, Graphics, CarbonInt, CarbonCanvas, Math,

LCLExtensions/include/carbon/uses_lclext.inc

@@ -0,0 +1,2 @@
+uses
+  LclIntf;

LCLExtensions/include/generic/independentfunctions.inc

@@ -0,0 +1,38 @@
+
+function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints; cPoints: UINT): Integer;
+var
+  i: Integer;
+  XOffset, YOffset: SmallInt;
+  FromPoint, ToPoint: TPoint;
+begin
+  FromPoint := Point(0, 0);
+  ToPoint := Point(0, 0);
+  if hWndFrom <> 0 then
+    ClientToScreen(hWndFrom, FromPoint);
+  if hWndTo <> 0 then
+    ClientToScreen(hWndTo, ToPoint);
+  XOffset := (FromPoint.X - ToPoint.X);
+  YOffset := (FromPoint.Y - ToPoint.Y);
+  for i := 0 to cPoints - 1 do
+  begin
+    PPoint(@lpPoints)[i].x := XOffset + PPoint(@lpPoints)[i].x;
+    PPoint(@lpPoints)[i].y := YOffset + PPoint(@lpPoints)[i].y;
+  end;
+  Result := MakeLong(XOffset, YOffset);
+end;
+
+{$ifndef HAS_GETDOUBLECLICKTIME}
+function GetDoubleClickTime: UINT;
+begin
+  //todo: see if gtk has a value. Use Windows default for now
+  Result := 500;
+end;
+{$endif}
+
+{$ifndef HAS_REDRAWWINDOW}
+function RedrawWindow(hWnd:THandle; lprcUpdate:PRECT; hrgnUpdate:HRGN; flags:LongWord):BOOLEAN;
+begin
+  //todo: see if there's a better way of doing this
+  Result := LCLIntf.InvalidateRect(hWnd, lprcUpdate, (RDW_ERASE and flags) > 0);
+end;
+{$endif}

LCLExtensions/include/generic/stubs.inc

@@ -0,0 +1,177 @@
+
+function BeginDeferWindowPos(nNumWindows:longint):THandle;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function CopyImage(hImage:THANDLE; uType:LongWord; cxDesired, cyDesired: LongInt; fuFlags:LongWord):THandle;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function DeferWindowPos(hWinPosInfo, hWnd, hWndInsertAfter:THandle; x, y, cx, cy:longint; uFlags:LongWord):THandle;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function EndDeferWindowPos(hWinPosInfo:THandle):Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function GdiFlush: Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function GetACP:LongWord;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+{$ifndef HAS_GETBKCOLOR}
+function GetBkColor(DC:HDC):COLORREF;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+{$ifndef HAS_GETCURRENTOBJECT}
+function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+function GetDCEx(hWnd:THandle; hrgnClip:HRGN; flags:DWORD):HDC;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function GetKeyboardLayout(dwLayout:DWORD):THandle;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function GetKeyboardState(lpKeyState: System.PByte):BOOLEAN;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function GetLocaleInfo(Locale, LCType:LongWord; lpLCData:PChar; cchData:longint):longint;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function GetRandomRgn(DC: HDC; Rgn: HRGN; iNum: Integer): Integer; stdcall;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+{$ifndef HAS_GETTEXTEXTENTEXPOINT}
+function GetTextExtentExPoint(DC: HDC; Str: PChar;
+  Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger;
+  var Size: TSize): BOOL;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+{$ifndef HAS_GETTEXTALIGN}
+function GetTextAlign(hDC:HDC): LongWord;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+{$ifndef HAS_GETWINDOWDC}
+function GetWindowDC(hWnd:THandle):HDC;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+function ImageList_DragShowNolock(fShow: Boolean): Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+{$ifndef HAS_INVERTRECT}
+function InvertRect(DC: HDC; const lprc: TRect): Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+function MultiByteToWideChar(CodePage, dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+{$ifndef HAS_OFFSETRGN}
+function OffsetRgn(hrgn:HRGN; nxOffset, nYOffset:longint):longint;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+function ScrollDC(DC:HDC; dx:longint; dy:longint; var lprcScroll:TRECT; var lprcClip:TRECT;hrgnUpdate:HRGN; lprcUpdate:PRECT):Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+{$ifndef HAS_SCROLLWINDOW}
+function ScrollWindow(hWnd:THandle; XAmount, YAmount:longint;lpRect:PRECT; lpClipRect:PRECT):Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+{$ifndef HAS_SETBRUSHORGEX}
+function SetBrushOrgEx(DC:HDC; nXOrg, nYOrg:longint; lppt:PPOINT):Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+{$endif}
+
+function SubtractRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOLEAN;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function ToAscii(uVirtKey, uScanCode:LongWord; lpKeyState: System.PByte; lpChar: System.PWord; uFlags:LongWord):longint;
+begin
+  Result := 0;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end;
+
+function UpdateWindow(Handle: HWND): Boolean;
+begin
+  Result := False;
+  {$ifdef DEBUG_DELPHICOMPAT} Logger.SendCallStack('Dummy WinAPI Implementation'); {$endif}
+end; 
+

LCLExtensions/include/generic/timerfunctions.inc

@@ -0,0 +1,8 @@
+
+function KillTimer(hWnd:THandle; nIDEvent: LongWord):Boolean;
+begin
+end;
+
+function SetTimer(hWnd:THandle; nIDEvent:LongWord; uElapse:LongWord; lpTimerFunc:TTimerNotify): LongWord;
+begin
+end;

LCLExtensions/include/generic/unicodefunctions.inc

@@ -0,0 +1,84 @@
+
+{
+GetUTF8ByteCount returns the number of bytes necessary to hold the requested number
+of characters (count). Not necessarily the number of characters is equal to the
+widestring length but here we assume it to skip the extra overhead
+}
+//todo do a function that convert the str and the count at one pass
+function GetUTF8ByteCount(const UTF8Str: UTF8String; WideCount: Integer): Integer;
+var
+  CharCount, CharLen, StrLen: Integer;
+  P: PChar;
+begin
+  Result := 0;
+  CharCount := 0;
+  P := PChar(UTF8Str);
+  StrLen := Length(UTF8Str);
+  WideCount := Min(WideCount, StrLen);
+  while (CharCount < WideCount) do
+  begin
+    CharLen := UTF8CharacterLength(P);
+    Inc(P, CharLen);
+    Inc(Result, CharLen);
+    Inc(CharCount);
+  end;
+  Result := Min(Result, StrLen);
+end;
+
+{$ifndef HAS_DRAWTEXTW}
+function DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect; uFormat: LongWord): Integer;
+var
+  TempStr: UTF8String;
+begin
+  TempStr := UTF8Encode(WideString(lpString));
+  Result := DrawText(hDC, PChar(TempStr), GetUTF8ByteCount(TempStr, nCount),
+    lpRect, uFormat);
+end;
+{$endif}
+
+function ExtTextOutW(DC: HDC; X, Y: Integer; Options: LongInt; Rect: PRect;
+  Str: PWideChar; Count: LongInt; Dx: ObjPas.PInteger): Boolean;
+var
+  TempStr: UTF8String;
+begin
+  TempStr := UTF8Encode(WideString(Str));
+  Result := ExtTextOut(DC, X, Y, Options, Rect, PChar(TempStr),
+    GetUTF8ByteCount(TempStr, Count), Dx);
+end;
+
+function GetTextExtentPoint32W(DC: HDC; Str: PWideChar; Count: Integer; out Size: TSize): Boolean;
+var
+  TempStr: UTF8String;
+begin
+  TempStr := UTF8Encode(WideString(Str));
+  Result := GetTextExtentPoint(DC, PChar(TempStr),
+    GetUTF8ByteCount(TempStr, Count), Size);
+end;
+
+function GetTextExtentExPointW(DC: HDC; Str: PWideChar;
+  Count, MaxWidth: Integer; MaxCount, PartialWidths: ObjPas.PInteger;
+  var Size: TSize): BOOL;
+var
+  TempStr: UTF8String;
+begin
+  TempStr := UTF8Encode(WideString(Str));
+  Result := DelphiCompat.GetTextExtentExPoint(DC, PChar(TempStr),
+    Count, MaxWidth, MaxCount, PartialWidths, Size);
+end;
+
+function GetTextExtentPointW(DC: HDC; Str: PWideChar; Count: Integer; out Size: TSize): Boolean;
+var
+  TempStr: UTF8String;
+begin
+  TempStr := UTF8Encode(WideString(Str));
+  Result := GetTextExtentPoint(DC, PChar(TempStr),
+    GetUTF8ByteCount(TempStr, Count), Size);
+end;
+
+function TextOutW(DC: HDC; X,Y : Integer; Str : PWideChar; Count: Integer) : Boolean;
+var
+  TempStr: UTF8String;
+begin
+  TempStr := UTF8Encode(WideString(Str));
+  Result := TextOut(DC, X, Y, PChar(TempStr), GetUTF8ByteCount(TempStr, Count));
+end;

LCLExtensions/include/gtk/delphicompat.inc

@@ -0,0 +1,336 @@
+
+{ This file is part of Delphi Compatibility Unit
+
+  Copyright (C) 2007 Luiz Américo Pereira Câmara
+  pascalive@bol.com.br
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+{$define HAS_INVERTRECT}
+{$define HAS_DRAWTEXTW}
+{$define HAS_GETCURRENTOBJECT}
+{$define HAS_GETBKCOLOR}
+{$define HAS_GETTEXTEXTENTEXPOINT}
+{$define HAS_DRAWFRAMECONTROL}
+{$define HAS_SCROLLWINDOW}
+
+{$i ../generic/stubs.inc}
+{$i ../generic/independentfunctions.inc}
+{$i ../generic/unicodefunctions.inc}
+
+function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
+  YSrc: Integer; Rop: DWORD): Boolean;
+begin
+  Result := GTKWidgetSet.StretchCopyArea(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
+   0, XSrc, YSrc, Rop);
+end;
+
+function DrawFrameControl(DC: HDC; const Rect: TRect; uType, uState: LongWord): Boolean;
+begin
+  Result := LCLIntf.DrawFrameControl(DC, Rect, uType, uState);
+end;
+
+function DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect; uFormat: LongWord): Integer;
+var
+  TempStr: UTF8String;
+  TempRect: TRect;
+  TextHeight: Integer;
+  TM: TTextMetric;
+begin
+  //Logger.Send('DrawTextW');
+  TempRect := lpRect;
+  //fix position under gtk (lcl bug 8565)
+  if (uFormat and DT_VCENTER) > 0 then
+  begin
+    GetTextMetrics(hDC, TM);
+    //gtk overestimate height
+    TextHeight := TM.tmHeight - 2;
+    TempRect.Top := (TempRect.Top + TempRect.Bottom - TextHeight) div 2;
+  end;
+  TempStr := UTF8Encode(WideString(lpString));
+  Result := DrawText(hDC, PChar(TempStr), GetUTF8ByteCount(TempStr, nCount),
+    TempRect, uFormat);
+  //Logger.Send('Rect',TempRect);
+end;
+
+function GetBkColor(DC:HDC):COLORREF;
+begin
+  if GTKWidgetSet.IsValidDC(DC) then
+    Result := TGtkDeviceContext(DC).CurrentBackColor.ColorRef
+  else
+    Result := CLR_INVALID;
+end;
+
+function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
+begin
+  Result := 0;
+  if GTKWidgetSet.IsValidDC(hdc) then
+  with TGtkDeviceContext(hdc) do
+  begin
+    case uObjectType of
+      OBJ_BITMAP: Result := HGDIOBJ(CurrentBitmap);
+      OBJ_BRUSH: Result := HGDIOBJ(CurrentBrush);
+      OBJ_FONT: Result := HGDIOBJ(CurrentFont);
+      OBJ_PEN: Result := HGDIOBJ(CurrentPen);
+    end;
+  end;
+end;
+
+function GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer;
+  MaxCount, PartialWidths: ObjPas.PInteger; var Size: TSize): BOOL;
+var
+  lbearing, rbearing, width, ascent,descent: LongInt;
+  UseFont : PGDKFont;
+  IsDBCSFont: Boolean;
+  NewCount,Accumulator,i: Integer;
+begin
+  //based in lcl code
+  Result := GTKWidgetSet.IsValidDC(DC);
+  if Result then
+  with TGtkDeviceContext(DC) do
+  begin
+    if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
+    then begin
+      UseFont := GTKWidgetSet.GetDefaultGtkFont(false);
+    end
+    else begin
+      UseFont := CurrentFont^.GDIFontObject;
+    end;
+    If UseFont = nil then
+      DebugLn('WARNING: [TGtkWidgetSet.GetTextExtentPoint] Missing font')
+    else begin
+      descent:=0;
+      {
+      UpdateDCTextMetric(TDeviceContext(DC));
+      IsDBCSFont:=TDeviceContext(DC).DCTextMetric.IsDoubleByteChar;
+
+      if IsDBCSFont then begin
+        NewCount:=Count*2;
+        if FExtUTF8OutCacheSize<NewCount then begin
+          ReAllocMem(FExtUTF8OutCache,NewCount);
+          FExtUTF8OutCacheSize:=NewCount;
+        end;
+        NewCount:=UTF8ToDoubleByte(Str,Count,FExtUTF8OutCache)*2;
+        gdk_text_extents(UseFont, FExtUTF8OutCache, NewCount,
+                         @lbearing, @rBearing, @width, @ascent, @descent);
+      end else begin
+        gdk_text_extents(UseFont, Str, Count,
+                         @lbearing, @rBearing, @width, @ascent, @descent);
+      end;
+      }
+      gdk_text_extents(UseFont, Str, Count,@lbearing, @rBearing, @width, @ascent, @descent);
+      Size.cX := Width;
+      Size.cY := ascent+descent;
+      if PartialWidths <> nil then
+      begin
+        Accumulator:=0;
+        for i:= 0 to Count - 1 do
+        begin
+          Inc(Accumulator,gdk_char_width(UseFont,(Str+i)^));
+          PartialWidths[i]:=Accumulator;
+        end;
+      end;
+    end;
+  end;
+end;
+
+function InvertRect(DC: HDC; const lprc: TRect): Boolean;
+var
+  DCOrigin: TPoint;
+  Values: TGdkGCValues;
+begin
+  //todo: see the windows result when rect is invalid
+  Result := GTKWidgetSet.IsValidDC(DC) and (lprc.Bottom > lprc.Top)
+    and (lprc.Right > lprc.Left);
+  if Result then
+  begin
+    with TGtkDeviceContext(DC) do
+    begin
+      DCOrigin := Offset;
+      //todo: see if is necessary store old function
+      gdk_gc_get_values(GC, @Values);
+      gdk_gc_set_function(GC,GDK_INVERT);
+      gdk_draw_rectangle(Drawable,GC,1,
+        DCOrigin.X + lprc.Left, DCOrigin.Y + lprc.Top,
+        lprc.Right - lprc.Left, lprc.Bottom - lprc.Top);
+      gdk_gc_set_function(GC,Values.thefunction);
+    end;
+  end;
+end;
+
+function ScrollWindow(hWnd:THandle; XAmount, YAmount:longint;lpRect:PRECT; lpClipRect:PRECT):Boolean;
+begin
+  //gtk implementation does nothing if lpRect and lpClipRect are not nil
+  Result := LCLIntf.ScrollWindowEx(hWnd, XAmount, YAmount, nil, nil, 0, nil, SW_INVALIDATE);
+end;
+
+var
+  CachedUnicodeFormat: TClipboardFormat;
+  
+function CF_UNICODETEXT: TClipboardFormat;
+begin
+  //todo: see what mime type gtk expects for utf16
+  if CachedUnicodeFormat = 0 then
+    CachedUnicodeFormat:= gdk_atom_intern('text/utf16',GdkFalse);
+  Result := CachedUnicodeFormat;
+end;
+
+type
+  TTimerRecord = record
+    Control: TControl;
+    Notify: TTimerNotify;
+    Id: LongWord;
+    TimerHandle: guint;
+  end;
+  PTimerRecord = ^TTimerRecord;
+
+  { TTimerList }
+
+  TTimerList = class
+  private
+    FList: TMap;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Add(hWnd: THandle; ID: LongWord; NotifyFunc: TTimerNotify; WinControl: TControl):PTimerRecord;
+    function GetTimerInfo(Handle: hWnd; idEvent:LongWord; out TimerInfo: TTimerRecord):Boolean;
+    function GetTimerInfoPtr(Handle: hWnd; idEvent:LongWord): PTimerRecord;
+  end;
+
+var
+  FTimerList: TTimerList;
+
+function MakeQWord(d1, d2: dword): QWord; inline;
+begin
+  Result:=(QWord(d2) shl 32) or d1;
+end;
+
+{ TTimerList }
+
+constructor TTimerList.Create;
+begin
+  //todo: see 64bit (itu16??)
+  FList:=TMap.Create(itu8,SizeOf(TTimerRecord));
+end;
+
+destructor TTimerList.Destroy;
+begin
+  FList.Destroy;
+  inherited Destroy;
+end;
+
+function TTimerList.Add(hWnd: THandle; ID: LongWord; NotifyFunc: TTimerNotify; WinControl: TControl):PTimerRecord;
+var
+  AID: QWord;
+  ATimerRec: TTimerRecord;
+begin
+  ATimerRec.Notify := NotifyFunc;
+  ATimerRec.Control := WinControl;
+  ATimerRec.Id := ID;
+  AId:=MakeQWord(hWnd,ID);
+  with FList do
+  begin
+    if HasId(AID) then
+      SetData(AID, ATimerRec)
+    else
+      Add(AID, ATimerRec);
+    Result := GetDataPtr(AID);
+  end;
+end;
+
+function TTimerList.GetTimerInfo(Handle: hWnd; idEvent: LongWord; out
+  TimerInfo: TTimerRecord): Boolean;
+begin
+  Result:= FList.GetData(MakeQWord(Handle,idEvent),TimerInfo);
+end;
+
+function TTimerList.GetTimerInfoPtr(Handle: hWnd; idEvent: LongWord
+  ): PTimerRecord;
+begin
+  Result := FList.GetDataPtr(MakeQWord(Handle,idEvent));
+end;
+
+function gtkTimerCB(Data: gPointer): {$IFDEF Gtk2}gBoolean{$ELSE}gint{$ENDIF}; cdecl;
+begin
+  Result := GdkFalse;  // assume: timer will stop
+  with PTimerRecord(Data)^ do
+  begin
+    //DebugLn('gtkTimerCalled for TimerHandle: %d',[TimerHandle]);
+    if TimerHandle <> 0 then
+    begin
+      if Notify <> nil then
+      begin
+        Notify(Id);
+        Result := GdkTrue;
+      end
+      else
+      begin
+        if Control <> nil then
+        begin
+          LCLSendTimerMsg(Control,Id,0);
+          Result := GdkTrue;
+        end;
+      end;
+    end;
+  end;
+end;
+
+function SetTimer(hWnd:THandle; nIDEvent:LongWord; uElapse:LongWord; lpTimerFunc:TTimerNotify):LongWord;
+var
+  TimerInfo: PTimerRecord;
+  Control: TControl;
+begin
+  //todo: properly set Result
+  //todo: make a custom GetLCLObject
+  if hWnd <> 0 then
+    Control := TControl(GetLCLObject(PGtkWidget(hWnd)))
+  else
+    Control := nil;
+  TimerInfo := FTimerList.Add(hWnd, nIDEvent, lpTimerFunc, Control);
+  TimerInfo^.TimerHandle := gtk_timeout_add(uElapse, @gtkTimerCB, TimerInfo);
+  //DebugLn('SetTimer HWnd: %d ID: %d TimerHandle: %d',[hWnd,nIDEvent,TimerInfo^.TimerHandle]);
+end;
+
+function KillTimer(hWnd:THandle; nIDEvent: LongWord):Boolean;
+var
+  TimerInfo: PTimerRecord;
+begin
+  TimerInfo := FTimerList.GetTimerInfoPtr(hWnd,nIDEvent);
+  if TimerInfo <> nil then
+  begin
+    //DebugLn('KillTimer HWnd: %d ID: %d TimerHandle: %d',[hWnd,nIDEvent,TimerInfo^.TimerHandle]);
+    gtk_timeout_remove(TimerInfo^.TimerHandle);
+    //next time gtkTimerCB be called the timeout will be destroied automatically
+    //todo: see if is really necessary to set TimerHandle to 0 and check in gtkTimerCB
+    TimerInfo^.TimerHandle := 0;
+  end;
+  //else
+  //  DebugLn('KillTimer Could not find the timer info of HWnd: %d ID: %d',[hWnd,nIDEvent]);
+end;
+
+

LCLExtensions/include/gtk/lclext.inc

@@ -0,0 +1,24 @@
+
+
+function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
+begin
+  //todo
+  Result := 0;
+end;
+
+function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
+begin
+  //todo: see if is possible todo it faster
+  Result := GTKWidgetSet.StretchCopyArea(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
+   Mask, XSrc, YSrc,  SRCCOPY);
+end;
+
+function OptimalPixelFormat: TPixelFormat;
+begin
+  Result := pfDevice;
+end;
+
+function OSSupportsUTF16: Boolean;
+begin
+  Result := False;
+end;

LCLExtensions/include/gtk/uses.inc

@@ -0,0 +1,3 @@
+
+  LCLIntf, Graphics, gtkdef, gdk, GTKProc, GtkInt, glib, gtk, Math,
+

LCLExtensions/include/gtk/uses_lclext.inc

@@ -0,0 +1,2 @@
+uses
+  GtkInt;

LCLExtensions/include/gtk2/delphicompat.inc

@@ -0,0 +1,394 @@
+{ This file is part of Delphi Compatibility Unit
+
+  Copyright (C) 2007 Luiz Américo Pereira Câmara
+  pascalive@bol.com.br
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+{$MACRO ON}
+{$if lcl_fullversion > 1000000}
+{$define TGtk2DeviceContext:=TGtkDeviceContext}
+{$endif}
+
+{$define HAS_INVERTRECT}
+{$define HAS_DRAWTEXTW}
+{$define HAS_GETCURRENTOBJECT}
+{$define HAS_GETBKCOLOR}
+{$define HAS_GETTEXTEXTENTEXPOINT}
+{$define HAS_SCROLLWINDOW}
+
+{$i ../generic/stubs.inc}
+{$i ../generic/independentfunctions.inc}
+{$i ../generic/unicodefunctions.inc}
+
+
+procedure pango_extents_to_pixels (ink_rect: PPangoRectangle;
+			  logical_rect: PPangoRectangle); cdecl; external 'libpango-1.0.so.0';
+
+function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
+  YSrc: Integer; Rop: DWORD): Boolean;
+begin
+  Result := GTK2WidgetSet.StretchCopyArea(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
+   0, XSrc, YSrc, Rop);
+end;
+
+function DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect; uFormat: LongWord): Integer;
+var
+  TempStr: UTF8String;
+  TempRect: TRect;
+  TextHeight: Integer;
+  TM: TTextMetric;
+begin
+  //Logger.Send('DrawTextW');
+  TempRect := lpRect;
+  //fix position under gtk (lcl bug 8565)
+  if (uFormat and DT_VCENTER) > 0 then
+  begin
+    GetTextMetrics(hDC, TM);
+    //gtk overestimate height
+    TextHeight := TM.tmHeight - 2;
+    TempRect.Top := (TempRect.Top + TempRect.Bottom - TextHeight) div 2;
+  end;
+  TempStr := UTF8Encode(WideString(lpString));
+  Result := DrawText(hDC, PChar(TempStr), GetUTF8ByteCount(TempStr, nCount),
+    TempRect, uFormat);
+  //Logger.Send('Rect',TempRect);
+end;
+
+function GetBkColor(DC:HDC):COLORREF;
+begin
+  if GTK2WidgetSet.IsValidDC(DC) then
+    Result := TGtkDeviceContext(DC).CurrentBackColor.ColorRef
+  else
+    Result := CLR_INVALID;
+end;
+
+function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
+begin
+  Result := 0;
+  if GTK2WidgetSet.IsValidDC(hdc) then
+  with TGtk2DeviceContext(hdc) do
+  begin
+    case uObjectType of
+      OBJ_BITMAP: Result := HGDIOBJ(CurrentBitmap);
+      OBJ_BRUSH: Result := HGDIOBJ(CurrentBrush);
+      OBJ_FONT: Result := HGDIOBJ(CurrentFont);
+      OBJ_PEN: Result := HGDIOBJ(CurrentPen);
+    end;
+  end;
+end;
+
+function GetTextExtentExPoint(DC: HDC; Str: PChar;
+  Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger;
+  var Size: TSize): BOOL;
+var
+  layout: PPangoLayout;
+  i: Integer;
+  Rect: TPangoRectangle;
+  iter : PPangoLayoutIter;
+begin
+  Result := GTK2WidgetSet.IsValidDC(DC);
+  if Result then
+  with TGtk2DeviceContext(DC) do
+  begin
+    if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) then
+      layout := GTK2WidgetSet.GetDefaultGtkFont(false)
+    else
+      layout := CurrentFont^.GDIFontObject;
+    pango_layout_set_text(layout, Str, Count);
+    if PartialWidths = nil then
+      pango_layout_get_pixel_size (layout, @Size.cx, @Size.cy)
+    else
+      begin
+        i := 0;
+        Size.cx := 0;
+        Size.cy := 0;
+        iter := pango_layout_get_iter(layout);
+        repeat
+          pango_layout_iter_get_char_extents(iter,@Rect);
+          pango_extents_to_pixels(nil,@Rect);
+          inc(Size.cx, Rect.Width);
+          PartialWidths[i] := Size.cx;
+          if Size.cy < Rect.Height then
+            Size.cy := Rect.Height;
+          inc(i);
+        until not pango_layout_iter_next_char(iter);
+        pango_layout_iter_free(iter);
+      end;
+  end;
+end;
+
+function InvertRect(DC: HDC; const lprc: TRect): Boolean;
+var
+  DCOrigin: TPoint;
+  Values: TGdkGCValues;
+begin
+  //todo: see the windows result when rect is invalid
+  Result := GTK2WidgetSet.IsValidDC(DC) and (lprc.Bottom > lprc.Top)
+    and (lprc.Right > lprc.Left);
+  if Result then
+  begin
+    with TGtk2DeviceContext(DC) do
+    begin
+      DCOrigin := Offset;
+      //todo: see if is necessary store old function
+      gdk_gc_get_values(GC, @Values);
+      gdk_gc_set_function(GC,GDK_INVERT);
+      gdk_draw_rectangle(Drawable,GC,1,
+        DCOrigin.X + lprc.Left, DCOrigin.Y + lprc.Top,
+        lprc.Right - lprc.Left, lprc.Bottom - lprc.Top);
+      gdk_gc_set_function(GC,Values._function);
+    end;
+  end;
+end;
+
+function ScrollWindow(hWnd:THandle; XAmount, YAmount:longint;lpRect:PRECT; lpClipRect:PRECT):Boolean;
+begin
+  //gtk implementation does nothing if lpRect and lpClipRect are not nil
+  Result := LCLIntf.ScrollWindowEx(hWnd, XAmount, YAmount, nil, nil, 0, nil, SW_INVALIDATE);
+end;
+
+var
+  CachedUnicodeFormat: TClipboardFormat;
+
+function CF_UNICODETEXT: TClipboardFormat;
+begin
+  //todo: see what mime type gtk expects for utf16
+  if CachedUnicodeFormat = 0 then
+    CachedUnicodeFormat:= gdk_atom_intern('text/utf16',GdkFalse);
+  Result := CachedUnicodeFormat;
+end;
+
+type
+
+  TTimerID = record
+    hWnd: THandle;
+    nIDEvent: UINT_PTR;
+  end;
+
+  { TGtk2Timer }
+
+  TGtk2Timer = class
+  private
+    FControl: TControl;
+    FNotify: TTimerNotify;
+    FId: UINT_PTR;
+    FHandle: THandle;
+    FTimerHandle: guint;
+  public
+    constructor Create(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify);
+    procedure Start(Interval: LongWord);
+    procedure Stop;
+  end;
+
+  { TTimerList }
+
+  TTimerList = class
+  private
+    FMap: TMap;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Delete(hWnd: THandle; nIDEvent: UINT_PTR);
+    function Find(hWnd: THandle; nIDEvent: UINT_PTR): TGtk2Timer;
+    function Get(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify): TGtk2Timer;
+  end;
+
+var
+  FTimerList: TTimerList;
+
+function gtkWidgetDestroyCB(Widget: PGtkWidget; Timer: TGtk2Timer): GBoolean; cdecl;
+begin
+  Result := GdkFalse;
+  Timer.Stop;
+  FTimerList.Delete(Timer.FHandle, Timer.FId);
+  Timer.Destroy;
+end;
+
+function gtkTimerCB(Timer: TGtk2Timer): gBoolean; cdecl;
+begin
+  Result := GdkFalse;  // assume: timer will stop
+  //DebugLn('gtkTimerCalled for TimerHandle: %d',[TimerHandle]);
+  if Timer.FNotify <> nil then
+  begin
+    Timer.FNotify(Timer.FId);
+    Result := GdkTrue;
+  end
+  else
+  begin
+    if Timer.FControl <> nil then
+    begin
+      LCLSendTimerMsg(Timer.FControl, Timer.FId, 0);
+      Result := GdkTrue;
+    end;
+  end;
+end;
+
+{ TGtk2TimerInfo }
+
+constructor TGtk2Timer.Create(hWnd: THandle; nIDEvent: UINT_PTR;
+  NotifyFunc: TTimerNotify);
+begin
+  //todo: make a custom GetLCLObject
+  if hWnd <> 0 then
+  begin
+    FControl := TControl(GetLCLObject(PGtkWidget(hWnd)));
+    g_signal_connect(PGObject(hWnd), 'destroy', gtk_Signal_Func(@gtkWidgetDestroyCB), Self);
+  end
+  else
+    FControl := nil;
+  FHandle := hWnd;
+  FId := nIDEvent;
+  FNotify := NotifyFunc;
+end;
+
+procedure TGtk2Timer.Start(Interval: LongWord);
+begin
+  //restart
+  if FTimerHandle <> 0 then
+    g_source_remove(FTimerHandle);
+  FTimerHandle := g_timeout_add(Interval, TGSourceFunc(@gtkTimerCB), Self);
+end;
+
+procedure TGtk2Timer.Stop;
+begin
+  if FTimerHandle <> 0 then
+  begin
+    g_source_remove(FTimerHandle);
+    FTimerHandle := 0;
+  end;
+end;
+
+{ TTimerList }
+
+constructor TTimerList.Create;
+begin
+  FMap := TMap.Create({$ifdef CPU64}itu16{$else}itu8{$endif}, SizeOf(TGtk2Timer));
+end;
+
+destructor TTimerList.Destroy;
+var
+  Iterator: TMapIterator;
+  TimerInfo: TGtk2Timer;
+begin
+  Iterator := TMapIterator.Create(FMap);
+  with Iterator do
+  begin
+    while not EOM do
+    begin
+      GetData(TimerInfo);
+      TimerInfo.Free;
+      Next;
+    end;
+    Destroy;
+  end;
+  FMap.Destroy;
+end;
+
+procedure TTimerList.Delete(hWnd: THandle; nIDEvent: UINT_PTR);
+var
+  TimerID: TTimerID;
+begin
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  FMap.Delete(TimerID);
+end;
+
+function TTimerList.Get(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify): TGtk2Timer;
+var
+  TimerID: TTimerID;
+begin
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  with FMap do
+  begin
+    if HasId(TimerID) then
+    begin
+      // DebugLn('Reset timer for HWnd: %d ID: %d AID: %d', [hWnd, ID, TimerID]);
+      GetData(TimerID, Result);
+      Result.FNotify := NotifyFunc;
+    end
+    else
+    begin
+      // DebugLn('Create timer for HWnd: %d ID: %d AID: %d', [hWnd, ID, TimerID]);
+      Result := TGtk2Timer.Create(hWnd, nIDEvent, NotifyFunc);
+      if hWnd = 0 then
+      begin
+        TimerID.nIDEvent := PtrUInt(Result);
+        Result.FId := PtrUInt(Result);
+      end;
+      Add(TimerID, Result);
+    end;
+  end;
+end;
+
+function TTimerList.Find(hWnd: THandle; nIDEvent: UINT_PTR): TGtk2Timer;
+var
+  DataPtr: ^TGtk2Timer;
+  TimerID: TTimerID;
+begin
+  Result := nil;
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  // DebugLn('GetTimerInfo for HWnd: %d ID: %d AID: %d', [hWnd, ID, TimerID]);
+  DataPtr := FMap.GetDataPtr(TimerID);
+  if DataPtr <> nil then
+    Result := DataPtr^;
+end;
+
+function SetTimer(hWnd: THandle; nIDEvent: UINT_PTR; uElapse: LongWord; lpTimerFunc: TTimerNotify): UINT_PTR;
+var
+  Timer: TGtk2Timer;
+begin
+  Timer := FTimerList.Get(hWnd, nIDEvent, lpTimerFunc);
+  try
+    Timer.Start(uElapse);
+    if hWnd = 0 then
+      Result := PtrUInt(Timer)
+    else
+      Result := nIdEvent;
+  except
+    Result := 0;
+  end;
+  //DebugLn('SetTimer HWnd: %d ID: %d TimerHandle: %d',[hWnd,nIDEvent,Timer.FTimerHandle]);
+end;
+
+function KillTimer(hWnd:THandle; nIDEvent: UINT_PTR): Boolean;
+var
+  Timer: TGtk2Timer;
+begin
+  //todo: investigate how to set result
+  Result := True;
+  Timer := FTimerList.Find(hWnd, nIDEvent);
+  //DebugLn('KillTimer HWnd: %d ID: %d TimerHandle: %d',[hWnd,nIDEvent,Timer^.TimerHandle]);
+  if Timer <> nil then
+    Timer.Stop;
+end;
+
+
+

LCLExtensions/include/gtk2/lclext.inc

@@ -0,0 +1,22 @@
+function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
+begin
+  //todo
+  Result := 0;
+end;
+
+function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
+begin
+  //todo: see if is possible todo it faster
+  Result := GTK2WidgetSet.StretchCopyArea(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
+   Mask, XSrc, YSrc,  SRCCOPY);
+end;
+
+function OptimalPixelFormat: TPixelFormat;
+begin
+  Result := pfDevice;
+end;
+
+function OSSupportsUTF16: Boolean;
+begin
+  Result := False;
+end;

LCLExtensions/include/gtk2/uses.inc

@@ -0,0 +1,2 @@
+
+  LCLIntf, Graphics, Gtk2Def, gdk2, gtk2, Gtk2Proc, Gtk2Int, pango, glib2, math,

LCLExtensions/include/gtk2/uses_lclext.inc

@@ -0,0 +1,2 @@
+uses
+  Gtk2Int;

LCLExtensions/include/qt/delphicompat.inc

@@ -0,0 +1,404 @@
+
+{
+  Qt Interface
+  
+  Initial implementation by Zeljan Rikalo
+
+  SetTimer/KillTimer implementation by Luiz Americo
+}
+
+function CF_UNICODETEXT: TClipboardFormat;
+begin
+  //todo
+  Result := TClipboardFormat(0);
+end;
+
+{$define HAS_GETBKCOLOR}
+{$define HAS_GETCURRENTOBJECT}
+{$define HAS_INVERTRECT}
+{$define HAS_GETTEXTEXTENTEXPOINT}
+{$define HAS_GETDOUBLECLICKTIME}
+{$define HAS_GETTEXTALIGN}
+{$define HAS_GETWINDOWDC}
+{$define HAS_OFFSETRGN}
+{$define HAS_REDRAWWINDOW}
+{$define HAS_SCROLLWINDOW}
+{$define HAS_SETBRUSHORGEX}
+
+
+{$i ../generic/stubs.inc}
+{$i ../generic/independentfunctions.inc}
+{$i ../generic/unicodefunctions.inc}
+
+function GetBkColor(DC:HDC):COLORREF;
+var
+  Color: PQColor;
+begin
+  if QtWidgetSet.IsValidDC(DC) then
+  begin
+    Color := TQtDeviceContext(DC).BackgroundBrush.getColor;
+    TQColorToColorRef(Color^, Result);
+  end else
+    Result := CLR_INVALID;
+end;
+
+function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
+  YSrc: Integer; Rop: DWORD): Boolean;
+begin
+  Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width,
+    Height, ROP);
+end;
+
+function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
+begin
+  Result := 0;
+  if QtWidgetSet.IsValidDC(hdc) then
+  with TQtDeviceContext(hdc) do
+  begin      {TODO: FIXME}
+    case uObjectType of
+      OBJ_BITMAP: Result := HGDIOBJ(vImage);
+      OBJ_BRUSH: Result := HGDIOBJ(vBrush);
+      OBJ_FONT: Result := HGDIOBJ(vFont);
+      OBJ_PEN: Result := HGDIOBJ(vPen);
+    end;
+  end;
+end;
+
+function GetDoubleClickTime: UINT;
+begin
+  Result := QApplication_doubleClickInterval;
+end;
+
+function GetTextExtentExPoint(DC: HDC; Str: PChar;
+  Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger;
+  var Size: TSize): BOOL;
+begin
+  Result := QtWidgetSet.GetTextExtentExPoint(DC, Str, Count, MaxWidth, MaxCount, PartialWidths, Size);
+end;
+
+function GetTextAlign(hDC:HDC): LongWord;
+var
+  QtDC: TQtDeviceContext;
+  QtFontMetrics: QFontMetricsH;
+  QtFont: QFontH;
+begin
+  Result := 0;
+  if not QtWidgetSet.IsValidDC(hdC) then
+    Exit;
+  QtDC := TQtDeviceContext(hDC);
+  QtFont := QtDC.vFont.FHandle;
+  QtFontMetrics := QFontMetrics_create(QtFont);
+  try
+  {TODO: FIXME we should save somehow text flags into QtDC
+   cause we don't have any function which returns current flags !}
+  finally
+    QFontMetrics_destroy(QtFontMetrics);
+  end;
+end;
+
+function GetWindowDC(hWnd:THandle): HDC;
+begin
+  Result := LCLIntf.GetDC(hWnd);
+end;
+
+function InvertRect(DC: HDC; const lprc: TRect): Boolean;
+var
+  DCOrigin: TQtPoint;
+begin
+  //todo: see the windows result when rect is invalid
+  Result := QtWidgetSet.IsValidDC(DC) and (lprc.Bottom > lprc.Top)
+    and (lprc.Right > lprc.Left);
+  if Result then
+  begin
+    with lprc do
+      Result := BitBlt(DC, Left, Top, Right - Left, Bottom-Top,
+        DC, Left, Top, LongWord(QPainterCompositionMode_DestinationOver));
+    {TODO: FIXME !}
+  end;
+end;
+
+function OffsetRgn(hrgn:HRGN; nxOffset, nYOffset:longint):longint;
+var
+  Region: TQtRegion;
+begin
+  Region := TQtRegion(hrgn);
+  QRegion_translate(Region.FHandle, nxOffset, nYOffset);
+  Result := Region.GetRegionType;
+end;
+
+function RedrawWindow(hWnd:THandle; lprcUpdate:PRECT; hrgnUpdate:HRGN; flags:LongWord):BOOLEAN;
+begin
+  Result := QtWidgetSet.RedrawWindow(hWnd, lprcUpdate, hrgnUpdate, flags);
+end;
+
+function ScrollWindow(hWnd:THandle; XAmount, YAmount:longint;lpRect:PRECT; lpClipRect:PRECT): Boolean;
+begin
+  Result := False;
+  if hWnd = 0 then
+    Exit;
+  QWidget_scroll(TQtWidget(hWnd).Widget, XAmount, YAmount, lpRect);
+  Result := True;
+end;
+
+function SetBrushOrgEx(DC:HDC; nXOrg, nYOrg:longint; lppt:PPOINT):Boolean;
+var
+  QtDC: TQtDeviceContext;
+begin
+  Result := False;
+  if not QtWidgetSet.IsValidDC(DC) then
+    Exit;
+  QtDC := TQtDeviceContext(DC);
+  if lppt <> nil then
+    QtDC.getBrushOrigin(lppt);
+  QtDC.setBrushOrigin(nXorg, nYOrg);
+  Result := True;
+end;
+
+
+type
+
+  TTimerID = record
+    hWnd: THandle;
+    nIDEvent: UINT_PTR;
+  end;
+
+  { TQtTimerEx }
+
+  TQtTimerEx = class(TQtObject)
+  private
+    FTimerHook: QTimer_hookH;
+    FWidgetHook: QObject_hookH;
+    FCallbackFunc: TTimerNotify;
+    FID: UINT_PTR;
+    FHandle: THandle;
+    FControl: TWinControl;
+  public
+    constructor Create(hWnd: THandle; nIDEvent: UINT_PTR; TimerFunc: TTimerNotify);
+    destructor Destroy; override;
+    procedure AttachEvents; override;
+    procedure DetachEvents; override;
+    procedure signalWidgetDestroyed; cdecl;
+    procedure signalTimeout; cdecl;
+  public
+    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
+    procedure Start(Interval: Integer);
+    procedure Stop;
+  end;
+
+
+  { TTimerList }
+
+  TTimerList = class
+  private
+    FMap: TMap;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Delete(hWnd: THandle; nIDEvent: UINT_PTR);
+    function Find(hWnd: THandle; nIDEvent: UINT_PTR): TQtTimerEx;
+    function Get(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify): TQtTimerEx;
+  end;
+
+  TQtWidgetSetHack = Class(TWidgetSet)
+  private
+    App: QApplicationH;
+  end;
+
+var
+  FTimerList: TTimerList;
+
+{ TQtTimerEx }
+
+constructor TQtTimerEx.Create(hWnd: THandle; nIDEvent: UINT_PTR; TimerFunc: TTimerNotify);
+var
+  AName: WideString;
+begin
+  inherited Create;
+  FDeleteLater := True;
+  FCallbackFunc := TimerFunc;
+  FID := nIDEvent;
+  FControl := FindControl(hWnd);
+  FHandle := hWnd;
+  if hWnd <> 0 then
+  begin
+    FWidgetHook := QObject_hook_create(TQtWidget(hWnd).TheObject);
+    QObject_hook_hook_destroyed(FWidgetHook, @signalWidgetDestroyed);
+  end;
+  //very big ultra extreme hack to get the app from QtWidgetset
+  TheObject := QTimer_create(TQtWidgetSetHack(QtWidgetSet).App);
+  AName := 'tqttimerex';
+  QObject_setObjectName(TheObject, @AName);
+
+  AttachEvents;
+end;
+
+destructor TQtTimerEx.Destroy;
+begin
+  if FWidgetHook <> nil then
+    QObject_hook_destroy(FWidgetHook);
+  inherited Destroy;
+end;
+
+procedure TQtTimerEx.AttachEvents;
+begin
+  FTimerHook := QTimer_hook_create(QTimerH(TheObject));
+  QTimer_hook_hook_timeout(FTimerHook, @signalTimeout);
+  inherited AttachEvents;
+end;
+
+procedure TQtTimerEx.DetachEvents;
+begin
+  QTimer_stop(QTimerH(TheObject));
+  if FTimerHook <> nil then
+    QTimer_hook_destroy(FTimerHook);
+  inherited DetachEvents;
+end;
+
+procedure TQtTimerEx.signalWidgetDestroyed; cdecl;
+begin
+  Stop;
+  FTimerList.Delete(FHandle, FID);
+  Destroy;
+end;
+
+procedure TQtTimerEx.signalTimeout; cdecl;
+begin
+  if Assigned(FCallbackFunc) then
+    FCallbackFunc(FID)
+  else if Assigned(FControl) then
+  begin
+    if ([csLoading, csDestroying] * FControl.ComponentState = []) and not
+      (csDestroyingHandle in FControl.ControlState) then
+    begin
+      LCLSendTimerMsg(FControl, FID, 0);
+    end;
+  end
+  else
+  begin
+    //orphan timer. Stop.
+    //todo: better to remove from the list?
+    Stop;
+  end;
+end;
+
+function TQtTimerEx.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
+begin
+  Result := False;
+  QEvent_accept(Event);
+end;
+
+procedure TQtTimerEx.Start(Interval: Integer);
+begin
+  QTimer_start(QTimerH(TheObject), Interval);
+end;
+
+procedure TQtTimerEx.Stop;
+begin
+  QTimer_stop(QTimerH(TheObject));
+end;
+  
+function KillTimer(hWnd: THandle; nIDEvent: UINT_PTR): Boolean;
+var
+  TimerObject: TQtTimerEx;
+begin
+  Result := True;
+  TimerObject := FTimerList.Find(hWnd, nIDEvent);
+  if TimerObject <> nil then
+  begin
+    // DebugLn('KillTimer HWnd: %d ID: %d TimerObject: %d',[hWnd, nIDEvent, PtrInt(TimerObject)]);
+    TimerObject.Stop;
+  end;
+end;
+
+function SetTimer(hWnd: THandle; nIDEvent: UINT_PTR; uElapse: LongWord; lpTimerFunc: TTimerNotify): UINT_PTR;
+var
+  TimerObject: TQtTimerEx;
+begin
+  TimerObject := FTimerList.Get(hWnd, nIDEvent, lpTimerFunc);
+  try
+    TimerObject.Start(uElapse);
+    if hWnd = 0 then
+      Result := PtrInt(TimerObject)
+    else
+      Result := nIdEvent;
+  except
+    Result := 0;
+  end;
+  //DebugLn('SetTimer HWnd: %d ID: %d TimerObject: %d',[hWnd, nIDEvent, PtrInt(TimerObject)]);
+end;
+
+function TTimerList.Get(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify): TQtTimerEx;
+var
+  AID: TTimerID;
+begin
+  AID.hWnd := hWnd;
+  AID.nIDEvent := nIDEvent;
+  with FMap do
+  begin
+    if HasId(AID) then
+    begin
+      // DebugLn('Reset timer for HWnd: %d ID: %d AID: %d', [hWnd, ID, AID]);
+      GetData(AID, Result);
+      Result.FCallbackFunc := NotifyFunc;
+    end
+    else
+    begin
+      // DebugLn('Create timer for HWnd: %d ID: %d AID: %d', [hWnd, ID, AID]);
+      Result := TQtTimerEx.Create(hWnd, nIDEvent, NotifyFunc);
+      if hWnd = 0 then
+      begin
+        AID.nIDEvent := PtrUInt(Result);
+        Result.FID := PtrUInt(Result);
+      end;
+      Add(AID, Result);
+    end;
+  end;
+end;
+
+constructor TTimerList.Create;
+begin
+  FMap := TMap.Create({$ifdef CPU64}itu16{$else}itu8{$endif}, SizeOf(TQtTimerEx));
+end;
+
+destructor TTimerList.Destroy;
+var
+  Iterator: TMapIterator;
+  TimerObject: TQtTimerEx;
+begin
+  Iterator := TMapIterator.Create(FMap);
+  with Iterator do
+  begin
+    while not EOM do
+    begin
+      GetData(TimerObject);
+      TimerObject.Free;
+      Next;
+    end;
+    Destroy;
+  end;
+  FMap.Destroy;
+end;
+
+procedure TTimerList.Delete(hWnd: THandle; nIDEvent: UINT_PTR);
+var
+  TimerID: TTimerID;
+begin
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  FMap.Delete(TimerID);
+end;
+
+function TTimerList.Find(hWnd: THandle; nIDEvent: UINT_PTR): TQtTimerEx;
+var
+  DataPtr: ^TQtTimerEx;
+  TimerID: TTimerID;
+begin
+  Result := nil;
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  // DebugLn('GetTimerObject for HWnd: %d ID: %d AID: %d', [hWnd, nIDEvent, TimerID]);
+  DataPtr := FMap.GetDataPtr(TimerID);
+  if DataPtr <> nil then
+    Result := DataPtr^;
+end;
+

LCLExtensions/include/qt/lclext.inc

@@ -0,0 +1,24 @@
+
+
+function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
+begin
+  //todo
+  Result := 0;
+end;
+
+function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
+begin
+  //todo: see if is possible todo it faster
+  Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
+   Mask, 0, 0,  SRCCOPY);
+end;
+
+function OptimalPixelFormat: TPixelFormat;
+begin
+  Result := pfDevice;
+end;
+
+function OSSupportsUTF16: Boolean;
+begin
+  Result := False;
+end;

LCLExtensions/include/qt/uses.inc

@@ -0,0 +1 @@
+  InterfaceBase, LCLIntf, Graphics, qt4, qtint, qtobjects, qtwidgets, Math,

LCLExtensions/include/qt/uses_lclext.inc

@@ -0,0 +1,2 @@
+uses
+  LclIntf;

LCLExtensions/include/win32/delphicompat.inc

@@ -0,0 +1,398 @@
+
+{ This file is part of Delphi Compatibility Unit
+
+  Copyright (C) 2007 Luiz Américo Pereira Câmara
+  pascalive@bol.com.br
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+}
+
+function BeginDeferWindowPos(nNumWindows: longint): THandle;
+begin
+  Result:=Windows.BeginDeferWindowPos(nNumWindows);
+end;
+
+function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
+  YSrc: Integer; Rop: DWORD): Boolean;
+begin
+  Result := Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Rop);
+end;
+
+function CF_UNICODETEXT: TClipboardFormat;
+begin
+  Result:=Windows.CF_UNICODETEXT;
+end;
+
+function CopyImage(hImage: THANDLE; uType: LongWord; cxDesired,
+  cyDesired: LongInt; fuFlags: LongWord): THandle;
+begin
+  Result := Windows.CopyImage(hImage,uType,cxDesired,cyDesired,fuFlags);
+end;
+
+function CreatePatternBrush(hbmp: HBITMAP): HBRUSH;
+begin
+  Result := Windows.CreatePatternBrush(hbmp);
+end;
+
+function DeferWindowPos(hWinPosInfo, hWnd, hWndInsertAfter: THandle;
+  x, y, cx, cy: longint; uFlags: LongWord): THandle;
+begin
+  Result := Windows.DeferWindowPos(hWinPosInfo,hWnd,hWndInsertAfter,x,y,cx,cy,uFlags);
+end;
+
+function DrawFrameControl(DC: HDC; const Rect: TRect; uType, uState: LongWord): Boolean;
+begin
+  Result := Windows.DrawFrameControl(DC,Rect,uType,uState);
+end;
+
+function DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
+  var lpRect: TRect; uFormat: LongWord): Integer;
+begin
+  Result := Windows.DrawTextW(hDC,lpString,nCount,lpRect,uFormat);
+end;
+  
+function EndDeferWindowPos(hWinPosInfo: THandle): Boolean;
+begin
+  Result:=Windows.EndDeferWindowPos(hWinPosInfo);
+end;
+
+function ExtTextOutW(DC: LCLType.HDC; X, Y: Integer; Options: LongInt; Rect: Types.PRect;
+  Str: PWideChar; Count: LongInt; Dx: ObjPas.PInteger): Boolean;
+begin
+  Result := Windows.ExtTextOutW(DC, X, Y, Options, Rect,Str, Count, Dx);
+end;
+
+function GdiFlush: Boolean;
+begin
+  Result := Windows.GdiFlush;
+end;
+
+function GetACP: LongWord;
+begin
+  Result := Windows.GetACP;
+end;
+
+function GetBkColor(DC: HDC): LCLType.COLORREF;
+begin
+  Result := Windows.GetBkColor(DC);
+end;
+
+function GetCurrentObject(hdc: HDC; uObjectType: UINT): HGDIOBJ;
+begin
+  Result := Windows.GetCurrentObject(hdc, uObjectType);
+end;
+
+function GetDCEx(hWnd: THandle; hrgnClip: HRGN; flags: DWORD): HDC;
+begin
+  Result := Windows.GetDCEx(hWnd,hrgnClip,flags);
+end;
+
+function GetDoubleClickTime: UINT;
+begin
+  Result := Windows.GetDoubleClickTime;
+end;
+
+function GetKeyboardLayout(dwLayout: DWORD): THandle;
+begin
+  Result := Windows.GetKeyboardLayout(dwLayout);
+end;
+
+function GetKeyboardState(lpKeyState: PBYTE): BOOLEAN;
+begin
+  Result := Windows.GetKeyboardState(lpKeyState);
+end;
+
+function GetLocaleInfo(Locale, LCType: LongWord; lpLCData: PChar;
+  cchData: longint): longint;
+begin
+  Result := Windows.GetLocaleInfo(Locale,LCType,lpLCData,cchData);
+end;
+
+{$if lcl_release < 29}
+function GetMapMode(DC: HDC): LongInt;
+begin
+  Result := Windows.GetMapMode(DC);
+end;
+{$endif}
+
+function GetRandomRgn(DC: HDC; Rgn: HRGN; iNum: Integer): Integer; stdcall; external 'GDI32.DLL';
+
+function GetTextAlign(hDC: HDC): LongWord;
+begin
+  Result := Windows.GetTextAlign(hDC);
+end;
+
+function GetTextExtentExPoint(DC: LCLType.HDC; Str: PChar;
+  Count, MaxWidth: Integer; MaxCount, PartialWidths: ObjPas.PInteger;
+  var Size: TSize): BOOL;
+begin
+  Result := Windows.GetTextExtentExPoint(DC, Str, Count, MaxWidth, MaxCount, PartialWidths,  Size);
+end;
+
+function GetTextExtentExPointW(DC: LCLType.HDC; Str: PWideChar;
+  Count, MaxWidth: Integer; MaxCount, PartialWidths: ObjPas.PInteger;
+  var Size: Types.TSize): BOOL;
+begin
+  Result := Windows.GetTextExtentExPointW(DC, Str, Count, MaxWidth, MaxCount, PartialWidths,  Size);
+end;
+
+function GetTextExtentPoint32W(DC: HDC; Str: PWideChar; Count: Integer; out Size: TSize): Boolean;
+begin
+  Result := Windows.GetTextExtentPointW(DC, Str, Count, Size);
+end;
+
+function GetTextExtentPointW(DC: HDC; Str: PWideChar; Count: Integer; out Size: TSize): Boolean;
+begin
+  Result := Windows.GetTextExtentPointW(DC, Str, Count, Size);
+end;
+
+function GetWindowDC(hWnd: THandle): HDC;
+begin
+  Result := Windows.GetWindowDC(hWnd);
+end;
+
+function ImageList_DragShowNolock(fShow: Boolean): Boolean;
+begin
+  Result := CommCtrl.ImageList_DragShowNolock(fShow);
+end;
+
+function InvertRect(DC: HDC; const lprc: TRect): Boolean;
+begin
+  Result := Windows.InvertRect(DC, PRect(@lprc)^);
+end;
+
+function LPtoDP(DC: HDC; var Points; Count: Integer): BOOLEAN;
+begin
+  Result := Windows.LPToDP(DC,Points,Count);
+end;
+
+function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints; cPoints: UINT
+  ): Integer;
+begin
+  Result:=Windows.MapWindowPoints(hWndFrom,hWndTo,lpPoints,cPoints);
+end;
+
+function MultiByteToWideChar(CodePage, dwFlags: DWORD; lpMultiByteStr: PChar;
+  cchMultiByte: longint; lpWideCharStr: PWideChar; cchWideChar: longint
+  ): longint;
+begin
+  Result := Windows.MultiByteToWideChar(CodePage,dwFlags,lpMultiByteStr,cchMultiByte,lpWideCharStr,cchWideChar);
+end;
+
+function OffsetRgn(hrgn: HRGN; nxOffset, nYOffset: longint): longint;
+begin
+  Result := Windows.OffsetRgn(hrgn,nxOffset,nYOffset);
+end;
+
+function RedrawWindow(hWnd: THandle; lprcUpdate: Types.PRECT; hrgnUpdate: HRGN;
+  flags: LongWord): BOOLEAN;
+begin
+  Result := Windows.RedrawWindow(hWnd,lprcUpdate,hrgnUpdate,flags);
+end;
+
+function SetBrushOrgEx(DC: LCLType.HDC; nXOrg, nYOrg: longint; lppt: Types.PPoint): Boolean;
+begin
+  Result := Windows.SetBrushOrgEx(DC,nXOrg,nYOrg,lppt);
+end;
+
+{$if lcl_release < 29}
+function SetMapMode(DC: HDC; fnMapMode: LongInt): LongInt;
+begin
+  Result := Windows.SetMapMode(DC, fnMapMode);
+end;
+{$endif}
+
+function ScrollDC(DC: LCLType.HDC; dx: longint; dy: longint; var lprcScroll: Types.TRect;
+  var lprcClip: Types.TRect; hrgnUpdate: LCLType.HRGN; lprcUpdate: Types.PRect): Boolean;
+begin
+  Result := Windows.ScrollDC(DC, dx, dy, lprcScroll, lprcClip, hrgnUpdate, lprcUpdate);
+end;
+
+function ScrollWindow(hWnd: THandle; XAmount, YAmount: longint; lpRect: Types.PRect;
+  lpClipRect: Types.PRect): Boolean;
+begin
+  Result := Windows.ScrollWindow(hWnd,XAmount,YAmount,lpRect,lpClipRect);
+end;
+
+function SubtractRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect
+  ): BOOLEAN;
+begin
+  Result := Windows.SubtractRect(lprcDst,lprcSrc1,lprcSrc2);
+end;
+
+function TextOutW(DC: HDC; X,Y : Integer; Str : PWideChar; Count: Integer) : Boolean;
+begin
+  Result := Windows.TextOutW(DC,X,Y,Str,Count);
+end;
+
+function ToAscii(uVirtKey, uScanCode: LongWord; lpKeyState: PBYTE;
+  lpChar: PWORD; uFlags: LongWord): longint;
+begin
+  Result := Windows.ToAscii(uVirtKey,uScanCode,lpKeyState,lpChar,uFlags);
+end;
+
+function UpdateWindow(Handle: HWND): Boolean;
+begin
+  Result := Windows.UpdateWindow(Handle);
+end;
+
+type
+  TTimerID = record
+    hWnd: THandle;
+    nIDEvent: UINT_PTR;
+  end;
+
+  TTimerRecord = record
+    Control: TControl;
+    Notify: TTimerNotify;
+  end;
+  
+  PTimerRecord = ^TTimerRecord;
+
+  { TTimerList }
+
+  TTimerList = class
+  private
+    FMap: TMap;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify; Control: TControl);
+    function GetTimerInfo(hWnd: THandle; nIDEvent: UINT_PTR; out TimerInfo: TTimerRecord):Boolean;
+    function GetTimerInfoPtr(hWnd: THandle; nIDEvent: UINT_PTR): PTimerRecord;
+  end;
+
+var
+  FTimerList: TTimerList;
+  
+{ TTimerList }
+
+constructor TTimerList.Create;
+begin
+  FMap := TMap.Create({$ifdef CPU64}itu16{$else}itu8{$endif}, SizeOf(TTimerRecord));
+end;
+
+destructor TTimerList.Destroy;
+begin
+  FMap.Destroy;
+  inherited Destroy;
+end;
+
+procedure TTimerList.Add(hWnd: THandle; nIDEvent: UINT_PTR; NotifyFunc: TTimerNotify; Control: TControl);
+var
+  TimerID: TTimerID;
+  TimerRec: TTimerRecord;
+begin
+  TimerRec.Notify := NotifyFunc;
+  TimerRec.Control := Control;
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  with FMap do
+  begin
+    if HasId(TimerID) then
+      SetData(TimerID, TimerRec)
+    else
+      Add(TimerID, TimerRec);
+  end;
+end;
+
+function TTimerList.GetTimerInfo(hWnd: THandle; nIDEvent: UINT_PTR;
+  out TimerInfo: TTimerRecord): Boolean;
+var
+  TimerID: TTimerID;
+begin
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  Result := FMap.GetData(TimerID, TimerInfo);
+end;
+
+function TTimerList.GetTimerInfoPtr(hWnd: THandle; nIDEvent: UINT_PTR): PTimerRecord;
+var
+  TimerID: TTimerID;
+begin
+  TimerID.hWnd := hWnd;
+  TimerID.nIDEvent := nIDEvent;
+  Result := FMap.GetDataPtr(TimerID);
+end;
+
+//workaround to buggy fpc header
+type
+  TIMERPROC64 = procedure (hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
+
+function SetTimer64(hWnd: HWND; nIDEvent: UINT_PTR; uElapse: UINT; lpTimerFunc: TIMERPROC64): UINT_PTR; stdcall external 'user32' name 'SetTimer';
+function KillTimer64(hWnd: HWND; uIDEvent: UINT_PTR):WINBOOL;  stdcall external 'user32' name 'KillTimer';
+
+procedure TimerCallBack(Handle: hWnd; Msg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
+var
+  TimerInfo: PTimerRecord;
+begin
+  //DebugLn('Executing Timer to Handle %d - ID: %d',[Handle, idEvent]);
+  TimerInfo := FTimerList.GetTimerInfoPtr(Handle, idEvent);
+  if TimerInfo <> nil then
+  with TimerInfo^ do
+  begin
+    if Notify <> nil then
+      Notify(idEvent)
+    else
+    begin
+      if Control <> nil then
+        LCLSendTimerMsg(Control,idEvent,0);
+    end;
+  end
+  else
+    DebugLn('Warning - No TimerInfo found for Hwnd: %d Id: %d',[Handle,idEvent]);
+end;
+
+function SetTimer(hWnd: THandle; nIDEvent: UINT_PTR; uElapse:LongWord; lpTimerFunc: TTimerNotify):UINT_PTR;
+var
+  WinInfo: PWin32WindowInfo;
+begin
+  if hWnd <> 0 then
+  begin
+    WinInfo := GetWin32WindowInfo(hWnd);
+    FTimerList.Add(hWnd,nIDEvent,lpTimerFunc,WinInfo^.WinControl);
+    Result := SetTimer64(hWnd,nIDEvent,uElapse,@TimerCallBack);
+  end
+  else
+  begin
+    //if handle is 0, the callback is mandatory otherwise we get a zombie timer
+    if lpTimerFunc <> nil then
+    begin
+      Result := SetTimer64(hWnd,nIDEvent,uElapse,@TimerCallBack);
+      FTimerList.Add(hWnd,Result,lpTimerFunc,nil);
+    end
+    else
+      Result := 0;
+  end;
+  //DebugLn('SetTimer - Handle %d - ID: %d - Result: %d',[hWnd,nIDEvent,Result]);
+end;
+
+function KillTimer(hWnd: THandle; nIDEvent: UINT_PTR):Boolean;
+begin
+  Result := KillTimer64(hWnd,nIDEvent);
+  //DebugLn('KillTimer - Handle %d - ID: %d',[hWnd,nIDEvent]);
+end;

LCLExtensions/include/win32/lclext.inc

@@ -0,0 +1,61 @@
+
+
+function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
+var
+  OldColor: COLORREF;
+  OldObj: HBITMAP;
+  MaskDC: HDC;
+begin
+  Result := Windows.CreateBitmap(Width,Height,1,1,nil);
+  MaskDC := Windows.CreateCompatibleDC(BitmapDC);
+  
+  OldObj := Windows.SelectObject(MaskDC,Result);
+  OldColor := Windows.SetBkColor(BitmapDC, Windows.COLORREF(ColorToRGB(TransparentColor)));
+
+  Windows.BitBlt(MaskDC,0,0,Width,Height,BitmapDC,0,0,SRCCOPY);
+
+  Windows.SetBkColor(BitmapDC,OldColor);
+  Windows.SelectObject(MaskDC,OldObj);
+  Windows.DeleteDC(MaskDC);
+end;
+
+function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
+var
+  MaskDC: HDC;
+  MaskObj: HGDIOBJ;
+  PrevTextColor, PrevBkColor: COLORREF;
+begin
+  //this is a stripped version of LCL.StretchMaskBlt
+  if Mask <> 0 then
+  begin
+    MaskDC := Windows.CreateCompatibleDC(DestDC);
+    MaskObj := Windows.SelectObject(MaskDC, Mask);
+
+    PrevTextColor := Windows.SetTextColor(DestDC, $00000000);
+    PrevBkColor := Windows.SetBkColor(DestDC, $00FFFFFF);
+    
+    Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
+    Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCAND);
+    Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
+    
+    Windows.SetTextColor(DestDC, PrevTextColor);
+    Windows.SetBkColor(DestDC, PrevBkColor);
+    Windows.SelectObject(MaskDC, MaskObj);
+    Windows.DeleteDC(MaskDC);
+  end
+  else
+    Result := Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCCOPY);
+end;
+
+function OptimalPixelFormat: TPixelFormat;
+begin
+  if ScreenInfo.ColorDepth = 32 then
+    Result := pf32bit
+  else
+    Result := pfDevice;
+end;
+
+function OSSupportsUTF16: Boolean;
+begin
+  Result := Win32Platform = VER_PLATFORM_WIN32_NT;
+end;

LCLExtensions/include/win32/uses.inc

@@ -0,0 +1,3 @@
+
+  Windows, win32proc, CommCtrl,
+

LCLExtensions/include/win32/uses_lclext.inc

@@ -0,0 +1,2 @@
+  uses
+    Windows;