The first part of removing the obsolete fpGUI and replacing it with the new multi-handle design from the prototypes directory.

4 files changed, 1978 insertions, 0 deletions

diff --git a/src/corelib/gdi/fpGFX2.lpk b/src/corelib/gdi/fpGFX2.lpk
new file mode 100644
index 00000000..4e261b61
--- /dev/null
+++ b/src/corelib/gdi/fpGFX2.lpk
@@ -0,0 +1,120 @@
+<?xml version="1.0"?>

+<CONFIG>

+  <Package Version="2">

+    <PathDelim Value="\"/>

+    <Name Value="fpGFX2"/>

+    <Author Value="Graeme Geldenhuys"/>

+    <CompilerOptions>

+      <Version Value="5"/>

+      <PathDelim Value="\"/>

+      <SearchPaths>

+        <IncludeFiles Value="..\..\"/>

+        <OtherUnitFiles Value="..\;..\..\gui\"/>

+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>

+      </SearchPaths>

+      <CodeGeneration>

+        <Generate Value="Faster"/>

+      </CodeGeneration>

+      <Other>

+        <CompilerPath Value="$(CompPath)"/>

+      </Other>

+    </CompilerOptions>

+    <Description Value="fpGFX redesign with multiple handles per window

+"/>

+    <License Value="Modified LGPL

+"/>

+    <Version Minor="1"/>

+    <Files Count="19">

+      <Item1>

+        <Filename Value="..\gfxbase.pas"/>

+        <UnitName Value="gfxbase"/>

+      </Item1>

+      <Item2>

+        <Filename Value="..\gfxbaseinterfaces.pas"/>

+        <UnitName Value="gfxbaseinterfaces"/>

+      </Item2>

+      <Item3>

+        <Filename Value="..\fpgfx.pas"/>

+        <UnitName Value="fpgfx"/>

+      </Item3>

+      <Item4>

+        <Filename Value="gfx_gdi.pas"/>

+        <UnitName Value="gfx_gdi"/>

+      </Item4>

+      <Item5>

+        <Filename Value="..\gfx_stdimages.pas"/>

+        <UnitName Value="gfx_stdimages"/>

+      </Item5>

+      <Item6>

+        <Filename Value="..\gfx_imgfmt_bmp.pas"/>

+        <UnitName Value="gfx_imgfmt_bmp"/>

+      </Item6>

+      <Item7>

+        <Filename Value="..\gfx_widget.pas"/>

+        <UnitName Value="gfx_widget"/>

+      </Item7>

+      <Item8>

+        <Filename Value="..\..\gui\gui_form.pas"/>

+        <UnitName Value="gui_form"/>

+      </Item8>

+      <Item9>

+        <Filename Value="..\..\gui\gui_label.pas"/>

+        <UnitName Value="gui_label"/>

+      </Item9>

+      <Item10>

+        <Filename Value="..\..\gui\gui_button.pas"/>

+        <UnitName Value="gui_button"/>

+      </Item10>

+      <Item11>

+        <Filename Value="..\..\gui\gui_edit.pas"/>

+        <UnitName Value="gui_edit"/>

+      </Item11>

+      <Item12>

+        <Filename Value="..\..\gui\gui_combobox.pas"/>

+        <UnitName Value="gui_combobox"/>

+      </Item12>

+      <Item13>

+        <Filename Value="..\..\gui\gui_popupwindow.pas"/>

+        <UnitName Value="gui_popupwindow"/>

+      </Item13>

+      <Item14>

+        <Filename Value="..\..\gui\gui_scrollbar.pas"/>

+        <UnitName Value="gui_scrollbar"/>

+      </Item14>

+      <Item15>

+        <Filename Value="..\..\gui\gui_memo.pas"/>

+        <UnitName Value="gui_memo"/>

+      </Item15>

+      <Item16>

+        <Filename Value="..\gfx_utf8utils.pas"/>

+        <UnitName Value="gfx_UTF8utils"/>

+      </Item16>

+      <Item17>

+        <Filename Value="..\..\gui\gui_dialogs.pas"/>

+        <UnitName Value="gui_dialogs"/>

+      </Item17>

+      <Item18>

+        <Filename Value="..\..\gui\gui_listbox.pas"/>

+        <UnitName Value="gui_listbox"/>

+      </Item18>

+      <Item19>
+        <Filename Value="..\gfx_extinterpolation.pas"/>
+        <UnitName Value="gfx_extinterpolation"/>
+      </Item19>
+    </Files>

+    <RequiredPkgs Count="1">

+      <Item1>

+        <PackageName Value="FCL"/>

+        <MinVersion Major="1" Valid="True"/>

+      </Item1>

+    </RequiredPkgs>

+    <UsageOptions>

+      <UnitPath Value="$(PkgOutDir)\"/>

+    </UsageOptions>

+    <PublishOptions>

+      <Version Value="2"/>

+      <DestinationDirectory Value="$(TestDir)\publishedpackage\"/>

+      <IgnoreBinaries Value="False"/>

+    </PublishOptions>

+  </Package>

+</CONFIG>

