この発言は
#00763　ぜえた          さんのﾌｧｲﾙのﾄﾞﾛｯﾌﾟを受け入れるようにするコンポ
に対するコメントです

この発言に対し以下のコメントが寄せられています

#01140　ぜえた          さん　RE^2:ﾌｧｲﾙのﾄﾞﾛｯﾌﾟを受け入れるようにする




　こんにちは、ぜえた です。





　前のものは参照先のコントロールがウインドウハンドルの再生成を行
うとドラッグ＆ドロップを受け入れなくなるので作り替えました。
　今回のものは TPanelを継承していてドラッグ＆ドロップの制御に標準
の OnDragOver, OnDragDropを使うようにしました。このパネルの上に他
のコントロールが乗っていてもエクスプローラなどからのファイルのド
ラッグ＆ドロップはこのパネルが反応します。

unit DAPanel;

interface

uses
  Windows, Messages, Classes, Controls, Forms, ExtCtrls, ActiveX, ShellApi;

type
  TFileDropTarget = class;

  TDragAcceptPanel = class(TPanel)
  private
    FDropTarget: TFileDropTarget;
    FFileNames: TStrings;
    FDragPosition: TPoint;
    FDragShiftState: TShiftState;
    procedure SetDragInfo(Keys: DWORD; pt: TPoint);
    function DoDragOver(State: TDragState): Boolean;
    procedure DoDragDrop;
    procedure GetInfo(Drop: HDrop);
    procedure CMEnableChanged(var Message: TMessage); message CM_ENABLEDCHANGED;  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FileNames: TStrings read FFileNames;
    property DragPosition: TPoint read FDragPosition;
    property DragShiftState: TShiftState read FDragShiftState;
  end;

  TFileDropTarget = class(TInterfacedObject, IDropTarget)
  private
    FDragAcceptPanel: TDragAcceptPanel;
    FAcceptable: Boolean;
  protected
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
  public
    constructor Create(ADragAcceptPanel: TDragAcceptPanel);
  end;

procedure Register;

implementation

{ TDragAcceptPanel }

constructor TDragAcceptPanel.Create(AOwner: TComponent); //override;
begin
  inherited Create(AOwner);
  FFileNames := TStringList.Create;
  FDropTarget := TFileDropTarget.Create(Self);
  FDropTarget._AddRef;
  CoLockObjectExternal(FDropTarget, True, False);
end;

destructor TDragAcceptPanel.Destroy; //override;
begin
  CoLockObjectExternal(FDropTarget, False, True);
  FDropTarget.Free;
  FFileNames.Free;
  inherited Destroy;
end;

procedure TDragAcceptPanel.CreateWnd; //override;
begin
  inherited CreateWnd;
  if Enabled then RegisterDragDrop(Handle, FDropTarget);
end;

procedure TDragAcceptPanel.DestroyWnd; //override;
begin
  if Enabled then RevokeDragDrop(Handle);
  inherited DestroyWnd;
end;

procedure TDragAcceptPanel.CMEnableChanged(var Message: TMessage); //message
CM_ENABLEDCHANGED;
begin
  inherited;
  if HandleAllocated then begin
    if Enabled then
      RegisterDragDrop(Handle, FDropTarget)
    else
      RevokeDragDrop(Handle);
  end;
end;

procedure TDragAcceptPanel.SetDragInfo(Keys: DWORD; pt: TPoint);
begin
  FDragShiftState := KeysToShiftState(Keys);
  FDragPosition := pt;
end;

function TDragAcceptPanel.DoDragOver(State: TDragState): Boolean;
begin
  with ScreenToClient(FDragPosition) do
    DragOver(Self, X, Y, State, Result);
end;

procedure TDragAcceptPanel.DoDragDrop;
begin
  with ScreenToClient(FDragPosition) do
    DragDrop(Self, X, Y);
end;

procedure TDragAcceptPanel.GetInfo(Drop: HDrop);
var
  c: Integer;
  i: Integer;
  Buf: array[0..MAX_PATH - 1] of Char;
begin
  c := DragQueryFile(Drop, $FFFFFFFF, Buf, MAX_PATH);
  FFileNames.Clear;
  FFileNames.Capacity := c;
  for i := 0 to c - 1 do begin
    DragQueryFile(Drop, i, Buf, MAX_PATH);
    FFileNames.Add(Buf);
  end;
end;

{ TFileDropTarget }

const
  FormatEtc: TFormatEtc = (
    cfFormat: CF_HDROP;
    ptd: nil;
    dwAspect: DVASPECT_CONTENT;
    lindex: -1;
    tymed: TYMED_HGLOBAL);

constructor TFileDropTarget.Create(ADragAcceptPanel: TDragAcceptPanel);
begin
  inherited Create;
  FDragAcceptPanel := ADragAcceptPanel;
end;

function TFileDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState:
Longint;
  pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
  FAcceptable := dataObj.QueryGetData(FormatEtc) = S_OK;
  FDragAcceptPanel.SetDragInfo(grfKeyState, pt);
  if FAcceptable and FDragAcceptPanel.DoDragOver(dsDragEnter) then
    dwEffect := DROPEFFECT_COPY
  else
    dwEffect := DROPEFFECT_NONE;
  Result := S_OK;
end;

function TFileDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
  var dwEffect: Longint): HResult; stdcall;
begin
  FDragAcceptPanel.SetDragInfo(grfKeyState, pt);
  if FAcceptable and FDragAcceptPanel.DoDragOver(dsDragMove) then
    dwEffect := DROPEFFECT_COPY
  else
    dwEffect := DROPEFFECT_NONE;
  Result := S_OK;
end;

function TFileDropTarget.DragLeave: HResult; stdcall;
begin
  FDragAcceptPanel.DoDragOver(dsDragLeave);
  Result := S_OK;
end;

function TFileDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint;
  var dwEffect: Longint): HResult; stdcall;
var
  Medium: TStgMedium;
begin
  if dataObj.GetData(FormatEtc, Medium) <> S_OK then begin
    dwEffect := DROPEFFECT_NONE;
    Result := E_UNEXPECTED;
    Exit;
  end;
  FDragAcceptPanel.SetDragInfo(grfKeyState, pt);
  try
    FDragAcceptPanel.GetInfo(Medium.hGlobal);
    FDragAcceptPanel.DoDragDrop;
  finally
    ReleaseStgMedium(Medium);
  end;
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

{ Register }

procedure Register;
begin
  RegisterComponents('Samples', [TDragAcceptPanel]);
end;

{ initialization, finalization }

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.

                                                    ぜえた (QZC05100)

Original document by ぜえた          氏 ID:(QZC05100)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。