Chip 1999 June/Chip_1999-06_cd.bin/zkuste/Delphi/jak/drafile/DrgDrp.Zip/DDDEST.PAS

Pascal/Delphi Source File | 1998-06-30 | 7KB | 257 lines

//===================== DRAG AND DROP DESTINATION HELPERS =====================
// These components are intended to provide an easy way to implement drag and
// drop of files into a Delphi application.
//
// TDnDRun     - items which have been dropped on the application's icon on
//               either the desktop or filemanager/explorer
// TDnDForm    - items dropped on a form
// TDnDControl - items dropped on a control (TWinControl only)
//
// Each component produces the same three events:
//    DnDStart  - sent before the items dropped list is sent
//    DnDItem   - sent for each item dropped
//    DnDFinish - sent when all items have been sent
//
// *Warning*  I have tested the code under Delphi 3.02 only
//
// Version 1.00 Grahame Marsh 16 October 1997
//         1.01 GSM 27 June 98 for UNDU
//
// Freeware - you get it for free, I take nothing, I make no promises!
//
// Please feel free to contact me: [e-mail]
//
//==============================================================================

unit DDDest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShellAPI, DsgnIntf;

type
  TDnDStartEvent = procedure (Sender: TObject; Count, X, Y: integer) of object;
  TDnDItemEvent = procedure (Sender: TObject; const Item: string) of object;

  TCustomDnD = class (TComponent)
  private
    FParent: THandle;
    FActive: boolean;
    FOnDnDStart: TDnDStartEvent;
    FOnDnDItem: TDnDItemEvent;
    FOnDnDFinish: TNotifyEvent;
    procedure SetActive (Value : boolean);
  public
    property Active: boolean read FActive write SetActive;
    property OnDnDStart: TDnDStartEvent read FOnDnDStart write FOnDnDStart;
    property OnDnDItem: TDnDItemEvent read FOnDnDItem write FOnDnDItem;
    property OnDnDFinish: TNotifyEvent read FOnDnDFinish write FOnDnDFinish;
  end;

  TDnDRun = class (TCustomDnD)
  protected
    procedure Loaded; override;
  public
    procedure Execute;
  published
    property Active;
    property OnDnDStart;
    property OnDnDItem;
    property OnDnDFinish;
  end;

  TDnDForm = class(TCustomDnD)
  private
    FOldDnDefWndProc,
    FNewDefWndProc: pointer;
    procedure NewDefWndProc (var Msg: TMessage);
  protected
    procedure Loaded; override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active;
    property OnDnDStart;
    property OnDnDItem;
    property OnDnDFinish;
  end;

  TDnDControl = class(TDnDForm)
  private
    FControl: TWinControl;
    procedure SetControl (Value: TWinControl);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property Control: TWinControl read FControl write SetControl;
  end;

function DroppedCount (DropHandle: hDrop): integer;
function DroppedItem (DropHandle: hDrop; Item: integer): string;

procedure Register;

implementation

//=== UTILITIES ================================================================

//--- function to return the number of items dropped given a drop handle
function DroppedCount (DropHandle: hDrop): integer;
begin
  Result := DragQueryFile (DropHandle, -1, nil, 0)
end;

//--- function to return an individual dropped item as a string, given the
//    drop handle and an index to an item
function DroppedItem (DropHandle: hDrop; Item: integer): string;
begin
  SetLength (Result, MAX_PATH);
  DragQueryFile (DropHandle, Item, pchar(Result), MAX_PATH-1);
  SetLength (Result, StrLen(pchar(Result)))
end;

procedure TCustomDnD.SetActive (Value : boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if FParent <> 0 then
      DragAcceptFiles (FParent, FActive)
  end
end;

//=== DROPPED ON RUN ===========================================================

// Dropped on application or in run parameter list so use the standard ParamCount
// and ParamStr() functions to invoke the events.  OnDnDStart returns 0, 0 for
// the X, Y point

procedure TDnDRun.Execute;
var
  Loop: integer;
begin
  if FActive and (ParamCount > 0) then
  begin
    if Assigned (FOnDnDStart) then
      FOnDnDStart (Self, ParamCount, 0, 0);

    if Assigned (FOnDnDItem) then
      for Loop := 1 to ParamCount do
        FOnDnDItem (Self, ParamStr (Loop));

    if Assigned (FOnDnDFinish) then
      FOnDnDFinish (Self)
  end
end;

procedure TDnDRun.Loaded;
begin
  inherited Loaded;
  Execute
end;

//=== DROPPED ON FORM ==========================================================
// Put a window subclass in so that we can watch for the WM_DROPFILES message.

constructor TDnDForm.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FParent := (AOwner as TForm).Handle;
  FNewDefWndProc := MakeObjectInstance (NewDefWndProc)
end;

procedure TDnDForm.Loaded;
begin
  inherited Loaded;
  FOldDnDefWndProc := pointer (SetWindowLong (FParent, GWL_WndProc, longint(FNewDefWndProc)));
  DragAcceptFiles (FParent, FActive)
end;

destructor TDnDForm.Destroy;
begin
  SetWindowLong (FParent, GWL_WndProc, longint(FOldDnDefWndProc));
  FreeObjectInstance (FNewDefWndProc);
  inherited Destroy
end;

procedure TDnDForm.NewDefWndProc (var Msg: TMessage);
var
  Loop,
  Count: integer;
  Point: TPoint;
begin
  with TWMDropFiles (Msg) do
    if Msg = WM_DropFiles then
    begin
// send OnStart with count and drop coords
      DragQueryPoint (Drop, Point);
      Count:= DroppedCount (Drop);
      if Assigned (FOnDnDStart) then
        FOnDnDStart (Self, Count, Point.X, Point.Y);
// send each item
      if Assigned (FOnDnDItem) then
        for Loop:= 0 to Count - 1 do
          FOnDnDItem (Self, DroppedItem (Drop, Loop));
// send finished
      DragFinish (Drop);
      if Assigned (FOnDnDFinish) then
        FOnDnDFinish (Self);

      Result := 0;
      exit
    end else
// if window is to be destroyed then stop drag files
      if Msg = WM_Destroy then
        Active := false;

  with Msg do
    Result := CallWindowProc (FOldDnDefWndProc, FParent, Msg, wParam, lParam)
end;

//=== DROPPED ON A TWinControl =================================================

procedure TDnDControl.Loaded;
begin
  if Assigned (FControl) then
    FParent := FControl.Handle;   // replace form handle with control's handle
                                  // if no control then will use the form's handle
  inherited Loaded                // before!! calling the inherited Loaded
end;

procedure TDnDControl.SetControl (Value: TWinControl);
var
  OldActive : boolean;
begin
  OldActive := FActive;
  Active := false;
  FControl := Value;
  if Assigned (FControl) then
  begin
    FControl.FreeNotification (Self);
    if Assigned (FControl) then
      FParent := FControl.Handle;
    Active := OldActive
  end
end;

procedure TDnDControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification (AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FControl) then
    FControl := nil
end;

//=== REGISTER COMPONENTS ======================================================

procedure Register;
begin
  RegisterComponents ('My Controls', [TDnDRun, TDnDForm, TDnDControl])
end;

end.