0,0 → 1,207 |
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. |