Sample Application: CustomTest2.dpr

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

Design-time form image
Project source: CustomTest2.dpr

program CustomTest2;
{Main program file for test application for UnitOOPS OLE Drag and Drop Components.}
uses
  Forms,
  fmCustomHDROP in 'fmCustomHDROP.pas' {Form1};

{$R *.RES}

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

unit fmCustomHDROP;

{ UnitOOPS OLE Drag and Drop Components - Example
  for dragging data in multiple custom (user-defined) formats.

 Last modified:  09/26/2000}

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    DriveComboBox1: TDriveComboBox;
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    UOTextSource1: TUOTextSource;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    Label3: TLabel;
    Image1: TImage;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    Label4: TLabel;
    procedure CheckBox1Click(Sender: TObject);
    procedure UOTextSource1BeforeDrop(Sender: TObject; Donor: TComponent;
      var dropText: String; var cancelDrop: Boolean);
    procedure UOTextSource1RenderCustomFormat(Sender: TObject;
      const formatName: String; var formatContent: String);
    procedure CheckBox5Click(Sender: TObject);
    procedure UOTextSource1AfterDrop(Sender: TObject; Donor: TComponent;
      droppedOK: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FTempFileName: string;

    function GetSelectedFileList: TStringList;
    function HDropFromSelectedFiles: string;
    function ShellIDListFromSelectedFiles: string;
    function FileGroupDescriptorFromSelectedFiles: string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ActiveX, ShlObj, uoPIDL;

{$R *.DFM}

function TForm1.FileGroupDescriptorFromSelectedFiles: string;
// Build the FileGroupDescriptor format.
var
  aSL: TStringList;
begin
  result := ''; // Fall-through value

  // Get the selected items into aSL.
  aSL := GetSelectedFileList;
  try
    // Now, build the FGD structure using the uoUtil function uoFileGroupDescriptorFromFileList
    // See Win32 help for details of the structure, which we just render onto a string
    result := uoFileGroupDescriptorFromFileList(DirectoryListBox1.Directory, aSL);
  finally
    aSL.Free;
  end;
end;

function TForm1.HDROPFromSelectedFiles: string;
// Build the HDROP format to allow dragging files.
var
  aSL: TStringList;
begin
  result := ''; // Fall-through value

  // Get the selected items into aSL.
  aSL := GetSelectedFileList;
  try
    // Now, build the HDROP structure using the uoUtil function uoHDROPFromFileList
    // See Win32 help for details of the structure, which we just render onto a string
    result := uoHDROPFromFileList(DirectoryListBox1.Directory, aSL);
  finally
    aSL.Free;
  end;
end;


function TForm1.ShellIDListFromSelectedFiles: string;
// Build the Shell ID List to allow dragging shortcuts.  Works in association
// with the CF_HDROP format.
var
  aSL: TStringList;
begin
  result := ''; // Fall-through value

  // Get the selected items into aSL.
  aSL := GetSelectedFileList;
  try
    // Now, build the ShellIDList using the uoUtil function uoShellIDListFromFileList
    // See Win32 help for details of the structure, which we just render onto a string
    result := uoShellIDListFromFileList(DirectoryListBox1.Directory, aSL);
  finally
    aSL.Free;
  end;
end;

function TForm1.GetSelectedFileList: TStringList;
// Put the list of currently selected files (names only, not full paths) in
// a TStringList, and pass it back.  Caller must free.
var
  j: Integer;
begin
  result := TStringList.create;

  with FileListBox1, Items do
  begin
    for j := 1 to Count do    // Iterate
    begin
      if Selected[j-1] then
        result.Add(Strings[j-1]);
    end;    // for
  end;    // with

end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Edit1.Enabled := CheckBox1.Checked;
  CheckBox7.Enabled := CheckBox1.Checked;
end;

procedure TForm1.UOTextSource1BeforeDrop(Sender: TObject;
  Donor: TComponent; var dropText: String; var cancelDrop: Boolean);
begin
  // Since we've defined custom formats, dropText is meaningless here
  // However, we could still cancel the drop using cancelDrop, if we
  // wanted, or modify the CustomFormatData list.
end;

procedure TForm1.UOTextSource1RenderCustomFormat(Sender: TObject;
  const formatName: String; var formatContent: String);
begin
  // Render formats that weren't rendered before executing the
  // TUOTextSource
  if (AnsiCompareText(IntToStr(CF_TEXT), formatName) = 0) then
    formatContent := 'Here is your custom-rendered string data!';

  if (AnsiCompareText('UnitOOPS e', formatName) = 0) then
    formatContent := uoEncodeDoubleToString(exp(1));
end;

procedure TForm1.CheckBox5Click(Sender: TObject);
begin
  CheckBox6.Enabled := CheckBox5.Checked;
  CheckBox8.Enabled := CheckBox5.Checked;
  CheckBox9.Enabled := CheckBox5.Checked;
  CheckBox10.Enabled := CheckBox5.Checked;
end;

procedure TForm1.UOTextSource1AfterDrop(Sender: TObject; Donor: TComponent;
  droppedOK: Boolean);
begin
  // If we created a temporary file for scrap drops, delete it here.
  if ((FTempFileName <> '') and FileExists(FTempFileName)) then
  begin
    DeleteFile(FTempFileName);
    FTempFileName := '';
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // At startup, make the drop effects checkboxes reflect the TUOTextSource
  // published properties set at design-time.
  CheckBox8.Checked := (deCopy in UOTextSource1.DropEffects);
  CheckBox9.Checked := (deMove in UOTextSource1.DropEffects);
  CheckBox10.Checked := (deLink in UOTextSource1.DropEffects);
end;

procedure TForm1.FileListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  aString: string;
  aHBitmap: HBitmap;
  aDe: TDropEffects;
begin
  if DragDetect(FileListBox1.Handle, POINT(X,Y)) then
  begin
    // Start with a clean slate of formats
    UOTextSource1.CustomFormatData.Clear;

    // Clear the temp file name
    FTempFileName := '';

    // Get set to drag files
    if CheckBox5.Checked then
    begin
      // Get the drop effects dynamically from the checkboxes.
      aDe := [];
      if CheckBox8.Checked then
        Include(aDe, deCopy)
      else
        Exclude(aDe, deCopy);
      if CheckBox9.Checked then
        Include(aDe, deMove)
      else
        Exclude(aDe, deMove);
      if CheckBox10.Checked then
        Include(aDe, deLink)
      else
        Exclude(aDe, deLink);
      UOTextSource1.DropEffects := aDe;

      // Drag the "Shell IDList Array" format to get file linking capabilities
      // Needs CF_HDROP (=15, see below) to be present too for move/copy
      UOTextSource1.CustomFormatData.addFormat('Shell IDList Array', ShellIDListFromSelectedFiles);

      // Set "Preferred DropEffect" format to deLink, to avoid the Move/Copy/Create shortcut
      // menu when the drop effect chosen is "Link".  In Win95 (original) you get the menu
      // anyway.  Works in cooperation with "Shell IDList Arrray".
      if CheckBox6.Checked then
        UOTextSource1.CustomFormatData.addFormat('Preferred DropEffect',
          uoEncodeDWORDToString(DropEffectFromEnum(deLink)));

      // Drag FileGroupDescriptor
      UOTextSource1.CustomFormatData.addFormat('FileGroupDescriptor',
        FileGroupDescriptorFromSelectedFiles);
      // Drag the CF_HDROP (=15) format to get file copying and moving.
      UOTextSource1.CustomFormatData.addFormat('15', HDropFromSelectedFiles);
    end;

    // Add CF_TEXT (1) for testing.  This has the same effect in a custom
    // format as just setting UOTextSource1.Text = Edit1.Text when not
    // using custom data formats.  This one will be rendered on demand
    // (the first time only) if Edit1.Text is blank.
    if CheckBox1.Checked then
    begin
      UOTextSource1.Customformatdata.addFormat(IntToStr(CF_TEXT), Edit1.Text);

      if CheckBox7.Checked then
      begin
        // Add FileName format to get scraps properly when dragging to the desktop.
        // The file name specified must be valid.  We create a temp file for this,
        // and delete it in the OnAfterDrop event.
        with TStringList.create do
        try
          add(Edit1.Text);
          FTempFileName := uoGetTempFileName('uox');
          // Give it the right extension, so we can open the scrap using the
          // associated program when it's double-clicked
          RenameFile(FTempFileName, ChangeFileExt(FTempFileName, '.txt'));
          FTempFileName := ChangeFileExt(FTempFileName, '.txt');
          SaveToFile(FTempFileName);
        finally
          free;
        end;    // with
        UOTextSource1.CustomFormatData.addFormat('FileName', FTempFileName);
      end;
    end;

    // Test bitmap on GDI handle.  This is an example of how a TUOTextSource with
    // custom data formats can be equivalent to a TUOGraphicSource!  Of course,
    // for best color results, you should transfer CF_DIB rather than CF_BITMAP.
    if CheckBox4.Checked then
    begin
      // We just put the bitmap handle itself on the string.  The component will
      // take care of copying it at the appropriate point.
      aHBitmap := Image1.Picture.Bitmap.Handle;
      aString := uoEncodeDWORDToString(aHBitmap);

      // The TYMED is passed in the objects[] array.  If there's no entry
      // for a given custom format, the components assume TYMED_HGLOBAL
      // which is the usual format.
      UOTextSource1.CustomFormatData.AddFormatEx(IntToStr(CF_BITMAP), aString, TYMED_GDI, -1);
    end;

    // Finally, add two custom formats
    // This one is the geometric constant Pi
    if CheckBox2.Checked then
      UOTextSource1.CustomFormatData.addFormat('UnitOOPS Pi', uoEncodeDoubleToString(3.141592654));

    // This one will be rendered on demand (the first time only), since its content
    // is blank.  See UOTextSource1RenderCustomFormat below - it will be used to
    // transfer the base of the natural logarithms, e.
    if CheckBox3.Checked then
      UOTextSource1.CustomFormatData.addFormat('UnitOOPS e', '');

    // Our drag source now knows how to supply several different standard data formats,
    // text and file lists) as well as our custom formats ('Unitoops Pi','UnitOOPS e')
    // that deliver "Pi" and "e" as doubles (test this using CustomTest1.DPR, with the
    // target format set to 'UnitOOPS Pi' and 'UnitOOPS e', respectively.
    UOTextSource1.Execute;
  end;
end;

end.
Back to top
Form source: fmCustomHDROP.dfm

object Form1: TForm1
  Left = 216
  Top = 139
  BorderStyle = bsDialog
  Caption = 'Test of custom OLE drag/drop formats - HDROP'
  ClientHeight = 317
  ClientWidth = 583
  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 = 48
    Width = 577
    Height = 265
    BevelOuter = bvNone
    TabOrder = 0
    object Label2: TLabel
      Left = 9
      Top = 9
      Width = 216
      Height = 13
      Caption = 'Drag from the list of files for all drag operations'
    end
    object DriveComboBox1: TDriveComboBox
      Left = 8
      Top = 29
      Width = 130
      Height = 19
      DirList = DirectoryListBox1
      TabOrder = 0
    end
    object FileListBox1: TFileListBox
      Left = 143
      Top = 29
      Width = 162
      Height = 234
      DragMode = dmAutomatic
      ItemHeight = 16
      MultiSelect = True
      TabOrder = 1
      OnStartDrag = FileListBox1StartDrag
    end
    object DirectoryListBox1: TDirectoryListBox
      Left = 8
      Top = 53
      Width = 130
      Height = 210
      FileList = FileListBox1
      ItemHeight = 16
      TabOrder = 2
    end
    object GroupBox1: TGroupBox
      Left = 311
      Top = 3
      Width = 266
      Height = 260
      Caption = 'What to drag...'
      TabOrder = 3
      object Label3: TLabel
        Left = 141
        Top = 123
        Width = 113
        Height = 13
        Alignment = taRightJustify
        Caption = '(delayed render if blank)'
      end
      object Image1: TImage
        Left = 30
        Top = 197
        Width = 122
        Height = 57
        AutoSize = True
        Picture.Data = {
          07544269746D6170D21F0000424DD21F00000000000036040000280000007A00
          ...truncated for brevity...
          D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D20000}
      end
      object Label4: TLabel
        Left = 29
        Top = 59
        Width = 110
        Height = 13
        Caption = 'Drop effects to include:'
      end
      object CheckBox1: TCheckBox
        Left = 9
        Top = 100
        Width = 65
        Height = 17
        Caption = 'this text:'
        State = cbChecked
        TabOrder = 0
        OnClick = CheckBox1Click
      end
      object Edit1: TEdit
        Left = 80
        Top = 98
        Width = 177
        Height = 21
        TabOrder = 1
        Text = 'Test text to drag'
      end
      object CheckBox2: TCheckBox
        Left = 9
        Top = 140
        Width = 201
        Height = 17
        Caption = '"UnitOOPS Pi" format'
        State = cbChecked
        TabOrder = 2
      end
      object CheckBox3: TCheckBox
        Left = 9
        Top = 160
        Width = 207
        Height = 17
        Caption = '"UnitOOPS e" format (delayed render)'
        State = cbChecked
        TabOrder = 3
      end
      object CheckBox4: TCheckBox
        Left = 9
        Top = 179
        Width = 200
        Height = 17
        Caption = 'This image in CF_BITMAP format'
        State = cbChecked
        TabOrder = 4
      end
      object CheckBox5: TCheckBox
        Left = 9
        Top = 22
        Width = 232
        Height = 17
        Caption = 'The selected files in the list'
        State = cbChecked
        TabOrder = 5
        OnClick = CheckBox5Click
      end
      object CheckBox6: TCheckBox
        Left = 29
        Top = 40
        Width = 220
        Height = 17
        Caption = 'Drag shortcuts by default'
        TabOrder = 6
      end
      object CheckBox7: TCheckBox
        Left = 28
        Top = 119
        Width = 97
        Height = 17
        Caption = 'Allow scraps'
        TabOrder = 7
      end
      object CheckBox8: TCheckBox
        Left = 29
        Top = 74
        Width = 51
        Height = 16
        Caption = 'Copy'
        TabOrder = 8
      end
      object CheckBox9: TCheckBox
        Left = 85
        Top = 74
        Width = 51
        Height = 16
        Caption = 'Move'
        TabOrder = 9
      end
      object CheckBox10: TCheckBox
        Left = 145
        Top = 74
        Width = 104
        Height = 16
        Caption = 'Link (shortcut)'
        TabOrder = 10
      end
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 583
    Height = 49
    Align = alTop
    BevelOuter = bvNone
    BorderWidth = 5
    TabOrder = 1
    object Label1: TLabel
      Left = 5
      Top = 5
      Width = 573
      Height = 39
      Align = alClient
      Caption = 
        'Demonstrates how to drag multiple custom data formats including ' +
        'custom-implemented versions of CF_HDROP and "Shell IDList Array"' +
        ' for dragging lists of files and shortcuts.'
      WordWrap = True
    end
  end
  object UOTextSource1: TUOTextSource
    OnBeforeDrop = UOTextSource1BeforeDrop
    OnAfterDrop = UOTextSource1AfterDrop
    OnRenderCustomFormat = UOTextSource1RenderCustomFormat
    Text = 'Default text'
    DropEffects = [deCopy, deMove, deLink]
    Left = 56
    Top = 232
  end
end
Back to top

Back to the examples page