Sample Application: FileTest.dpr

Project source
Form source (Pascal)
Form source (DFM)

Run-time form image
Project source: FileTest.dpr 

program FileTest;

{Test application for UnitOOPS OLE Drag and Drop components}

uses
  Forms,
  fmFileTest in 'fmFileTest.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
Back to top
Form source: fmFileTest.pas 

unit fmFileTest;

{ UnitOOPS OLE Drag and Drop Components - Example
  for accepting files dragged from Explorer or other
  file sources, and displaying them with icons, etc.
  Also, dragging shortcuts from a window elsewhere.

  Last modified:  03/23/2001}
  
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, uoole;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Panel2: TPanel;
    Panel3: TPanel;
    Button1: TButton;
    Panel4: TPanel;
    ListView1: TListView;
    RadioGroup1: TRadioGroup;
    UOTextTarget1: TUOTextTarget;
    UOTextSource1: TUOTextSource;
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
      const dropText: String; X, Y: Integer);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    ilLarge: TImageList;
    ilSmall: TImageList;

    function FileAge(const FileName: string): Integer;
    function FormatFileSize(aSize: integer): string;
    function FormatFileAttr(aAttr: integer): string;
    function GetFileSize(const fileName: String): integer;
    procedure WMGetMinMaxInfO(var msg: TWMGetMinMaxInfo);
      message WM_GETMINMAXINFO;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ShellAPI, ShlObj, uoUtil;

procedure TForm1.WMGetMinMaxInfO(var msg: TWMGetMinMaxInfo);
// Limit smallest size of form.  In Delphi 4 and above, you can do this 
// using constraints.
begin
  with msg.MinMaxInfo^ do
  begin
    ptMinTrackSize := POINT(448, 163);
  end;    // with
end;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  aSHFi: TSHFileInfo;
begin
  // Synchronize the listview and the radio group
  RadioGroup1Click(RadioGroup1);

  // Set up the image lists - small and large separately.
  // They are owned by the form, and will be destroyed along with it.
  // Share the images so that we won't destroy the system
  // image lists.
  // Use a dummy wildcard filename for this call.
  ilSmall := TImageList.Create(Self);
  ilSmall.ShareImages := true;
  ilSmall.Handle := SHGetFileInfo('*.*', 0, aSHFi, sizeOf(aSHFi),
       SHGFI_ATTRIBUTES	  // Retrieves the file attribute flags.
    or SHGFI_DISPLAYNAME  // Retrieves the display name for the file.
    or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
    or SHGFI_SMALLICON	  // Causes the small icon to be retrieved
  );
  ListView1.SmallImages := ilSmall;

  ilLarge := TImageList.Create(Self);
  ilLarge.ShareImages := true;
  ilLarge.Handle := SHGetFileInfo('*.*', 0, aSHFi, sizeOf(aSHFi),
       SHGFI_ATTRIBUTES	  // Retrieves the file attribute flags.
    or SHGFI_DISPLAYNAME  // Retrieves the display name for the file.
    or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
    or SHGFI_LARGEICON	  // Causes the large icon to be retrieved
  );
  ListView1.LargeImages := ilLarge;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  // Change the view style based on the radio button selection
  ListView1.ViewStyle := TViewStyle(RadioGroup1.ItemIndex);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListView1.Items.Clear;
end;

function TForm1.GetFileSize(const fileName: String): integer;
// Returns the size of the file named in fileName, or -1
var
  searchRec: TSearchRec;
begin
  result := -1; // Fall-through value
  if (FindFirst(ExpandFileName(fileName), faAnyFile, SearchRec) = 0) then
  begin
    result := SearchRec.Size;
    FindClose(SearchRec);
  end;
end;

function TForm1.FormatFileSize(aSize: integer): string;
// Format file size like Explorer, in KB with thousands
// separators.
begin
  result := '';  // Fall-through value

  if (aSize >= 0) then
  begin
    if (aSize = 0) then
      result := '0KB' // Some files are actually zero-size.
    else
      if (aSize < 1024) then // Files smaller than 1KB reported as 1KB
        result := '1KB'
      else
        result := Format('%3.0nKB', [aSize/1024]); // Display to nearest KB
  end;
end;

function TForm1.FormatFileAttr(aAttr: integer): string;
// Format file attributes like Explorer
begin
  result := ''; // Fall-through value

  if ((aAttr and faReadOnly) <> 0) then
    result := result + 'R';
  if ((aAttr and faHidden) <> 0) then
    result := result + 'H';
  if ((aAttr and faSysFile) <> 0) then
    result := result + 'S';
  if ((aAttr and faArchive) <> 0) then
    result := result + 'A';
