unit DropBtns;

{ (C) 1995, ingenieursbureau Office Automation
  All Rights Reserved

  Hereby the right to distribute this work electronically is granted,
  provided such is done for at most a nominal fee. Also the right is
  granted to store this work on a computer system.
  Finally the right is granted to incorporate this work into other
  work provided no fee is asked for this work.
  In all cases of distribution this work must be distributed in full,
  which specifically includes this notice.
  Liability is limited to the amount payed for this work. Legal
  jurisdiction is with the court of Leeuwarden, the Netherlands.
}

interface

uses
  WinTypes, WinProcs, Messages, Classes, Controls, Forms, Graphics,
  StdCtrls, ExtCtrls, Buttons, ShellApi, SysUtils;

type
  TDropButton = class(TBitBtn)
  protected
    procedure CreateParams(var Params : TCreateParams); override;
    procedure WMDropFiles(var Message : TMessage); message WM_DROPFILES;
  end;

procedure Register;

implementation

procedure TDropButton.CreateParams(var Params : TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    ExStyle := ExStyle or WS_EX_ACCEPTFILES;
  end;
end;

procedure TDropButton.WMDropFiles(var Message : TMessage);
var
  hDrop : THandle;
  nFiles, i, j, size : word;
  Glyphs : integer; {darned privates!}
  Pstr : PChar;
begin
  hDrop := Message.WParam;
  Pstr := StrAlloc(256);
  Pstr[0] := chr(0);
  Message.Result := 0; {accept}
  try
    nFiles := DragQueryFile(hDrop, $FFFF, Pstr, size);
    dec(nFiles);
    for i := nFiles to nFiles do
    begin
      size := DragQueryFile(hDrop, i, nil, size); {don't ask}
      size := DragQueryFile(hDrop, i, Pstr, size+1);
      Glyph.LoadFromFile(StrPas(Pstr));
      if Glyph.Width mod Glyph.Height = 0 then
      begin
        Glyphs := Glyph.Width div Glyph.Height;
        if Glyphs > 4 then Glyphs := 1;
        NumGlyphs := Glyphs;
      end;
    end;
  finally
    DragFinish(hDrop);
    StrDispose(Pstr);
  end;
end;

procedure Register;
begin
  RegisterComponents('IBOA', [TDropButton]);
end;

end.