diff --git a/src/corelib/gdi/fpGFX2.pas b/src/corelib/gdi/fpGFX2.pas
new file mode 100644
index 00000000..1a748229
--- /dev/null
+++ b/src/corelib/gdi/fpGFX2.pas
@@ -0,0 +1,17 @@
+{ This file was automatically created by Lazarus. Do not edit!
+This source is only used to compile and install the package.
+ }
+
+unit fpGFX2; 
+
+interface
+
+uses
+  gfxbase, gfxbaseinterfaces, fpgfx, gfx_gdi, gfx_stdimages, gfx_imgfmt_bmp, 
+    gfx_widget, gui_form, gui_label, gui_button, gui_edit, gui_combobox, 
+    gui_popupwindow, gui_scrollbar, gui_memo, gfx_UTF8utils, gui_dialogs, 
+    gui_listbox; 
+
+implementation
+
+end.
diff --git a/src/corelib/gdi/gdikeys.inc b/src/corelib/gdi/gdikeys.inc
new file mode 100644
index 00000000..1be7a470
--- /dev/null
+++ b/src/corelib/gdi/gdikeys.inc
@@ -0,0 +1,321 @@
+{
+    fpGFX  -  Free Pascal Graphics Library
+
+    Win32 GDI target implementation: Keycode translation helpers
+
+    See the file COPYING.modifiedLGPL, 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.
+
+ **********************************************************************}
+
+
+function VirtKeyToKeycode(VirtKey: Byte): Word;
+const
+  TranslTable: array[Byte] of Integer = (
+    -1,			// $00
+    -1,			// $01  VK_LBUTTON
+    -1,			// $02  VK_RBUTTON
+    -1,			// $03  VK_CANCEL
+    -1,			// $04  VK_MBUTTON
+    -1,			// $05  VK_XBUTTON1
+    -1,			// $06  VK_XBUTTON2
+    -1,			// $07
+    keyBackSpace,	// $08  VK_BACK
+    keyTab,		// $09  VK_TAB
+    -1,			// $0a
+    -1,			// $0b
+    keyClear,		// $0c  VK_CLEAR
+    keyReturn,		// $0d  VK_RETURN
+    -1,			// $0e
+    -1,			// $0f
+    keyShift,		// $10  VK_SHIFT
+    keyCtrl,		// $11  VK_CONTROL
+    keyAlt,		// $12  VK_MENU
+    keyPause,		// $13  VK_PAUSE
+    -1,			// $14  VK_CAPITAL
+    -1,			// $15  VK_KANA
+    -1,			// $16
+    -1,			// $17  VK_JUNJA
+    -1,			// $18  VK_FINAL
+    -1,			// $19  VK_HANJA
+    -1,			// $1a
+    keyEscape,		// $1b  VK_ESCAPE
+    -1,			// $1c  VK_CONVERT
+    -1,			// $1d  VK_NONCONVERT
+    -1,			// $1e  VK_ACCEPT
+    keyModeSwitch,	// $1f  VK_MODECHANGE
+    $20,		// $20  VK_SPACE
+    keyPrior,		// $21  VK_PRIOR
+    keyNext,		// $22  VK_NEXT
+    keyEnd,		// $23  VK_END
+    keyHome,		// $24  VK_HOME
+    keyLeft,		// $25  VK_LEFT
+    keyUp,		// $26  VK_UP
+    keyRight,		// $27  VK_RIGHT
+    keyDown,		// $28  VK_DOWN
+    keySelect,		// $29  VK_SELECT
+    keyPrintScreen,	// $2a  VK_PRINT
+    keyExecute,		// $2b  VK_EXECUTE
+    keyPrintScreen,	// $2c  VK_SNAPSHOT
+    keyInsert,		// $2d  VK_INSERT
+    keyDelete,		// $2e  VK_DELETE
+    keyHelp,		// $2f  VK_HELP
+    $30,		// $30  '0'
+    $31,		// $31  '1'
+    $32,		// $32  '2'
+    $33,		// $33  '3'
+    $34,		// $34  '4'
+    $35,		// $35  '5'
+    $36,		// $36  '6'
+    $37,		// $37  '7'
+    $38,		// $38  '8'
+    $39,		// $39  '9'
+    -1,			// $3a
+    -1,			// $3b
+    -1,			// $3c
+    -1,			// $3d
+    -1,			// $3e
+    -1,			// $3f
+    -1,			// $40
+    $41,		// $41  'A'
+    $42,		// $42  'B'
+    $43,		// $43  'C'
+    $44,		// $44  'D'
+    $45,		// $45  'E'
+    $46,		// $46  'F'
+    $47,		// $47  'G'
+    $48,		// $48  'H'
+    $49,		// $49  'I'
+    $4a,		// $4a  'J'
+    $4b,		// $4b  'K'
+    $4c,		// $4c  'L'
+    $4d,		// $4d  'M'
+    $4e,		// $4e  'N'
+    $4f,		// $4f  'O'
+    $50,		// $50  'P'
+    $51,		// $51  'Q'
+    $52,		// $52  'R'
+    $53,		// $53  'S'
+    $54,		// $54  'T'
+    $55,		// $55  'U'
+    $56,		// $56  'V'
+    $57,		// $57  'W'
+    $58,		// $58  'X'
+    $59,		// $59  'Y'
+    $5a,		// $5a  'Z'
+    -1,			// $5b  VK_LWIN
+    -1,			// $5c  VK_RWIN
+    -1,			// $5d  VK_APPS
+    -1,			// $5e
+    -1,			// $5f  VK_SLEEP
+    keyP0,		// $60  VK_NUMPAD0
+    keyP1,		// $61  VK_NUMPAD1
+    keyP2,		// $62  VK_NUMPAD2
+    keyP3,		// $63  VK_NUMPAD3
+    keyP4,		// $64  VK_NUMPAD4
+    keyP5,		// $65  VK_NUMPAD5
+    keyP6,		// $66  VK_NUMPAD6
+    keyP7,		// $67  VK_NUMPAD7
+    keyP8,		// $68  VK_NUMPAD8
+    keyP9,		// $69  VK_NUMPAD9
+    keyPAsterisk,	// $6a  VK_MULTIPLY
+    keyPPlus,		// $6b  VK_ADD
+    keyPSeparator,	// $6c  VK_SEPARATOR
+    keyPMinus,		// $6d  VK_SUBTRACT
+    keyPDecimal,	// $6e  VK_DECIMAL
+    keyPSlash,		// $6f  VK_DIVIDE
+    keyF1,		// $70  VK_F1
+    keyF2,		// $71  VK_F2
+    keyF3,		// $72  VK_F3
+    keyF4,		// $73  VK_F4
+    keyF5,		// $74  VK_F5
+    keyF6,		// $75  VK_F6
+    keyF7,		// $76  VK_F7
+    keyF8,		// $77  VK_F8
+    keyF9,		// $78  VK_F9
+    keyF10,		// $79  VK_F10
+    keyF11,		// $7a  VK_F11
+    keyF12,		// $7b  VK_F12
+    keyF13,		// $7c  VK_F13
+    keyF14,		// $7d  VK_F14
+    keyF15,		// $7e  VK_F15
+    keyF16,		// $7f  VK_F16
+    keyF17,		// $80  VK_F17
+    keyF18,		// $81  VK_F18
+    keyF19,		// $82  VK_F19
+    keyF20,		// $83  VK_F20
+    keyF21,		// $84  VK_F21
+    keyF22,		// $85  VK_F22
+    keyF23,		// $86  VK_F23
+    keyF24,		// $87  VK_F24
+    -1,			// $88
+    -1,			// $89
+    -1,			// $8a
+    -1,			// $8b
+    -1,			// $8c
+    -1,			// $8d
+    -1,			// $8e
+    -1,			// $8f
+    keyNumLock,		// $90  VK_NUMLOCK
+    keyScroll,		// $91  VK_SCROLL
+    -1,			// $92  VK_OEM_NEC_EQUAL
+    -1,			// $93  VK_OEM_FJ_MASSHOU
+    -1,			// $94  VK_OEM_FJ_TOUROKU
+    -1,			// $95  VK_OEM_FJ_LOYA
+    -1,			// $96  VK_OEM_FJ_ROYA
+    -1,			// $97
+    -1,			// $98
+    -1,			// $99
+    -1,			// $9a
+    -1,			// $9b
+    -1,			// $9c
+    -1,			// $9d
+    -1,			// $9e
+    -1,			// $9f
+    keyShiftL,		// $a0  VK_LSHIFT
+    keyShiftR,		// $a1  VK_RSHIFT
+    keyCtrlL,		// $a2  VK_LCONTROL
+    keyCtrlR,		// $a3  VK_RCONTROL
+    -1,			// $a4  VK_LMENU
+    -1,			// $a5  VK_RMENU
+    -1,			// $a6  VK_BROWSER_BACK
+    -1,			// $a7  VK_BROWSER_FORWARD
+    -1,			// $a8  VK_BROWSER_REFRESH
+    -1,			// $a9  VK_BROWSER_STOP
+    -1,			// $aa  VK_BROWSER_SEARCH
+    -1,			// $ab  VK_BROWSER_FAVORITES
+    -1,			// $ac  VK_BROWSER_HOME
+    -1,			// $ad  VK_VOLUME_MUTE
+    -1,			// $ae  VK_VOLUME_DOWN
+    -1,			// $af  VK_VOLUME_UP
+    -1,			// $b0  VK_MEDIA_NEXT_TRACK
+    -1,			// $b1  VK_MEDIA_PREV_TRACK
+    -1,			// $b2  VK_MEDIA_STOP
+    -1,			// $b3  VK_MEDIA_PLAY_PAUSE
+    -1,			// $b4  VK_LAUNCH_MAIL
+    -1,			// $b5  VK_LAUNCH_MEDIA_SELECT
+    -1,			// $b6  VK_LAUNCH_APP1
+    -1,			// $b7  VK_LAUNCH_APP2
+    -1,			// $b8
+    -1,			// $b9
+    $dc, {U Umlaut}	// $ba  VK_OEM_1
+    $2b, {+ char}	// $bb  VK_OEM_PLUS
+    $2c, {, char}	// $bc  VK_OEM_COMMA
+    $2d, {- char}	// $bd  VK_OEM_MINUS
+    $2e, {. char}	// $be  VK_OEM_PERIOD
+    $23, {# char}	// $bf  VK_OEM_2
+    $d6, {O Umlaut}	// $c0  VK_OEM_3
+    -1,			// $c1
+    -1,			// $c2
+    -1,			// $c3
+    -1,			// $c4
+    -1,			// $c5
+    -1,			// $c6
+    -1,			// $c7
+    -1,			// $c8
+    -1,			// $c9
+    -1,			// $ca
+    -1,			// $cb
+    -1,			// $cc
+    -1,			// $cd
+    -1,			// $ce
+    -1,			// $cf
+    -1,			// $d0
+    -1,			// $d1
+    -1,			// $d2
+    -1,			// $d3
+    -1,			// $d4
+    -1,			// $d5
+    -1,			// $d6
+    -1,			// $d7
+    -1,			// $d8
+    -1,			// $d9
+    -1,			// $da
+    -1,			// $db  VK_OEM_4
+    keyDeadCircumflex,	// $dc  VK_OEM_5
+    keyDeadAcute,	// $dd  VK_OEM_6
+    $c4, {A Umlaut}	// $de  VK_OEM_7
+    -1,    	        // $df  VK_OEM_8
+    -1,			// $e0
+    -1,			// $e1  VK_OEM_AX
+    $3c, {< char}	// $e2  VK_OEM_102
+    -1,			// $e3  VK_ICO_HELP
+    keyP5,		// $e4  VK_ICO_00
+    -1,			// $e5  VK_PROCESSKEY
+    -1,			// $e6  VK_ICO_CLEAR
+    -1,			// $e7  VK_PACKET
+    -1,			// $e8
+    -1,			// $e9  VK_OEM_RESET
+    -1,			// $ea  VK_OEM_JUMP
+    -1,			// $eb  VK_OEM_PA1
+    -1,			// $ec  VK_OEM_PA2
+    -1,			// $ed  VK_OEM_PA3
+    -1,			// $ee  VK_OEM_WSCTRL
+    -1,			// $ef  VK_OEM_CUSEL
+    -1,			// $f0  VK_OEM_ATTN
+    -1,			// $f1  VK_OEM_FINISH
+    -1,			// $f2  VK_OEM_COPY
+    -1,			// $f3  VK_OEM_AUTO
+    -1,			// $f4  VK_OEM_ENLW
+    -1,			// $f5  VK_OEM_BACKTAB
+    -1,			// $f6  VK_ATTN
+    -1,			// $f7  VK_CRSEL
+    -1,			// $f8  VK_EXSEL
+    -1,			// $f9  VK_EREOF
+    -1,			// $fa  VK_PLAY
+    -1,			// $fb  VK_ZOOM
+    -1,			// $fc  VK_NONAME
+    -1,			// $fd  VK_PA1
+    -1,			// $fe  VK_OEM_CLEAR
+    -1			// $ff
+  );
+begin
+  if TranslTable[VirtKey]  = -1 then
+  begin
+{$IFDEF Debug}
+    WriteLn('No mapping for virtual keycode $', IntToHex(VirtKey, 2));
+{$ENDIF}
+    Result := keyNIL
+  end else
+  begin
+    Result := TranslTable[VirtKey];
+{$IFDEF Debug}
+    WriteLn('Key $', IntToHex(VirtKey, 2), ' mapped to $', IntToHex(Result, 4));
+{$ENDIF}
+  end;
+end;
+
+
+function GetKeyboardShiftState: TShiftState;
+var
+  State: array[Byte] of Byte;
+begin
+  {$ifndef wince}
+  Windows.GetKeyboardState(State);
+  {$endif}
+  Result := [];
+  if (State[VK_SHIFT] and 128) <> 0 then
+    Include(Result, ssShift);
+  if (State[VK_MENU] and 128) <> 0 then
+    Include(Result, ssAlt);
+  if (State[VK_CONTROL] and 128) <> 0 then
+    Include(Result, ssCtrl);
+  if (State[VK_LBUTTON] and 128) <> 0 then
+    Include(Result, ssLeft);
+  if (State[VK_RBUTTON] and 128) <> 0 then
+    Include(Result, ssRight);
+  if (State[VK_MBUTTON] and 128) <> 0 then
+    Include(Result, ssMiddle);
+  if (State[VK_CAPITAL] and 1) <> 0 then
+    Include(Result, ssCaps);
+  if (State[VK_NUMLOCK] and 1) <> 0 then
+    Include(Result, ssNum);
+  if (State[VK_SCROLL] and 1) <> 0 then
+    Include(Result, ssScroll);
+end;
+
+
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
new file mode 100644
index 00000000..a30f343c
--- /dev/null
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -0,0 +1,1520 @@
+unit gfx_gdi;
+
+{$mode objfpc}{$H+}
+
+{.$Define Debug}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  Windows,
+  gfxbase;
+
+{ Constants missing on windows unit }
+const
+  WM_MOUSEWHEEL         = $020a;
+  VER_PLATFORM_WIN32_CE = 3;
+
+{ Unicode selection variables }
+var
+  UnicodeEnabledOS: Boolean;
+  WinVersion: TOSVersionInfo;
+
+
+type
+  TfpgWinHandle = HWND;
+  TfpgGContext  = HDC;
+
+type
+  TfpgWindowImpl = class;
+
+
+  TfpgFontResourceImpl = class(TfpgFontResourceBase)
+  private
+    FFontData: HFONT;
+    FMetrics: Windows.TEXTMETRIC;
+  protected
+    function    OpenFontByDesc(const desc: string): HFONT;
+    property    Handle: HFONT read FFontData;
+  public
+    constructor Create(const afontdesc: string);
+    destructor  Destroy; override;
+    function    HandleIsValid: boolean;
+    function    GetAscent: integer; override;
+    function    GetDescent: integer; override;
+    function    GetHeight: integer; override;
+    function    GetTextWidth(const txt: string): integer; override;
+  end;
+
+
+  TfpgFontImpl = class(TfpgFontBase)
+  end;
+
+
+  TfpgImageImpl = class(TfpgImageBase)
+  private
+    FBMPHandle: HBITMAP;
+    FMaskHandle: HBITMAP;
+    FIsTwoColor: boolean;
+    property    BMPHandle: HBITMAP read FBMPHandle;
+    property    MaskHandle: HBITMAP read FMaskHandle;
+  protected
+    procedure   DoFreeImage; override;
+    procedure   DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); override;
+    procedure   DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); override;
+  public
+    constructor Create;
+  end;
+
+
+  TfpgCanvasImpl = class(TfpgCanvasBase)
+  private
+    FDrawing: boolean;
+    FBufferBitmap: HBitmap;
+    FDrawWindow: TfpgWindowImpl;
+    Fgc: TfpgGContext;
+    FWinGC: TfpgGContext;
+    FBackgroundColor: TfpgColor;
+    FCurFontRes: TfpgFontResourceImpl;
+    FClipRect: TfpgRect;
+    FClipRectSet: Boolean;
+    FWindowsColor: longword;
+    FBrush: HBRUSH;
+    FPen: HPEN;
+    FClipRegion: HRGN;
+    FIntLineStyle: integer;
+  protected
+    procedure   DoSetFontRes(fntres: TfpgFontResourceBase); override;
+    procedure   DoSetTextColor(cl: TfpgColor); override;
+    procedure   DoSetColor(cl: TfpgColor); override;
+    procedure   DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); override;
+    procedure   DoGetWinRect(var r: TfpgRect); override;
+    procedure   DoFillRectangle(x, y, w, h: TfpgCoord); override;
+    procedure   DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); override;
+    procedure   DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); override;
+    procedure   DoDrawRectangle(x, y, w, h: TfpgCoord); override;
+    procedure   DoDrawLine(x1, y1, x2, y2: TfpgCoord); override;
+    procedure   DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); override;
+    procedure   DoDrawString(x, y: TfpgCoord; const txt: string); override;
+    procedure   DoSetClipRect(const rect: TfpgRect); override;
+    function    DoGetClipRect: TfpgRect; override;
+    procedure   DoAddClipRect(const rect: TfpgRect); override;
+    procedure   DoClearClipRect; override;
+    procedure   DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); override;
+    procedure   DoPutBufferToScreen(x, y, w, h: TfpgCoord); override;
+    procedure   DoEndDraw; override;
+    function    GetPixel(X, Y: integer): TfpgColor; override;
+    procedure   SetPixel(X, Y: integer; const AValue: TfpgColor); override;
+  public
+    constructor Create; override;
+    destructor  Destroy; override;
+  end;
+
+
+  { TfpgWindowImpl }
+
+  TfpgWindowImpl = class(TfpgWindowBase)
+  private
+    FMouseInWindow: boolean;
+    function    DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean;
+  protected
+    FWinHandle: TfpgWinHandle;
+    FModalForWin: TfpgWindowImpl;
+    FWinStyle: longword;
+    FWinStyleEx: longword;
+    FParentWinHandle: TfpgWinHandle;
+    procedure   DoAllocateWindowHandle(AParent: TfpgWindowBase); override;
+    procedure   DoReleaseWindowHandle; override;
+    function    HandleIsValid: boolean; override;
+    procedure   DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override;
+    procedure   DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override;
+    function    DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override;
+    //procedure MoveToScreenCenter; override;
+    procedure   DoSetWindowTitle(const ATitle: string); override;
+    property    WinHandle: TfpgWinHandle read FWinHandle;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure   CaptureMouse; override;
+    procedure   ReleaseMouse; override;
+  end;
+
+
+  TfpgApplicationImpl = class(TfpgApplicationBase)
+  protected
+    FDisplay: HDC;
+    WindowClass: TWndClass;
+    WidgetClass: TWndClass;
+    hcr_default: HCURSOR;
+    hcr_dir_ew: HCURSOR;
+    hcr_dir_ns: HCURSOR;
+    hcr_edit: HCURSOR;
+    hcr_dir_nwse: HCURSOR;
+    hcr_dir_nesw: HCURSOR;
+    hcr_move: HCURSOR;
+    hcr_crosshair: HCURSOR;
+    FFocusedWindow: THANDLE;
+    LastClickWindow: TfpgWinHandle; // double click generation
+    LastWinClickTime: longword;
+    FTimerWnd: HWND;
+  public
+    constructor Create(const aparams: string); override;
+    function    DoMessagesPending: boolean;
+    procedure   DoWaitWindowMessage(atimeoutms: integer);
+    procedure   DoFlush;
+    function    GetScreenWidth: TfpgCoord;
+    function    GetScreenHeight: TfpgCoord;
+    property    Display: HDC read FDisplay;
+  end;
+
+
+implementation
+
+uses
+  {$Note Remove the dependency on gfx_widget and gfx_form units.}
+  fpgfx,
+  gfx_widget,//, gfx_form;
+  gfx_UTF8Utils;
+
+var
+  wapplication: TfpgApplication;
+  MouseFocusedWH: HWND;
+
+// some required keyboard functions
+{$INCLUDE gdikeys.inc}
+
+function fpgColorToWin(col: TfpgColor): longword;
+var
+  c: dword;
+begin
+  c      := fpgColorToRGB(col);
+  //swapping bytes (Red and Blue colors)
+  Result := ((c and $FF0000) shr 16) or ((c and $0000FF) shl 16) or (c and $00FF00);
+end;
+
+function WinColorTofpgColor(col: longword): TfpgColor;
+begin
+  //swapping bytes
+  Result := fpgColorToWin(col);
+end;
+
+function GetMyWidgetFromHandle(wh: TfpgWinHandle): TfpgWidget;
+begin
+  if (wh <> 0) and (MainInstance = longword(GetWindowLong(wh, GWL_HINSTANCE))) then
+    Result := TfpgWidget(Windows.GetWindowLong(wh, GWL_USERDATA))
+  else
+    Result := nil;
+end;
+
+(*
+procedure SendMouseMessage(wg : TWidget; msg : UINT; button : integer; wParam : WPARAM; lParam : LPARAM);
+var
+  p3 : integer;
+  x,y : integer;
+  wwg : TWidget;
+  pwg : TWidget;
+  h : THANDLE;
+  pt : TPOINT;
+begin
+  x := SmallInt(lParam and $FFFF);
+  y := SmallInt((lParam and $FFFF0000) shr 16);
+
+  p3 := button shl 8;
+
+  if (wParam and MK_CONTROL) <> 0 then p3 := p3 or ss_control;
+  if (wParam and MK_SHIFT)   <> 0 then p3 := p3 or ss_shift;
+
+
+  wwg := wg;
+
+  if (PopupListFirst <> nil) then
+  begin
+    if wg = nil then Writeln('wg is NIL !!!');
+
+    pt.x := x;
+    pt.y := y;
+
+    ClientToScreen(wg.WinHandle, pt);
+
+    //Writeln('click x=',pt.X,' y=',pt.y);
+
+    h := WindowFromPoint(pt);
+    wwg := GetMyWidgetFromHandle(h);
+
+    // if wwg <> nil then writeln('widget ok.');
+
+    pwg := wwg;
+    while (pwg <> nil) and (pwg.Parent <> nil) do pwg := pwg.Parent;
+
+    if ((pwg = nil) or (PopupListFind(pwg.WinHandle) = nil)) and (not PopupDontCloseWidget(wwg)) and
+       ((msg = MSG_MOUSEDOWN) or (msg = MSG_MOUSEUP)) then
+    begin
+      ClosePopups;
+
+      SendMessage(nil, wwg, MSG_POPUPCLOSE, 0, 0, 0 );
+    end;
+
+    // sending the message...
+    if wwg <> nil then
+    begin
+      ScreenToClient(wwg.WinHandle, pt);
+      x := pt.x;
+      y := pt.y;
+    end;
+  end;
+
+  if ptkTopModalForm <> nil then
+  begin
+    pwg := WidgetParentForm(wwg);
+    if (pwg <> nil) and (ptkTopModalForm <> pwg) then wwg := nil;
+  end;
+
+  if wwg <> nil then
+  begin
+    if (Msg = MSG_MOUSEDOWN) and (PopupListFirst = nil) then
+    begin
+      SetCapture(wwg.WinHandle);
+    end
+    else if (Msg = MSG_MOUSEUP) and (PopupListFirst = nil) then
+    begin
+      ReleaseCapture();
+    end;
+
+    SendMessage(nil, wwg, Msg, x, y, p3);
+
+  end;
+
+end;
+
+*)
+
+function fpgWindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+var
+  w: TfpgWindowImpl;
+  kwg: TfpgWidget;
+  mw: TfpgWindowImpl;
+  kcode: integer;
+  i: integer;
+  sstate: integer;
+  h: THANDLE;
+  p: PChar;
+  pt: TPOINT;
+  r: TRECT;
+  blockmsg: boolean;
+  msgp: TfpgMessageParams;
+  mcode: integer;
+  wmsg: TMsg;
+  PaintStruct: TPaintStruct;
+begin
+  if uMsg = WM_CREATE then
+  begin
+    w := TfpgWindowImpl(PCreateStruct(lParam)^.lpCreateParams);
+    w.FWinHandle := hwnd; // this is very important, because number of messages sent
+    // before the createwindow returns the window handle
+    Windows.SetWindowLong(hwnd, GWL_USERDATA, longword(w));
+  end;
+
+  w      := TfpgWindowImpl(Windows.GetWindowLong(hwnd, GWL_USERDATA));
+  Result := 0;
+
+  if not Assigned(w) then
+  begin
+    Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
+    Exit;
+  end;
+
+  blockmsg := False;
+  fillchar(msgp, sizeof(msgp), 0);
+
+  case uMsg of
+    WM_CHAR,
+    WM_KEYUP,
+    WM_KEYDOWN:
+    begin
+      kwg := FindKeyboardFocus;
+      if kwg <> nil then
+        w := kwg;
+
+      msgp.keyboard.shiftstate := GetKeyboardShiftState;
+      msgp.keyboard.keycode := VirtKeyToKeycode(wParam);
+
+      if uMsg = WM_KEYDOWN then
+      begin
+        fpgSendMessage(nil, w, FPGM_KEYPRESS, msgp);
+
+        // generating WM_CHAR
+        fillchar(wmsg, sizeof(wmsg), 0);
+
+        wmsg.hwnd    := hwnd;
+        wmsg.message := uMsg;
+        wmsg.wParam  := wParam;
+        wmsg.lParam  := lParam;
+
+        Windows.TranslateMessage(@wmsg);
+
+        // TranslateMessage sends WM_CHAR ocassionally
+        // but NOBODY KNOWS WHEN!
+        
+        
+        if (wParam = $2e {VK_DELETE}) then
+        begin
+          msgp.keyboard.keychar := #127;
+          msgp.keyboard.keycode := 0;
+          fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
+        end;
+
+        // lets generate the FPGM_KEYCHAR for some special keys
+        // based on this table of Windows virtual keys
+//        case wParam of
+//          $70..$7B,  // F1..F12
+//          $21..$24,  // home, end, pageup, pagedn
+//          $2D..$2E,  // insert, delete
+//          $25..$28:  // arrows
+//          begin
+//            msgp.keyboard.keycode := kcode or $FF00; // scan code + $FF00
+//            fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
+//          end;
+//        end;
+
+      end
+      else if uMsg = WM_KEYUP then
+        fpgSendMessage(nil, w, FPGM_KEYRELEASE, msgp)
+      else if uMsg = WM_CHAR then
+      begin
+        msgp.keyboard.keychar := Chr(wParam);
+        fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
+      end;
+
+    end;
+
+(*
+    WM_SETCURSOR:
+    begin
+      //Writeln('Hittest: ',IntToHex((lParam and $FFFF),4));
+      if (lParam and $FFFF) <= 1 then
+      begin
+        ptkSetMouseCursor(wg.WinHandle, wg.MouseCursor);
+        result := 1;
+      end
+      else Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
+    end;
+*)
+
+    WM_MOUSEMOVE,
+    WM_LBUTTONDOWN,
+    WM_LBUTTONUP,
+    WM_LBUTTONDBLCLK,
+    WM_RBUTTONDOWN,
+    WM_RBUTTONUP:
+    begin
+      msgp.mouse.x := smallint(lParam and $FFFF);
+      msgp.mouse.y := smallint((lParam and $FFFF0000) shr 16);
+
+      case uMsg of
+        WM_MOUSEMOVE:
+          mcode := FPGM_MOUSEMOVE;
+        WM_LBUTTONDOWN,
+        WM_RBUTTONDOWN:
+          mcode := FPGM_MOUSEDOWN;
+        WM_LBUTTONUP,
+        WM_RBUTTONUP:
+          mcode := FPGM_MOUSEUP;
+        WM_LBUTTONDBLCLK:
+          mcode := FPGM_DOUBLECLICK;
+        else
+          mcode := 0;
+      end;
+
+      case uMsg of
+        WM_MOUSEMOVE:
+        begin
+          i := 0;
+          if (wParam and MK_LBUTTON) <> 0 then
+            i := i or MOUSE_LEFT;
+          if (wParam and MK_RBUTTON) <> 0 then
+            i := i or MOUSE_RIGHT;
+          if (wParam and MK_MBUTTON) <> 0 then
+            i := i or MOUSE_MIDDLE;
+          msgp.mouse.Buttons := i;
+        end;
+
+        WM_LBUTTONDOWN,
+        WM_LBUTTONUP,
+        WM_LBUTTONDBLCLK:
+          msgp.mouse.Buttons := MOUSE_LEFT;
+
+        WM_RBUTTONDOWN,
+        WM_RBUTTONUP:
+          msgp.mouse.Buttons := MOUSE_RIGHT;
+      end;
+
+      msgp.mouse.shiftstate := GetKeyboardShiftState;
+
+      if uMsg = WM_MouseMove then
+        w.DoMouseEnterLeaveCheck(w, uMsg, wParam, lParam);
+
+      if mcode <> 0 then
+        fpgSendMessage(nil, w, mcode, msgp);
+    end;
+
+    WM_SIZE:
+    begin
+      // note that WM_SIZING allows some control on sizeing
+
+      //writeln('WM_SIZE: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8));
+
+      msgp.rect.Width  := smallint(lParam and $FFFF);
+      msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16);
+
+      //writeln('WM_SIZE: width=',msgp.rect.width, ' height=',msgp.rect.height);
+
+      // skip minimize...
+      if lparam <> 0 then
+        fpgSendMessage(nil, w, FPGM_RESIZE, msgp);
+    end;
+
+
+    WM_MOVE:
+    begin
+      // window decoration correction ...
+      if (GetWindowLong(w.WinHandle, GWL_STYLE) and WS_CHILD) = 0 then
+      begin
+        GetWindowRect(w.WinHandle, r);
+        msgp.rect.Left := r.Left;
+        msgp.rect.top  := r.Top;
+      end
+      else
+      begin
+        msgp.rect.Left := smallint(lParam and $FFFF);
+        msgp.rect.Top  := smallint((lParam and $FFFF0000) shr 16);
+      end;
+
+      fpgSendMessage(nil, w, FPGM_MOVE, msgp);
+    end;
+
+    WM_MOUSEWHEEL:
+    begin
+      //writeln('MWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); // and $FF00) shr 8);
+      pt.x := LoWord(lparam);
+      pt.y := HiWord(lparam);
+      mw   := nil;
+      h    := WindowFromPoint(pt);
+      if h > 0 then  // get window mouse is hovering over
+        mw := TfpgWindowImpl(Windows.GetWindowLong(h, GWL_USERDATA));
+
+      if mw <> nil then
+      begin
+        msgp.mouse.x := pt.x;
+        msgp.mouse.y := pt.y;
+        msgp.mouse.delta := SmallInt(HiWord(wParam)) div -120;
+        
+        i := 0;
+        if (wParam and MK_LBUTTON) <> 0 then
+          i := i or MOUSE_LEFT;
+        if (wParam and MK_RBUTTON) <> 0 then
+          i := i or MOUSE_RIGHT;
+        if (wParam and MK_MBUTTON) <> 0 then
+          i := i or MOUSE_MIDDLE;
+        msgp.mouse.Buttons := i;
+        msgp.mouse.shiftstate := GetKeyboardShiftState;
+
+        fpgSendMessage(nil, mw, FPGM_SCROLL, msgp)
+      end;
+    end;
+
+    WM_ACTIVATE:
+      if ((wParam and $FFFF) = WA_INACTIVE) then
+        fpgSendMessage(nil, w, FPGM_DEACTIVATE)
+      else
+        fpgSendMessage(nil, w, FPGM_ACTIVATE);
+
+    WM_TIMER:
+      Result := 0;
+      //Writeln('TIMER EVENT!!!');
+      // used for event wait timeout
+
+
+    (*
+    WM_NCACTIVATE:
+    begin
+      if (ptkTopModalForm <> nil) then
+      begin
+        if (wParam = 0) and (ptkTopModalForm = wg) then
+        begin
+          blockmsg := true;
+        end
+        else if (wParam <> 0) and (ptkTopModalForm <> wg) then
+        begin
+          blockmsg := true;
+        end;
+      end;
+
+      if (PopupListFirst <> nil) and (PopupListFirst.Visible) then BlockMsg := True;
+
+      //writeln('ncactivate: ', ord(BlockMsg));
+
+      if not BlockMsg then
+        Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
+
+    end;
+*)
+
+    WM_CLOSE:
+        fpgSendMessage(nil, w, FPGM_CLOSE, msgp);
+
+    WM_PAINT:
+        begin
+          Windows.BeginPaint(w.WinHandle, @PaintStruct);
+          fpgSendMessage(nil, w, FPGM_PAINT, msgp);
+          Windows.EndPaint(w.WinHandle, @PaintStruct);
+        end;
+
+    else
+      Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
+  end;
+end;
+
+{ TfpgApplicationImpl }
+
+constructor TfpgApplicationImpl.Create(const aparams: string);
+begin
+  FIsInitialized  := False;
+  FDisplay        := Windows.GetDC(0);
+
+  with WindowClass do
+  begin
+    style         := CS_HREDRAW or CS_VREDRAW or CS_OWNDC or CS_DBLCLKS;
+    lpfnWndProc   := WndProc(@fpgWindowProc);
+    hInstance     := MainInstance;
+    hIcon         := LoadIcon(0, IDI_APPLICATION);
+    hCursor       := LoadCursor(0, IDC_ARROW);
+    hbrBackground := 0; //COLOR_WINDOW;
+    lpszClassName := 'FPGWIN';
+  end;
+  Windows.RegisterClass(@WindowClass);
+
+  with WidgetClass do
+  begin
+    style         := CS_OWNDC or CS_DBLCLKS;
+    lpfnWndProc   := WndProc(@fpgWindowProc);
+    hInstance     := MainInstance;
+    hIcon         := 0;
+    hCursor       := 0;
+    hbrBackground := 0; //COLOR_BACKGROUND;
+    lpszClassName := 'FPGWIDGET';
+  end;
+  Windows.RegisterClass(@WidgetClass);
+
+  hcr_default   := LoadCursor(0, IDC_ARROW);
+  hcr_dir_ew    := LoadCursor(0, IDC_SIZEWE);
+  hcr_dir_ns    := LoadCursor(0, IDC_SIZENS);
+  hcr_edit      := LoadCursor(0, IDC_IBEAM);
+  hcr_dir_nwse  := LoadCursor(0, IDC_SIZENWSE);
+  hcr_DIR_NESW  := LoadCursor(0, IDC_SIZENESW);
+  hcr_MOVE      := LoadCursor(0, IDC_SIZEALL);
+  hcr_CROSSHAIR := LoadCursor(0, IDC_CROSS);
+
+  FIsInitialized := True;
+  wapplication        := TfpgApplication(self);
+end;
+
+function TfpgApplicationImpl.DoMessagesPending: boolean;
+var
+  Msg: TMsg;
+begin
+  Result := Windows.PeekMessageW(@Msg, 0, 0, 0, PM_NOREMOVE);
+end;
+
+procedure TfpgApplicationImpl.DoWaitWindowMessage(atimeoutms: integer);
+var
+  Msg: TMsg;
+  timerid: longword;
+  timerwnd: HWND;
+  mp: boolean;
+begin
+  timerid  := 0;
+  timerwnd := 0;
+
+  if (atimeoutms >= 0) and (not DoMessagesPending) then
+    if atimeoutms > 0 then
+      timerid := Windows.SetTimer(timerwnd, 1, atimeoutms, nil)
+      {$Note This needs to be enabled again, but find a butter solution.}
+      // timerwnd := fpgMainForm.WinHandle;
+    else
+      Exit;  // handling waiting timeout
+
+  {$Note Incorporate Felipe's code from previous fpGUI in here. It handles WinCE and Windows just fine. }
+  if (GetVersion() < $80000000) then
+    Windows.GetMessageW(@Msg, 0, 0, 0)   //NT
+  else
+    Windows.GetMessage(@Msg, 0, 0, 0);   //Win98
+
+  Windows.DispatchMessage(@msg);
+
+  if timerid > 0 then
+    Windows.KillTimer(timerwnd, 1);
+end;
+
+procedure TfpgApplicationImpl.DoFlush;
+begin
+  GdiFlush;
+end;
+
+function TfpgApplicationImpl.GetScreenWidth: TfpgCoord;
+var
+  r: TRECT;
+begin
+  GetWindowRect(GetDesktopWindow, r);
+  Result := r.Right - r.Left;
+end;
+
+function TfpgApplicationImpl.GetScreenHeight: TfpgCoord;
+var
+  r: TRECT;
+begin
+  GetWindowRect(GetDesktopWindow, r);
+  Result := r.Bottom - r.Top;
+end;
+
+{ TfpgWindowImpl }
+
+function TfpgWindowImpl.DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean;
+
+  //----------------------
+  function CursorInDifferentWindow: Boolean;
+  var
+    pt: Windows.POINT;
+  begin
+    pt.x := LoWord(lParam);
+    pt.y := HiWord(lParam);
+
+    // only WM_MOUSEWHEEL uses screen coordinates!!!
+    if uMsg <> WM_MOUSEWHEEL then
+      Windows.ClientToScreen(FWinHandle, @pt);
+
+    Result := WindowFromPoint(pt) <> FWinHandle;
+  end;
+
+var
+  pt: Windows.POINT;
+//  Event: TFEvent;
+  msgp: TfpgMessageParams;
+begin
+  FillChar(msgp, sizeof(msgp), 0);
+  if not FMouseInWindow then
+  begin
+    FMouseInWindow := True;
+//    DoSetCursor;
+    Windows.SetCapture(FWinHandle);
+    //Event := TFEvent.Create;
+    //try
+      //Event.lParam := lParam;
+      //Event.EventType := etMouseEnter;
+      //ProcessEvent(Event);
+    //finally
+      //Event.Free;
+    //end;
+    fpgSendMessage(nil, AWindow, FPGM_MOUSEENTER, msgp);
+    Result := uMsg <> WM_MOUSEMOVE;
+  end
+  else
+  begin
+    pt.x := LoWord(lParam);
+    pt.y := HiWord(lParam);
+    if uMsg = WM_MOUSEWHEEL then
+      Windows.ScreenToClient(FWinHandle, @pt);
+    // we should change the Width and Height to ClientWidth, ClientHeight
+    if (pt.x < 0) or (pt.y < 0) or (pt.x >= Width) or
+      (pt.y >= Height) or CursorInDifferentWindow then
+      FMouseInWindow := False;
+
+    if {(not FHasMouseCapture) and} (not FMouseInWindow) then
+    begin
+      Windows.ReleaseCapture;
+      //Event := TFEvent.Create;
+      //try
+        //Event.EventType := etMouseLeave;
+        //ProcessEvent(Event);
+      //finally
+        //Event.Free;
+      //end;
+      msgp.mouse.x := LoWord(lParam);
+      msgp.mouse.y := HiWord(lParam);
+      fpgSendMessage(nil, AWindow, FPGM_MOUSEEXIT, msgp);
+      Result := False;
+    end
+    else
+      Result := True;
+  end;
+end;
+
+procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase);
+var
+  wcname: string;
+  wname: string;
+  mid: dword;
+  rwidth: integer;
+  rheight: integer;
+  r: TRect;
+begin
+  if FWinHandle > 0 then
+    Exit;
+
+  FWinStyle   := WS_OVERLAPPEDWINDOW;
+  FWinStyleEx := WS_EX_APPWINDOW;
+  mid         := 0;
+  wcname      := 'FPGWIN';
+
+  if aparent <> nil then
+    FParentWinHandle := TfpgWindowImpl(AParent).WinHandle
+  else
+    FParentWinHandle := 0;
+
+  if FWindowType = wtChild then
+  begin
+    FWinStyle   := WS_CHILD;
+    FWinStyleEx := 0;
+    mid         := 1;
+    wcname      := 'FPGWIDGET';
+  end
+  else if FWindowType in [wtPopup] then
+  begin
+    FWinStyle   := WS_POPUP;
+    FWinStyleEx := WS_EX_TOOLWINDOW;
+  end;
+
+  if FWindowType = wtModalForm then
+  begin
+    // for modal windows, this is necessary
+    FWinStyle   := WS_OVERLAPPEDWINDOW or WS_POPUPWINDOW;
+    FWinStyle   := FWinStyle and not (WS_MINIMIZEBOX);
+    FWinStyleEx := 0;
+  end;
+
+  AdjustWindowStyle;
+
+  if waAutoPos in FWindowAttributes then
+  begin
+    FLeft := TfpgCoord(CW_USEDEFAULT);
+    FTop  := TfpgCoord(CW_USEDEFAULT);
+  end;
+
+  if (FWindowType <> wtChild) and not (waSizeable in FWindowAttributes) then
+    FWinStyle := FWinStyle and not (WS_SIZEBOX or WS_MAXIMIZEBOX or WS_MINIMIZEBOX);
+
+  FWinStyle := FWinStyle or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
+
+  wname   := '';
+  rwidth  := FWidth;
+  rheight := FHeight;
+
+  if (FWinStyle and WS_CHILD) = 0 then
+  begin
+    r.Left   := FLeft;
+    r.Top    := FTop;
+    r.Right  := FLeft + FWidth;
+    r.Bottom := FTop + FHeight;
+    AdjustWindowRectEx(r, FWinStyle, False, FWinStyleEx);
+    rwidth   := r.Right - r.Left;
+    rheight  := r.Bottom - r.Top;
+  end;
+
+  FWinHandle := Windows.CreateWindowEx(
+    FWinStyleEx,     // extended window style
+    PChar(wcname),   // registered class name
+    PChar(wname),    // window name
+    FWinStyle,       // window style
+    FLeft,           // horizontal position of window
+    FTop,            // vertical position of window
+    rwidth,          // window width
+    rheight,         // window height
+    FParentWinHandle, // handle to parent or owner window
+    mid,             // menu handle or child identifier
+    MainInstance,    // handle to application instance
+    Self             // window-creation data
+    );
+
+  if waScreenCenterPos in FWindowAttributes then
+  begin
+    FLeft := (wapplication.ScreenWidth - FWidth) div 2;
+    FTop  := (wapplication.ScreenHeight - FHeight) div 2;
+    DoMoveWindow(FLeft, FTop);
+  end;
+
+  SetWindowParameters; // the forms require some adjustments before the Window appears
+
+  BringWindowToTop(FWinHandle);
+
+  if FWindowType in [wtPopup] then
+    Windows.ShowWindow(FWinHandle, SW_SHOWNOACTIVATE)
+  else
+    Windows.ShowWindow(FWinHandle, SW_SHOWNORMAL);
+
+  if (waAutoPos in FWindowAttributes) or
+    (waScreenCenterPos in FWindowAttributes) then
+  begin
+    GetWindowRect(FWinHandle, r);
+    FLeft := r.Left;
+    FTop  := r.Top;
+  end;
+
+  Windows.UpdateWindow(FWinHandle);
+end;
+
+procedure TfpgWindowImpl.DoReleaseWindowHandle;
+begin
+  if FWinHandle <= 0 then
+    Exit;
+  Windows.DestroyWindow(FWinHandle);
+  FWinHandle := 0;
+end;
+
+procedure TfpgWindowImpl.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord);
+begin
+  if HandleIsValid then
+    Windows.SetWindowPos(WinHandle, 0, x, y, 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOREDRAW);
+end;
+
+function TfpgWindowImpl.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint;
+begin
+  if not HandleIsValid then
+    Exit; //==>
+
+  Result.X := AScreenPos.X;
+  Result.Y := AScreenPos.Y;
+  ClientToScreen(TfpgWindowImpl(ASource).WinHandle, Result);
+end;
+
+{
+procedure TfpgWindowImpl.MoveToScreenCenter;
+var
+  r : TRECT;
+begin
+  GetWindowRect(WinHandle, r);
+  FLeft := (wapplication.ScreenWidth-(r.Right - r.Left)) div 2;
+  FTop := (wapplication.ScreenHeight-(r.Bottom - r.Top)) div 2;
+  MoveWindow(FLeft,FTop);
+end;
+}
+
+procedure TfpgWindowImpl.DoSetWindowTitle(const atitle: string);
+begin
+  {$ifdef wince}
+  Windows.SetWindowText(WinHandle, PWideChar(Utf8Decode(ATitle)));
+  {$else}
+  if UnicodeEnabledOS then
+    Windows.SetWindowTextW(WinHandle, PWideChar(Utf8Decode(ATitle)))
+  else
+    Windows.SetWindowText(WinHandle, PChar(Utf8ToAnsi(ATitle)));
+  {$endif}
+end;
+
+constructor TfpgWindowImpl.Create(aowner: TComponent);
+begin
+  inherited;
+  FWinHandle := 0;
+end;
+
+procedure TfpgWindowImpl.CaptureMouse;
+begin
+  Windows.SetCapture(FWinHandle);
+end;
+
+procedure TfpgWindowImpl.ReleaseMouse;
+begin
+  Windows.ReleaseCapture;
+end;
+
+function TfpgWindowImpl.HandleIsValid: boolean;
+begin
+  Result := FWinHandle > 0;
+end;
+
+procedure TfpgWindowImpl.DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord);
+begin
+  Windows.SetWindowPos(
+    WinHandle, 0,
+    aleft, atop, awidth, aheight,
+    SWP_NOZORDER or SWP_NOREDRAW
+    );
+end;
+
+{ TfpgCanvasImpl }
+
+constructor TfpgCanvasImpl.Create;
+begin
+  inherited;
+  FDrawing      := False;
+  FDrawWindow   := nil;
+  FBufferBitmap := 0;
+end;
+
+destructor TfpgCanvasImpl.Destroy;
+begin
+  if FDrawing then
+    DoEndDraw;
+  inherited;
+end;
+
+procedure TfpgCanvasImpl.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean);
+var
+  ARect: TfpgRect;
+  bmsize: Windows.TSIZE;
+begin
+  if FDrawing and buffered and (FBufferBitmap > 0) then
+  begin
+    // check if the dimensions are ok
+    GetBitmapDimensionEx(FBufferBitmap, bmsize);
+    FDrawWindow := TfpgWindowImpl(awin);
+    DoGetWinRect(ARect);
+    if (bmsize.cx <> ARect.Width) or (bmsize.cy <> ARect.Height) then
+      DoEndDraw;
+  end;
+
+  if not FDrawing then
+  begin
+    FDrawWindow := TfpgWindowImpl(awin);
+    FWinGC      := Windows.GetDC(FDrawWindow.FWinHandle);
+
+    if buffered then
+    begin
+      DoGetWinRect(ARect);
+      FBufferBitmap := Windows.CreateCompatibleBitmap(FWinGC, ARect.Width, ARect.Height);
+      Fgc           := CreateCompatibleDC(FWinGC);
+      SelectObject(Fgc, FBufferBitmap);
+    end
+    else
+    begin
+      FBufferBitmap := 0;
+      Fgc           := FWinGC;
+    end;
+
+    SetTextAlign(Fgc, TA_TOP); //TA_BASELINE);
+    SetBkMode(Fgc, TRANSPARENT);
+
+    FBrush      := CreateSolidBrush(0);
+    FPen        := CreatePen(PS_SOLID, 0, 0); // defaults to black
+    FClipRegion := CreateRectRgn(0, 0, 1, 1);
+
+    FColor           := fpgColorToWin(clText1);
+    FLineStyle       := lsSolid;
+    FLineWidth       := 0;
+    FBackgroundColor := fpgColorToWin(clBoxColor);
+  end;
+
+  FDrawing := True;
+end;
+
+procedure TfpgCanvasImpl.DoEndDraw;
+begin
+  if FDrawing then
+  begin
+    DeleteObject(FBrush);
+    DeleteObject(FPen);
+    DeleteObject(FClipRegion);
+
+    if FBufferBitmap > 0 then
+      DeleteObject(FBufferBitmap);
+    FBufferBitmap := 0;
+
+    if Fgc <> FWinGC then
+      DeleteDC(Fgc);
+
+    Windows.ReleaseDC(FDrawWindow.FWinHandle, FWingc);
+
+    FDrawing    := False;
+    FDrawWindow := nil;
+  end;
+end;
+
+function TfpgCanvasImpl.GetPixel(X, Y: integer): TfpgColor;
+var
+  c: longword;
+begin
+  c := Windows.GetPixel(Fgc, X, Y);
+  if c = CLR_INVALID then
+    Writeln('fpGFX/GDI: TfpgCanvasImpl.GetPixel returned an invalid color');
+  Result := WinColorTofpgColor(c);
+end;
+
+procedure TfpgCanvasImpl.SetPixel(X, Y: integer; const AValue: TfpgColor);
+begin
+  Windows.SetPixel(Fgc, X, Y, fpgColorToWin(AValue));
+end;
+
+procedure TfpgCanvasImpl.DoPutBufferToScreen(x, y, w, h: TfpgCoord);
+begin
+  if FBufferBitmap > 0 then
+    BitBlt(FWinGC, x, y, w, h, Fgc, x, y, SRCCOPY);
+end;
+
+procedure TfpgCanvasImpl.DoAddClipRect(const rect: TfpgRect);
+var
+  rg: HRGN;
+begin
+  rg           := CreateRectRgn(rect.left, rect.top, rect.left + rect.Width, rect.top + rect.Height);
+  FClipRect    := Rect;
+  FClipRectSet := True;
+  CombineRgn(FClipRegion, rg, FClipRegion, RGN_AND);
+  SelectClipRgn(Fgc, FClipRegion);
+  DeleteObject(rg);
+end;
+
+procedure TfpgCanvasImpl.DoClearClipRect;
+begin
+  SelectClipRgn(Fgc, 0);
+  FClipRectSet := False;
+end;
+
+procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord);
+begin
+  Windows.MoveToEx(Fgc, x1, y1, nil);
+  Windows.LineTo(Fgc, x2, y2);
+end;
+
+procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord);
+begin
+  Windows.MoveToEx(Fgc, x, y, nil);
+  Windows.LineTo(Fgc, x+w-1, y);
+  Windows.LineTo(Fgc, x+w-1, y+h-1);
+  Windows.LineTo(Fgc, x, y+h-1);
+  Windows.LineTo(Fgc, x, y);
+end;
+
+procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string);
+var
+  WideText: widestring;
+begin
+  if UTF8Length(txt) < 1 then
+    Exit; //==>
+
+  WideText := Utf8Decode(txt);
+  {$ifdef wince}
+  Windows.ExtTextOut(Fgc, x, y, ETO_CLIPPED, nil, PWideChar(WideText), Length(WideText), nil);
+  {$else}
+  Windows.TextOutW(Fgc, x, y, PWideChar(WideText), Length(WideText));
+  {$endif}
+end;
+
+procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord);
+var
+  wr: Windows.TRect;
+begin
+  wr.Left   := x;
+  wr.Top    := y;
+  wr.Right  := x + w;
+  wr.Bottom := y + h;
+  Windows.FillRect(Fgc, wr, FBrush);
+end;
+
+procedure TfpgCanvasImpl.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord);
+var
+  pts: array[1..3] of Windows.TPoint;
+begin
+  pts[1].X := x1;
+  pts[1].Y := y1;
+  pts[2].X := x2;
+  pts[2].Y := y2;
+  pts[3].X := x3;
+  pts[3].Y := y3;
+  Windows.Polygon(Fgc, pts, 3);
+end;
+
+function TfpgCanvasImpl.DoGetClipRect: TfpgRect;
+begin
+  Result := FClipRect;
+end;
+
+procedure TfpgCanvasImpl.DoGetWinRect(var r: TfpgRect);
+var
+  wr: Windows.TRECT;
+begin
+  GetClientRect(FDrawWindow.FWinHandle, wr);
+  r.top    := wr.Top;
+  r.left   := wr.Left;
+  r.Width  := wr.Right - wr.Left + 1;
+  r.Height := wr.Bottom - wr.Top + 1;
+end;
+
+procedure TfpgCanvasImpl.DoSetClipRect(const rect: TfpgRect);
+begin
+  FClipRectSet := True;
+  FClipRect    := rect;
+  DeleteObject(FClipRegion);
+  FClipRegion  := CreateRectRgn(rect.left, rect.top, rect.left + rect.Width, rect.top + rect.Height);
+  SelectClipRgn(Fgc, FClipRegion);
+end;
+
+procedure TfpgCanvasImpl.DoSetColor(cl: TfpgColor);
+var
+  newBrush, oldBrush: HBRUSH;
+  newPen, oldPen: HPEN;
+begin
+  FWindowsColor := fpgColorToWin(cl);
+
+  newBrush  := CreateSolidBrush(FWindowsColor);
+  newPen    := CreatePen(FintLineStyle, FLineWidth, FWindowsColor);
+  oldBrush  := SelectObject(Fgc, newBrush);
+  oldPen    := SelectObject(Fgc, newPen);
+  FBrush    := newBrush;
+  FPen      := newPen;
+
+  DeleteObject(oldBrush);
+  DeleteObject(oldPen);
+end;
+
+procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle);
+var
+  lw: integer;
+  lPen: HPEN;
+begin
+{ Notes from MSDN: If the value specified by nWidth is greater
+than 1, the fnPenStyle parameter must be PS_NULL, PS_SOLID, or
+PS_INSIDEFRAME. }
+  FLineWidth := awidth;
+  case AStyle of
+    lsDot:
+      begin
+        FintLineStyle := PS_DOT;
+        lw := 1;
+      end;
+    lsDash:
+      begin
+        FintLineStyle := PS_DASH;
+        lw := 1;
+      end;
+    lsSolid:
+      begin
+        FintLineStyle := PS_SOLID;
+        lw := FLineWidth;
+      end;
+    else
+      begin
+        FintLineStyle := PS_SOLID;
+        lw := 1;
+      end;
+  end;
+
+  lPen := CreatePen(FintLineStyle, lw, FWindowsColor);
+  Windows.SelectObject(Fgc, lPen);
+  Windows.DeleteObject(FPen);
+  FPen := lPen;
+end;
+
+procedure TfpgCanvasImpl.DoSetTextColor(cl: TfpgColor);
+begin
+  Windows.SetTextColor(Fgc, fpgColorToWin(cl));
+end;
+
+procedure TfpgCanvasImpl.DoSetFontRes(fntres: TfpgFontResourceBase);
+begin
+  if fntres = nil then
+    Exit; //==>
+  FCurFontRes := TfpgFontResourceImpl(fntres);
+  Windows.SelectObject(Fgc, FCurFontRes.Handle);
+end;
+
+procedure TfpgCanvasImpl.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer);
+const
+  DSTCOPY     = $00AA0029;
+  ROP_DSPDxax = $00E20746;
+var
+  tmpdc: HDC;
+  rop: longword;
+begin
+  if img = nil then
+    Exit; //==>
+
+  tmpdc := CreateCompatibleDC(wapplication.display);
+  SelectObject(tmpdc, TfpgImageImpl(img).BMPHandle);
+
+  if TfpgImageImpl(img).FIsTwoColor then
+    rop := PATCOPY  //ROP_DSPDxax
+  else
+    rop := SRCCOPY;
+
+  if TfpgImageImpl(img).MaskHandle > 0 then
+    MaskBlt(Fgc, x, y, w, h, tmpdc, xi, yi, TfpgImageImpl(img).MaskHandle, xi, yi, MakeRop4(rop, DSTCOPY))
+  else
+    BitBlt(Fgc, x, y, w, h, tmpdc, xi, yi, rop);
+
+  DeleteDC(tmpdc);
+end;
+
+procedure TfpgCanvasImpl.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord);
+var
+  hb: HBRUSH;
+  nullpen: HPEN;
+begin
+  hb      := CreateSolidBrush(fpgColorToWin(fpgColorToRGB(col)));
+  nullpen := CreatePen(PS_NULL, 0, 0);
+
+  SetROP2(Fgc, R2_XORPEN);
+  SelectObject(Fgc, hb);
+  SelectObject(Fgc, nullpen);
+
+  Windows.Rectangle(Fgc, x, y, x + w + 1, y + h + 1);
+
+  SetROP2(Fgc, R2_COPYPEN);
+  DeleteObject(hb);
+  SelectObject(Fgc, FPen);
+end;
+
+{ TfpgFontResourceImpl }
+
+constructor TfpgFontResourceImpl.Create(const afontdesc: string);
+begin
+  FFontData := OpenFontByDesc(afontdesc);
+
+  if HandleIsValid then
+  begin
+    SelectObject(wapplication.display, FFontData);
+    GetTextMetrics(wapplication.display, FMetrics);
+  end;
+end;
+
+destructor TfpgFontResourceImpl.Destroy;
+begin
+  if HandleIsValid then
+    Windows.DeleteObject(FFontData);
+  inherited;
+end;
+
+function TfpgFontResourceImpl.OpenFontByDesc(const desc: string): HFONT;
+var
+  lf: Windows.LOGFONT;
+  facename: string;
+  cp: integer;
+  c: char;
+  token: string;
+  prop, propval: string;
+
+  function NextC: char;
+  begin
+    Inc(cp);
+    if cp > length(desc) then
+      c := #0
+    else
+      c := desc[cp];
+    Result := c;
+  end;
+
+  procedure NextToken;
+  begin
+    token := '';
+    while (c <> #0) and (c in [' ', 'a'..'z', 'A'..'Z', '_', '0'..'9']) do
+    begin
+      token := token + c;
+      NextC;
+    end;
+  end;
+
+begin
+  FillChar(lf, sizeof(lf), 0);
+
+  with lf do
+  begin
+    lfWidth          := 0; { have font mapper choose }
+    lfEscapement     := 0; { only straight fonts }
+    lfOrientation    := 0; { no rotation }
+    lfWeight         := FW_NORMAL;
+    lfItalic         := 0;
+    lfUnderline      := 0;
+    lfStrikeOut      := 0;
+    lfCharSet        := DEFAULT_CHARSET; //0; //Byte(Font.Charset);
+    lfQuality        := ANTIALIASED_QUALITY;
+    { Everything else as default }
+    lfOutPrecision   := OUT_DEFAULT_PRECIS;
+    lfClipPrecision  := CLIP_DEFAULT_PRECIS;
+    lfPitchAndFamily := DEFAULT_PITCH;
+  end;
+
+  cp := 0;
+  NextC;
+  NextToken;
+
+  facename := token + #0;
+  move(facename[1], lf.lfFaceName[0], length(facename));
+
+  if c = '-' then
+  begin
+    NextC;
+    NextToken;
+    lf.lfHeight := -MulDiv(StrToIntDef(token, 0), GetDeviceCaps(wapplication.display, LOGPIXELSY), 72);
+  end;
+
+  while c = ':' do
+  begin
+    NextC;
+    NextToken;
+
+    prop    := UpperCase(token);
+    propval := '';
+
+    if c = '=' then
+    begin
+      NextC;
+      NextToken;
+      propval := UpperCase(token);
+    end;
+
+    if prop = 'BOLD' then
+      lf.lfWeight := FW_BOLD
+    else if prop = 'ITALIC' then
+      lf.lfItalic := 1
+    else if prop = 'ANTIALIAS' then
+      if propval = 'FALSE' then
+        lf.lfQuality := DEFAULT_QUALITY;
+  end;
+
+  Result := CreateFontIndirectA(@lf);
+end;
+
+function TfpgFontResourceImpl.HandleIsValid: boolean;
+begin
+  Result := FFontData <> 0;
+end;
+
+function TfpgFontResourceImpl.GetAscent: integer;
+begin
+  Result := FMetrics.tmAscent;
+end;
+
+function TfpgFontResourceImpl.GetDescent: integer;
+begin
+  Result := FMetrics.tmDescent;
+end;
+
+function TfpgFontResourceImpl.GetHeight: integer;
+begin
+  Result := FMetrics.tmHeight;
+end;
+
+function TfpgFontResourceImpl.GetTextWidth(const txt: string): integer;
+var
+  ts: Windows.SIZE;
+  WideText: widestring;
+begin
+  if length(txt) < 1 then
+  begin
+    Result := 0;
+    Exit;
+  end;
+  SelectObject(wapplication.display, FFontData);
+
+  WideText := Utf8Decode(txt);
+  {$ifdef wince}
+  Windows.GetTextExtentPoint32(wapplication.display, PWideChar(WideText), Length(WideText), ts);
+  {$else}
+  Windows.GetTextExtentPoint32W(wapplication.display, PWideChar(WideText), Length(WideText), ts);
+  {$endif}
+
+  Result := ts.cx;
+end;
+
+{ TfpgImageImpl }
+
+constructor TfpgImageImpl.Create;
+begin
+  FBMPHandle  := 0;
+  FMaskHandle := 0;
+  FIsTwoColor := False;
+end;
+
+procedure TfpgImageImpl.DoFreeImage;
+begin
+  if FBMPHandle > 0 then
+    DeleteObject(FBMPHandle);
+  FBMPHandle := 0;
+  if FMaskHandle > 0 then
+    DeleteObject(FMaskHandle);
+  FMaskHandle := 0;
+end;
+
+procedure TfpgImageImpl.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer);
+var
+  bi: TBitmapInfo;
+begin
+  if FBMPHandle > 0 then
+    DeleteObject(FBMPHandle);
+
+  FBMPHandle := CreateCompatibleBitmap(wapplication.display, awidth, aheight);
+
+  FillChar(bi, sizeof(bi), 0);
+
+  with bi.bmiHeader do
+  begin
+    biSize   := sizeof(bi);
+    biWidth  := awidth;
+    biHeight := -aheight;
+    biPlanes := 1;
+    if acolordepth = 1 then
+      bibitcount := 1
+    else
+      bibitcount := 32;
+    biCompression := BI_RGB;
+    biSizeImage := 0;
+    biXPelsPerMeter := 96;
+    biYPelsPerMeter := 96;
+    biClrUsed       := 0;
+    biClrImportant  := 0;
+  end;
+
+  SetDIBits(wapplication.display, FBMPHandle, 0, aheight, aimgdata, bi, DIB_RGB_COLORS);
+
+  FIsTwoColor := (acolordepth = 1);
+end;
+
+type
+  TMyMonoBitmap = packed record
+    bmiHeader: TBitmapInfoHeader;
+    bmColors: array[1..2] of longword;
+  end;
+
+procedure TfpgImageImpl.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer);
+var
+  bi: TMyMonoBitmap;
+  pbi: PBitmapInfo;
+begin
+  if FMaskHandle > 0 then
+    DeleteObject(FMaskHandle);
+  FMaskHandle := CreateBitmap(awidth, aheight, 1, 1, nil);
+  FillChar(bi, sizeof(bi), 0);
+
+  with bi.bmiHeader do
+  begin
+    biSize          := sizeof(bi.bmiHeader);
+    biWidth         := awidth;
+    biHeight        := -aheight;
+    biPlanes        := 1;
+    bibitcount      := 1;
+    biCompression   := BI_RGB;
+    biSizeImage     := 0;
+    biXPelsPerMeter := 96;
+    biYPelsPerMeter := 96;
+    biClrUsed       := 2;
+    biClrImportant  := 0;
+  end;
+  bi.bmColors[1] := $000000;
+  bi.bmColors[2] := $FFFFFF;
+
+  pbi := @bi;
+  SetDIBits(wapplication.display, FMaskHandle, 0, aheight, aimgdata, pbi^, DIB_RGB_COLORS);
+end;
+
+initialization
+  wapplication   := nil;
+  MouseFocusedWH := 0;
+
+{$IFDEF WinCE}
+  UnicodeEnabledOS := True;
+{$ELSE}
+  WinVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
+  GetVersionEx(WinVersion);
+  UnicodeEnabledOS := (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) or
+    (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_CE);
+{$ENDIF}
+
+end.
+