PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue146/Delphi/CopyDlph.exe/lpunit.pas

Pascal/Delphi Source File | 1998-08-06 | 5.6 KB | 152 lines

unit Lpunit;
{
  PC Plus sample Delphi application.

  A simple drag-and-drop-enabled application 'launch pad'.

  Usage: Select 1 or more files in the Windows Explorer and drag/drop
  them onto the launch pad. Those that contain an icon will be shown as
  an iconic button, those without an icon will be shown as a plain labelled
  button. Once installed, a button can be clicked to launch the
  associated application.

  Limitations: No error checking, does not handle a case when more buttons
  are added than will fit into the panel, no ability to save and restore
  the panel state, cannot load document files with the icons of their associated
  application.

  Compatibility: Delphi 1 and above
  Author: Huw Collingbourne
}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs,
  ShellAPI, StdCtrls, Buttons, ExtCtrls; {!! must use the ShellAPI unit    }
                                         {!! BitBtn needs the Buttons unit }

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ButtonPanel: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    ButtonList : TStringList;    {!! This StringList holds our BitBtns      }
    procedure RespondToMessage(var Msg: Tmsg; var Handled: Boolean);
    procedure BtnClick(Sender: TObject);
  public
    { Public declarations }
  end;

const
  BUFFLEN = 255;
type
  CHARARRAY = array[0..BUFFLEN] of char;
var
  Form1: TForm1;
  Icon : TIcon; {!! An icon to put onto a button }

implementation
{$R *.DFM}

function ExecuteFile(const FileName, Dir : string ) : THandle;
{!! A simple interface to the API's ShellExecute function that opens
    the application specified by FileName }
var
  ntFileName, ntDir : CHARARRAY;
begin
  Result := ShellExecute(Application.MainForm.Handle,
  nil,      { nil here equates to the default command,'Open' }
  StrPCopy(ntFileName, FileName),
  nil,
  StrPCopy(ntDir,Dir),
  SW_SHOW);
end;

procedure TForm1.RespondToMessage(var Msg: Tmsg; var Handled: Boolean);
{ Iterate through all file names if a multi-file selection was dropped }
const
  FileIndex : Cardinal = Cardinal(-1);   { return a count of dropped files }
var                                      { $FFFF 16-bit;  $FFFFFFFF 32-bit }
  buffer : CHARARRAY;
  fname : string;
  fnum  : word;
begin
   if Msg.Message = WM_DROPFILES then
   begin
      for fnum := 0 to DragQueryFile(Msg.WParam, FileIndex, NIL, BUFFLEN)-1 do
      begin
         DragQueryFile(Msg.WParam, fnum, buffer, BUFFLEN);
         fname  := StrPas(buffer);
         Memo1.Lines.Add(fname);
      {!!===================================================================== }
      {!!=== This is the code that installs BitBtn(s) for a dropped filname(s) }
      {!!===================================================================== }
         Icon.Handle := ExtractIcon(HInstance, buffer, 0);  {!! get icon       }
         ButtonList.AddObject(fname, TBitBtn.Create(Self));{!! add Btn to list}
         with TBitBtn(ButtonList.Objects[ButtonList.Count-1]) do
         begin
              with Glyph do     { size the Glyph (picture area) of the BitBtn  }
              begin
                width := 32;
                height := 32;
               if Icon.Handle <> 0 then { if we've found an icon put it on Btn }
                   Canvas.Draw(0,0,Icon);
              end;
                               { set the size, font etc. of the BitBtn itself  }
              width := 100;
              layout := blGlyphTop;
              font.name := 'Arial';
              font.size := 8;
              caption := ExtractFileName(fname);
              Align := alLeft;
              Parent := ButtonPanel;    {!! put the BitBtn onto the panel      }
              OnClick := BtnClick;      {!! set BitBtn's OnClick event-handler }
         end;
      {!!===================================================================== }
      end;
    DragFinish(Msg.WParam);
    Handled := True;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {!! make this form drag-friendly }
  DragAcceptFiles(Form1.Handle, true);
  Application.OnMessage := RespondToMessage;
  ButtonList := TStringList.Create; {!! Create StringList to store our BitBtns }
end;

procedure TForm1.BtnClick(Sender: TObject);
{!! The BitBtns' OnClick event-handler                                         }
{!! The Sender parameter indicates which button on the form was clicked.
    We locate the position of the button in our ButtonList.
    ButtonList is a StringList containing a String (the executable file's path)
    alongside each button. We are able to use pass this string (and also to
    parse out the directory part of the string) to a function that launches the
    application.
}
var
   obindex : integer;
   filename, filepath : string;
begin
   obindex := ButtonList.IndexOfObject(Sender);{ get pos of Btn in ButtonList  }
   filename := ButtonList.Strings[obindex];    { get string in list at same pos}
   filepath := ExtractFilePath(filename);      { extract the path from string  }
   Memo1.Lines.Add('Object at index: ' + IntToStr(obindex) +
                                     ', LAUNCHING:  ' + filename);
   Memo1.Lines.Add('Default directory is: ' + filepath );
   ExecuteFile(filename, filepath);           { execute the file specified     }

(* --- this is the more terse version of the code ----
   filename := ButtonList.Strings[ButtonList.IndexOfObject(Sender)];
   ExecuteFile(filename, ExtractFilePath(filename));
   -------------------------------------------------- *)
end;

end.