home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / D234C13 / RALIB.ZIP / RALib / Lib / RAOle.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-05  |  5KB  |  197 lines
  1. {***********************************************************
  2.                 R&A Library
  3.        Copyright (C) 1996-98 R&A
  4.  
  5.        component   : none
  6.        description : Ole2 support routines
  7.  
  8.        programer   : black
  9.        e-mail      : blacknbs@chat.ru
  10.        www         : www.chat.ru\~blacknbs\ralib
  11. ************************************************************}
  12.  
  13. {$INCLUDE RA.INC}
  14.  
  15. unit RAOle;
  16.  
  17. interface
  18.  
  19. uses Windows, Ole2;
  20.  
  21. { TEnumFormatEtc - format enumerator for TDataObject }
  22. type
  23.   PFormatList = ^TFormatList;
  24.   TFormatList = array[0..255] of TFormatEtc;
  25.  
  26. type
  27.   TEnumFormatEtc = class(IEnumFormatEtc)
  28.   private
  29.     FRefCount: Integer;
  30.     FFormatList: PFormatList;
  31.     FFormatCount: Integer;
  32.     FIndex: Integer;
  33.   public
  34.     constructor Create(FormatList: PFormatList; FormatCount, Index: Integer);
  35.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  36.     function AddRef: Longint; override;
  37.     function Release: Longint; override;
  38.     function Next(celt: Longint; var elt;
  39.       pceltFetched: PLongint): HResult; override;
  40.     function Skip(celt: Longint): HResult; override;
  41.     function Reset: HResult; override;
  42.     function Clone(var enum: IEnumFormatEtc): HResult; override;
  43.   end;
  44.  
  45.   ITrueDropTarget = class(IUnknown)
  46.   public
  47.     function DragEnter(dataObj: IDataObject; grfKeyState: longint;
  48.       pt: TPoint; var dwEffect: Longint): HResult; virtual; stdcall; abstract;
  49.     function DragOver(grfKeyState: Longint; pt: TPoint;
  50.       var dwEffect: Longint): HResult; virtual; stdcall; abstract;
  51.     function DragLeave: HResult; virtual; stdcall; abstract;
  52.     function Drop(dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  53.       var dwEffect: Longint): HResult; virtual; stdcall; abstract;
  54.   end;
  55.  
  56.   TRADropTarget = class(ITrueDropTarget)
  57.     FRefCount : integer;
  58.   public
  59.     constructor Create;
  60.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  61.     function AddRef: Longint; override;
  62.     function Release: Longint; override;
  63.     function DragLeave: HResult; override;
  64.   end;
  65.  
  66.   function OleStdGetDropEffect(grfKeyState: Longint) : Longint;
  67.  
  68. implementation
  69.  
  70. constructor TEnumFormatEtc.Create(FormatList: PFormatList;
  71.   FormatCount, Index: Integer);
  72. begin
  73.   FRefCount := 1;
  74.   FFormatList := FormatList;
  75.   FFormatCount := FormatCount;
  76.   FIndex := Index;
  77. end;
  78.  
  79. function TEnumFormatEtc.QueryInterface(const iid: TIID; var obj): HResult;
  80. begin
  81.   if IsEqualIID(iid, IID_IUnknown) or IsEqualIID(iid, IID_IEnumFormatEtc) then
  82.   begin
  83.     Pointer(obj) := Self;
  84.     AddRef;
  85.     Result := S_OK;
  86.   end else
  87.   begin
  88.     Pointer(obj) := nil;
  89.     Result := E_NOINTERFACE;
  90.   end;
  91. end;
  92.  
  93. function TEnumFormatEtc.AddRef: Longint;
  94. begin
  95.   Inc(FRefCount);
  96.   Result := FRefCount;
  97. end;
  98.  
  99. function TEnumFormatEtc.Release: Longint;
  100. begin
  101.   Dec(FRefCount);
  102.   Result := FRefCount;
  103.   if FRefCount = 0 then Free;
  104. end;
  105.  
  106. function TEnumFormatEtc.Next(celt: Longint; var elt;
  107.   pceltFetched: PLongint): HResult;
  108. var
  109.   I: Integer;
  110. begin
  111.   I := 0;
  112.   while (I < celt) and (FIndex < FFormatCount) do
  113.   begin
  114.     TFormatList(elt)[I] := FFormatList[FIndex];
  115.     Inc(FIndex);
  116.     Inc(I);
  117.   end;
  118.   if pceltFetched <> nil then pceltFetched^ := I;
  119.   if I = celt then Result := S_OK else Result := S_FALSE;
  120. end;
  121.  
  122. function TEnumFormatEtc.Skip(celt: Longint): HResult;
  123. begin
  124.   if celt <= FFormatCount - FIndex then
  125.   begin
  126.     FIndex := FIndex + celt;
  127.     Result := S_OK;
  128.   end else
  129.   begin
  130.     FIndex := FFormatCount;
  131.     Result := S_FALSE;
  132.   end;
  133. end;
  134.  
  135. function TEnumFormatEtc.Reset: HResult;
  136. begin
  137.   FIndex := 0;
  138.   Result := S_OK;
  139. end;
  140.  
  141. function TEnumFormatEtc.Clone(var enum: IEnumFormatEtc): HResult;
  142. begin
  143.   enum := TEnumFormatEtc.Create(FFormatList, FFormatCount, FIndex);
  144.   Result := S_OK;
  145. end;
  146.  
  147. {********************* TRADropTarget ********************}
  148. constructor TRADropTarget.Create;
  149. begin
  150.   FRefCount := 1;
  151. end;
  152.  
  153. function TRADropTarget.QueryInterface(const iid: TIID; var obj): HResult;
  154. begin
  155.   if IsEqualIID(iid, IID_IUnknown) or IsEqualIID(iid, IID_IDropTarget) then
  156.   begin
  157.     Pointer(obj) := Self;
  158.     AddRef;
  159.     Result := S_OK;
  160.   end else
  161.   begin
  162.     Pointer(obj) := nil;
  163.     Result := E_NOINTERFACE;
  164.   end;
  165. end;
  166.  
  167. function TRADropTarget.AddRef: Longint;
  168. begin
  169.   Inc(FRefCount);
  170.   Result := FRefCount;
  171. end;
  172.  
  173. function TRADropTarget.Release: Longint;
  174. begin
  175.   Dec(FRefCount);
  176.   Result := FRefCount;
  177.   if FRefCount = 0 then Free;
  178. end;
  179.  
  180. function TRADropTarget.DragLeave: HResult;
  181. begin
  182.   Result := S_OK;
  183. end;
  184. {##################### TRADropTarget ####################}
  185.  
  186.  
  187. function OleStdGetDropEffect(grfKeyState: Longint) : Longint;
  188. begin
  189.   if (grfKeyState and MK_CONTROL) = MK_CONTROL then
  190.     if (grfKeyState and MK_SHIFT) = MK_SHIFT then Result := DROPEFFECT_LINK
  191.     else Result := DROPEFFECT_COPY
  192.   else if (grfKeyState and MK_SHIFT) = MK_SHIFT then Result := DROPEFFECT_MOVE
  193.   else Result := 0;
  194. end;
  195.  
  196. end.
  197.