home *** CD-ROM | disk | FTP | other *** search
/ The Mother of All Windows Books / CD-MOM.iso / cd_mom / newsletr / vbz / vbz1-3 / dll_src.exe / D&DSERVE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-24  |  5KB  |  183 lines
  1. library DnDSERVE;
  2. {DLL to provide Drag 'n Drop Server support to Visual Basic}
  3. {by Jonathan Zuck -=- Copyright 1993 User Friendly, Inc.}
  4.  
  5. {$R D&DSERVE}
  6. {$R D&DCURS}
  7.  
  8. uses WinTypes, WinProcs, Win31, Strings;
  9.  
  10. const
  11.   GMEM_DROP = GMEM_MOVEABLE or GMEM_ZEROINIT or GMEM_SHARE;
  12.  
  13. type
  14.     DropFileRec = record
  15.       StrucSize:Word;
  16.     MousePoint:TPoint;
  17.     InNC:WordBool;
  18.   end;
  19.  
  20.   pDropFileRec = ^DropFileRec;
  21.  
  22.   IntArr = array [1..5440] of Integer;
  23.  
  24. var
  25.   MousePos: TPoint;
  26.  
  27. function DragMeister (nFiles, VKButton:Integer):HWND;export;
  28. Var
  29.   Cursor_OK, Cursor_NOTOK,
  30.   Cursor_Prev:hCursor;
  31.   TargetWnd:hWnd;
  32.   OKToDrop:WordBool;
  33.   Msg:TMSG;
  34.  
  35. Begin
  36.     if nFiles = 1 then Cursor_OK := LoadCursor (HInstance, 'OK_SINGLE')
  37.       else Cursor_OK := LoadCursor (HInstance, 'OK_MULTI');
  38.   Cursor_NOTOK := LoadCursor (HInstance, 'NOT_OK');
  39.   while Bool(GetAsyncKeyState(VKButton) and $8000) do
  40.       Begin
  41.       GetCursorPos (MousePos);
  42.       TargetWnd := WindowFromPoint (MousePos);
  43.       OkToDrop := False;
  44.       while (OkToDrop = False) and (TargetWnd <> 0) do begin
  45.             OkToDrop := Bool(GetWindowLong(TargetWnd, GWL_EXSTYLE)
  46.                                          and WS_EX_ACCEPTFILES);
  47.             if OkToDrop = False then TargetWnd := GetParent(TargetWnd);
  48.       end; {while}
  49.       if OkToDrop then
  50.             SetCursor (Cursor_OK)
  51.       else
  52.             SetCursor (Cursor_NOTOK);
  53.       while PeekMessage (Msg, 0, 0, 0, PM_REMOVE) do;
  54.     end;
  55.   if GetCursor = Cursor_OK then DragMeister := TargetWnd
  56.       else DragMeister := 0;
  57.   ReleaseCapture;
  58.   DestroyCursor (Cursor_OK);
  59.   DestroyCursor (Cursor_NOTOK);
  60. End;
  61.  
  62. function InitGlobalDroppings (hTarget:HWND;nBytes:LongInt):THandle;export;
  63. var
  64.     hMem:THandle;
  65.     pRec:pDropFileRec;
  66. begin
  67.     hMem := GlobalAlloc (GMEM_DROP, nBytes);
  68.   pRec := GlobalLock (hMem);
  69.   pRec^.StrucSize := SizeOf(DropFileRec);
  70.   pRec^.InNC := (htClient <> SendMessage (hTarget, WM_NCHITTEST, 0,
  71.          MakeLong (MousePos.x, MousePos.y)));
  72.   ScreenToClient (hTarget, MousePos);
  73.   pRec^.MousePoint.x := MousePos.x;
  74.   pRec^.MousePoint.y := MousePos.y;
  75.   GlobalUnlock (hMem);
  76.   InitGlobalDroppings := hMem;
  77. end;
  78.  
  79. function DropSelItems (hLBox:HWND;lpPath:PChar;Button:Integer):HWND;export;
  80.     Var
  81.       nFiles, Item,
  82.     PathLen, ItemSize:Integer;
  83.     hTarget:HWND;
  84.     MemSize:LongInt;
  85.     Pos:PChar;
  86.     lpArr:^IntArr;
  87.     hMem:THandle;
  88.   Begin
  89.     nFiles := SendMessage (hLBox, LB_GETSELCOUNT, 0, 0);
  90.     hTarget := DragMeister (nFiles, Button);
  91.     if hTarget > 0 then
  92.         Begin
  93.           GetMem (lpArr, nFiles * 2);
  94.         SendMessage (hLBox, LB_GETSELITEMS, 5440, LongInt(lpArr));
  95.         PathLen := StrLen (lpPath);
  96.         MemSize := 8;
  97.         for Item := 1 to nFiles do
  98.             Begin
  99.             ItemSize := SendMessage (hLBox, LB_GETTEXTLEN, lpArr^[Item], 0);
  100.             MemSize := MemSize + PathLen + ItemSize + 1;
  101.           end;
  102.         hMem := InitGlobalDroppings (hTarget, MemSize);
  103.         Pos := GlobalLock (hMem);
  104.         Pos := Pos + 8;
  105.         for Item := 1 to nFiles do
  106.             Begin
  107.             StrMove (Pos, lpPath, PathLen);
  108.             Pos := Pos + PathLen;
  109.             ItemSize := SendMessage (hLBox, LB_GETTEXT,
  110.                 lpArr^[Item], LongInt(Pos));
  111.             Pos := Pos + ItemSize + 1;
  112.           end;
  113.         GlobalUnlock (hMem);
  114.         FreeMem (lpArr, nFiles * 2);
  115.         PostMessage (hTarget, WM_DROPFILES, hMem, 0);
  116.       end;
  117.       DropSelItems := hTarget;
  118.   end;
  119.  
  120. function DropAllItems (hLBox:HWND;Button:Integer):HWND;export;
  121.     Var
  122.       nFiles, Item,
  123.     ItemSize:Integer;
  124.     hTarget:HWND;
  125.     MemSize:LongInt;
  126.     Pos:PChar;
  127.     hMem:THandle;
  128.   Begin
  129.     nFiles := SendMessage (hLBox, LB_GETCOUNT, 0, 0);
  130.     hTarget := DragMeister (nFiles, Button);
  131.     if hTarget > 0 then
  132.         Begin
  133.         MemSize := 8;
  134.         for Item := 0 to nFiles - 1 do
  135.             Begin
  136.             ItemSize := SendMessage (hLBox, LB_GETTEXTLEN, Item, 0);
  137.             MemSize := MemSize + ItemSize + 1;
  138.           end;
  139.         hMem := InitGlobalDroppings (hTarget, MemSize);
  140.         Pos := GlobalLock (hMem);
  141.         Pos := Pos + 8;
  142.         for Item := 0 to nFiles - 1 do
  143.             Begin
  144.             ItemSize := SendMessage (hLBox, LB_GETTEXT,
  145.                 Item, LongInt(Pos));
  146.             Pos := Pos + ItemSize + 1;
  147.           end;
  148.         GlobalUnlock (hMem);
  149.         PostMessage (hTarget, WM_DROPFILES, hMem, 0);
  150.       end;
  151.       DropAllItems := hTarget;
  152.   end;
  153.  
  154. function DropBuff (Buff:PChar;BuffSize,nFiles, Button:Integer):HWND;export;
  155.     Var
  156.     hTarget:HWND;
  157.     MemSize:LongInt;
  158.     Pos:PChar;
  159.     hMem:THandle;
  160.   Begin
  161.     hTarget := DragMeister (nFiles, Button);
  162.     if hTarget > 0 then
  163.         Begin
  164.         MemSize := SizeOf(DropFileRec) + BuffSize;
  165.         hMem := InitGlobalDroppings (hTarget, MemSize);
  166.         Pos := GlobalLock (hMem);
  167.         Pos := Pos + SizeOf(DropFileRec);
  168.         StrMove (Pos, Buff, BuffSize);
  169.         GlobalUnlock (hMem);
  170.         PostMessage (hTarget, WM_DROPFILES, hMem, 0);
  171.       end;
  172.       DropBuff := hTarget;
  173.   end;
  174.  
  175. Exports
  176.     DragMeister resident,
  177.   InitGlobalDroppings resident,
  178.     DropSelItems resident,
  179.   DropAllItems resident,
  180.   DropBuff resident;
  181.  
  182. Begin
  183. End.