You've already forked lazarus-ccr
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
This commit is contained in:
blikblum
@ -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;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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);
|
||||
|
||||
Reference in New Issue
Block a user