Removed direct dependency of ActiveX and OleUtils

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@119 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/virtualtreeview-unstable/VirtualTrees.pas

@@ -105,6 +105,9 @@ interface
 uses
   {$ifdef UseExternalDragManager}
   virtualdragmanager,
+  {$else}
+  ActiveX,
+  OleUtils,
   {$endif}
   Windows, DelphiCompat, vtlogger,  LCLType, LResources, LCLIntf,  LMessages, Types,
   SysUtils, Classes, Graphics, Controls, Forms, ImgList, StdCtrls, Menus, Printers,
@@ -123,12 +126,7 @@ uses
   {$endif TntSupport}
   {$ifdef EnableAccessible}
   , oleacc // for MSAA IAccessible support
-  {$endif}
+  {$endif};
-  {$ifdef EnableOLE}
-  , ActiveX,
-  OleUtils
-  {$endif}
-  ;
 
 const
   {$I lclconstants.inc}
@@ -689,7 +687,7 @@ type
     Medium: TStgMedium;
   end;
   TInternalStgMediumArray = array of TInternalStgMedium;
-  {$endif}
+
   TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
   private
     FTree: TBaseVirtualTree;
@@ -704,8 +702,6 @@ type
     function Skip(celt: LongWord): HResult; stdcall;
   end;
 
-
-  {$ifndef UseExternalDragManager}
   // ----- OLE drag'n drop handling
 
   { 01.05.2006  Jim - Problem with BDS2006 C++ compiler and ambiguous defines}
@@ -886,8 +882,6 @@ type
     disSystemSupport    // Running on Windows 2000 or higher. System supports drag images natively.
   );
   
-  {$ifdef EnableOLE}
-
   // Class to manage header and tree drag image during a drag'n drop operation.
   TVTDragImage = class
   private
@@ -930,7 +924,7 @@ type
     property Transparency: TVTTransparency read FTransparency write FTransparency default 128;
     property Visible: Boolean read GetVisible;
   end;
-  {$endif}
+
   // tree columns implementation
   TVirtualTreeColumns = class;
   TVTHeader = class;
@@ -5738,6 +5732,7 @@ end;
 
 {$endif UseLocalMemoryManager}
 
+{$ifndef UseExternalDragManager}
 //----------------------------------------------------------------------------------------------------------------------
 
 // OLE drag and drop support classes
@@ -5745,7 +5740,7 @@ end;
 // of DD'ing various kinds of virtual data and works also between applications.
 
 //----------------- TEnumFormatEtc -------------------------------------------------------------------------------------
-{$ifdef EnableOLE}
+
 constructor TEnumFormatEtc.Create(Tree: TBaseVirtualTree; AFormatEtcArray: TFormatEtcArray);
 
 var
@@ -5827,7 +5822,7 @@ begin
     Result := S_FALSE;
 end;
 
-{$ifndef UseExternalDragManager}
+
 
 //----------------- TVTDataObject --------------------------------------------------------------------------------------
 
@@ -6457,7 +6452,7 @@ begin
       Result := S_OK;
 end;
 {$endif} //UseExternalDragManager
-{$endif} //EnableOLE
+
 //----------------- TVirtualTreeHintWindow -----------------------------------------------------------------------------
 
 var
@@ -18801,7 +18796,7 @@ begin
     DragEffect := DROPEFFECT_NONE;
     AllowedEffects := GetDragOperations;
     try
-      VirtualTrees.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, @DragEffect);
+      virtualdragmanager.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, @DragEffect);
       DragManager.ForceDragLeave;
     finally
       GetCursorPos(P);