end;


function TForm1.FileAge(const FileName: string): Integer;
// Get the last modification time for the file named FileName.
// SysUtils.FileAge deliberately ignores directories.  This source was
// copied from SysUtils, and the directory if-statement was commented out.
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    //if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    //begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    //end;
  end;
  Result := -1;
end;

procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
  const dropText: String; X, Y: Integer);
// A file drop has taken place on the listview, as specified by UOTextTarget1.
// Handle it by processing the files listed in UOTextTargett1.DroppedLines.
var
  j: Integer;
  aFileName: string;
  S: string;
  aLi: TListItem;
  aSHFi: TSHFileInfo;
  fileSize: integer;
  fileDate: TDateTime;
  fileAttr: integer;
begin
  // Loop over all dropped file names
  for j := 1 to UOTextTarget1.DroppedLines.Count do    // Iterate
  begin
    // Get the filename
    aFileName := UOTextTarget1.DroppedLines[j-1];
    // Get the icon info, etc, from the shell
    SHGetFileInfo(PChar(aFileName), 0, aSHFi, sizeOf(aSHFi),
         SHGFI_ATTRIBUTES   // Retrieves the file attribute flags.
      or SHGFI_DISPLAYNAME  // Retrieves the display name for the file.
      or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
      or SHGFI_TYPENAME     // Retrieves the type of item
      or SHGFI_SMALLICON    // Causes the small icon to be retrieved
    );

    // Add an empty item to the list
    aLi := ListView1.Items.Add;

    // Populate the list item with the file details
    with aLi do
    begin
      // Caption of the item - display name
      Caption := StrPas(aSHFi.szDisplayName);

      // Image index in the system image list
      ImageIndex := aSHFi.iIcon;

      // The remainder of the information goes in the SubItems string list
      // which shows all columns beyond the first in when ViewStyle is vsReport

      // File name
      SubItems.Add(aFileName);

      // Size of file
      fileSize := GetFileSize(aFileName);
      // Write file size only if not a folder.  See FormatFileSize above
      if ((aSHFi.dwAttributes and SFGAO_FOLDER) = 0) then
        SubItems.Add(FormatFileSize(fileSize))
      else
        SubItems.Add('');


      // Type of file.
      if (length(aSHFi.szTypeName) = 0) then
      begin
        // No file type.  For something.Ext use "EXT File"
        // just like Explorer.
        s := UpperCase(ExtractFileExt(aFileName))+ ' File';
        System.Delete(s, 1, 1);
        SubItems.Add(s);
      end
      else
      begin
        SubItems.Add(aSHFi.szTypeName);
      end;

      // Time of last modification
      // Explorer uses the short date and time formats that the user has
      // set in the Control Panel Regional Settings, so we do too!
      fileDate := FileDateToDateTime(FileAge(aFileName)); // Date as a TDateTime
      SubItems.Add(FormatDateTime(ShortDateFormat+' '+ShortTimeFormat, fileDate));

      // File attributes
      fileAttr := FileGetAttr(aFileName);
      SubItems.Add(FormatFileAttr(fileAttr));
    end;    // with

  end;    // for
end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
// Click on a column header.  Here's where you'd call your code for sorting
// the data based on columns.  This is not related to the example at hand, so
// we don't bother.
begin
  if (ListView1.Items.Count > 0) then
    MessageBox(Self.Handle, 'Sorting of columns is left as an exercise for the user!',
     'UnitOOPS FileTest Demo', MB_OK + MB_ICONINFORMATION + MB_SETFOREGROUND);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
// If we double-click an item, launch it.
var
  aLi: TListItem;
begin
  aLi := ListView1.Selected;

  // Is there a selection?
  if assigned(aLi) then
  begin
    // Launch it.  The file name is in SubItems[0] (see UOTextTarget1Drop() above.
    ShellExecute(Handle, 'open', PChar(aLi.SubItems[0]), nil, nil, SW_SHOW);
  end;
end;

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// Detect drags and initiate drag of shortcuts to the files
// Detect the drag by handling OnMouseDown, and using the Win32 call
// DragDetect()
var
  aSL: TStringList;
  aLi: TListItem;
