Solved

implementing an OCX that supports drag/drop

Posted on 1998-01-29
4
332 Views
Last Modified: 2010-04-04
I need to create an ocx that allows items to be drag/dropped from other instances of the same ocx.  

Here is a simple example:
Lets say I created an OCX from the TListbox control in delphi.  I want to be able to drap/drop between two instances of these controls in ,lets say, VB5.  How should I do this.  I probably need to do this using COM/OLE.  But I'm lazy and don't want to spend the time trying to figure out the IDragSource and IDataObject interfaces.  That's why I'm offering the following:

100 points for an example
500 points for working example OCX that does exactly what I stated above.  Don't worry the acually thing  plan on doing us much more complicated that strings.  But its a start.
0
Comment
Question by:blitz051697
  • 2
  • 2
4 Comments
 
LVL 4

Accepted Solution

by:
d003303 earned 500 total points
Comment Utility
Yo,

here is all you need. Yes, it is NOT an OCX-source. BUT you can implement it with ANY TWinControl-descendant. To see how, just look at the source. Inherit from any TWinControl-descendant you like, put the wrapper object into the private area, initialize it, register the component and build your OCX.
DropWrap.pas encapsulates the OLE stuff and the data transfer. The functionality is very extendable, also the transfered data size. It only accepts drags from providers that use the same private clipboard format. I think everything in the code should speak for itself.
The demo project is using the wrapper on a TListView. To see that it all really works, build the project and start multiple instances. You can drag and drop between all of them.
OK, here is the code :

// to be DropWrap.pas
unit DropWrap;

interface

uses
  Windows, SysUtils, Classes, Controls, ActiveX;

const ClipBoardFormatIDString = 'MyDragDrop Format';

