Merge branch 'master' of ssh://fpgui.git.sourceforge.net/gitroot/fpgui/fpgui

6 files changed, 1673 insertions, 62 deletions

diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index e242bfb6..6f95d8a8 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.pas
@@ -24,19 +24,25 @@ unit fpg_gdi;
 {$mode objfpc}{$H+}
 
 {.$Define Debug}
+{.$Define DND_DEBUG}
 
 interface
 
 uses
-  Windows,
   Classes,
   SysUtils,
+  Windows,
+  ActiveX,
   fpg_base,
-  fpg_impl;
+  fpg_impl
+  {$IFDEF DEBUG}
+  ,dbugintf
+  {$ENDIF DEBUG}
+  ,fpg_OLEDragDrop
+  ;
 
 { Constants missing on windows unit }
 const
-  WM_MOUSEWHEEL         = $020a;    // we could remove this since FPC 2.0.4
   VER_PLATFORM_WIN32_CE = 3;
   CLEARTYPE_QUALITY     = 5;
 
@@ -50,6 +56,8 @@ var
 type
   // forward declaration
   TfpgGDIWindow = class;
+  TGDIDragManager = class;
+  TfpgGDIDrag = class;
 
 
   TfpgGDIFontResource = class(TfpgFontResourceBase)
@@ -140,13 +148,25 @@ type
 
   TfpgGDIWindow = class(TfpgWindowBase)
   private
+    FDropManager: TfpgOLEDropTarget;
+    FDropPos: TPoint;
+    FUserMimeSelection: TfpgString;
+    FUserAcceptDrag: Boolean;
+    function    GetDropManager: TfpgOLEDropTarget;
+    procedure   HandleDNDLeave(Sender: TObject);
+    procedure   HandleDNDEnter(Sender: TObject; DataObj: IDataObject; KeyState: Longint; PT: TPoint; var Effect: DWORD);
+    procedure   HandleDNDPosition(Sender: TObject; KeyState: Longint; PT: TPoint; var Effect: TfpgOLEDragDropEffect);
+    procedure   HandleDNDDrop(Sender: TObject; DataObj: IDataObject; KeyState: Longint; PT: TPoint; Effect: TfpgOLEDragDropEffect);
+  private
     FMouseInWindow: boolean;
     FNonFullscreenRect: TfpgRect;
     FNonFullscreenStyle: longword;
     FFullscreenIsSet: boolean;
     FSkipResizeMessage: boolean;
+    QueueAcceptDrops: boolean;
     function    DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean;
     procedure   WindowSetFullscreen(aFullScreen, aUpdate: boolean);
+    property    DropManager: TfpgOLEDropTarget read GetDropManager;
   protected
     FWinHandle: TfpgWinHandle;
     FModalForWin: TfpgGDIWindow;
@@ -164,9 +184,13 @@ type
     //procedure MoveToScreenCenter; override;
     procedure   DoSetWindowTitle(const ATitle: string); override;
     procedure   DoSetMouseCursor; override;
+    procedure   DoDNDEnabled(const AValue: boolean); override;
+    procedure   DoAcceptDrops(const AValue: boolean); override;
+    procedure   DoDragStartDetected; override;
     property    WinHandle: TfpgWinHandle read FWinHandle;
   public
     constructor Create(AOwner: TComponent); override;
+    destructor  Destroy; override;
     procedure   ActivateWindow; override;
     procedure   CaptureMouse; override;
     procedure   ReleaseMouse; override;
@@ -175,6 +199,10 @@ type
 
 
   TfpgGDIApplication = class(TfpgApplicationBase)
+  private
+    FDrag: TfpgGDIDrag;
+    procedure   SetDrag(const AValue: TfpgGDIDrag);
+    property    Drag: TfpgGDIDrag read FDrag write SetDrag;
   protected
     FDisplay: HDC;
     WindowClass: TWndClass;
@@ -234,6 +262,42 @@ type
   end;
 
 
