GDI: introduced a template TGDIDragManager class

* implements the IDropTarget interface
* Also initialize/uninitialize OLE at application startup/stop

1 files changed, 97 insertions, 2 deletions

diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index db549a2c..f59c7330 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.pas
@@ -53,6 +53,7 @@ var
 type
   // forward declaration
   TfpgGDIWindow = class;
+  TGDIDragManager = class;
 
 
   TfpgGDIFontResource = class(TfpgFontResourceBase)
@@ -143,6 +144,9 @@ type
 
   TfpgGDIWindow = class(TfpgWindowBase)
   private
+    FDragManager: TGDIDragManager;
+    function    GetDragManager: TGDIDragManager;
+  private
     FMouseInWindow: boolean;
     FNonFullscreenRect: TfpgRect;
     FNonFullscreenStyle: longword;
@@ -150,6 +154,7 @@ type
     FSkipResizeMessage: boolean;
     function    DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean;
     procedure   WindowSetFullscreen(aFullScreen, aUpdate: boolean);
+    property    DragManager: TGDIDragManager read GetDragManager;
   protected
     FWinHandle: TfpgWinHandle;
     FModalForWin: TfpgGDIWindow;
@@ -171,6 +176,7 @@ type
     property    WinHandle: TfpgWinHandle read FWinHandle;
   public
     constructor Create(AOwner: TComponent); override;
+    destructor  Destroy; override;
     procedure   ActivateWindow; override;
     procedure   CaptureMouse; override;
     procedure   ReleaseMouse; override;
@@ -251,6 +257,26 @@ type
   end;
 
 
+  { TGDIDragManager }
+
+  TGDIDragManager = class(TInterfacedObject, IDropTarget)
+  private
+    FDropTarget: TObject;  { 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: TObject); reintroduce;
+    destructor  Destroy; override;
+    procedure   RegisterDragDrop;
+    procedure   RevokeDragDrop;
+    property    DropTarget: TObject read FDropTarget; { actually a TfpgWidget }
+  end;
+
+
 implementation
 
 uses
@@ -266,7 +292,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}
@@ -1249,7 +1275,14 @@ end;
 var
   // this are required for Windows MouseEnter & MouseExit detection.
   uLastWindowHndl: TfpgWinHandle;
-  
+
+function TfpgGDIWindow.GetDragManager: TGDIDragManager;
+begin
+  if not Assigned(FDragManager) then
+     FDragManager := TGDIDragManager.Create(self);
+  Result := FDragManager;
+end;
+
 function TfpgGDIWindow.DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean;
 var
   pt, spt: Windows.POINT;
@@ -1647,6 +1680,14 @@ begin
   FFullscreenIsSet := false;
 end;
 
+destructor TfpgGDIWindow.Destroy;
+begin
+  if (self as TfpgWidget).AcceptDrops and Assigned(FDragManager) then
+    FDragManager.RevokeDragDrop;
+  FDragManager := nil;     { frees drag manager instance }
+  inherited Destroy;
+end;
+
 procedure TfpgGDIWindow.ActivateWindow;
 begin
   SetForegroundWindow(FWinHandle);
@@ -2494,9 +2535,59 @@ begin
   Result := daCopy;
 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: TObject);
+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;
@@ -2514,5 +2605,9 @@ initialization
       FontSmoothingType := ANTIALIASED_QUALITY;
 {$ENDIF}
 
+finalization
+  if NeedToUnitialize then
+    OleUninitialize;
+
 end.