Subversion Repositories decoder

unit DropSource3;

// -----------------------------------------------------------------------------

//

//                      *** NOT FOR RELEASE ***

//

// -----------------------------------------------------------------------------

// Project:         Drag and Drop Component Suite

// Module:          DropSource3

// Description:     Deprecated TDropSource class.

//                  Provided for compatibility with previous versions of the

//                  Drag and Drop Component Suite.

// Version:         4.0

// Date:            25-JUN-2000

// Target:          Win32, Delphi 3-6 and C++ Builder 3-5

// Authors:         Angus Johnson, ajohnson@rpi.net.au

//                  Anders Melander, anders@melander.dk, http://www.melander.dk

// Copyright        © 1997-2000 Angus Johnson & Anders Melander

// -----------------------------------------------------------------------------

interface

uses

  DragDrop,

  DropSource,

  ActiveX,

  Classes;

{$include DragDrop.inc}

const

  MAXFORMATS = 20;

type

  // TODO -oanme -cStopShip : Verify that TDropSource can be used for pre v4 components.

  TDropSource = class(TCustomDropSource)

  private

    FDataFormats: array[0..MAXFORMATS-1] of TFormatEtc;

    FDataFormatsCount: integer;

  protected

    // IDataObject implementation

    function QueryGetData(const FormatEtc: TFormatEtc): HRESULT; stdcall;

    // TCustomDropSource implementation

    function HasFormat(const FormatEtc: TFormatEtc): boolean; override;

    function GetEnumFormatEtc(dwDirection: LongInt): IEnumFormatEtc; override;

    // New functions...

    procedure AddFormatEtc(cfFmt: TClipFormat; pt: PDVTargetDevice;

      dwAsp, lInd, tym: longint); virtual;

  public

    constructor Create(AOwner: TComponent); override;

  end;

implementation

uses

  ShlObj,

  SysUtils,

  Windows;

// -----------------------------------------------------------------------------

//                      TEnumFormatEtc

// -----------------------------------------------------------------------------

type

  pFormatList = ^TFormatList;

  TFormatList = array[0..255] of TFormatEtc;

  TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)

  private

    FFormatList: pFormatList;

    FFormatCount: Integer;

    FIndex: Integer;

  public

    constructor Create(FormatList: pFormatList; FormatCount, Index: Integer);

    { IEnumFormatEtc }

    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;

// -----------------------------------------------------------------------------

constructor TEnumFormatEtc.Create(FormatList: pFormatList;

            FormatCount, Index: Integer);

begin

  inherited Create;

  FFormatList := FormatList;

  FFormatCount := FormatCount;

  FIndex := Index;

end;

// -----------------------------------------------------------------------------

function TEnumFormatEtc.Next(Celt: LongInt;

  out Elt; pCeltFetched: pLongInt): HRESULT;

var

  i: Integer;

begin

  i := 0;

  WHILE (i < Celt) and (FIndex < FFormatCount) do

  begin

    TFormatList(Elt)[i] := FFormatList[fIndex];

    Inc(FIndex);

    Inc(i);

  end;

  if pCeltFetched <> NIL then pCeltFetched^ := i;

  if i = Celt then result := S_OK else result := S_FALSE;

end;

// -----------------------------------------------------------------------------

function TEnumFormatEtc.Skip(Celt: LongInt): HRESULT;

begin

  if Celt <= FFormatCount - FIndex then

  begin

    FIndex := FIndex + Celt;

    result := S_OK;

  end else

  begin

    FIndex := FFormatCount;

    result := S_FALSE;

  end;

end;

// -----------------------------------------------------------------------------

function TEnumFormatEtc.ReSet: HRESULT;

begin

  fIndex := 0;

  result := S_OK;

end;

// -----------------------------------------------------------------------------

function TEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HRESULT;

begin

  enum := TEnumFormatEtc.Create(FFormatList, FFormatCount, FIndex);

  result := S_OK;

end;

// -----------------------------------------------------------------------------

//                      TDropSource

// -----------------------------------------------------------------------------

constructor TDropSource.Create(AOwner: TComponent);

begin

  inherited Create(aOwner);

  FDataFormatsCount := 0;

end;

// -----------------------------------------------------------------------------

function TDropSource.QueryGetData(const FormatEtc: TFormatEtc): HRESULT; stdcall;

var

  i: integer;

begin

  result:= S_OK;

  for i := 0 to FDataFormatsCount-1 do

    with FDataFormats[i] do

    begin

      if (FormatEtc.cfFormat = cfFormat) and

         (FormatEtc.dwAspect = dwAspect) and

         (FormatEtc.tymed and tymed <> 0) then exit; //result:= S_OK;

    end;

  result:= E_FAIL;

end;

// -----------------------------------------------------------------------------

function TDropSource.GetEnumFormatEtc(dwDirection: Integer): IEnumFormatEtc;

begin

  if (dwDirection = DATADIR_GET) then

    Result := TEnumFormatEtc.Create(pFormatList(@FDataFormats), FDataFormatsCount, 0)

  else

    result := nil;

end;

// -----------------------------------------------------------------------------

procedure TDropSource.AddFormatEtc(cfFmt: TClipFormat;

  pt: PDVTargetDevice; dwAsp, lInd, tym: longint);

begin

  if fDataFormatsCount = MAXFORMATS then exit;

  FDataFormats[fDataFormatsCount].cfFormat := cfFmt;

  FDataFormats[fDataFormatsCount].ptd := pt;

  FDataFormats[fDataFormatsCount].dwAspect := dwAsp;

  FDataFormats[fDataFormatsCount].lIndex := lInd;

  FDataFormats[fDataFormatsCount].tymed := tym;

  inc(FDataFormatsCount);

end;

// -----------------------------------------------------------------------------

// -----------------------------------------------------------------------------

function TDropSource.HasFormat(const FormatEtc: TFormatEtc): boolean;

begin

  Result := True;

 { TODO -oanme -cStopShip : TDropSource.HasFormat needs implementation }

end;

initialization

  OleInitialize(NIL);

  ShGetMalloc(ShellMalloc);

finalization

  ShellMalloc := nil;

  OleUninitialize;

end.