+  TfpgGDIMimeDataBase = class(TfpgMimeDataBase)
+  end;
+
+
+  { Used mainly for sending drags - being the source of the drag }
+  TfpgGDIDrag = class(TfpgDragBase)
+  private
+    function    StringToHandle(const AString: TfpgString): HGLOBAL;
+  protected
+    FSource: TfpgGDIWindow;
+    function    GetSource: TfpgGDIWindow; virtual;
+  public
+    destructor  Destroy; override;
+    function    Execute(const ADropActions: TfpgDropActions; const ADefaultAction: TfpgDropAction=daCopy): TfpgDropAction; override;
+  end;
+
+
+  { Used mainly for receiving drags - being the target of the drag }
+  TGDIDragManager = class(TInterfacedObject, IDropTarget)
+  private
+    FDropTarget: TfpgWindowBase;  { actually a TfpgWidget }
+    FRegistered: boolean;
+    { IDropTarget }
+    function    DragEnter(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;StdCall;
+    function    DragOver(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;StdCall;
+    function    DragLeave: HResult;StdCall;
+    function    Drop(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD):HResult;StdCall;
+  public
+    constructor Create(ADropTarget: TfpgWindowBase); reintroduce;
+    destructor  Destroy; override;
+    procedure   RegisterDragDrop;
+    procedure   RevokeDragDrop;
+    property    DropTarget: TfpgWindowBase read FDropTarget; { actually a TfpgWidget }
+  end;
+
+
 implementation
 
 uses
@@ -249,7 +313,7 @@ var
   wapplication: TfpgApplication;
   MouseFocusedWH: HWND;
   OldMousePos: TPoint;  // used to detect fake MouseMove events
-
+  NeedToUnitialize: Boolean;
 
 // some required keyboard functions
 {$INCLUDE fpg_keys_gdi.inc}
@@ -434,20 +498,68 @@ begin
   {$ENDIF}
 end;
 
+{  **********   Some helper conversion functions   ************* }
+
 function WinkeystateToShiftstate(keystate: cardinal): TShiftState;
 begin
- result:= [];
-  if GetKeyState(vk_menu) < 0 then begin
+  Result := [];
+  if GetKeyState(vk_menu) < 0 then
     Include(result, ssAlt);
-  end;
-  if GetKeyState(vk_shift) < 0 then begin
+  if GetKeyState(vk_shift) < 0 then
     Include(result, ssShift);
-  end;
-  if GetKeyState(vk_control) < 0 then begin
+  if GetKeyState(vk_control) < 0 then
     Include(result, ssCtrl);
-  end;
 end;
 
+function TranslateToFPGDropActions(const pdwEffects: DWORD): TfpgDropActions;
+begin
+  Result := [daIgnore];
+  if (pdwEffects and DROPEFFECT_LINK) <> 0 then
+    Result := Result + [daLink];
+  if (pdwEffects and DROPEFFECT_COPY) <> 0  then
+    Result := Result + [daCopy];
+  if (pdwEffects and DROPEFFECT_MOVE) <> 0  then
+    Result := Result + [daMove];
+end;
+
+function TranslateToFPGDropAction(const pdwEffects: DWORD): TfpgDropAction;
+begin
+  if (pdwEffects and DROPEFFECT_LINK) <> 0 then
+    Result := daLink
+  else if (pdwEffects and DROPEFFECT_COPY) <> 0 then
+    Result := daCopy
+  else if (pdwEffects and DROPEFFECT_MOVE) <> 0 then
+    Result := daMove
+  else
+    Result := daIgnore;
+end;
+
+function TranslateToWinDragEffects(const AActions: TfpgDropActions): DWORD;
+begin
+  Result := DROPEFFECT_NONE;
+  if daLink in AActions then
+    Result := Result or DROPEFFECT_LINK;
+  if daCopy in AActions then
+    Result := Result or DROPEFFECT_COPY;
+  if daMove in AActions then
+    Result := Result or DROPEFFECT_MOVE;
+end;
+
+function TranslateToWinDragEffect(const AAction: TfpgDropAction): DWORD;
+begin
+  if AAction = daIgnore then
+    Result := DROPEFFECT_NONE
+  else if daLink = AAction then
+    Result := DROPEFFECT_LINK
+  else if daCopy = AAction then
+    Result := DROPEFFECT_COPY
+  else if daMove = AAction then
+    Result := DROPEFFECT_MOVE
+  else
+    Result := DROPEFFECT_NONE; { fallback, but should never be reached }
+end;
+
+
 {$IFDEF wince}
 procedure WinCESetDibBits(BMP: HBITMAP; awidth, aheight: Integer; aimgdata: Pointer; var bi: TBitmapInfo);
 var
@@ -631,7 +743,7 @@ begin
 
   if not (w is TfpgGDIWindow) then
   begin
-    {$IFDEF DEBUG} writeln('fpGFX/GDI: Unable to detect Window - using DefWindowProc'); {$ENDIF}
+    {$IFDEF DEBUG} SendDebug('fpGFX/GDI: Unable to detect Window - using DefWindowProc'); {$ENDIF}
     Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
     Exit; //==>
   end;
@@ -646,8 +758,7 @@ begin
     WM_KEYDOWN,
     WM_SYSKEYDOWN:
         begin
-          {$IFDEF DEBUG} write(w.ClassName + ': '); {$ENDIF}
-          {$IFDEF DEBUG} writeln('wm_char, wm_keyup, wm_keydown'); {$ENDIF}
+          {$IFDEF DEBUG} SendDebug(w.ClassName + ': wm_char, wm_keyup, wm_keydown'); {$ENDIF}
           kwg := FindKeyboardFocus;
           if kwg <> nil then
             w := kwg;
@@ -725,16 +836,15 @@ begin
           if uMsg = WM_MOUSEMOVE then
           begin
             {$IFDEF DEBUG}
-            Writeln('old x=', OldMousePos.x, ' y=', OldMousePos.y);
-            writeln('new x=', msgp.mouse.x, ' y=', msgp.mouse.y);
-            writeln('---');
+            SendDebugFmt('old x=%d  y=%d', [OldMousePos.x, OldMousePos.y]);
+            SendDebugFmt('new x=%d  y=%d', [msgp.mouse.x, msgp.mouse.y]);
             {$ENDIF}
             // Check for fake MouseMove messages - Windows sucks!
             if (OldMousePos.x = msgp.mouse.x) and
                (OldMousePos.y = msgp.mouse.y) then
             begin
               {$IFDEF DEBUG}
-              writeln('We received fake MouseMove messages');
+              SendDebug('We received fake MouseMove messages');
               {$ENDIF}
               Exit; //==>
             end
@@ -790,7 +900,7 @@ begin
               WM_RBUTTONDOWN:
                   begin
                     {$IFDEF DEBUG}
-                    writeln('fpGUI/GDI:', w.ClassName + ': MouseButtonDown event');
+                    SendDebug('fpGUI/GDI: ' + w.ClassName + ': MouseButtonDown event');
                     {$ENDIF}
                     // This is temporary and we should try and move it to
                     // the UI Designer code instead.
@@ -807,7 +917,7 @@ begin
               WM_RBUTTONUP:
                   begin
                     {$IFDEF DEBUG}
-                    writeln('fpGFX/GDI:', w.ClassName + ': MouseButtonUp event');
+                    SendDebug('fpGFX/GDI: '+ w.ClassName + ': MouseButtonUp event');
                     {$ENDIF}
                     // This is temporary and we should try and move it to
                     // the UI Designer code instead.
@@ -875,8 +985,7 @@ begin
           msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16);
 
           {$IFDEF DEBUG}
-            write(w.ClassName + ': ');
-            writeln('WM_SIZE: width=',msgp.rect.width, ' height=',msgp.rect.height);
+            SendDebugFmt('%s: WM_SIZE  w=%d  h=%d', [w.ClassName, msgp.rect.width, msgp.rect.Height]);
           {$ENDIF}
           // skip minimize...
           if lparam <> 0 then
@@ -886,8 +995,7 @@ begin
     WM_MOVE:
         begin
           {$IFDEF DEBUG}
-          write(w.ClassName + ': ');
-          writeln('WM_MOVE');
+          SendDebug(w.ClassName + ': WM_MOVE');
           {$ENDIF}
           // window decoration correction ...
           if (GetWindowLong(w.WinHandle, GWL_STYLE) and WS_CHILD) = 0 then
@@ -908,8 +1016,7 @@ begin
     WM_MOUSEWHEEL:
         begin
           {$IFDEF DEBUG}
-            write(w.ClassName + ': ');
-            writeln('WM_MOUSEWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8));
+            SendDebugFmt('%s: WM_MOUSEWHEEL: wp=%s  lp=%s', [w.ClassName, IntToHex(wparam,8), IntToHex(lparam,8)]);
           {$ENDIF}
           pt.x := GET_X_LPARAM(lParam);
           pt.y := GET_Y_LPARAM(lParam);
@@ -941,7 +1048,7 @@ begin
     WM_ACTIVATE:  // We currently use WM_NCACTIVATE instead!
         begin
           {$IFDEF DEBUG}
-            writeln(w.ClassName + ': WM_ACTIVATE');
+            SendDebug(w.ClassName + ': WM_ACTIVATE');
           {$ENDIF}
           if (Lo(wParam) = WA_INACTIVE) then
             fpgSendMessage(nil, w, FPGM_DEACTIVATE)
@@ -955,11 +1062,19 @@ begin
           Result := 0;
         end;
 
+    WM_TIMECHANGE:
+        begin
+          {$IFDEF DEBUG}
+          SendDebug(w.ClassName + ': WM_TIMECHANGE');
+          {$ENDIF}
+          writeln('fpGUI/GDI: ' + w.ClassName + ': WM_TIMECHANGE');
+          fpgResetAllTimers;
+        end;
+
     WM_NCACTIVATE:
         begin
           {$IFDEF DEBUG}
-            write(w.ClassName + ': WM_NCACTIVATE ');
-            writeln(wParam);
+            SendDebugFmt('%s: WM_NCACTIVATE wparam=%d', [w.ClassName, wParam]);
           {$ENDIF}
           if (wParam = 0) then
             fpgSendMessage(nil, w, FPGM_DEACTIVATE)
@@ -969,7 +1084,7 @@ begin
           if (PopupListFirst <> nil) and (PopupListFirst.Visible) then
           begin
             {$IFDEF DEBUG}
-            writeln(' Blockmsg = True (part 1) : ' + PopupListFirst.ClassName);
+            SendDebug(' Blockmsg = True (part 1) : ' + PopupListFirst.ClassName);
             {$ENDIF}
             // This is ugly but needed for now to get TfpgCombobox to work
             if (PopupListFirst.ClassName <> 'TDropDownWindow') then
@@ -1002,8 +1117,7 @@ begin
     WM_CLOSE:
         begin
           {$IFDEF DEBUG}
-            write(w.ClassName + ': ');
-            writeln('WM_Close');
+            SendDebug(w.ClassName + ': WM_Close');
           {$ENDIF}
           fpgSendMessage(nil, w, FPGM_CLOSE, msgp);
         end;
@@ -1011,8 +1125,7 @@ begin
     WM_PAINT:
         begin
           {$IFDEF DEBUG}
-            write(w.ClassName + ': ');
-            writeln('WM_PAINT');
+            SendDebug(w.ClassName + ': WM_PAINT');
           {$ENDIF}
           Windows.BeginPaint(w.WinHandle, @PaintStruct);
           fpgSendMessage(nil, w, FPGM_PAINT, msgp);
@@ -1060,6 +1173,13 @@ begin
   Result.Sort;
 end;
 
+procedure TfpgGDIApplication.SetDrag(const AValue: TfpgGDIDrag);
+begin
+  if Assigned(FDrag) then
+    FDrag.Free;
+  FDrag := AValue;
+end;
+
 function TfpgGDIApplication.GetHiddenWindow: HWND;
 begin
   if (FHiddenWindow = 0) then
@@ -1137,6 +1257,8 @@ end;
 
 destructor TfpgGDIApplication.Destroy;
 begin
+  if Assigned(FDrag) then
+    FDrag.Free;
   UnhookWindowsHookEx(ActivationHook);
   inherited Destroy;
 end;
@@ -1163,6 +1285,8 @@ begin
 
   if (atimeoutms >= 0) and (not DoMessagesPending) then
   begin
+    if Assigned(FOnIdle) then
+      OnIdle(self);
     if atimeoutms > 0 then
       timerid := Windows.SetTimer(ltimerWnd, 1, atimeoutms, nil)
     else
@@ -1229,7 +1353,153 @@ end;
 var
   // this are required for Windows MouseEnter & MouseExit detection.
   uLastWindowHndl: TfpgWinHandle;
-  
+
+procedure TfpgGDIWindow.HandleDNDLeave(Sender: TObject);
+var
+  wg: TfpgWidget;
+begin
+  {$IFDEF DND_DEBUG}
+  writeln('TfpgGDIWindow.HandleDNDLeave ');
+  {$ENDIF}
+  FUserMimeSelection := '';
+  wg := self as TfpgWidget;
+  if wg.AcceptDrops then  { if we get here, this should always be true anyway }
+  begin
+    if Assigned(wg.OnDragLeave) then
+      wg.OnDragLeave(nil);
+  end;
+end;
+
+procedure TfpgGDIWindow.HandleDNDEnter(Sender: TObject; DataObj: IDataObject;
+    KeyState: Longint; PT: TPoint; var Effect: DWORD);
+var
+  wg: TfpgWidget;
+  lMimeList: TStringList;
+  lMimeChoice: TfpgString;
+  lAccept: Boolean;
+  lDropAction: TfpgDropAction;
+  EnumIntf: IEnumFORMATETC;
+  msgp: TfpgMessageParams;
+begin
+  {$IFDEF DND_DEBUG}
+  writeln('TfpgGDIWindow.HandleDNDEnter ');
+  {$ENDIF}
+  wg := self as TfpgWidget;
+  if wg.AcceptDrops then
+  begin
+    lAccept := False;
+
+    { enumerate the available formats and return them as a StringList }
+    lMimeList := EnumDataToStringList(DataObj);
+    try
+      if lMimeList.Count > 0 then
+        lMimeChoice := lMimeList[0]
+      else
+        {$NOTE We need to replace this message with a resouce string }
+        raise Exception.Create('fpGUI/GDI: no mime types available for DND operation');
+
+      lDropAction := TranslateToFPGDropAction(Effect);
+      if Assigned(wg.OnDragEnter) then
+        wg.OnDragEnter(self, nil, lMimeList, lMimeChoice, lDropAction, lAccept);
+    finally
+      lMimeList.Free;
+    end;
+    if not lAccept then
+      Effect := DROPEFFECT_NONE
+    else
+    begin
+      Effect := TranslateToWinDragEffect(lDropAction);
+      FUserMimeSelection := lMimeChoice;
+      FUserAcceptDrag := True;
+    end;
+
+    { Notify widget of drag status, so it can update its look }
+    if lAccept then
+    begin
+      FDropPos.x := PT.x;
+      FDropPos.y := PT.y;
+      fillchar(msgp, sizeof(msgp), 0);
+      msgp.mouse.x := PT.x;
+      msgp.mouse.y := PT.y;
+      fpgPostMessage(nil, wg, FPGM_DROPENTER, msgp);
+    end;
+  end;
+end;
+
+procedure TfpgGDIWindow.HandleDNDPosition(Sender: TObject; KeyState: Longint; PT: TPoint; var Effect: TfpgOLEDragDropEffect);
+var
+  msgp: TfpgMessageParams;
+  wg: TfpgWidget;
+begin
+  wg := self as TfpgWidget;
+  { Notify widget of drag status, so it can update its look. We do the pos
+    check because OLE framework calls DragOver repeatedly even if the mouse
+    doesn't move, but simply because the mouse is over the widget. We don't
+    want that, for performance reasons. }
+  if FDropPos <> PT then
+  begin
+    {$IFDEF DND_DEBUG}
+    writeln('TfpgGDIWindow.HandleDNDPosition ');
+    {$ENDIF}
+    FDropPos.x := PT.x;
+    FDropPos.y := PT.y;
+    fillchar(msgp, sizeof(msgp), 0);
+    msgp.mouse.x := PT.x;
+    msgp.mouse.y := PT.y;
+    fpgPostMessage(nil, wg, FPGM_DROPENTER, msgp);
+  end;
+end;
+
+procedure TfpgGDIWindow.HandleDNDDrop(Sender: TObject; DataObj: IDataObject;
+    KeyState: Longint; PT: TPoint; Effect: TfpgOLEDragDropEffect);
+var
+  FE: FORMATETC;
+  stgmed: STGMEDIUM;
+  data: pchar;
+  wg: TfpgWidget;
+  CF: DWORD;
+  lIsTranslated: Boolean;
+begin
+  if not FUserAcceptDrag then
+    exit;
+
+  {$IFDEF DND_DEBUG}
+  Writeln('TfpgGDIWindow.HandleDNDDrop');
+  {$ENDIF}
+
+  wg := self as TfpgWidget;
+  { construct a FORMATETC object }
+  CF := WindowsClipboardLookup(FUserMimeSelection, lIsTranslated);
+  FE := GetFormatEtc(CF);
+
+  if DataObj.QueryGetData(FE) = S_OK then
+  begin
+    if DataObj.GetData(FE, stgmed) = S_OK then
+    begin
+      { Yippie! the data is there, so go get it! }
+      data := GlobalLock(stgmed.HGLOBAL);
+      if Assigned(wg.OnDragDrop) then
+        wg.OnDragDrop(self, nil, pt.x, pt.y, data);
+      GlobalUnlock(stgmed.HGLOBAL);
+      { release the data using the COM API }
+      ReleaseStgMedium(stgmed);
+    end;
+  end;
+end;
+
+function TfpgGDIWindow.GetDropManager: TfpgOLEDropTarget;
+begin
+  if not Assigned(FDropManager) then
+  begin
+    FDropManager := TfpgOLEDropTarget.Create(self);
+    FDropManager.OnDragLeave := @HandleDNDLeave;
+    FDropManager.OnDragEnter := @HandleDNDEnter;
+    FDropManager.OnDragOver  := @HandleDNDPosition;
+    FDropManager.OnDragDrop  := @HandleDNDDrop;
+  end;
+  Result := FDropManager;
+end;
+
 function TfpgGDIWindow.DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean;
 var
   pt, spt: Windows.POINT;
@@ -1392,8 +1662,12 @@ begin
   end
   else if WindowType = wtModalForm then
   begin
-    // set parent window to special hidden window. It helps to hide window taskbar button.
-    FParentWinHandle := wapplication.GetHiddenWindow;
+    if FocusRootWidget <> nil then
+      FParentWinHandle := FocusRootWidget.WinHandle
+    else
+      // set parent window to special hidden window. It helps to hide window taskbar button.
+      FParentWinHandle := wapplication.GetHiddenWindow;
+
     // for modal windows, this is necessary
     FWinStyle   := WS_OVERLAPPEDWINDOW or WS_POPUPWINDOW;
     FWinStyle   := FWinStyle and not (WS_MINIMIZEBOX);
@@ -1496,6 +1770,11 @@ begin
   // the forms require some adjustments before the Window appears
   SetWindowParameters;
   FSkipResizeMessage := False;
+
+  if QueueAcceptDrops then
+  begin
+    DoAcceptDrops(True);
+  end;
 end;
 
 procedure TfpgGDIWindow.DoReleaseWindowHandle;
@@ -1611,11 +1890,56 @@ begin
   SetCursor(hc);
 end;
 
+procedure TfpgGDIWindow.DoDNDEnabled(const AValue: boolean);
+begin
+  { GDI has nothing to do here }
+end;
+
+procedure TfpgGDIWindow.DoAcceptDrops(const AValue: boolean);
+begin
+  if AValue then
+  begin
+    if HasHandle then
+        DropManager.RegisterDragDrop
+    else
+      QueueAcceptDrops := True; // we need to do this once we have a winhandle
+  end
+  else
+  begin
+    if HasHandle then
+      DropManager.RevokeDragDrop;
+    QueueAcceptDrops := False;
+  end;
+end;
+
+procedure TfpgGDIWindow.DoDragStartDetected;
+begin
+  inherited DoDragStartDetected;
+  { In windows OLE dragging is a blocking function, so it never returns until
+    OnStartDragDetected is complete. So we need to set FDragActive to False
+    here. }
+  FDragActive := False;
+  if Assigned(wapplication.FDrag) then
+    FreeAndNil(wapplication.FDrag);
+end;
+
 constructor TfpgGDIWindow.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FWinHandle := 0;
+  FDropManager := nil;
+  FDropPos.x := 0;
+  FDropPos.y := 0;
   FFullscreenIsSet := false;
+  FUserMimeSelection := '';
+  FUserAcceptDrag := False;
+end;
+
+destructor TfpgGDIWindow.Destroy;
+begin
+  if Assigned(FDropManager) then
+    FDropManager.Free;
+  inherited Destroy;
 end;
 
 procedure TfpgGDIWindow.ActivateWindow;
@@ -2350,36 +2674,47 @@ begin
 end;
 
 procedure TfpgGDIClipboard.DoSetText(const AValue: TfpgString);
+var
+  mem: THandle;
+  po2: PWideChar;
+  str: PWideChar;
 begin
   FClipboardText := AValue;
-  if OpenClipboard(FClipboardWndHandle) then
+  if OpenClipboard(0) then
   begin
-    EmptyClipboard;
-    SetClipboardData(CF_TEXT, 0);
+    str := PWideChar(Utf8Decode(AValue));
+    if EmptyClipboard then
+    begin
+      // Allocate a global memory object for the text.
+      mem:= globalalloc(GMEM_MOVEABLE or GMEM_DDESHARE, (length(AValue)+1)*2);
+      if mem <> 0 then
+      begin
+        po2:= globallock(mem);
+        if po2 <> nil then
+        begin
+          move(str^, po2^, (length(AValue)+1)*2);
+          globalunlock(mem);
+          if SetClipboardData(CF_UNICODETEXT,longword(mem)) <> 0 then
+          begin
+            //writeln('Successfully copied to clipboard');
+          end;
+        end
+        else
+        begin
+          globalfree(mem);
+        end;
+      end;
+    end;
     CloseClipboard;
   end;
 end;
 
 procedure TfpgGDIClipboard.InitClipboard;
 begin
-  {$WARNING This does not work! 'FPGUI' window class was not registered,
-  so CreateWindowEx always returns 0}
-  FClipboardWndHandle := Windows.CreateWindowEx(
-      0,            // extended window style
-      'FPGUI',      // registered class name
-      nil,          // window name
-      0,            // window style
-      0,            // horizontal position of window
-      0,            // vertical position of window
-      10,           // window width
-      10,           // window height
-      0,            // handle to parent or owner window
-      0,            // menu handle or child identifier
-      MainInstance, // handle to application instance
-      nil           // window-creation data
-      );
+  // nothing to do here
 end;
 
+
 { TfpgGDIFileList }
 
 function TfpgGDIFileList.EncodeAttributesString(attrs: longword
@@ -2440,9 +2775,196 @@ begin
   inherited PopulateSpecialDirs(aDirectory);
 end;
 
+{ TfpgGDIDrag }
+
+function TfpgGDIDrag.StringToHandle(const AString: TfpgString): HGLOBAL;
+var
+  dest: HGLOBAL;
+  l: integer;
+  p: PChar;
+begin
+  p := PChar(AString);
+  l := Length(AString)+1;
+  { allocate and lock a global memory buffer. Make it fixed
+    data so we don't have to use GlobalLock }
+  dest := GlobalAlloc(GMEM_FIXED, l);
+  { Copy the string into the buffer }
+  Move(p^, PChar(dest)^, l);
+  Result := dest;
+end;
+
+function TfpgGDIDrag.GetSource: TfpgGDIWindow;
+begin
+  Result := FSource;
+end;
+
+destructor TfpgGDIDrag.Destroy;
+begin
+  {$IFDEF DND_DEBUG}
+  writeln('TfpgGDIDrag.Destroy ');
+  {$ENDIF}
+  inherited Destroy;
+end;
+
+function TfpgGDIDrag.Execute(const ADropActions: TfpgDropActions; const ADefaultAction: TfpgDropAction): TfpgDropAction;
+var
+  dwEffect: DWORD;
+  dwResult: HRESULT;
+  i: Integer;
+  F: PFormatEtc;
+  S: string;
+  M: PStgMedium;
+  itm: TfpgMimeDataItem;
+  lEffects: DWORD;
+  FDataObject: TfpgOLEDataObject;
+  FDropSource: TfpgOLEDropSource;
+  lIsTranslated: boolean;
+begin
+  { TODO: this still needs to be implemented }
+  if FDragging then
+  begin
+    {$IFDEF DND_DEBUG}
+    writeln('TfpgGDIDrag.Execute (already dragging)');
+    {$ENDIF}
+    Result := daIgnore;
+  end
+  else
+  begin
+    {$IFDEF DND_DEBUG}
+    writeln('TfpgGDIDrag.Execute (new drag)');
+    {$ENDIF}
+    FDragging := True;
+    wapplication.Drag := self;
+    lEffects := TranslateToWinDragEffects(ADropActions);
+    FDataObject := TfpgOLEDataObject.Create;
+
+    for i := 0 to FMimeData.Count-1 do
+    begin
+      F := nil;
+      M := nil;
+      lIsTranslated := False;
+      {$Note OLE DND: We are only handling strings at the moment, this needs to be extended to other types too }
+      itm := FMimeData[i];
+      {$IFDEF DND_DEBUG}
+      writeln('  Processing mime-type: ', itm.Format);
+      {$ENDIF}
+
+      { description of data we are sending }
+      New(F);
+      F^.cfFormat := WindowsClipboardLookup(itm.format, lIsTranslated);
+      F^.ptd := nil;
+      F^.dwAspect := DVASPECT_CONTENT;
+      F^.lindex := -1;
+      F^.tymed := TYMED_HGLOBAL;
+      FDataObject.FormatEtcList.Add(F);
+
+      { storage for data we are sending }
+      s := itm.data;
+      New(M);
+      M^.tymed := TYMED_HGLOBAL;
+      M^.hGlobal := StringToHandle(s);
+      FDataObject.StgMediumList.Add(M);
+
+      { Original mime type was translated to a known Windows CF_ formats, add
+        mimetype string as-is as well }
+      if lIsTranslated then
+      begin
+        New(F);
+        F^.cfFormat := RegisterClipboardFormat(PChar(itm.format));
+        F^.ptd := nil;
+        F^.dwAspect := DVASPECT_CONTENT;
+        F^.lindex := -1;
+        F^.tymed := TYMED_HGLOBAL;
+        FDataObject.FormatEtcList.Add(F);
+
+        { storage for data we are sending }
+        s := itm.data;
+        New(M);
+        M^.tymed := TYMED_HGLOBAL;
+        M^.hGlobal := StringToHandle(s);
+        FDataObject.StgMediumList.Add(M);
+      end;
+    end;
+
+    { Now let OLE take over from here }
+    FDropSource := TfpgOLEDropSource.Create;
+    dwResult := ActiveX.DoDragDrop( FDataObject as IDataObject,
+                                    FDropSource as IDropSource,
+                                    lEffects,
+                                    @dwEffect);
+    Result := TranslateToFPGDropAction(dwEffect);
+
+    if dwResult = DRAGDROP_S_DROP then
+    begin
+      { which action did the user select, and act accordingly }
+      if dwEffect = DROPEFFECT_COPY then
+      begin
+        // nothing to do here
+      end;
+      if dwEffect = DROPEFFECT_MOVE then
+      begin
+        // Sowehow we need to remove the data from source
+      end;
+    end;
+
+//    (FDropSource as IUnknown)._Release;
+//    (FDataObject as IUnknown)._Release;
+  end;
+end;
+
+{ TGDIDragManager }
+
+function TGDIDragManager.DragEnter(const dataObj: IDataObject;
+  grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult; StdCall;
+begin
+
+end;
+
+function TGDIDragManager.DragOver(grfKeyState: DWORD; pt: TPoint;
+  var dwEffect: DWORD): HResult; StdCall;
+begin
+
+end;
+
+function TGDIDragManager.DragLeave: HResult; StdCall;
+begin
+
+end;
+
+function TGDIDragManager.Drop(const dataObj: IDataObject; grfKeyState: DWORD;
+  pt: TPoint; var dwEffect: DWORD): HResult; StdCall;
+begin
+
+end;
+
+constructor TGDIDragManager.Create(ADropTarget: TfpgWindowBase);
+begin
+  inherited Create;
+  FDropTarget := ADropTarget;
+  FRegistered := False;
+end;
+
+destructor TGDIDragManager.Destroy;
+begin
+  if FRegistered then
+    RevokeDragDrop;
+  inherited Destroy;
+end;
+
+procedure TGDIDragManager.RegisterDragDrop;
+begin
+  Activex.RegisterDragDrop(TfpgWidget(FDropTarget).WinHandle, self as IDropTarget)
+end;
+
+procedure TGDIDragManager.RevokeDragDrop;
+begin
+  ActiveX.RevokeDragDrop(TfpgWidget(FDropTarget).WinHandle);
+end;
+
 initialization
   wapplication   := nil;
   MouseFocusedWH := 0;
+  NeedToUnitialize := Succeeded(OleInitialize(nil));
 
 {$IFDEF WinCE}
   UnicodeEnabledOS := True;
@@ -2460,5 +2982,9 @@ initialization
       FontSmoothingType := ANTIALIASED_QUALITY;
 {$ENDIF}
 
+finalization
+  if NeedToUnitialize then
+    OleUninitialize;
+
 end.
 
diff --git a/src/corelib/gdi/fpg_interface.pas b/src/corelib/gdi/fpg_interface.pas
index c75aaa28..ef58e46d 100644
--- a/src/corelib/gdi/fpg_interface.pas
+++ b/src/corelib/gdi/fpg_interface.pas
@@ -33,6 +33,8 @@ type
   TfpgApplicationImpl   = TfpgGDIApplication;
   TfpgClipboardImpl     = TfpgGDIClipboard;
   TfpgFileListImpl      = TfpgGDIFileList;
+  TfpgMimeDataImpl      = TfpgGDIMimeDataBase;
+  TfpgDragImpl          = TfpgGDIDrag;
 
 implementation
 
diff --git a/src/corelib/gdi/fpg_oledragdrop.pas b/src/corelib/gdi/fpg_oledragdrop.pas
new file mode 100644
index 00000000..fa17ba67
--- /dev/null
+++ b/src/corelib/gdi/fpg_oledragdrop.pas
@@ -0,0 +1,1061 @@
+{

+    fpGUI  -  Free Pascal GUI Toolkit

+

+    Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this

+    distribution, for details of the copyright.

+

+    See the file COPYING.modifiedLGPL, included in this distribution,

+    for details about redistributing fpGUI.

+

+    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.

+

+    Description:

+      This unit implements the OLE Drag-n-Drop functionality of Windows.

+      This unit is implemented based on the articles posted on

+        http://www.catch22.net/tuts/dragdrop/

+}

+unit fpg_OLEDragDrop;

+

+{$mode delphi}{$H+}

+

+interface

+

+uses

+  Windows, Classes, ActiveX, ShellAPI, fpg_base;

+

+const

+  CFSTR_FILENAMEMAPA          = 'FileNameMap';            { CF_FILENAMEMAPA }

+  CFSTR_FILENAMEMAP           = CFSTR_FILENAMEMAPA;

+  CFSTR_FILEDESCRIPTORA       = 'FileGroupDescriptor';    { CF_FILEGROUPDESCRIPTORA }

+  CFSTR_FILEDESCRIPTOR        = CFSTR_FILEDESCRIPTORA;

+  CFSTR_FILECONTENTS          = 'FileContents';           { CF_FILECONTENTS }

+

+type

+  TfpgOLEFormatEtcList = class(TList)

+  private

+    function    GetFormatEtc(Index: Integer): PFormatEtc;

+  protected

+    procedure   Notify(Ptr: Pointer; Action: TListNotification); override;

+  public

+    constructor CreateCopy(AFormatEtcList: TfpgOLEFormatEtcList);

+    property    FormatEtc[Index: Integer]: PFormatEtc read GetFormatEtc; default;

+  end;

+

+

+  TfpgOLEStgMediumList = class(TList)

+  private

+    function    GetStgMedium(Index: Integer): PStgMedium;

+  protected

+    procedure   Notify(Ptr: Pointer; Action: TListNotification); override;

+  public

+    property    StgMedium[Index: Integer]: PStgMedium read GetStgMedium; default;

+  end;

+

+

+  TfpgOLEDropSource = class(TInterfacedObject, IDropSource)

+  private

+    { IDropSource }

+    function    QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;

+    function    GiveFeedback(dwEffect: Longint): HResult; stdcall;

+  end;

+

+

+  TfpgOLEDragDropEffect = (deNone, deCopy, deMove, deLink);

+  TfpgOLEDragEnterEvent = procedure(Sender: TObject; DataObj: IDataObject; KeyState: Longint; PT: TPoint; var Effect: DWORD) of object;

+  TfpgOLEDragOverEvent = procedure(Sender: TObject; KeyState: Longint; PT: TPoint; var Effect: TfpgOLEDragDropEffect) of object;

+  TfpgOLEDragDropEvent = procedure(Sender: TObject; DataObj: IDataObject; KeyState: Longint; PT: TPoint; Effect: TfpgOLEDragDropEffect) of object;

+

+

+  TfpgOLEDropTarget = class(TObject, IInterface, IDropTarget)

+  private

+    FDropTarget: TfpgWindowBase;

+    FRegistered: Boolean;

+    FOnDragEnter: TfpgOLEDragEnterEvent;

+    FOnDragOver: TfpgOLEDragOverEvent;

+    FOnDragLeave: TNotifyEvent;

+    FOnDragDrop: TfpgOLEDragDropEvent;

+  private

+    { IInterface }

+    function    QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

+    function    _AddRef: Integer; stdcall;

+    function    _Release: Integer; stdcall;

+    { IDropTarget }

+    function    DragEnter(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;StdCall;

+    function    DragOver(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult; stdcall;

+    function    DragLeave: HResult; stdcall;

+    function    Drop(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult; stdcall;

+  protected

+    procedure   DoDragEnter(DataObj: IDataObject; KeyState: Longint; PT: TPoint; var Effect: DWORD); virtual;

+    procedure   DoDragOver(KeyState: Longint; PT: TPoint; var Effect: TfpgOLEDragDropEffect); virtual;

+    procedure   DoDragLeave;

+    procedure   DoDragDrop(DataObj: IDataObject; KeyState: Longint; PT: TPoint; Effect: TfpgOLEDragDropEffect); virtual;

+  public

+    property    OnDragEnter: TfpgOLEDragEnterEvent read FOnDragEnter write FOnDragEnter;

+    property    OnDragOver: TfpgOLEDragOverEvent read FOnDragOver write FOnDragOver;

+    property    OnDragLeave: TNotifyEvent read FOnDragLeave write FOnDragLeave;

+    property    OnDragDrop: TfpgOLEDragDropEvent read FOnDragDrop write FOnDragDrop;

+  public

+    constructor Create(ADropTargetWidget: TfpgWindowBase); reintroduce; { Actually a TfpgWidget }

+    destructor  Destroy; override;

+    procedure   RegisterDragDrop;

+    procedure   RevokeDragDrop;

+    property    DropTarget: TfpgWindowBase read FDropTarget;

+  end;

+

+

+  TfpgOLEDataObject = class(TInterfacedObject, IDataObject)

+  private

+    FFormatEtcList: TfpgOLEFormatEtcList;

+    FStgMediumList: TfpgOLEStgMediumList;

+    function    LookupFormatEtc(AFormat: TFormatEtc): Integer;

+  protected

+    { IDataObject }

+    function    GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;

+    function    GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;

+    function    QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;

+    function    GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall;

+    function    SetData(const formatetc: TFormatEtc; const medium: TStgMedium; fRelease: BOOL): HResult; stdcall;

+    function    EnumFormatEtc(dwDirection: DWORD; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;

+    function    DAdvise(const formatetc: TFormatEtc; advf: DWORD; const advSink: IAdviseSink; out dwConnection: DWORD): HResult; stdcall;

+    function    DUnadvise(dwConnection: DWORD): HResult; stdcall;

+    function    EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;

+  public

+    constructor Create; overload;

+    constructor Create(AFormatEtcList: TfpgOLEFormatEtcList); overload;

+    destructor  Destroy; override;

+    property    FormatEtcList: TfpgOLEFormatEtcList read FFormatEtcList;

+    property    StgMediumList: TfpgOLEStgMediumList read FStgMediumList;

+  end;

+

+

+  TfpgOLEEnumFormatEtc = class(TInterfacedObject, IEnumFORMATETC)

+  private

+    FFormatEtcList: TfpgOLEFormatEtcList;

+    FIndex: Integer;

+  protected

+    { IEnumFORMATETC }

+    function    Next(celt: ULong; out elt:FormatEtc; pceltFetched: pULong=nil): HResult; stdcall;

+    function    Skip(celt: ULong): HResult; stdcall;

+    function    Reset: HResult; stdcall;

+    function    Clone(out Enum: IEnumFormatEtc): HResult; stdcall;

+  public

+    constructor Create(AFormatEtcList: TfpgOLEFormatEtcList);

+    destructor  Destroy; override;

+  end;

+

+

+  TDragFilesSource = class(TObject)

+  private

+    FFileNames: TStrings;

+    FAliasFileNames: TStrings;

+    function    GetAliasFileNames: TStrings;

+    function    GetSourceFileNames: TStrings;

+    procedure   SetAliasFileNames(const Value: TStrings);

+    procedure   SetSourceFileNames(const Value: TStrings);

+  public

+    constructor Create;

+    destructor  Destroy; override;

+    procedure   Execute;

+    property    SourceFileNames: TStrings read GetSourceFileNames write SetSourceFileNames;

+    property    AliasFileNames: TStrings read GetAliasFileNames write SetAliasFileNames;

+  end;

+

+

+  TDragAcceptFilesEvent = function(Sender: TObject; FileNames: TStrings): Boolean of object;

+  TDragAcceptPositionEvent = function(Sender: TObject; PT: TPoint): Boolean of object;

+  TDropFilesEvent = procedure(Sender: TObject; PT: TPoint; FileNames: TStrings) of object;

+

+

+  TDragFilesTarget = class(TfpgOLEDropTarget)

+  private

+    FDragAcceptFiles: Boolean;

+    FOnDragAcceptFiles: TDragAcceptFilesEvent;

+    FOnDragAcceptPosition: TDragAcceptPositionEvent;

+    FOnDropFiles: TDropFilesEvent;

+    procedure   GetFileNamesFromDropHandle(DropHandle: HDROP; SL: TStrings);

+    procedure   StreamToFile(Stream: IStream; const FileName: string);

+  protected

+    function    DoDragAcceptFiles(DataObj: IDataObject): Boolean;

+    function    DoDragAcceptPosition(PT: TPoint): Boolean;

+    procedure   DoDropFiles(DataObj: IDataObject; PT: TPoint);

+    procedure   DoDragEnter(DataObj: IDataObject; KeyState: Longint; PT: TPoint; var Effect: DWORD); override;

+    procedure   DoDragOver(KeyState: Longint; PT: TPoint; var Effect: TfpgOLEDragDropEffect); override;

+    procedure   DoDragDrop(DataObj: IDataObject; KeyState: Longint; PT: TPoint; Effect: TfpgOLEDragDropEffect); override;

+  public

+    property    OnDragAcceptFiles: TDragAcceptFilesEvent read FOnDragAcceptFiles write FOnDragAcceptFiles;

+    property    OnDragAcceptPosition: TDragAcceptPositionEvent read FOnDragAcceptPosition write FOnDragAcceptPosition;

+    property    OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;

+  end;

+

+

+function WindowsMimeLookup(const CFFormat: string): string;

+function WindowsClipboardLookup(const AMime: string; var IsTranslated: Boolean): DWORD;

+function EnumDataToStringList(DataObj: IDataObject): TStringList;

+function GetFormatEtc(const CFFormat: DWORD): FORMATETC;

+

+implementation

+

+uses

+  SysUtils, ShlObj, fpg_widget;

+

+var

+  CF_FILENAMEMAP: Cardinal;

+  CF_FILEDESCRIPTOR: Cardinal;

+  CF_FILECONTENTS: Cardinal;

+

+

+function WindowsMimeLookup(const CFFormat: string): string;

+begin

+  { replace know clipboard formats with mime types }

+  if CFFormat = 'CF_TEXT' then

+    Result := 'text/plain'

+  else if CFFormat = 'CF_UNICODETEXT' then

+    Result := 'text/plain'

+  else if CFFormat = 'CF_OEMTEXT' then

+    Result := 'text/plain'

+  else if CFFormat = 'CF_HDROP' then

+    Result := 'text/uri-list'

+  else if CFFormat = 'CF_RICHTEXT' then

+    Result := 'text/html'

+  else

+    Result := CFFormat;

+end;

+

+function WindowsClipboardLookup(const AMime: string; var IsTranslated: Boolean): DWORD;

+begin

+  { TODO: We need to improve this implementation }

+  if AMime = 'text/html' then

+  begin

+    { We don't want duplicate CF_TEXT in DataObject, so register some of our

+      known convenience types (from TfpgMimeData) as-is }

+    IsTranslated := False;

+    Result := RegisterClipboardFormat('text/html');

+  end

+  else if Pos('text/', AMime) = 1 then

+  begin

+    IsTranslated := True;

+    Result := CF_TEXT;  // fallback result

+  end

+  else

+  begin

+    IsTranslated := False;

+    Result := RegisterClipboardFormat(PChar(AMime));

+  end;

+end;

+

+function WindowsClipboardFormatToString(const CFFormat: integer): string;

+begin

+  { replace know clipboard formats with mime types }

+  case CFFormat of

+    CF_DIF          : result := 'CF_DIF';

+    CF_DIB          : result := 'CF_DIB';

+    CF_TEXT         : result := 'CF_TEXT';

+    CF_SYLK         : result := 'CF_SYLK';

+    CF_TIFF         : result := 'CF_TIFF';

+    CF_RIFF         : result := 'CF_RIFF';

+    CF_WAVE         : result := 'CF_WAVE';

+    CF_HDROP        : result := 'CF_HDROP';

+    CF_BITMAP       : result := 'CF_BITMAP';

+    CF_LOCALE       : result := 'CF_LOCALE';

+    CF_OEMTEXT      : result := 'CF_OEMTEXT';

+    CF_PALETTE      : result := 'CF_PALETTE';

+    CF_PENDATA      : result := 'CF_PENDATA';

+    CF_UNICODETEXT  : result := 'CF_UNICODETEXT';

+    CF_ENHMETAFILE  : result := 'CF_ENHMETAFILE';

+    CF_METAFILEPICT : result := 'CF_METAFILEPICT';

+    else

+      Result := Format('unknown (%d)', [CFFormat]);

+  end;

+end;

+

+function EnumDataToStringList(DataObj: IDataObject): TStringList;

+var

+	FE: FORMATETC;

+	EnumFormats: IEnumFORMATETC;

+	num: integer;

+  lname: string;

+  lMimeName: string;

+  FormatName: array[0..MAX_PATH] of Char;

+  i: integer;

+begin

+  if DataObj.EnumFormatEtc(DATADIR_GET, EnumFormats) <> S_OK then

+    raise Exception.Create('EnumDataToStringList: Failed to get EnumFormatEtc interface');

+

+  Result := TStringList.Create;

+  EnumFormats.Reset;

+  while EnumFormats.Next(1, FE, @num) = S_OK do

+  begin

+    lName := '';

+    i := GetClipboardFormatName(FE.cfFormat,FormatName,MAX_PATH);

+    if i <> 0 then

+    begin

+      lName := FormatName;

+    end

+    else

+    begin

+      lName := WindowsClipboardFormatToString(FE.cfFormat);

+    end;

+    Result.Add(lName);

+  end;

+end;

+

+function GetFormatEtc(const CFFormat: DWORD): FORMATETC;

+begin

+  Result.CfFormat := CFFormat;

+  Result.Ptd := nil;

+  Result.dwAspect := DVASPECT_CONTENT;

+  Result.lindex := -1;

+  Result.tymed := TYMED_HGLOBAL;

+end;

+

+procedure DeepCopyFormatEtc(P1, P2: PFormatEtc);

+begin

+  P2^ := P1^;

+  if P1^.ptd <> nil then begin

+    P2^.ptd := CoTaskMemAlloc(SizeOf(tagDVTARGETDEVICE));

+    P2^.ptd^ := P1^.ptd^;

+  end;

+end;

+

+function DupGlobalMem(hMem: HGLOBAL): HGLOBAL;

+var

+  len: DWORD;

+  Source: Pointer;

+  Dest: HGLOBAL;

+begin

+  len := GlobalSize(hMem);

+  Source := GlobalLock(hMem);

+  Dest := GlobalAlloc(GMEM_FIXED, len);

+  Move(Source^, Pointer(Dest)^, len);

+  GlobalUnlock(hMem);

+  Result := Dest;

+end;

+

+{ TDragFilesSource }

+

+constructor TDragFilesSource.Create;

+begin

+  inherited Create;

+  FFileNames := TStringList.Create;

+  FAliasFileNames := TStringList.Create;

+end;

+

+destructor TDragFilesSource.Destroy;

+begin

+  FreeAndNil(FFileNames);

+  FreeAndNil(FAliasFileNames);

+  inherited Destroy;

+end;

+

+procedure TDragFilesSource.Execute;

+var

+  DataObject: TfpgOLEDataObject;

+  DropSource: TfpgOLEDropSource;

+  dwEffect: DWORD;

+  dwResult: HRESULT;

+  I: Integer;

+  F: PFormatEtc;

+  S: string;

+  M: PStgMedium;

+begin

+  DataObject := TfpgOLEDataObject.Create;

+

+  { append filenames as one long string delimited by #0. ie: something like a PChar }

+  S := '';

+  for I := 0 to FFileNames.Count - 1 do

+  begin

+    SetLength(S, Length(S)+Length(FFileNames[I])+1);

+    Move(FFileNames[I][1], S[Length(S)-Length(FFileNames[I])], Length(FFileNames[I]));

+    S[Length(S)] := #0;

+  end;

+  SetLength(S, Length(S)+1);

+  S[Length(S)] := #0;

+

+  { description of data we are sending }

+  New(F);

+  F^.cfFormat := CF_HDROP;

+  F^.ptd := nil;

+  F^.dwAspect := DVASPECT_CONTENT;

+  F^.lindex := -1;

+  F^.tymed := TYMED_HGLOBAL;

+  DataObject.FormatEtcList.Add(F);

+

+  { storage for data we are sending }

+  New(M);

+  M^.tymed := TYMED_HGLOBAL;

+  M^.hGlobal := Cardinal(GlobalAlloc(GMEM_FIXED, SizeOf(TDropFiles)+Length(S)));

+  PDropFiles(M^.hGlobal)^.pFiles := SizeOf(TDropFiles);

+  PDropFiles(M^.hGlobal)^.pt := Point(0,0);

+  PDropFiles(M^.hGlobal)^.fNC := FALSE;

+  PDropFiles(M^.hGlobal)^.fWide := FALSE;

+  Move(S[1], PChar(M^.hGlobal+SizeOf(TDropFiles))^, Length(S));

+  DataObject.StgMediumList.Add(M);

+

+  if (FAliasFileNames.Count > 0) and (FAliasFileNames.Count = FFileNames.Count) then

+  begin

+    { append filename aliases as one long string delimited by #0. ie: something like a PChar }

+    S := '';

+    for I := 0 to FAliasFileNames.Count - 1 do

+    begin

+      SetLength(S, Length(S)+Length(FAliasFileNames[I])+1);

+      Move(FAliasFileNames[I][1], S[Length(S)-Length(FAliasFileNames[I])], Length(FAliasFileNames[I]));

+      S[Length(S)] := #0;

+    end;

+    SetLength(S, Length(S)+1);

+    S[Length(S)] := #0;

+

+    { description of data we are sending }

+    New(F);

+    F^.cfFormat := CF_FILENAMEMAP;

+    F^.ptd := nil;

+    F^.dwAspect := DVASPECT_CONTENT;

+    F^.lindex := -1;

+    F^.tymed := TYMED_HGLOBAL;

+    DataObject.FormatEtcList.Add(F);

+

+    { storage for data we are sending }

+    New(M);

+    M^.tymed := TYMED_HGLOBAL;

+    M^.hGlobal := Cardinal(GlobalAlloc(GMEM_FIXED, Length(S)));

+    Move(S[1], PChar(M^.hGlobal)^, Length(S));

+    DataObject.StgMediumList.Add(M);

+  end;

+

+  DropSource := TfpgOLEDropSource.Create;

+  dwResult := ActiveX.DoDragDrop(DataObject as IDataObject, DropSource as IDropSource, DROPEFFECT_COPY, @dwEffect);

+

+  if dwResult = DRAGDROP_S_DROP then

+  begin

+    if dwEffect = DROPEFFECT_COPY then

+    begin

+      // nothing to do. If this whas xxx_MOVE, we would remove data from source

+    end;

+  end;

+end;

+

+function TDragFilesSource.GetAliasFileNames: TStrings;

+begin

+  Result := FAliasFileNames;

+end;

+

+function TDragFilesSource.GetSourceFileNames: TStrings;

+begin

+  Result := FFileNames;

+end;

+

+procedure TDragFilesSource.SetAliasFileNames(const Value: TStrings);

+begin

+  FAliasFileNames.Assign(Value);

+end;

+

+procedure TDragFilesSource.SetSourceFileNames(const Value: TStrings);

+begin

+  FFileNames.Assign(Value);

+end;

+

+{ TfpgOLEDropSource }

+

+function TfpgOLEDropSource.GiveFeedback(dwEffect: Integer): HResult;

+begin

+  Result := DRAGDROP_S_USEDEFAULTCURSORS;

+end;

+

+function TfpgOLEDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Integer): HResult;

+begin

+  if FEscapePressed then

+    Result := DRAGDROP_S_CANCEL

+  else if (grfKeyState and (MK_LBUTTON or MK_RBUTTON) = 0) then

+    Result := DRAGDROP_S_DROP

+  else

+    Result := S_OK;

+  {$IFDEF DND_DEBUG}

+  writeln('TfpgOLEDropSource.QueryContinueDrag  Result = ', Result);

+  {$ENDIF}

+end;

+

+{ TfpgOLEDataObject }

+

+constructor TfpgOLEDataObject.Create(AFormatEtcList: TfpgOLEFormatEtcList);

+begin

+  inherited Create;

+  FFormatEtcList := TfpgOLEFormatEtcList.CreateCopy(AFormatEtcList);

+  FStgMediumList := TfpgOLEStgMediumList.Create;

+end;

+

+constructor TfpgOLEDataObject.Create;

+begin

+  inherited Create;

+  FFormatEtcList := TfpgOLEFormatEtcList.Create;

+  FStgMediumList := TfpgOLEStgMediumList.Create;

+end;

+

+function TfpgOLEDataObject.DAdvise(const formatetc: TFormatEtc; advf: DWORD;

+  const advSink: IAdviseSink; out dwConnection: DWORD): HResult;

+begin

+  Result := OLE_E_ADVISENOTSUPPORTED;

+end;

+

+destructor TfpgOLEDataObject.Destroy;

+begin

+  FreeAndNil(FFormatEtcList);

+  FreeAndNil(FStgMediumList);

+  inherited Destroy;

+end;

+

+function TfpgOLEDataObject.DUnadvise(dwConnection: DWORD): HResult;

+begin

+  Result := OLE_E_ADVISENOTSUPPORTED;

+end;

+

+function TfpgOLEDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;

+begin

+  Result := OLE_E_ADVISENOTSUPPORTED;

+end;

+

+function TfpgOLEDataObject.EnumFormatEtc(dwDirection: DWORD;

+  out enumFormatEtc: IEnumFormatEtc): HResult;

+begin

+  if dwDirection = DATADIR_GET then

+  begin

+    enumFormatEtc := TfpgOLEEnumFormatEtc.Create(FFormatEtcList) as IEnumFormatEtc;

+    Result := S_OK;

+  end

+  else begin

+    Result := E_NOTIMPL;

+  end;

+end;

+

+function TfpgOLEDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc;

+  out formatetcOut: TFormatEtc): HResult;

+begin

+  // Apparently we have to set this field to NULL even though we don't do anything else

+  formatetcOut.ptd := nil;

+  Result := E_NOTIMPL;

+end;

+

+function TfpgOLEDataObject.GetData(const formatetcIn: TFormatEtc;

+  out medium: TStgMedium): HResult;

+var

+  Idx: Integer;

+begin

+  Idx := LookupFormatEtc(formatetcIn);

+  if Idx = -1 then

+    Result := DV_E_FORMATETC

+  else

+  begin

+    medium.tymed := FFormatEtcList[Idx]^.tymed;

+    medium.PUnkForRelease := nil;

+    if medium.tymed = TYMED_HGLOBAL then

+    begin

+      medium.hGlobal := DupGlobalMem(FStgMediumList[Idx]^.hGlobal);

+      Result := S_OK;

+    end

+    else

+      Result := DV_E_FORMATETC;

+  end;

+end;

+

+function TfpgOLEDataObject.GetDataHere(const formatetc: TFormatEtc;

+  out medium: TStgMedium): HResult;

+begin

+  Result := DV_E_FORMATETC;

+end;

+

+function TfpgOLEDataObject.LookupFormatEtc(AFormat: TFormatEtc): Integer;

+var

+  I: Integer;

+begin

+  Result := -1;

+  for I := 0 to FFormatEtcList.Count - 1 do begin

+    if (FFormatEtcList[I]^.cfFormat = AFormat.cfFormat) and

+       (FFormatEtcList[I]^.dwAspect = AFormat.dwAspect) and

+       (FFormatEtcList[I]^.tymed = AFormat.tymed) then begin

+      Result := I;

+      Break;

+    end;

+  end;

+end;

+

+function TfpgOLEDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;

+begin

+  if LookupFormatEtc(formatetc) >= 0 then begin

+    Result := S_OK;

+  end

+  else begin

+    Result := DV_E_FORMATETC;

+  end;

+end;

+

+function TfpgOLEDataObject.SetData(const formatetc: TFormatEtc;

+  const medium: TStgMedium; fRelease: BOOL): HResult;

+begin

+  Result := E_NOTIMPL;

+end;

+

+{ TfpgOLEEnumFormatEtc }

+

+function TfpgOLEEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HResult;

+var

+  C: TfpgOLEEnumFormatEtc;

+begin

+  // make a duplicate enumerator

+  C := TfpgOLEEnumFormatEtc.Create(FFormatEtcList);

+  // manually set the index state

+  C.FIndex := FIndex;

+  Enum := C as IEnumFormatEtc;

+  Result := S_OK;

+end;

+

+constructor TfpgOLEEnumFormatEtc.Create(AFormatEtcList: TfpgOLEFormatEtcList);

+begin

+  FFormatEtcList := TfpgOLEFormatEtcList.CreateCopy(AFormatEtcList);

+  FIndex := 0;

+end;

+

+destructor TfpgOLEEnumFormatEtc.Destroy;

+begin

+  FreeAndNil(FFormatEtcList);

+  inherited;

+end;

+

+function TfpgOLEEnumFormatEtc.Next(celt: ULong; out elt:FormatEtc;

+  pceltFetched: pULong): HResult;

+var

+  Copied: Integer;

+  OutBuf: PFormatEtc;

+begin

+  // copy the FORMATETC structures into the caller's buffer

+  OutBuf := PFormatEtc(@elt);

+  Copied := 0;

+  while(FIndex < FFormatEtcList.Count) and (Copied < celt) do begin

+    DeepCopyFormatEtc(FFormatEtcList[FIndex], OutBuf);

+    OutBuf := PFormatEtc(Cardinal(OutBuf) + SizeOf(TFormatEtc));

+    Inc(Copied);

+    FIndex := FIndex + 1;

+  end;

+

+  // store result

+  if (pceltFetched <> nil) then

+    pceltFetched^ := Copied;

+

+  // did we copy all that was requested?

+  if (Copied = celt) then Result := S_OK

+  else Result := S_FALSE;

+end;

+

+function TfpgOLEEnumFormatEtc.Reset: HResult;

+begin

+  FIndex := 0;

+  Result := S_OK;

+end;

+

+function TfpgOLEEnumFormatEtc.Skip(celt: ULong): HResult;

+begin

+  FIndex := FIndex + celt;

+  if FIndex <= FFormatEtcList.Count then Result := S_OK

+  else Result := S_FALSE;

+end;

+

+{ TfpgOLEFormatEtcList }

+

+constructor TfpgOLEFormatEtcList.CreateCopy(AFormatEtcList: TfpgOLEFormatEtcList);

+var

+  I: Integer;

+  P: PFormatEtc;

+begin

+  Create;

+  for I := 0 to AFormatEtcList.Count - 1 do begin

+    New(P);

+    DeepCopyFormatEtc(AFormatEtcList[I], P);

+    Add(P);

+  end;

+end;

+

+function TfpgOLEFormatEtcList.GetFormatEtc(Index: Integer): PFormatEtc;

+begin

+  Result := PFormatEtc(Get(Index));

+end;

+

+procedure TfpgOLEFormatEtcList.Notify(Ptr: Pointer; Action: TListNotification);

+begin

+  if Action = lnDeleted then begin

+    if PFormatEtc(Ptr)^.ptd <> nil then begin

+      CoTaskMemFree(PFormatEtc(Ptr)^.ptd);

+    end;

+    Dispose(PFormatEtc(Ptr));

+  end;

+  inherited;

+end;

+

+{ TfpgOLEStgMediumList }

+

+function TfpgOLEStgMediumList.GetStgMedium(Index: Integer): PStgMedium;

+begin

+  Result := PStgMedium(Get(Index));

+end;

+

+procedure TfpgOLEStgMediumList.Notify(Ptr: Pointer; Action: TListNotification);

+begin

+  if Action = lnDeleted then begin

+    if PStgMedium(Ptr)^.hGlobal <> 0 then begin

+      GlobalFree(PStgMedium(Ptr)^.hGlobal);

+    end;

+    Dispose(Ptr);

+  end;

+  inherited;

+end;

+

+{ TfpgOLEDropTarget }

+

+function TfpgOLEDropTarget.DragEnter(const dataObj: IDataObject;

+  grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;

+//var

+//  Effect: TfpgOLEDragDropEffect;

+begin

+  //dwEffect := DROPEFFECT_NONE;

+  //Effect := deNone;

+  DoDragEnter(dataObj, grfKeyState, pt, dwEffect);

+  //case Effect of

+  //  deNone: dwEffect := DROPEFFECT_NONE;

+  //  deCopy: dwEffect := DROPEFFECT_COPY;

+  //  deMove: dwEffect := DROPEFFECT_MOVE;

+  //  deLink: dwEffect := DROPEFFECT_LINK;

+  //end;

+  Result := S_OK;

+end;

+

+function TfpgOLEDropTarget.DragLeave: HResult;

+begin

+  Result := S_OK;

+  DoDragLeave;

+end;

+

+function TfpgOLEDropTarget.DragOver(grfKeyState: DWORD; pt: TPoint;

+  var dwEffect: DWORD): HResult;

+var

+  Effect: TfpgOLEDragDropEffect;

+begin

+  if ((MK_SHIFT and grfKeyState) = MK_SHIFT) and

+     ((dwEffect and DROPEFFECT_MOVE) = DROPEFFECT_MOVE) then begin

+    Effect := deMove;

+  end;

+  if ((MK_CONTROL and grfKeyState) = MK_CONTROL) and

+     ((dwEffect and DROPEFFECT_COPY) = DROPEFFECT_COPY) then begin

+    Effect := deCopy;

+  end;

+  if dwEffect and DROPEFFECT_COPY > 0 then Effect := deCopy

+  else if dwEffect and DROPEFFECT_MOVE  > 0 then Effect := deMove

+  else if dwEffect and DROPEFFECT_LINK > 0 then Effect := deLink

+  else Effect := deNone;

+  DoDragOver(grfKeyState, pt, Effect);

+  case Effect of

+    deNone: dwEffect := DROPEFFECT_NONE;

+    deCopy: dwEffect := DROPEFFECT_COPY;

+    deMove: dwEffect := DROPEFFECT_MOVE;

+    deLink: dwEffect := DROPEFFECT_LINK;

+  end;

+  Result := S_OK;

+end;

+

+function TfpgOLEDropTarget.Drop(const dataObj: IDataObject;

+  grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;

+var

+  Effect: TfpgOLEDragDropEffect;

+begin

+  if dwEffect and DROPEFFECT_COPY > 0 then

+    Effect := deCopy

+  else if dwEffect and DROPEFFECT_MOVE  > 0 then

+    Effect := deMove

+  else if dwEffect and DROPEFFECT_LINK > 0 then

+    Effect := deLink

+  else

+    Effect := deNone;

+  DoDragDrop(dataObj, grfKeyState, pt, Effect);

+  Result := S_OK;

+end;

+

+function TfpgOLEDropTarget._AddRef: Integer;

+begin

+  Result := 1;

+end;

+

+function TfpgOLEDropTarget._Release: Integer;

+begin

+  Result := 1;

+end;

+

+function TfpgOLEDropTarget.QueryInterface(const IID: TGUID; out Obj): HResult;

+begin

+  if GetInterface(IID, Obj) then

+    Result := 0

+  else

+    Result := E_NOINTERFACE;

+end;

+

+constructor TfpgOLEDropTarget.Create(ADropTargetWidget: TfpgWindowBase);

+begin

+  inherited Create;

+  FDropTarget := ADropTargetWidget;

+  FRegistered := False;

+end;

+

+procedure TfpgOLEDropTarget.RegisterDragDrop;

+begin

+  ActiveX.RegisterDragDrop(TfpgWidget(FDropTarget).WinHandle, Self as IDropTarget);

+  FRegistered := True;

+end;

+

+procedure TfpgOLEDropTarget.RevokeDragDrop;

+begin

+  FRegistered := False;

+  ActiveX.RevokeDragDrop(TfpgWidget(FDropTarget).WinHandle);

+end;

+

+destructor TfpgOLEDropTarget.Destroy;

+begin

+  if FRegistered then RevokeDragDrop;

+  inherited;

+end;

+

+procedure TfpgOLEDropTarget.DoDragEnter(DataObj: IDataObject;

+  KeyState: LongInt; PT: TPoint; var Effect: DWORD);

+begin

+  if Assigned(FOnDragEnter) then begin

+    FOnDragEnter(Self, DataObj, KeyState, PT, Effect);

+  end;

+end;

+

+procedure TfpgOLEDropTarget.DoDragOver(KeyState: LongInt; PT: TPoint;

+  var Effect: TfpgOLEDragDropEffect);

+begin

+  if Assigned(FOnDragOver) then begin

+    FOnDragOver(Self, KeyState, PT, Effect);

+  end;

+end;

+

+procedure TfpgOLEDropTarget.DoDragLeave;

+begin

+  if Assigned(FOnDragLeave) then

+    FOnDragLeave(self);

+end;

+

+procedure TfpgOLEDropTarget.DoDragDrop(DataObj: IDataObject; KeyState: LongInt;

+  PT: TPoint; Effect: TfpgOLEDragDropEffect);

+begin

+  if Assigned(FOnDragDrop) then begin

+    FOnDragDrop(Self, DataObj, KeyState, PT, Effect);

+  end;

+end;

+

+{ TDragFilesTarget }

+

+function TDragFilesTarget.DoDragAcceptFiles(DataObj: IDataObject): Boolean;

+const

+  FormatEtcHDrop:           TFormatEtc = (cfFormat:CF_HDROP;ptd:nil;dwAspect:DVASPECT_CONTENT;lindex:-1;tymed:TYMED_HGLOBAL);

+  FormatEtcFileDescriptor:  TFormatEtc = (cfFormat:0;ptd:nil;dwAspect:DVASPECT_CONTENT;lindex:-1;tymed:TYMED_HGLOBAL);

+  FormatEtcFileContents:    TFormatEtc = (cfFormat:0;ptd:nil;dwAspect:DVASPECT_CONTENT;lindex:-1;tymed:TYMED_ISTREAM);

+var

+  StgMedium: TStgMedium;

+  DropHandle: HDROP;

+  EnumFormatEtc: IEnumFORMATETC;

+  FE: TFormatEtc;

+  FetchedCount: Longint;

+  FormatName: array[0..MAX_PATH] of Char;

+  FileGroupDescriptor: PFileGroupDescriptorA;

+  I, Count: Integer;

+  FileDescriptor: TFileDescriptorA;

+  FileNames: TStringList;

+begin

+  FileNames := TStringList.Create;

+  try

+    if Assigned(FOnDragAcceptFiles) then

+    begin

+      Result := False;

+      FormatEtcFileDescriptor.cfFormat := CF_FILEDESCRIPTOR;

+      FormatEtcFileContents.cfFormat := CF_FILECONTENTS;

+

+      if (DataObj.QueryGetData(FormatEtcHDrop) = S_OK) and

+         (DataObj.GetData(FormatEtcHDrop,StgMedium) = S_OK) then

+      begin

+        DropHandle := StgMedium.hGlobal;

+        GetFileNamesFromDropHandle(DropHandle, FileNames);

+        Result := FOnDragAcceptFiles(Self, FileNames);

+        ReleaseStgMedium(StgMedium);

+      end

+      else

+      if (DataObj.QueryGetData(FormatEtcFileDescriptor) = S_OK) and

+         (DataObj.QueryGetData(FormatEtcFileContents) = S_OK) and

+         (DataObj.GetData(FormatEtcFileDescriptor,StgMedium) = S_OK) then

+      begin

+        FileGroupDescriptor := GlobalLock(StgMedium.hGlobal);

+        if FileGroupDescriptor <> nil then

+        begin

+          Count := FileGroupDescriptor^.cItems;

+          I := 0;

+          while I < Count do

+          begin

+            FileDescriptor := FileGroupDescriptor^.fgd[I];

+            FileNames.Add(FileDescriptor.cFileName);

+            Inc(I);

+          end;

+          GlobalUnlock(StgMedium.hGlobal);

+        end;

+        Result := FOnDragAcceptFiles(Self, FileNames);

+        ReleaseStgMedium(StgMedium);

+      end

+      else

+      begin

+//        DataObj.EnumFormatEtc(DATADIR_GET, EnumFormatEtc);

+//        EnumFormatEtc.Reset;

+//        while EnumFormatEtc.Next(1, FE, @FetchedCount) = S_OK do begin

+//          GetClipboardFormatName(FE.cfFormat,FormatName,MAX_PATH);

+//          ShowMessage(FormatName);

+//        end;

+      end;

+    end

+    else

+    begin

+      Result := True;

+    end;

+  finally

+    FileNames.Free;

+  end;

+end;

+

+procedure TDragFilesTarget.DoDragEnter(DataObj: IDataObject;

+  KeyState: LongInt; PT: TPoint; var Effect: DWORD);

+begin

+  FDragAcceptFiles := DoDragAcceptFiles(DataObj);

+  if FDragAcceptFiles and DoDragAcceptPosition(PT) then

+    inherited DoDragEnter(DataObj, KeyState, PT, Effect)

+  else

+    Effect := DROPEFFECT_NONE;

+end;

+

+procedure TDragFilesTarget.DoDragOver(KeyState: LongInt; PT: TPoint; var Effect: TfpgOLEDragDropEffect);

+begin

+  if FDragAcceptFiles and DoDragAcceptPosition(PT) then

+    inherited DoDragOver(KeyState, PT, Effect)

+  else

+    Effect := deNone;

+end;

+

+procedure TDragFilesTarget.DoDragDrop(DataObj: IDataObject;

+  KeyState: LongInt; PT: TPoint; Effect: TfpgOLEDragDropEffect);

+begin

+  DoDropFiles(DataObj, PT);

+  inherited;

+end;

+

+function TDragFilesTarget.DoDragAcceptPosition(PT: TPoint): Boolean;

+begin

+  if Assigned(FOnDragAcceptPosition) then begin

+    Result := FOnDragAcceptPosition(Self, PT);

+  end else begin

+    Result := True;

+  end;

+end;

+

+procedure TDragFilesTarget.DoDropFiles(DataObj: IDataObject; PT: TPoint);

+const

+  FormatEtcHDrop: TFormatEtc = (cfFormat:CF_HDROP;ptd:nil;dwAspect:DVASPECT_CONTENT;lindex:-1;tymed:TYMED_HGLOBAL);

+  FormatEtcFileDescriptor: TFormatEtc =

+    (cfFormat:0;ptd:nil;dwAspect:DVASPECT_CONTENT;lindex:-1;tymed:TYMED_HGLOBAL);

+  FormatEtcFileContents: TFormatEtc =

+    (cfFormat:0;ptd:nil;dwAspect:DVASPECT_CONTENT;lindex:-1;tymed:TYMED_ISTREAM);

+var

+  StgMedium, StgMediumContents: TStgMedium;

+  DropHandle: HDROP;

+  FileNames: TStringList;

+  FileGroupDescriptor: PFileGroupDescriptorA;

+  I, Count: Integer;

+  FileDescriptor: TFileDescriptorA;

+  Path: array[0..MAX_PATH] of Char;

+  TempFileName: string;

+begin

+  if not Assigned(FOnDropFiles) then Exit;

+  FileNames := TStringList.Create;

+  try

+    FormatEtcFileDescriptor.cfFormat := CF_FILEDESCRIPTOR;

+    FormatEtcFileContents.cfFormat := CF_FILECONTENTS;

+    if (DataObj.QueryGetData(FormatEtcHDrop) = S_OK) and

+       (DataObj.GetData(FormatEtcHDrop,StgMedium) = S_OK) then begin

+      DropHandle := StgMedium.hGlobal;

+      GetFileNamesFromDropHandle(DropHandle, FileNames);

+      FOnDropFiles(Self, PT, FileNames);

+      ReleaseStgMedium(StgMedium);

+    end else

+    if (DataObj.QueryGetData(FormatEtcFileDescriptor) = S_OK) and

+       (DataObj.QueryGetData(FormatEtcFileContents) = S_OK) and

+       (DataObj.GetData(FormatEtcFileDescriptor,StgMedium) = S_OK) then begin

+      GetTempPath(MAX_PATH, Path);

+      GetTempFileName(Path, 'PXM', 0, Path);

+      FileGroupDescriptor := GlobalLock(StgMedium.hGlobal);

+      if FileGroupDescriptor <> nil then begin

+        Count := FileGroupDescriptor^.cItems;

+        I := 0;

+        while I < Count do begin

+          FileDescriptor := FileGroupDescriptor^.fgd[I];

+          TempFileName := ChangeFileExt(Path, ExtractFileExt(FileDescriptor.cFileName));

+          FormatEtcFileContents.lindex := I;

+          if (DataObj.GetData(FormatEtcFileContents,StgMediumContents) = S_OK) then begin

+            StreamToFile(IStream(StgMediumContents.pstm), TempFileName);

+            FileNames.Clear;

+            FileNames.Add(TempFileName);

+            FOnDropFiles(Self, PT, FileNames);

+            ReleaseStgMedium(StgMediumContents);

+          end;

+          Inc(I);

+        end;

+        GlobalUnlock(StgMedium.hGlobal);

+      end;

+      FOnDropFiles(Self, PT, FileNames);

+      ReleaseStgMedium(StgMedium);

+      ReleaseStgMedium(StgMediumContents);

+    end;

+  finally

+    FileNames.Free;

+  end;

+end;

+

+procedure TDragFilesTarget.GetFileNamesFromDropHandle(DropHandle: HDROP; SL: TStrings);

+var

+  I: Integer;

+  Path: array[0..MAX_PATH] of Char;

+begin

+  for I := 0 to DragQueryFile(DropHandle, $FFFFFFFF, nil, 0) do begin

+    DragQueryFile(DropHandle, I, Path, MAX_PATH);

+    SL.Add(Path);

+  end;

+  DragFinish(DropHandle);

+end;

+

+procedure TDragFilesTarget.StreamToFile(Stream: IStream; const FileName: string);

+const

+  BLOCK_SIZE = 4096;

+var

+  BytesRead: Longint;

+  FileStream: TFileStream;

+  Buffer: array[0..BLOCK_SIZE] of Byte;

+begin

+  FileStream := TFileStream.Create(FileName, fmCreate);

+  try

+    while (Stream.Read(@Buffer[0], BLOCK_SIZE, @BytesRead) = S_OK) and (BytesRead > 0) do begin

+      FileStream.Write(Buffer, BytesRead);

+    end;

+  finally

+    FileStream.Free;

+  end;

+end;

+

+initialization

+  CF_FILENAMEMAP := RegisterClipboardFormat(CFSTR_FILENAMEMAP);

+  CF_FILEDESCRIPTOR := RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR);

+  CF_FILECONTENTS := RegisterClipboardFormat(CFSTR_FILECONTENTS);

+

+finalization

+

+end.

+

diff --git a/src/corelib/gdi/fpg_utils_impl.inc b/src/corelib/gdi/fpg_utils_impl.inc
index d3bb2f0c..ab4761ae 100644
--- a/src/corelib/gdi/fpg_utils_impl.inc
+++ b/src/corelib/gdi/fpg_utils_impl.inc
@@ -1,7 +1,7 @@
 {%mainunit fpg_utils.pas}
 
 uses
-  Shellapi;
+  Shellapi, Windows, fpg_constants, fpg_stringutils;
   
 // GDI specific implementations of encoding functions
 
@@ -26,3 +26,22 @@ begin
   end;
 end;
 
+function fpgFileSize(const AFilename: TfpgString): integer;
+var
+  FindData: TWIN32FindDataW;
+  FindHandle: THandle;
+  Str: widestring;
+begin
+  // Don't assign the widestring to TSearchRec.name because it is of type
+  // string, which will generate a conversion to the system encoding
+  Str := UTF8Decode(AFilename);
+  FindHandle:=Windows.FindFirstFileW(PWideChar(Str), FindData);
+  if FindHandle=Windows.Invalid_Handle_value then
+  begin
+    Result:=-1;
+    exit;
+  end;
+  Result := (int64(FindData.nFileSizeHigh) shl 32)+FindData.nFileSizeLow;
+  Windows.FindClose(FindHandle);
+end;
+
diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk
index 11731043..2f606e9f 100644
--- a/src/corelib/gdi/fpgui_toolkit.lpk
+++ b/src/corelib/gdi/fpgui_toolkit.lpk
@@ -5,7 +5,7 @@
     <Name Value="fpgui_toolkit"/>

     <Author Value="Graeme Geldenhuys"/>

     <CompilerOptions>

-      <Version Value="8"/>

+      <Version Value="9"/>

       <PathDelim Value="\"/>

       <SearchPaths>

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

@@ -16,7 +16,6 @@
         <SyntaxOptions>

           <AllowLabel Value="False"/>

           <CPPInline Value="False"/>

-          <UseAnsiStrings Value="True"/>

         </SyntaxOptions>

       </Parsing>

       <CodeGeneration>

@@ -31,7 +30,7 @@
     <Description Value="fpGUI Toolkit"/>

     <License Value="LGPL 2 with static linking exception."/>

     <Version Minor="7"/>

-    <Files Count="80">

+    <Files Count="81">

       <Item1>

         <Filename Value="..\stdimages.inc"/>

         <Type Value="Include"/>

@@ -352,6 +351,10 @@
         <Filename Value="..\..\VERSION_FILE.inc"/>

         <Type Value="Include"/>

       </Item80>

+      <Item81>

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

+        <UnitName Value="fpg_OLEDragDrop"/>

+      </Item81>

     </Files>

     <LazDoc Paths="..\..\..\docs\xml\corelib\;..\..\..\docs\xml\corelib\x11\;..\..\..\docs\xml\corelib\gdi\;..\..\..\docs\xml\gui\"/>

     <RequiredPkgs Count="1">

diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas
index 2e3e81b6..adc1c74d 100644
--- a/src/corelib/gdi/fpgui_toolkit.pas
+++ b/src/corelib/gdi/fpgui_toolkit.pas
@@ -1,4 +1,4 @@
-{ This file was automatically created by Lazarus. do not edit!

+{ This file was automatically created by Lazarus. Do not edit!

   This source is only used to compile and install the package.

  }

 

@@ -18,7 +18,7 @@ uses
   fpg_radiobutton, fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, 

   fpgui_db, fpg_gdi, fpg_impl, fpg_splitter, fpg_hint, fpg_spinedit, 

   fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel, fpg_interface, 

-  fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils;

+  fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_OLEDragDrop;

 

 implementation