Fixes line ending issues

1 files changed, 1074 insertions, 1074 deletions

diff --git a/src/corelib/gdi/fpg_oledragdrop.pas b/src/corelib/gdi/fpg_oledragdrop.pas
index 36eed0a5..11798bb6 100644
--- a/src/corelib/gdi/fpg_oledragdrop.pas
+++ b/src/corelib/gdi/fpg_oledragdrop.pas
@@ -1,1074 +1,1074 @@
-{

-    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 }

-    {$IF FPC_FULLVERSION>=20601}

-    function    QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: DWORD):HResult; StdCall;

-    function    GiveFeedback(dwEffect: DWORD): HResult; StdCall;

-    {$ELSE}

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

-    function    GiveFeedback(dwEffect: longint): HResult; stdcall;

-    {$ENDIF}

-  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({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: TGuid; out obj): LongInt; stdcall;

-    function    _AddRef: longint; stdcall;

-    function    _Release: longint; 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 known 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 }

-

-{$IF FPC_FULLVERSION>=20601}

-function TfpgOLEDropSource.GiveFeedback(dwEffect: DWORD): HResult;

-{$ELSE}

-function TfpgOLEDropSource.GiveFeedback(dwEffect: longint): HResult;

-{$ENDIF}

-begin

-  Result := DRAGDROP_S_USEDEFAULTCURSORS;

-end;

-

-{$IF FPC_FULLVERSION>=20601}

-function TfpgOLEDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: DWORD):HResult;

-{$ELSE}

-function TfpgOLEDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: LongInt): HResult;

-{$ENDIF}

-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: longint;

-begin

-  Result := 1;

-end;

-

-function TfpgOLEDropTarget._Release: longint;

-begin

-  Result := 1;

-end;

-

-function TfpgOLEDropTarget.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: TGuid; out obj): longint; stdcall;

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

-

+{
+    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 }
+    {$IF FPC_FULLVERSION>=20601}
+    function    QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: DWORD):HResult; StdCall;
+    function    GiveFeedback(dwEffect: DWORD): HResult; StdCall;
+    {$ELSE}
+    function    QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
+    function    GiveFeedback(dwEffect: longint): HResult; stdcall;
+    {$ENDIF}
+  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({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: TGuid; out obj): LongInt; stdcall;
+    function    _AddRef: longint; stdcall;
+    function    _Release: longint; 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 known 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 }
+
+{$IF FPC_FULLVERSION>=20601}
+function TfpgOLEDropSource.GiveFeedback(dwEffect: DWORD): HResult;
+{$ELSE}
+function TfpgOLEDropSource.GiveFeedback(dwEffect: longint): HResult;
+{$ENDIF}
+begin
+  Result := DRAGDROP_S_USEDEFAULTCURSORS;
+end;
+
+{$IF FPC_FULLVERSION>=20601}
+function TfpgOLEDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: DWORD):HResult;
+{$ELSE}
+function TfpgOLEDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: LongInt): HResult;
+{$ENDIF}
+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: longint;
+begin
+  Result := 1;
+end;
+
+function TfpgOLEDropTarget._Release: longint;
+begin
+  Result := 1;
+end;
+
+function TfpgOLEDropTarget.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: TGuid; out obj): longint; stdcall;
+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.
+