droptarget.pas

Delphi高级开发指南是开发程序的好帮手

unit DropTarget;

{ Implementation of a DropTarget object. Used by the Drag and Drop
  component. This component is responsible for providing user interface
  feedback throughout the drag operation. The cursor changes shape
  depending on the return value of the DragOver function. The actual
  drop event is initiated when the OLE libraries call the Drop function.

  jfl
}

interface

uses
  Windows, Classes, ActiveX, ComObj, ComServ, ShellApi, Dialogs,
    Interfaces, DropComponent;

type
  TDropState = ( dsNone, dsEntered, dsDisallow );
  
  TDropTarget = class( TComObject, IDropTarget, IInitDropTarget )
  private
    FAllowMultipleFiles: Boolean;
    FDropComponent: TCustomDropComponent;
    FEnabled: Boolean;
    FState: TDropState;
    function GetKeyState( grfKeyState: Longint ): DWORD;
  public
    procedure Initialize; override;
    { IDropTarget methods }
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    { IInitDropTarget methods }
    function AllowMultipleFiles( Value: Boolean ): HResult; stdcall;
    function Enabled( Value: Boolean ): HResult; stdcall;
    function SetDropTargetInstance(
      const DropTarget: TCustomDropComponent ): HResult; stdcall;
  end;

implementation

{ TDropTarget }
{ Private }

function TDropTarget.GetKeyState( grfKeyState: Longint ): DWORD;
begin
  Result := DROPEFFECT_NONE;
  if (grfKeyState and (MK_CONTROL or MK_ALT or MK_SHIFT)) = 0 then
    Result := DROPEFFECT_COPY;
  if (grfKeyState and (MK_CONTROL or MK_ALT or MK_SHIFT)) =
    (MK_CONTROL or MK_ALT or MK_SHIFT) then
    Result := DROPEFFECT_COPY;
  if (grfKeyState and MK_CONTROL) <> 0 then
    Result := DROPEFFECT_COPY;
end;

{ IDropTarget methods }

procedure TDropTarget.Initialize;
begin
  FState := dsNone;
  inherited Initialize;
end;

function TDropTarget.DragEnter( const dataObj: IDataObject;
  grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult;
var
  buffer:     String;
  count:      Integer;
  formatEtc:  TFormatEtc;
  medium:     TStgMedium;
begin
  dwEffect := DROPEFFECT_NONE;
  Result := S_OK;

  if not FEnabled then
    Exit;
    
  // We only accept the CF_HDROP format
  try
    with formatEtc do
    begin
      cfFormat  := CF_HDROP;
      ptd       := nil;
      dwAspect  := DVASPECT_CONTENT;
      lindex    := -1;
      tymed     := TYMED_HGLOBAL;
    end;
    if dataObj.QueryGetData( formatEtc ) = S_OK then
    begin
      // This code now attempts to find out how many files are
      // contained within the DataObject that implements the drag
      // and drop operation.
      SetLength( buffer, MAX_PATH );
      OleCheck( dataObj.GetData( formatEtc, medium ) );
      try
        count := DragQueryFile( medium.hGlobal, -1, @buffer[ 1 ],
          MAX_PATH );
      finally
        ReleaseStgMedium( medium );
      end;

      if (count > 1) and (not FAllowMultipleFiles) then
      begin
        dwEffect := DROPEFFECT_NONE;
        FState := dsDisallow;
      end else
      begin
        dwEffect := GetKeyState( grfKeyState );
        FState := dsEntered;
      end;
    end;
  except
    on E: EOleSysError do Result := E.ErrorCode;
  else
    Result := E_UNEXPECTED;
  end;
end;

function TDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
  var dwEffect: Longint): HResult;
begin
  try
    Result := S_OK;
    dwEffect := DROPEFFECT_NONE;
    if not FEnabled or (FState = dsDisallow) then
      Exit;

    // Default action always returns the COPY cursor (with + symbol)
    // Change the following code to return the LINK or MOVE cursors
    dwEffect := GetKeyState( grfKeyState );
  except
    on E: EOleSysError do Result := E.ErrorCode;
  else
    Result := E_UNEXPECTED;
  end;
end;

function TDropTarget.DragLeave: HResult;
begin
  FState := dsNone;
  Result := S_OK;
end;

function TDropTarget.Drop( const dataObj: IDataObject; grfKeyState: Longint;
  pt: TPoint; var dwEffect: Longint ): HResult;
begin
  try
    // Handle a file drop. We wind up notifying the Drop component
    // of the successful completion of the drop.
    Result := S_OK;
    if not FEnabled then
      Exit;

    dwEffect := GetKeyState( grfKeyState );
    FDropComponent.Drop( dataObj, dwEffect );
  except
    on E: EOleSysError do Result := E.ErrorCode;
  else
    Result := E_UNEXPECTED;
  end;
end;

{ IInitDropTarget methods }

function TDropTarget.AllowMultipleFiles( Value: Boolean ): HResult;
begin
  FAllowMultipleFiles := Value;
  Result := S_OK;
end;

function TDropTarget.SetDropTargetInstance(
  const DropTarget: TCustomDropComponent ): HResult;
begin
  FDropComponent := DropTarget;
  Result := S_OK;
end;

function TDropTarget.Enabled( Value: Boolean ): HResult;
begin
  FEnabled := Value;
  Result := S_OK;
end;

initialization
  TComObjectFactory.Create( ComServer, TDropTarget, Class_DropTarget,
    'DropTarget', 'Drop Target Object', ciMultiInstance );

end.