begin
  // Are we dragging?
  if DragDetect(ListView1.Handle, POINT(X, Y)) then
  begin
    // Build a string list to hold the list of files we're dragging
    aSL := TStringList.Create;

    try
      // Get the first selected item in the list view
      aLi := ListView1.Selected;

      // Now find the rest of the selected items
      while assigned(aLI) do
      begin
        // Add the filename for the selection
        aSL.Add(aLi.SubItems[0]);

        // Go find the next selected item
        aLi := ListView1.GetNextItem(aLi, sdAll, [isSelected]);
      end;    // while

      // Now, we have the list of selections, which could be empty
      if (aSL.Count > 0) then
      begin
        with UOTextSource1 do
        begin
          // Clear out the custom format data from any previous executions
          CustomFormatData.Clear;
          // 'Shell IDList Array' is the format to drag for shortcuts
          // Use uoUtils.uoShellIDListFromFileList
          CustomFormatData.AddFormat('Shell IDList Array',
            uoShellIDListFromFileList('', aSL));
          // 'Preferred DropEffect' tells the shell not to bother giving
          // us the "copy here", "Move here", "Create shortcut here" menu
          CustomFormatData.addFormat('Preferred DropEffect',
            uoEncodeDWORDToString(DropEffectFromEnum(deLink)));
          // The shortcuts you drag are usually arranged on the desktop e.g.
          // cascading down and right.  You could use the 'Shell Object Offsets'
          // drag format to have them positioned in a different manner, if you
          // like.  Search for "Shell Object Offsets" (including the "") in the
          // Win32 help that ships with Delphi 4 for more details, on in MSDN.

          // Do the drag operation
          Execute;
        end;
      end;

    finally
      aSL.Free;
    end;
  end;
end;

end.
Back to top
Form source: fmFileTest.dfm 

object Form1: TForm1
  Left = 226
  Top = 154
  Width = 579
  Height = 325
  Caption = 'File drop and shortcut drag demo'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 571
    Height = 33
    Align = alTop
    BevelOuter = bvNone
    BorderWidth = 3
    TabOrder = 0
    object Label1: TLabel
      Left = 3
      Top = 3
      Width = 565
      Height = 27
      Align = alClient
      Caption = 
        'Drop lists of files from Explorer or other sources onto the list' +
        ' below.  Execute any file by double-clicking it.  Drag files fro' +
        'm the list to make a shortcuts elsewhere.'
      WordWrap = True
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 254
    Width = 571
    Height = 44
    Align = alBottom
    BevelOuter = bvNone
    TabOrder = 1
    object Panel3: TPanel
      Left = 474
      Top = 0
      Width = 97
      Height = 44
      Align = alRight
      BevelOuter = bvNone
      TabOrder = 0
      object Button1: TButton
        Left = 10
        Top = 11
        Width = 75
        Height = 25
        Caption = 'Clear list'
        TabOrder = 0
        OnClick = Button1Click
      end
    end
    object RadioGroup1: TRadioGroup
      Left = 5
      Top = 2
      Width = 337
      Height = 38
      Caption = 'List view style'
      Columns = 4
      ItemIndex = 3
      Items.Strings = (
        'Icons'
        'Small Icons'
        'List'
        'Report')
      TabOrder = 1
      OnClick = RadioGroup1Click
    end
  end
  object Panel4: TPanel
    Left = 0
    Top = 33
    Width = 571
    Height = 221
    Align = alClient
    BevelOuter = bvNone
    BorderWidth = 3
    Caption = 'Panel4'
    TabOrder = 2
    object ListView1: TListView
      Left = 3
      Top = 3
      Width = 565
      Height = 215
      Align = alClient
      OnDblClick = ListView1DblClick
      Columns = <
        item
          Caption = 'Display Name'
          Width = 100
        end
        item
          Caption = 'File Name'
          Width = 100
        end
        item
          Alignment = taRightJustify
          Caption = 'Size'
          Width = 60
        end
        item
          Caption = 'Type'
          Width = 120
        end
        item
          Caption = 'Modified'
          Width = 120
        end
        item
          Alignment = taRightJustify
          Caption = 'Attributes'
          Width = 60
        end>
      ReadOnly = True
      MultiSelect = True
      OnColumnClick = ListView1ColumnClick
      OnMouseDown = ListView1MouseDown
      TabOrder = 0
      ViewStyle = vsReport
    end
  end
  object UOTextTarget1: TUOTextTarget
    AcceptorControl = ListView1
    AcceptTextFormats = [dtfFiles]
    OnDrop = UOTextTarget1Drop
    Left = 104
    Top = 177
  end
  object UOTextSource1: TUOTextSource
    DropEffects = [deLink]
    Left = 312
    Top = 121
  end
end
Back to top

Back to the examples page