type

  TMyDropEffect = (deNone, deCopy, deMove, deLink, deScroll);
  TMyAllowedDropEffects = set of deCopy..deScroll;

  TMyDropEvent = procedure(DropString : string; Point : TPoint) of object;
  TMyDragEvent = procedure(DropEffect : TMyDropEffect) of object;

  TMyDragObject = class;
  TMyDropObject = class;

  TMyOLEDragDropInterface = class(TComponent)
  private
    FDragDropControl    : TWinControl;
    MyDragObject        : TMyDragObject;
    MyDropTarget        : TMyDropObject;
    FOnDrop             : TMyDropEvent;
    FOnDragFinished     : TMyDragEvent;
    FDropEffect         : TMyDropEffect;
    FAllowedDragEffects,
    FAllowedDropEffects : TMyAllowedDropEffects;
    FPointDroped        : TPoint;
    FStringDroped,
    FStringToDrag       : string;
    FIsInDragging       : Boolean;
    procedure SetDragDropControl(NewValue : TWinControl);
  protected
    function GetReqBufferSize: LongInt;
    procedure SetReqBufferSize(ASize : LongInt);
    procedure DoDropFinished;
    procedure DoDragFinished;
    procedure SetDragObjectData(MemBuffer : Pointer);
    procedure SetDropObjectData(MemBuffer : Pointer);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure StartDrag(StringToDrag : string);
  published
    property IsInDragging : Boolean read FIsInDragging;
    property AllowedDragEffects : TMyAllowedDropEffects read FAllowedDragEffects write FAllowedDragEffects;
    property AllowedDropEffects : TMyAllowedDropEffects read FAllowedDropEffects write FAllowedDropEffects;
    property DragDropControl : TWinControl read FDragDropControl write SetDragDropControl;
    property OnDrop : TMyDropEvent read FOnDrop write FOnDrop;
    property OnDragFinished : TMyDragEvent read FOnDragFinished write FOnDragFinished;
  end;

  TMyEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
  private
    FmtPtr : LongInt;
  public
    constructor Create;
    // IEnumFormatEtc interface
    function Next(celt: Longint; out elt;
      pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out enum: IEnumFormatEtc): HResult; stdcall;
  end;

  TMyDragObject = class(TInterfacedObject, IDataObject, IDropSource)
  private
    // internal stuff
    ParentHandler : TMyOLEDragDropInterface;
    DragEffect    : LongInt;
  public
    // IDataObject interface
    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; var medium: TStgMedium;
      fRelease: BOOL): HResult; stdcall;
    function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
      IEnumFormatEtc): HResult; stdcall;
    function DAdvise(const formatetc: TFormatEtc; advf: Longint;
      const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
    function DUnadvise(dwConnection: Longint): HResult; stdcall;
    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
      stdcall;
    // IDropSource interface
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  end;

  TMyDropObject = class(TInterfacedObject, IDropTarget)
  private
    // internal stuff
    ParentHandler : TMyOLEDragDropInterface;
  public
    // IDropTarget interface
    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;
  end;

  EMyOLEDragDropInterfaceException = class(Exception);

implementation

var MyFormatEtc   : TFormatEtc;
    CF_MyDragDrop : LongInt;

function CheckClipboardFormat(dataObj: IDataObject): Boolean;
begin
  Result := Succeeded(dataObj.QueryGetData(MyFormatEtc));
end;

// here we translate the standard key behaviour
function TranslateKeyStateToDragEffect(KS : Longint; ADE : TMyAllowedDropEffects): LongInt;
begin
  // none by default
  Result := DROPEFFECT_NONE;
  // move is default without key pressed
  if deMove in ADE
   then Result := DROPEFFECT_MOVE;
  // copy
  if (KS and MK_CONTROL) = MK_CONTROL then
   begin
     if deCopy in ADE
      then Result := DROPEFFECT_COPY;
     // link
     if (KS and MK_SHIFT) = MK_SHIFT then
      if deLink in ADE
       then Result := DROPEFFECT_LINK;
   end;
end;

////////////////////////////////////////////////////////////////////////////////

constructor TMyOLEDragDropInterface.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FDragDropControl := nil;
  FAllowedDragEffects := [deCopy, deMove, deLink];
  FAllowedDropEffects := [deCopy, deMove, deLink];
  MyDropTarget := TMyDropObject.Create;
  MyDropTarget.ParentHandler := Self;
  MyDropTarget._AddRef;
end;

destructor TMyOLEDragDropInterface.Destroy;
begin
  MyDropTarget._Release;
  inherited Destroy;
end;

procedure TMyOLEDragDropInterface.SetDragDropControl(NewValue : TWinControl);
var RegisterResult : HResult;
    ErrorStr       : string;
begin
  if NewValue <> FDragDropControl then
   begin
     if FDragDropControl <> nil then
      begin
        // first unregister old window
        RegisterResult := RevokeDragDrop(FDragDropControl.Handle);
        if (RegisterResult <> S_OK) and (RegisterResult <> DRAGDROP_E_NOTREGISTERED) then
         begin
           case RegisterResult of
             DRAGDROP_E_INVALIDHWND : ErrorStr := 'Invalid window handle';
             E_OUTOFMEMORY : ErrorStr := 'Out of memory';
           end;
           FDragDropControl := nil;
           raise EMyOLEDragDropInterfaceException.Create(ErrorStr);
         end;
      end;
     // now register new window
     RegisterResult := RegisterDragDrop(NewValue.Handle, MyDropTarget as IDropTarget);
     if (RegisterResult <> S_OK) and (RegisterResult <> DRAGDROP_E_ALREADYREGISTERED) then
      begin
        case RegisterResult of
          DRAGDROP_E_INVALIDHWND : ErrorStr := 'Invalid window handle';
          E_OUTOFMEMORY : ErrorStr := 'Out of memory';
        end;
        raise EMyOLEDragDropInterfaceException.Create(ErrorStr);
      end;
     FDragDropControl := NewValue;
   end;
end;

procedure TMyOLEDragDropInterface.StartDrag(StringToDrag : string);
var dwDropEffect : LongInt;
begin
  dwDropEffect := DROPEFFECT_NONE;
  if deCopy in FAllowedDragEffects
   then dwDropEffect := dwDropEffect or DROPEFFECT_COPY;
  if deMove in FAllowedDragEffects
   then dwDropEffect := dwDropEffect or DROPEFFECT_MOVE;
  if deLink in FAllowedDragEffects
   then dwDropEffect := dwDropEffect or DROPEFFECT_LINK;
  FStringToDrag := StringToDrag;
  MyDragObject := TMyDragObject.Create;
  MyDragObject._AddRef;
  MyDragObject.ParentHandler := Self;
  FIsInDragging := true;
  DoDragDrop(MyDragObject as IDataObject, MyDragObject as IDropSource,
             dwDropEffect, MyDragObject.DragEffect);
  dwDropEffect := MyDragObject.DragEffect;
  MyDragObject._Release;
  if (dwDropEffect and DROPEFFECT_NONE) = DROPEFFECT_NONE
   then FDropEffect := deNone;
  if (dwDropEffect and DROPEFFECT_COPY) = DROPEFFECT_COPY
   then FDropEffect := deCopy;
  if (dwDropEffect and DROPEFFECT_MOVE) = DROPEFFECT_MOVE
   then FDropEffect := deMove;
  if (dwDropEffect and DROPEFFECT_LINK) = DROPEFFECT_LINK
   then FDropEffect := deLink;
  FIsInDragging := false;
  DoDragFinished;
end;

function TMyOLEDragDropInterface.GetReqBufferSize: LongInt;
begin
  Result := Length(FStringToDrag) + 1;
end;

procedure TMyOLEDragDropInterface.SetReqBufferSize(ASize : LongInt);
begin
  // does nothing here, used for extensions
end;

procedure TMyOLEDragDropInterface.SetDragObjectData(MemBuffer : Pointer);
begin
  // copy data only if drop succesful
  StrPCopy(MemBuffer, FStringToDrag);
end;

procedure TMyOLEDragDropInterface.SetDropObjectData(MemBuffer : Pointer);
begin
  FStringDroped := StrPas(MemBuffer);
end;

procedure TMyOLEDragDropInterface.DoDropFinished;
begin
  if Assigned(FOnDrop)
   then FOnDrop(FStringDroped, FDragDropControl.ScreenToClient(FPointDroped));
end;

procedure TMyOLEDragDropInterface.DoDragFinished;
begin
  if Assigned(FOnDragFinished)
   then FOnDragFinished(FDropEffect);
end;

////////////////////////////////////////////////////////////////////////////////

constructor TMyEnumFormatEtc.Create;
begin
  inherited Create;
  Reset;
end;

function TMyEnumFormatEtc.Next(celt: Longint; out elt; pceltFetched: PLongint): HResult;
begin
  Result :=  S_FALSE;
  // all out ?
  if FmtPtr = 1
   then Exit;
  Pointer(elt) := @MyFormatEtc;
  Inc(FmtPtr);
  if pceltFetched <> nil
   then pceltFetched^ := 1;
  if celt = 1
   then Result := S_OK;
end;

function TMyEnumFormatEtc.Skip(celt: Longint): HResult;
begin
  if FmtPtr + celt > 1 then
   begin
     Result :=  S_FALSE;
     Exit;
   end;
  FmtPtr := FmtPtr + celt;
  Result := S_OK;
end;

function TMyEnumFormatEtc.Reset: HResult;
begin
  FmtPtr := 1;
  Result := S_OK;
end;

function TMyEnumFormatEtc.Clone(out enum: IEnumFormatEtc): HResult;
var NewEnum : TMyEnumFormatEtc;
begin
  // create object
  NewEnum := TMyEnumFormatEtc.Create;
  if NewEnum = nil then
   begin
     Result := E_OUTOFMEMORY;
     Exit;
   end;
  // clone current state
  NewEnum.FmtPtr := FmtPtr;
  enum := NewEnum;
  Result := S_OK;
end;

////////////////////////////////////////////////////////////////////////////////

function TMyDragObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
var MemHandle  : THandle;
    MemPointer : Pointer;
begin
  // look if format ok
  Result := QueryGetData(formatetcIn);
  if Failed(Result)
   then Exit;
  MemHandle := GlobalAlloc(GMEM_MOVEABLE, ParentHandler.GetReqBufferSize);
  try
    MemPointer := GlobalLock(MemHandle);
    ParentHandler.SetDragObjectData(MemPointer);
    GlobalUnlock(MemHandle);
    medium.tymed :=  TYMED_HGLOBAL;
    medium.hGlobal := MemHandle;
    // receiver shall free memory
    medium.unkForRelease := nil;
  except
    Result := E_UNEXPECTED;
    GlobalFree(MemHandle);
  end;
end;

function TMyDragObject.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyDragObject.QueryGetData(const formatetc: TFormatEtc): HResult;
begin
  with formatetc do
   begin
     if cfFormat <> MyFormatEtc.cfFormat
      then Result := DV_E_FORMATETC
      else
       if dwAspect <> MyFormatEtc.dwAspect
        then Result := DV_E_DVASPECT
        else if lindex <> MyFormatEtc.lindex
         then Result := DV_E_LINDEX
         else if tymed <> MyFormatEtc.tymed
          then Result := DV_E_TYMED
          else Result := S_OK;
   end;
end;

function TMyDragObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyDragObject.SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyDragObject.EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult;
begin
  if dwDirection = DATADIR_SET then
   begin
     Result := E_NOTIMPL;
     Exit;
   end;
  enumFormatEtc := TMyEnumFormatEtc.Create;
  if enumFormatEtc = nil
   then Result := E_OUTOFMEMORY
   else Result := S_OK;
end;

function TMyDragObject.DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyDragObject.DUnadvise(dwConnection: Longint): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyDragObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
begin
  Result := E_NOTIMPL;
end;

function TMyDragObject.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult;
begin
  Result := S_OK;
  // cancel drag on escape
  if fEscapePressed
   then Result := DRAGDROP_S_CANCEL;
  // commit drag on left mouse button up
  if (grfKeyState and MK_LBUTTON) <> MK_LBUTTON
   then Result := DRAGDROP_S_DROP;
end;

function TMyDragObject.GiveFeedback(dwEffect: Longint): HResult;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;

////////////////////////////////////////////////////////////////////////////////

function TMyDropObject.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
begin
  // no data object, no acceptance
  // query clipboard format
  if (dataObj = nil) or (not CheckClipboardFormat(dataObj)) then
   begin
     Result := E_FAIL;
     Exit;
   end;
  // proceed with standard keys
  dwEffect := TranslateKeyStateToDragEffect(grfKeyState, ParentHandler.AllowedDropEffects);
  Result := S_OK;
end;

function TMyDropObject.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
begin
  // proceed with standard keys
  dwEffect := TranslateKeyStateToDragEffect(grfKeyState, ParentHandler.AllowedDropEffects);
  Result := S_OK;
end;

function TMyDropObject.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TMyDropObject.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
var medium     : TStgMedium;
    MemPointer : Pointer;
begin
  Result := E_FAIL;
  // no data object, no acceptance
  // query clipboard format
  if (dataObj = nil) or (not CheckClipboardFormat(dataObj))
   then Exit;

  Result := dataObj.GetData(MyFormatEtc, medium);
  if Failed(Result)
   then Exit;

  ParentHandler.SetReqBufferSize(GlobalSize(medium.hGlobal));
  MemPointer := GlobalLock(medium.hGlobal);
  try
    ParentHandler.SetDropObjectData(MemPointer);
    ParentHandler.FPointDroped := pt;
  finally
    GlobalUnlock(medium.hGlobal);
    ReleaseStgMedium(medium);
  end;

  _AddRef;
  try
    ParentHandler.DoDropFinished;
  finally
    _Release;
  end;
  dwEffect := TranslateKeyStateToDragEffect(grfKeyState, ParentHandler.AllowedDropEffects);
  Result := S_OK;
end;

initialization
  OleInitialize(nil);
  CF_MyDragDrop := RegisterClipboardFormat(ClipBoardFormatIDString);
  with MyFormatEtc do
   begin
     cfFormat := CF_MyDragDrop;
     ptd := nil;
     dwAspect := DVASPECT_CONTENT;
     lindex := -1;
     tymed := TYMED_HGLOBAL;
   end;
finalization
  OleUnInitialize;
end.

// sample project files : form code
// to be _tst.pas
unit _tst;

interface

uses
  Windows,Classes, Controls, Forms, StdCtrls, ComCtrls, ExtCtrls, DropWrap;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    Panel1: TPanel;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    GroupBox2: TGroupBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    procedure ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
  private
    { Private declarations }
    MyWrapper  : TMyOLEDragDropInterface;
    DragedItem : TListItem;
    procedure ProcessAllowDrag(EF : TMyAllowedDropEffects; CB : TCheckBox);
    procedure ProcessAllowDrop(EF : TMyAllowedDropEffects; CB : TCheckBox);
    procedure OnDrop(DropString : string; Point : TPoint);
    procedure OnDragFinished(DropEffect : TMyDropEffect);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.OnDrop(DropString : string; Point : TPoint);
var AListItem : TListItem;
begin
  AListItem := ListView1.Items.Add;
  AListItem.Caption := DropString;
  AListItem.SetPosition(Point);
end;

procedure TForm1.OnDragFinished(DropEffect : TMyDropEffect);
begin
  case DropEffect of
    deNone : Panel1.Caption := '  Drag cancelled';
    deCopy : Panel1.Caption := '  Item copied';
    deMove : begin
               Panel1.Caption := '  Item moved';
               DragedItem.Delete;
             end;
    deLink : Panel1.Caption := '  Item linked';
  end;
end;

procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (ssLeft in Shift) and (not MyWrapper.IsInDragging) then
   begin
     Panel1.Caption := '';
     if ListView1.SelCount <> 0 then
      begin
        DragedItem := ListView1.Selected;
        MyWrapper.StartDrag(DragedItem.Caption);
      end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyWrapper := TMyOLEDragDropInterface.Create(Self);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  MyWrapper.DragDropControl := ListView1;
  MyWrapper.OnDrop := OnDrop;
  MyWrapper.OnDragFinished := OnDragFinished;
end;

procedure TForm1.ProcessAllowDrag(EF : TMyAllowedDropEffects; CB : TCheckBox);
begin
  if CB.Checked
   then MyWrapper.AllowedDragEffects := MyWrapper.AllowedDragEffects + EF
   else MyWrapper.AllowedDragEffects := MyWrapper.AllowedDragEffects - EF;
end;

procedure TForm1.ProcessAllowDrop(EF : TMyAllowedDropEffects; CB : TCheckBox);
begin
  if CB.Checked
   then MyWrapper.AllowedDropEffects := MyWrapper.AllowedDropEffects + EF
   else MyWrapper.AllowedDropEffects := MyWrapper.AllowedDropEffects - EF;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  ProcessAllowDrag([deCopy], CheckBox1);
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  ProcessAllowDrag([deMove], CheckBox2);
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  ProcessAllowDrag([deLink], CheckBox3);
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
  ProcessAllowDrop([deCopy], CheckBox4);
end;

procedure TForm1.CheckBox5Click(Sender: TObject);
begin
  ProcessAllowDrop([deMove], CheckBox5);
end;

procedure TForm1.CheckBox6Click(Sender: TObject);
begin
  ProcessAllowDrop([deLink], CheckBox6);
end;

end.

// to be _tst.dfm
object Form1: TForm1
  Left = 200
  Top = 108
  Width = 637
  Height = 413
  Caption = 'Form1'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 97
    Top = 0
    Width = 532
    Height = 370
    Align = alClient
    Columns = <>
    Items.Data = {
      590000000300000000000000FFFFFFFFFFFFFFFF000000000000000006497465
      6D203101000000FFFFFFFFFFFFFFFF0000000000000000064974656D20320200
      0000FFFFFFFFFFFFFFFF0000000000000000064974656D2033}
    OnMouseMove = ListView1MouseMove
    TabOrder = 0
    LargeImages = ImageList1
  end
  object Panel1: TPanel
    Left = 0
    Top = 370
    Width = 629
    Height = 16
    Align = alBottom
    Alignment = taLeftJustify
    BevelOuter = bvLowered
    TabOrder = 1
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 97
    Height = 370
    Align = alLeft
    BevelOuter = bvLowered
    TabOrder = 2
    object GroupBox1: TGroupBox
      Left = 12
      Top = 8
      Width = 73
      Height = 85
      Caption = 'Drag Allow'
      TabOrder = 0
      object CheckBox1: TCheckBox
        Left = 12
        Top = 20
        Width = 49
        Height = 17
        Caption = 'Copy'
        State = cbChecked
        TabOrder = 0
        OnClick = CheckBox1Click
      end
      object CheckBox2: TCheckBox
        Left = 12
        Top = 40
        Width = 53
        Height = 17
        Caption = 'Move'
        State = cbChecked
        TabOrder = 1
        OnClick = CheckBox2Click
      end
      object CheckBox3: TCheckBox
        Left = 12
        Top = 60
        Width = 49
        Height = 17
        Caption = 'Link'
        State = cbChecked
        TabOrder = 2
        OnClick = CheckBox3Click
      end
    end
    object GroupBox2: TGroupBox
      Left = 12
      Top = 96
      Width = 73
      Height = 85
      Caption = 'Drop Allow'
      TabOrder = 1
      object CheckBox4: TCheckBox
        Left = 12
        Top = 20
        Width = 53
        Height = 17
        Caption = 'Copy'
        State = cbChecked
        TabOrder = 0
        OnClick = CheckBox4Click
      end
      object CheckBox5: TCheckBox
        Left = 12
        Top = 40
        Width = 53
        Height = 17
        Caption = 'Move'
        State = cbChecked
        TabOrder = 1
        OnClick = CheckBox5Click
      end
      object CheckBox6: TCheckBox
        Left = 12
        Top = 60
        Width = 45
        Height = 17
        Caption = 'Link'
        State = cbChecked
        TabOrder = 2
        OnClick = CheckBox6Click
      end
    end
  end
  object ImageList1: TImageList
    Left = 12
    Top = 200
    Bitmap = {
      4206000003000000424D42060000000000004200000028000000300000001000
      000001001000030000000006000000000000000000000000000000000000007C
      0000E00300001F000000000000000000000000000000000000000042FF7F1042
      FF7F00000000000000000000000000000000000000000000FF7FFF7FFF7F0000
      00000000000000000000000000000000FF7FFF7FFF7FFF7FFF7FFF7F00000000
      FF7FFF7FFF7F00000000000000000000000000000000FF7F0000E07F00000000
      1042FF7F000000000000000000000000000000000000FF7F0000000010420000
      000000000000000000000000FF7F0000E07FE07FE07FE07F0042004200000000
      E07FE07F0000FF7F00000000000000000000000000000042FF7F000010421042
      00001042FF7F00000000000000000000FF7FFF7FFF7F00001042000010420000
      FF7FFF7F0000000000000000004200420000000000000000000000000000E07F
      E07FE07F0042000000000000000000000000FF7F0000E07F0000104200000000
      104200001042FF7F000000000000FF7F1042000010420000186300000000FF7F
      00001042FF7F0000000000000000004200420042004200420042E07FE07FE07F
      0042E07FE07FE07FFF7F00000000000000000042FF7F00001042000000000000
      0000104200001042000000000000104218631863104210421042104210421042
      1042000010420000000000000042004200420042004200420042E07FE07F0042
      E07FE07F0042E07FFF7F00000000FF7F0000E07F000010420000000000000000
      00000000104210420000000000000000186318631863186318631863FF7F1863
      10420000FF7F00000000004200000000E07FE07FE07F00420042E07FE07F0042
      E07F00000042E07FFF7F000000000042FF7F0000104200000000000000001042
      000000000000000000420000104210421863186318631863000010421042FF7F
      1042000010421042FF7F00420042004200420042004200420042E07F00420042
      E07FE07FE07FE07FFF7FFF7F0000E07F00001042000000000000000000000000
      00000000FF7FE07FE07F104200000000FF7F1863186318630000104210421863
      1042000000000000FF7F0000000000420042000000000000000000000042E07F
      00420042E07F000000000042FF7F000010420000000000001042104200000000
      00000000004200000000104218631863FF7F1042000000000000000000001863
      1042186310420000FF7F00000000E07FE07FE07FE07FE07FE07FE07FE07F0042
      E07FE07F000000000000E07F0000104200000000000010421042000000000000
      FF7FE07FE07F00000000104200000000FF7F10421863FF7F0000186318631863
      1042000000000000FF7F0000000000000000E07F186318631863186300000000
      0000000000000000000000001042000000000000000010420000000000000000
      0042000000000000000000000000000018630000104218630000186318631863
      10420000FF7F0000000000000000004218630000E07FE07FE07FE07FE07FE07F
      0000FF7F000000000000104200000000104210421042000000000000FF7FE07F
      E07F000000000000000000000000FF7F1863FF7F000010421042186318631863
      1042000010420000000000000000000000420042FF7FFF7FFF7F004200420042
      00420042FF7F0000000000000000000010421042104200000000000000420000
      00000000000000000000000000001042186318631863FF7FFF7FFF7F18631042
      10420000FF7F00000000000000000000000000420042E07FE07FE07FE07FE07F
      00420000FF7F000000000000000000000000000000000000FF7FE07FE07F0000
      0000000000000000000000000000000010420000FF7F00001863000010420000
      0000FF7F00000000000000000000000000000042E07FE07FE07FE07FE07F0042
      0042000000000000000000000000000000000000000000000042000000000000
      0000000000000000000000000000000000000000000000001863000010420000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000FF7FE07FE07F000000000000
      0000000000000000000000000000000000000000000010421042104210420000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000424DBE000000000000003E0000002800000030000000
      1000000001000100000000008000000000000000000000000200000002000000
      00000000FFFFFF00FF0FFE3FE0630000FD07FC3F80010000FC03E02780010000
      F401C00380000000F001C00300000000D001E00300000000C000800000000000
      4000000080010000000300008003000000030000800F0000000FE00380070000
      000FC003C0030000803FC003E0030000C03FE027E0070000E0FFFC3FF81F0000
      F0FFFC3FFFFF0000}
  end
end

// to be test.dpr
program test;

uses
  Forms,
  _tst in '_tst.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

///////////////////////////////////////////7

Have fun,
Slash/d003303
0
 

Author Comment

by:blitz051697
Comment Utility
Thanks, I'll try it today and award points after.  It looks like just what I needed.

blitz
0
 

Author Comment

by:blitz051697
Comment Utility
Your example works great.  three additional questions.

1.   What if I want to pass a COM object around rather than a string.  how difficult would this be.  I have a string grid filled with data.  when someone whats to drag/drop or manipulate the information, I instanciate a com object for the selected item in the grid.  If they drag to another window --I would want to pass the object reference.  

2.  How do I handle multi-select?
3. What is the "link" method.   I didn't see where this was ever used in your example?  

thanks, blitz
0
 
LVL 4

Expert Comment

by:d003303
Comment Utility
1 + 2:  You even do not need a COM object. You can use any component, fill it with appropriate data, stream it into a memory stream (TMemoryStream.WriteComponent) and copy the memory into the global transfer mem. On the client side, you copy the global memory into a memory stream and use ReadComponent to create the component that now includes all data fields.

So e.g. you create 2 invisible string grids as transfer objects. When the drag starts, empty the first grid, copy all selected fields into this grid and stream the grid into memory. When the drop occurs, empty the second grid, stream the memory component into the grid and look what's in. All data and properties are properly set in  there.

3: The Link method does a copy in my example. It is the equivalent to "create shortcut" (cursor with little arrow in the br corner).

Slash/d003303
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now