@@ -22996,20 +22991,23 @@ function TBaseVirtualTree.RenderOLEData(const FormatEtcIn: TFormatEtc; out Mediu
   end;
 
   //--------------- end local function ----------------------------------------
-
+{$ifndef UseExternalDragManager}
 var
   Data: PCardinal;
   ResPointer: Pointer;
   ResSize: Integer;
   OLEStream: IStream;
   VCLStream: TStream;
-
+{$endif}
 begin
   FillChar(Medium, SizeOf(Medium), 0);
-  {$ifdef NeedWindows}
   // We can render the native clipboard format in two different storage media.
   if (FormatEtcIn.cfFormat = CF_VIRTUALTREE) and (FormatEtcIn.tymed and (TYMED_HGLOBAL or TYMED_ISTREAM) <> 0) then
   begin
+    {$ifdef UseExternalDragManager}
+    //Separated function to help isolate OLE code
+    virtualdragmanager.RenderOLEData(Self,FormatEtcIn,Medium,ForClipboard);
+    {$else}
     VCLStream := nil;
     try
       Medium.PunkForRelease := nil;
@@ -23058,10 +23056,10 @@ begin
       // the OLEStream which exists independently.
       VCLStream.Free;
     end;
+    {$endif}
   end
   else // Ask application descendants to render self defined formats.
     Result := DoRenderOLEData(FormatEtcIn, Medium, ForClipboard);
-  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -28446,7 +28444,7 @@ begin
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
-
+{$ifndef UseExternalDragManager}
 type
   // needed to handle OLE global memory objects
   TOLEMemoryStream = class(TCustomMemoryStream)
@@ -28466,6 +28464,8 @@ begin
   {$endif COMPILER_5_UP}
 end;
 
+{$endif}
+
 //----------------------------------------------------------------------------------------------------------------------
 
 function TBaseVirtualTree.ProcessOLEData(Source: TBaseVirtualTree; DataObject: IDataObject; TargetNode: PVirtualNode;
@@ -28483,7 +28483,9 @@ function TBaseVirtualTree.ProcessOLEData(Source: TBaseVirtualTree; DataObject: I
 var
   Medium: TStgMedium;
   Stream: TStream;
+  {$ifndef UseExternalDragManager}
   Data: Pointer;
+  {$endif}
   Node: PVirtualNode;
   Nodes: TNodeArray;
   I: Integer;
@@ -28491,7 +28493,6 @@ var
   ChangeReason: TChangeReason;
 
 begin
-  {$ifdef NeedWindows}
   Nodes := nil;
   // Check the data format available by the data object.
   with StandardOLEFormat do
@@ -28553,6 +28554,9 @@ begin
             TYMED_ISTREAM, // IStream interface
             TYMED_HGLOBAL: // global memory block
               begin
+                {$ifdef UseExternalDragManager}
+                Stream:=GetStreamFromMedium(Medium);
+                {$else}
                 Stream := nil;
                 if Medium.tymed = TYMED_ISTREAM then
                   Stream := TOLEStream.Create(IUnknown(Medium.Pstm) as IStream)
@@ -28568,7 +28572,7 @@ begin
                     TOLEMemoryStream(Stream).SetPointer(Data, I);
                   end;
                 end;
-
+                {$endif}
                 if Assigned(Stream) then
                 try
                   while Stream.Position < Stream.Size do
@@ -28593,8 +28597,12 @@ begin
                   Result := True;
                 finally
                   Stream.Free;
+                  {$ifdef UseExternalDragManager}
+                    UnlockMediumData(Medium);
+                  {$else}
                   if Medium.tymed = TYMED_HGLOBAL then
                     GlobalUnlock(Medium.hGlobal);
+                  {$endif}
                 end;
               end;
           end;
@@ -28605,7 +28613,6 @@ begin
       EndUpdate;
     end;
   end;
-  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------

components/virtualtreeview-unstable/lclfunctions.inc

@@ -254,6 +254,7 @@ end;
 
 {$endif}
 
+{$ifndef UseExternalDragManager}
 function RegisterDragDrop(hwnd:HWND; pDropTarget:IDropTarget):WINOLEAPI;stdcall;external 'ole32.dll' name 'RegisterDragDrop';
 
 function RevokeDragDrop(hwnd:HWND):WINOLEAPI;stdcall;external 'ole32.dll' name 'RevokeDragDrop';
@@ -274,4 +275,6 @@ function OleFlushClipboard:WINOLEAPI;stdcall;external 'ole32.dll' name 'OleFlush
 
 function OleIsCurrentClipboard(pDataObj:IDataObject):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleIsCurrentClipboard';
 
+function CreateStreamOnHGlobal(hGlobal:HGLOBAL; fDeleteOnRelease:BOOL;out stm:IStream):WINOLEAPI;stdcall;external 'ole32.dll' name 'CreateStreamOnHGlobal';
 
+{$endif}

components/virtualtreeview-unstable/units/win32/virtualdragmanager.pas

@@ -18,7 +18,32 @@ const
   SID_IDragSourceHelper = '{DE5BF786-477A-11D2-839D-00C04FD918D0}';
   SID_IDropTarget = '{00000122-0000-0000-C000-000000000046}';
   
+  //Bridge to ActiveX constants
+  
+  TYMED_HGLOBAL = ActiveX.TYMED_HGLOBAL;
+  TYMED_ISTREAM = ActiveX.TYMED_ISTREAM;
+  DVASPECT_CONTENT = ActiveX.DVASPECT_CONTENT;
+  CLSCTX_INPROC_SERVER = ActiveX.CLSCTX_INPROC_SERVER;
+  DROPEFFECT_COPY = ActiveX.DROPEFFECT_COPY;
+  DROPEFFECT_LINK = ActiveX.DROPEFFECT_LINK;
+  DROPEFFECT_MOVE = ActiveX.DROPEFFECT_MOVE;
+  DROPEFFECT_NONE = ActiveX.DROPEFFECT_NONE;
+  DROPEFFECT_SCROLL = ActiveX.DROPEFFECT_SCROLL;
+  DATADIR_GET = ActiveX.DATADIR_GET;
+  
 type
+  //Bridge to ActiveX Types
+  IDataObject = ActiveX.IDataObject;
+  IDropTarget = ActiveX.IDropTarget;
+  IDropSource = ActiveX.IDropSource;
+  IEnumFormatEtc = ActiveX.IEnumFORMATETC;
+  
+  //WINOLEAPI = ActiveX.WINOLEAPI;
+  
+  TFormatEtc = ActiveX.TFORMATETC;
+  TStgMedium = ActiveX.TStgMedium;
+  PDVTargetDevice = ActiveX.PDVTARGETDEVICE;
+
   // OLE drag'n drop support
   TFormatEtcArray = array of TFormatEtc;
   TFormatArray = array of Word;
@@ -30,6 +55,19 @@ type
   end;
   TInternalStgMediumArray = array of TInternalStgMedium;
 
+  TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
+  private
+    FTree: TObject;
+    FFormatEtcArray: TFormatEtcArray;
+    FCurrentIndex: Integer;
+  public
+    constructor Create(Tree: TObject; AFormatEtcArray: TFormatEtcArray);
+
+    function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
+    function Next(celt: LongWord; out elt: FormatEtc; out pceltFetched: LongWord): HResult; stdcall;
+    function Reset: HResult; stdcall;
+    function Skip(celt: LongWord): HResult; stdcall;
+  end;
 
   IDropTargetHelper = interface(IUnknown)
     [SID_IDropTargetHelper]
@@ -139,15 +177,272 @@ type
     function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
   end;
   
+  //ActiveX functions that have wrong calling convention in fpc
+  
+  function RegisterDragDrop(hwnd:HWND; pDropTarget:IDropTarget):WINOLEAPI;stdcall;external 'ole32.dll' name 'RegisterDragDrop';
+
+  function RevokeDragDrop(hwnd:HWND):WINOLEAPI;stdcall;external 'ole32.dll' name 'RevokeDragDrop';
+
+  function DoDragDrop(pDataObj:IDataObject; pDropSource:IDropSource; dwOKEffects:DWORD; pdwEffect:LPDWORD):WINOLEAPI;stdcall;external 'ole32.dll' name 'DoDragDrop';
+
+  function OleInitialize(pvReserved:LPVOID):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleInitialize';
+
+  procedure OleUninitialize;stdcall;external 'ole32.dll' name 'OleUninitialize';
+
+  procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium';
+
+  function OleSetClipboard(pDataObj:IDataObject):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleSetClipboard';
+
+  function OleGetClipboard(out ppDataObj:IDataObject):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleGetClipboard';
+
+  function OleFlushClipboard:WINOLEAPI;stdcall;external 'ole32.dll' name 'OleFlushClipboard';
+
+  function OleIsCurrentClipboard(pDataObj:IDataObject):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleIsCurrentClipboard';
+
+  function CreateStreamOnHGlobal(hGlobal:HGLOBAL; fDeleteOnRelease:BOOL;out stm:IStream):WINOLEAPI;stdcall;external 'ole32.dll' name 'CreateStreamOnHGlobal';
+  
+  function CoCreateInstance(const _para1:TCLSID; _para2:IUnknown; _para3:DWORD;const _para4:TIID;out _para5):HRESULT;stdcall; external  'ole32.dll' name 'CoCreateInstance';
+
+  //helper functions to isolate windows/OLE specific code
+  
+  function RenderOLEData(Tree: TObject; const FormatEtcIn: TFormatEtc; out Medium: TStgMedium;
+    ForClipboard: Boolean): HResult;
+    
+  function GetStreamFromMedium(Medium:TStgMedium):TStream;
+  
+  procedure UnlockMediumData(Medium:TStgMedium);
+
 implementation
 
 uses
-  VirtualTrees, Controls;
+  VirtualTrees, Controls, oleutils;
   
 type
   TVirtualTreeAccess = class (TBaseVirtualTree)
   end;
 
+function RenderOLEData(Tree: TObject; const FormatEtcIn: TFormatEtc; out
+  Medium: TStgMedium; ForClipboard: Boolean): HResult;
+
+  //--------------- local function --------------------------------------------
+
+  procedure WriteNodes(Stream: TStream);
+
+  var
+    Selection: TNodeArray;
+    I: Integer;
+
+  begin
+    with TVirtualTreeAccess(Tree) do
+    begin
+      if ForClipboard then
+        Selection := GetSortedCutCopySet(True)
+      else
+        Selection := GetSortedSelection(True);
+      for I := 0 to High(Selection) do
+        WriteNode(Stream, Selection[I]);
+    end;
+  end;
+
+  //--------------- end local function ----------------------------------------
+
+var
+  Data: PCardinal;
+  ResPointer: Pointer;
+  ResSize: Integer;
+  OLEStream: IStream;
+  VCLStream: TStream;
+  
+begin
+  VCLStream := nil;
+  try
+    Medium.PunkForRelease := nil;
+    // Return data in one of the supported storage formats, prefer IStream.
+    if FormatEtcIn.tymed and TYMED_ISTREAM <> 0 then
+    begin
+      // Create an IStream on a memory handle (here it is 0 which indicates to implicitely allocated a handle).
+      // Do not use TStreamAdapter as it is not compatible with OLE (when flushing the clipboard OLE wants the HGlobal
+      // back which is not supported by TStreamAdapater).
+      CreateStreamOnHGlobal(0, True, OLEStream);
+
+      VCLStream := TOLEStream.Create(OLEStream);
+      WriteNodes(VCLStream);
+      // Rewind stream.
+      VCLStream.Position := 0;
+      Medium.tymed := TYMED_ISTREAM;
+      IUnknown(Medium.Pstm) := OLEStream;
+      Result := S_OK;
+    end
+    else
+    begin
+      VCLStream := TMemoryStream.Create;
+      WriteNodes(VCLStream);
+      ResPointer := TMemoryStream(VCLStream).Memory;
+      ResSize := VCLStream.Position;
+
+      // Allocate memory to hold the string.
+      if ResSize > 0 then
+      begin
+        Medium.hGlobal := GlobalAlloc(GHND or GMEM_SHARE, ResSize + SizeOf(Cardinal));
+        Data := GlobalLock(Medium.hGlobal);
+        // Store the size of the data too, for easy retrival.
+        Data^ := ResSize;
+        Inc(Data);
+        Move(ResPointer^, Data^, ResSize);
+        GlobalUnlock(Medium.hGlobal);
+        Medium.tymed := TYMED_HGLOBAL;
+
+        Result := S_OK;
+      end
+      else
+        Result := E_FAIL;
+    end;
+  finally
+    // We can free the VCL stream here since it was either a pure memory stream or only a wrapper around
+    // the OLEStream which exists independently.
+    VCLStream.Free;
+  end;
+end;
+
+
+type
+  // needed to handle OLE global memory objects
+  TOLEMemoryStream = class(TCustomMemoryStream)
+  public
+    function Write(const Buffer; Count: Integer): Longint; override;
+  end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+function TOLEMemoryStream.Write(const Buffer; Count: Integer): Integer;
+
+begin
+  {$ifdef COMPILER_5_UP}
+    raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
+  {$else}
+    raise EStreamError.Create(SCantWriteResourceStreamError);
+  {$endif COMPILER_5_UP}
+end;
+
+
+function GetStreamFromMedium(Medium: TStgMedium): TStream;
+var
+  Data: Pointer;
+  I: Integer;
+begin
+  Result := nil;
+  if Medium.tymed = TYMED_ISTREAM then
+    Result := TOLEStream.Create(IUnknown(Medium.Pstm) as IStream)
+  else
+  begin
+    Data := GlobalLock(Medium.hGlobal);
+    if Assigned(Data) then
+    begin
+      // Get the total size of data to retrieve.
+      I := PCardinal(Data)^;
+      Inc(PCardinal(Data));
+      Result := TOLEMemoryStream.Create;
+      TOLEMemoryStream(Result).SetPointer(Data, I);
+    end;
+  end;
+end;
+
+procedure UnlockMediumData(Medium: TStgMedium);
+begin
+  if Medium.tymed = TYMED_HGLOBAL then
+    GlobalUnlock(Medium.hGlobal);
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+// OLE drag and drop support classes
+// This is quite heavy stuff (compared with the VCL implementation) but is much better suited to fit the needs
+// of DD'ing various kinds of virtual data and works also between applications.
+
+//----------------- TEnumFormatEtc -------------------------------------------------------------------------------------
+
+constructor TEnumFormatEtc.Create(Tree: TObject; AFormatEtcArray: TFormatEtcArray);
+
+var
+  I: Integer;
+
+begin
+  inherited Create;
+
+  FTree := Tree;
+  // Make a local copy of the format data.
+  SetLength(FFormatEtcArray, Length(AFormatEtcArray));
+  for I := 0 to High(AFormatEtcArray) do
+    FFormatEtcArray[I] := AFormatEtcArray[I];
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+function TEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HResult;
+
+var
+  AClone: TEnumFormatEtc;
+
+begin
+  Result := S_OK;
+  try
+    AClone := TEnumFormatEtc.Create(nil, FFormatEtcArray);
+    AClone.FCurrentIndex := FCurrentIndex;
+    Enum := AClone as IEnumFormatEtc;
+  except
+    Result := E_FAIL;
+  end;
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+function TEnumFormatEtc.Next(celt: LongWord; out elt: FormatEtc; out pceltFetched: LongWord): HResult;
+
+var
+  CopyCount: LongWord;
+
+begin
+  Result := S_FALSE;
+  CopyCount := Length(FFormatEtcArray) - FCurrentIndex;
+  if celt < CopyCount then
+    CopyCount := celt;
+  if CopyCount > 0 then
+  begin
+    Move(FFormatEtcArray[FCurrentIndex], elt, CopyCount * SizeOf(TFormatEtc));
+    Inc(FCurrentIndex, CopyCount);
+    Result := S_OK;
+  end;
+  //todo_lcl_check Delphi treats pceltFetched an PInteger. Implemented like in fpc.activex. What heappens with
+  // a C Program call with a NULL in pCeltFetcjed??
+  //Answer: Yes. Is necessary a check here
+  if @pceltFetched <> nil then
+    pceltFetched := CopyCount;
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+function TEnumFormatEtc.Reset: HResult;
+
+begin
+  FCurrentIndex := 0;
+  Result := S_OK;
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+function TEnumFormatEtc.Skip(celt: LongWord): HResult;
+
+begin
+  if FCurrentIndex + celt < High(FFormatEtcArray) then
+  begin
+    Inc(FCurrentIndex, celt);
+    Result := S_Ok;
+  end
+  else
+    Result := S_FALSE;
+end;
+
+
 //----------------- TVTDataObject --------------------------------------------------------------------------------------
 
 constructor TVTDataObject.Create(AOwner: TObject; ForClipboard: Boolean);