[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    unit DropPnl;

    { (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.

      Roelof Osinga, 29 december 1995
    }

    interface

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

    type
      TDropActions = (daSimple, daRecursive, daEventOnly);

      TDropEvent = procedure(Sender : TObject; FileList : TStringList; X, Y: Integer) of object;

      TDropPanel = class(TPanel)
      protected
        FDroppedList : TStringList;
        FDroppedPoint : TPoint;
        FDropAction : TDropActions;
        FAtRunTime : boolean;
        FOnDrop : TDropEvent;
        function HandleDroppedGlyphs(aGlyph : TBitmap; const aStr : string) : integer;
        procedure HandleDroppedBitBtnGlyphs(aComp : TBitBtn; const aStr : string);
        procedure HandleDroppedSpeedButtonGlyphs(aComp : TSpeedButton; const aStr : string);
        procedure HandleDroppedFiles;
        function HandleDroppedFilesRec(aComp : TWinControl; dropAt : TPoint) : boolean;
        procedure CreateParams(var Params : TCreateParams); override;
        procedure WMDropFiles(var Message : TMessage); message WM_DROPFILES;
        destructor Destroy; override;
      public
        constructor Create(anOwner : TComponent); override;
      published
        property DropAction : TDropActions read FDropAction write FDropAction default daRecursive;
        property AtRunTime : boolean read FAtRunTime write FAtRunTime default true;
        property OnDrop : TDropEvent read FOnDrop write FOnDrop;
      end;

    procedure Register;

    implementation

    constructor TDropPanel.Create(anOwner : TComponent);
    begin
      inherited Create(anOwner);
      FDroppedList := TStringList.Create;
      FDroppedPoint := Point(0,0);
      FDropAction := daRecursive;
      FAtRunTime := true;
    end;

    destructor TDropPanel.Destroy;
    begin
      FDroppedList.Free;
      inherited Destroy;
    end;

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

    function TDropPanel.HandleDroppedGlyphs(aGlyph : TBitmap; const aStr : string) : integer;
    var Glyphs : integer;
    begin
      Result := 1;
      try
        aGlyph.LoadFromFile(aStr);
        if (aGlyph.Width mod aGlyph.Height) = 0
        then begin
          Glyphs := aGlyph.Width div aGlyph.Height;
          if Glyphs > 4
          then Glyphs := 1;
          Result := Glyphs;
        end;
      except
        ;
      end;
    end;

    procedure TDropPanel.HandleDroppedBitBtnGlyphs(aComp : TBitBtn; const aStr : string);
    begin
      aComp.NumGlyphs := HandleDroppedGlyphs(aComp.Glyph, aStr); {FDroppedList[0]);}
    end;

    procedure TDropPanel.HandleDroppedSpeedButtonGlyphs(aComp : TSpeedButton; const aStr : string);
    begin
      aComp.NumGlyphs := HandleDroppedGlyphs(aComp.Glyph, aStr); {FDroppedList[0]);}
    end;

    procedure TDropPanel.HandleDroppedFiles;
    var
      i, j, nL, nC : integer;
      comp : TComponent;
    begin
      nL := FDroppedList.Count - 1;
      if nL > -1
      then begin
        nC := ControlCount - 1;
        for i := 0 to nC do
        begin
          comp := Controls[i];
          if PtInRect(TControl(comp).BoundsRect, FDroppedPoint)
          then begin
             if comp is TImage
             then (comp as TImage).Picture.LoadFromFile(FDroppedList[0]);
             if comp is TMemo
             then (comp as TMemo).Lines.LoadFromFile(FDroppedList[0]);
             if (comp is TBitBtn)
             then HandleDroppedBitBtnGlyphs(TBitBtn(comp), FDroppedList[0]);
             if (comp is TSpeedButton)
             then HandleDroppedSpeedButtonGlyphs(TSpeedButton(comp), FDroppedList[0]);
           end;
        end;
      end;
    end;

    function TDropPanel.HandleDroppedFilesRec(aComp : TWinControl; dropAt : TPoint) : boolean;
    var
      i, nL, nC : integer;
      done : boolean;
      aControl : TComponent;
    begin
      done := false;
      nL := FDroppedList.Count - 1;
      if nL > -1
      then begin
        nC := aComp.ControlCount - 1;
        i := -1;
        while not done and (i < nC) do
        begin
          inc(i);
          aControl := aComp.Controls[i];
          if PtInRect(TControl(aControl).BoundsRect, dropAt)
          then begin
             if not done and (aControl is TImage)
             then begin
               try
                 (aControl as TImage).Picture.LoadFromFile(FDroppedList[0]);
               except ;
               end;
               done := true;
             end;
             if not done and (aControl is TMemo)
             then begin
               (aControl as TMemo).Lines.LoadFromFile(FDroppedList[0]);
               done := true;
             end;
             if not done and (aControl is TBitBtn)
             then begin
               HandleDroppedBitBtnGlyphs(TBitBtn(aControl), FDroppedList[0]);
               done := true;
             end;
             if not done and (aControl is TSpeedButton)
             then begin
               HandleDroppedSpeedButtonGlyphs(TSpeedButton(aControl), FDroppedList[0]);
               done := true;
             end;
             if not done and (aControl is TWinControl) and
               not ((aControl is TMemo) or (aControl is TBitBtn))
             then begin
               done := HandleDroppedFilesRec(TWinControl(aControl),
                         TWinControl(aControl).ScreenToClient(aComp.ClientToScreen(dropAt)) );
             end;
           end;
        end;
      end;
      if not done and (aComp = Self)
      then MessageBeep(0);
      Result := done;
    end;

    procedure TDropPanel.WMDropFiles(var Message : TMessage);
    var
      hDrop : THandle;
      nFiles, i, size : word;
      Pstr : PChar;
    begin
      hDrop := Message.WParam;
      Pstr := StrAlloc(256);
      Message.Result := 0; {accept}
      try
        DragQueryPoint(hDrop, FDroppedPoint);
        nFiles := DragQueryFile(hDrop, $FFFF, Pstr, size);
        dec(nFiles);
        FDroppedList.Clear;
        for i := 0 to nFiles do
        begin
          {size := DragQueryFile(hDrop, i, nil, size);}
          size := 255;
          size := DragQueryFile(hDrop, i, Pstr, size+1);
          FDroppedList.Add(StrPas(Pstr));
        end;
      finally
        DragFinish(hDrop);
        StrDispose(Pstr);
      end;
      if Assigned(FOnDrop)
      then FOnDrop(Self, FDroppedList, FDroppedPoint.X, FDroppedPoint.Y);
      if FAtRunTime or (csDesigning in ComponentState)
      then
        case FDropAction of
          daSimple : HandleDroppedFiles;
          daRecursive : HandleDroppedFilesRec(Self, FDroppedPoint);
        end;
    end;

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

    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]