home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / DELPHI.SWG / 0004_TDropButton Component - Drag-Drop Button.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  2.1 KB  |  81 lines
  1. unit DropBtns;
  2.  
  3. { (C) 1995, ingenieursbureau Office Automation
  4.   All Rights Reserved
  5.  
  6.   Hereby the right to distribute this work electronically is granted,
  7.   provided such is done for at most a nominal fee. Also the right is
  8.   granted to store this work on a computer system.
  9.   Finally the right is granted to incorporate this work into other
  10.   work provided no fee is asked for this work.
  11.   In all cases of distribution this work must be distributed in full,
  12.   which specifically includes this notice.
  13.   Liability is limited to the amount payed for this work. Legal
  14.   jurisdiction is with the court of Leeuwarden, the Netherlands.
  15. }
  16.  
  17. interface
  18.  
  19. uses
  20.   WinTypes, WinProcs, Messages, Classes, Controls, Forms, Graphics,
  21.   StdCtrls, ExtCtrls, Buttons, ShellApi, SysUtils;
  22.  
  23. type
  24.   TDropButton = class(TBitBtn)
  25.   protected
  26.     procedure CreateParams(var Params : TCreateParams); override;
  27.     procedure WMDropFiles(var Message : TMessage); message WM_DROPFILES;
  28.   end;
  29.  
  30. procedure Register;
  31.  
  32. implementation
  33.  
  34. procedure TDropButton.CreateParams(var Params : TCreateParams);
  35. begin
  36.   inherited CreateParams(Params);
  37.   with Params do
  38.   begin
  39.     ExStyle := ExStyle or WS_EX_ACCEPTFILES;
  40.   end;
  41. end;
  42.  
  43. procedure TDropButton.WMDropFiles(var Message : TMessage);
  44. var
  45.   hDrop : THandle;
  46.   nFiles, i, j, size : word;
  47.   Glyphs : integer; {darned privates!}
  48.   Pstr : PChar;
  49. begin
  50.   hDrop := Message.WParam;
  51.   Pstr := StrAlloc(256);
  52.   Pstr[0] := chr(0);
  53.   Message.Result := 0; {accept}
  54.   try
  55.     nFiles := DragQueryFile(hDrop, $FFFF, Pstr, size);
  56.     dec(nFiles);
  57.     for i := nFiles to nFiles do
  58.     begin
  59.       size := DragQueryFile(hDrop, i, nil, size); {don't ask}
  60.       size := DragQueryFile(hDrop, i, Pstr, size+1);
  61.       Glyph.LoadFromFile(StrPas(Pstr));
  62.       if Glyph.Width mod Glyph.Height = 0 then
  63.       begin
  64.         Glyphs := Glyph.Width div Glyph.Height;
  65.         if Glyphs > 4 then Glyphs := 1;
  66.         NumGlyphs := Glyphs;
  67.       end;
  68.     end;
  69.   finally
  70.     DragFinish(hDrop);
  71.     StrDispose(Pstr);
  72.   end;
  73. end;
  74.  
  75. procedure Register;
  76. begin
  77.   RegisterComponents('IBOA', [TDropButton]);
  78. end;
  79.  
  80. end.
  81.