From e7a96e5b6b65ad1235a50c38cfc452054c97497a Mon Sep 17 00:00:00 2001 From: blikblum Date: Tue, 6 Mar 2007 12:16:42 +0000 Subject: [PATCH] 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 --- .../virtualtreeview-unstable/VirtualTrees.pas | 55 ++-- .../virtualtreeview-unstable/lclfunctions.inc | 3 + .../units/win32/virtualdragmanager.pas | 299 +++++++++++++++++- 3 files changed, 331 insertions(+), 26 deletions(-) diff --git a/components/virtualtreeview-unstable/VirtualTrees.pas b/components/virtualtreeview-unstable/VirtualTrees.pas index e7cc60753..97ad8dd9f 100644 --- a/components/virtualtreeview-unstable/VirtualTrees.pas +++ b/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} - {$ifdef EnableOLE} - , ActiveX, - OleUtils - {$endif} - ; + {$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; //---------------------------------------------------------------------------------------------------------------------- diff --git a/components/virtualtreeview-unstable/lclfunctions.inc b/components/virtualtreeview-unstable/lclfunctions.inc index 39b4cacf2..291a4b70d 100644 --- a/components/virtualtreeview-unstable/lclfunctions.inc +++ b/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} diff --git a/components/virtualtreeview-unstable/units/win32/virtualdragmanager.pas b/components/virtualtreeview-unstable/units/win32/virtualdragmanager.pas index 9ed84eea4..0c3fb5b3c 100644 --- a/components/virtualtreeview-unstable/units/win32/virtualdragmanager.pas +++ b/components/virtualtreeview-unstable/units/win32/virtualdragmanager.pas @@ -17,8 +17,33 @@ const SID_IDropTargetHelper = '{4657278B-411B-11D2-839A-00C04FD918D0}'; 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] @@ -138,16 +176,273 @@ type function GiveFeedback(Effect: Integer): HResult; stdcall; 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);