Tag: delphi

In Friday in our SIM (Shareware Information System) I added the possibility to drag’n’drop the mail content from external mailer (MS Outlook, Outlook Express etc)

To add this feature you need:
1. declare two new Cliboard formats that need to be registered:

var
  CF_FILECONTENTS,
  CF_FILEDESCRIPTOR: Integer;initialization

  // Initialize the OLE libraries
  OleInitialize(nil);

  // Register the clipboard formats that we need to handle in the
  // OLE drag drop operation
  CF_FILECONTENTS := RegisterClipboardFormat(CFSTR_FILECONTENTS);
  CF_FILEDESCRIPTOR := RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR);

finalization
  OleUninitialize;

2. in OnCreate event for your form allow window to accept drop events. Just execute the next code:

OleCheck(RegisterDragDrop(Handle, Self));

3. for your form you need implement a few methods for IDropTarget interface:

type
  TfrmOrderWizard = class(TForm, IDropTarget)
  ...
  private
    { IDropTarget }
    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;
    { IUnknown
     Ignore referance counting }
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    ...

where:

function TfrmOrderWizard.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
     var dwEffect: Longint): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result  := S_OK;
end;

function TfrmOrderWizard.DragOver(grfKeyState: Longint; pt: TPoint;
     var dwEffect: Longint): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

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

function TfrmOrderWizard._AddRef: Integer;
begin
   Result := 1;
end;

function TfrmOrderWizard._Release: Integer;
begin
  Result := 1;
end;

function TfrmOrderWizard.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  var dwEffect: Longint): HResult;
const
  PT_TSTRING = ULONG(30);
  PT_UNICODE = ULONG(31);
  PR_BODY    = PT_TSTRING or ($1000 shl 16);
  PR_BODY_W  = PT_UNICODE or ($1000 shl 16);
var
  aFmtEtc: TFORMATETC;
  aStgMed, stgmitem: TSTGMEDIUM;
  pData: PChar;
  pfgd: PFileGroupDescriptor;
  dwCount, dwfetch: Integer;

  stat: STATSTG;
  pstg: IStorage;
  pstm: IStream;
begin
  {Make certain the data rendering is available}
  if (dataObj = nil) then
    raise Exception.Create('IDataObject-Pointer is not valid!');
  with aFmtEtc do
  begin
    cfFormat := CF_TEXT;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  {Get the data}
  OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
  try
    {Lock the global memory handle to get a pointer to the data}
    pData := GlobalLock(aStgMed.hGlobal);
    { Replace Text }
    MemoOrder.Text := pData;
  finally
    {Finished with the pointer}
    GlobalUnlock(aStgMed.hGlobal);
    {Free the memory}
    ReleaseStgMedium(aStgMed);
  end;

  // Get the file descriptors
  with aFmtEtc do
  begin
    cfFormat := CF_FILEDESCRIPTOR;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
  try
    pfgd := PFileGroupDescriptor(GlobalLock(aStgMed.hGlobal));
    // Iterate each of the files
    for dwCount := 0 to pfgd.cItems-1 do
    begin
      // Set up for getting the file data
      with aFmtEtc do
      begin
        cfFormat := CF_FILECONTENTS;
        ptd := nil;
        dwAspect := DVASPECT_CONTENT;
        lindex := dwCount;
        tymed := TYMED_ISTORAGE;
      end;
      if (dataObj.GetData(aFmtEtc, stgmitem) = S_OK) then
      begin
        // IStorage (handle the outlook item)
        pstg := IStorage(stgmitem.stg);
        // Hard coded to open the outlook message item stream
        if (pstg.OpenStream('__substg1.0_1000001F', nil, STGM_SHARE_EXCLUSIVE or STGM_READ, 0, pstm) = S_OK) or
           (pstg.OpenStream('__substg1.0_1000001E', nil, STGM_SHARE_EXCLUSIVE or STGM_READ, 0, pstm) = S_OK) then
        begin
          pstm.Stat(stat, STATFLAG_DEFAULT);
          pData := AllocMem(stat.cbSize);
          try
            pstm.Read(pData, stat.cbSize, @dwFetch);
            // Set the msg body
            MemoOrder.Lines.Add(String(pData));
          finally
            // Free buffer memory
            FreeMem(pData);
          end;
          // Free the stream
          pstm := nil;
        end;
        // Free the storage
        pstg := nil;
        // Release the storage medium
        ReleaseStgMedium(stgmitem);
      end;
    end;
  finally
    // Unlock the memory
    GlobalUnLock(aStgMed.hGlobal);
    // Release the storage medium
    ReleaseStgMedium(aStgMed);
  end;

  Result := S_OK;
end;