Sample Application: DropEffectTest.dpr

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

Design-time form image
Project source: DropEffectTest.dpr.dpr 

program DropEffectTest;

{Example application for UnitOOPS OLE Drag and Drop Components}

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

{$R *.RES}

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

unit fmDropEffectTest;

{ UnitOOPS OLE Drag and Drop Components - Example
  for drop effect manipulations.

 Last modified:  11/17/98}

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Panel2: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    GroupBox1: TGroupBox;
    Label6: TLabel;
    UOTextTarget1: TUOTextTarget;
    Label7: TLabel;
    Label8: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
      X, Y: Integer);
    procedure UOTextTarget1DragLeave(Sender: TObject);
    procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
      const dropText: String; X, Y: Integer);
    procedure ComboBox1Click(Sender: TObject);
    procedure UOTextTarget1DragEnter(Sender: TObject; effect: TDropEffect;
      X, Y: Integer);
  private
    { Private declarations }
    procedure UpdateEffectLabel;
    procedure ResetEffects;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.UpdateEffectLabel;
begin
  // Put the currently available drop effects on the label
  Label3.Caption := stringFromDropEffects(UOTextTarget1.AvailableDropEffects);
end;

procedure TForm1.ResetEffects;
// Make all of the effect comboboxes visible again, and reset the label
begin
  ComboBox1.Visible := true;
  ComboBox2.Visible := true;
  ComboBox3.Visible := true;
  Label3.Caption := '[]';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Set up the initial values of the drop effect comboboxes
  ComboBox1.ItemIndex := ord(deCopy);
  ComboBox2.ItemIndex := ord(deMove);
  ComboBox3.ItemIndex := ord(deLink);

  // Nominate the whole form to be the acceptor of drags
  UOTextTarget1.AcceptorControl := Self;
end;

procedure TForm1.UOTextTarget1DragOver(Sender: TObject;
  effect: TDropEffect; X, Y: Integer);
begin
  // Update the drop effect label as we drag over the window
  UpdateEffectLabel;
end;

procedure TForm1.UOTextTarget1DragLeave(Sender: TObject);
begin
  // Reset the effects
  ResetEffects;
end;

procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
  const dropText: String; X, Y: Integer);
begin
  // Reset the effects
  ResetEffects;
end;

procedure TForm1.ComboBox1Click(Sender: TObject);
// Change the drop effect overrides based on the current selections in the
// comboboxes.
begin
  with UOTextTarget1 do
  begin
    if (Sender = ComboBox1) then
    begin
      // Copy
      OverrideDropEffects[deCopy] := TDropEffect(ComboBox1.ItemIndex);
    end
    else if (Sender = ComboBox2) then
    begin
      // Move
      OverrideDropEffects[deMove] := TDropEffect(ComboBox2.ItemIndex);
    end
    else if (Sender = ComboBox3) then
    begin
      // Link
      OverrideDropEffects[deLink] := TDropEffect(ComboBox3.ItemIndex);
    end
  end;    // with
end;

procedure TForm1.UOTextTarget1DragEnter(Sender: TObject;
  effect: TDropEffect; X, Y: Integer);
// A drag has just entered this window.  Hide all override comboboxes for
// drop effects that are not available.
var
  aDe: TDropEffect;
  aComboBox: TComboBox;
begin
  for aDe := deCopy to deLink  do    // Iterate
  begin
    aComboBox := FindComponent(Format('ComboBox%d', [ord(aDe)])) as TComboBox;
    aComboBox.Visible := aDe in UOTextTarget1.AvailableDropEffects;
  end;    // for
end;

end.
Back to top
Form source: fmDropEffectTest.dfm 

object Form1: TForm1
  Left = 247
  Top = 208
  BorderStyle = bsDialog
  Caption = 'Test of drag source drop effect manipulation'
  ClientHeight = 218
  ClientWidth = 316
  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 = 316
    Height = 57
    Align = alTop
    BevelOuter = bvNone
    BorderWidth = 3
    Caption = 'Panel1'
    TabOrder = 0
    object Label1: TLabel
      Left = 3
      Top = 3
      Width = 310
      Height = 51
      Align = alClient
      Caption = 
        'Drag from a drag source over this window to see the available dr' +
        'op effects.  You can override the drop effects using the combobo' +
        'xes below, e.g., set them all to "Nothing" to prevent all drops.'
      WordWrap = True
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 57
    Width = 316
    Height = 161
    Align = alClient
    BevelOuter = bvNone
    BorderWidth = 5
    TabOrder = 1
    object Label2: TLabel
      Left = 16
      Top = 24
      Width = 111
      Height = 13
      Alignment = taRightJustify
      AutoSize = False
      Caption = 'Available drop effects:  '
    end
    object Label3: TLabel
      Left = 136
      Top = 24
      Width = 169
      Height = 13
      AutoSize = False
      Caption = '[]'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clRed
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
    end
    object GroupBox1: TGroupBox
      Left = 8
      Top = 48
      Width = 297
      Height = 105
      Caption = 'Drop Effect Overrides'
      TabOrder = 0
      object Label6: TLabel
        Left = 24
        Top = 24
        Width = 84
        Height = 13
        Alignment = taRightJustify
        AutoSize = False
        Caption = 'Copy [deCopy]:'
      end
      object Label7: TLabel
        Left = 24
        Top = 48
        Width = 84
        Height = 13
        Alignment = taRightJustify
        AutoSize = False
        Caption = 'Move [deMove]:'
      end
      object Label8: TLabel
        Left = 24
        Top = 72
        Width = 84
        Height = 13
        Alignment = taRightJustify
        AutoSize = False
        Caption = 'Link [deLink]:'
      end
      object ComboBox1: TComboBox
        Left = 120
        Top = 21
        Width = 153
        Height = 21
        Style = csDropDownList
        ItemHeight = 13
        Items.Strings = (
          'Nothing [deNone]'
          'Copy [deCopy]'
          'Move [deMove]'
          'Link [deLink]')
        TabOrder = 0
        OnClick = ComboBox1Click
      end
      object ComboBox2: TComboBox
        Left = 120
        Top = 45
        Width = 153
        Height = 21
        Style = csDropDownList
        ItemHeight = 13
        Items.Strings = (
          'Nothing [deNone]'
          'Copy [deCopy]'
          'Move [deMove]'
          'Link [deLink]')
        TabOrder = 1
        OnClick = ComboBox1Click
      end
      object ComboBox3: TComboBox
        Left = 120
        Top = 69
        Width = 153
        Height = 21
        Style = csDropDownList
        ItemHeight = 13
        Items.Strings = (
          'Nothing [deNone]'
          'Copy [deCopy]'
          'Move [deMove]'
          'Link [deLink]')
        TabOrder = 2
        OnClick = ComboBox1Click
      end
    end
  end
  object UOTextTarget1: TUOTextTarget
    AcceptTextFormats = [dtfURL, dtfIEHTML, dtfRichText, dtfText, dtfFiles, dtfCustom]
    OnDragOver = UOTextTarget1DragOver
    OnDragLeave = UOTextTarget1DragLeave
    OnDrop = UOTextTarget1Drop
    Left = 240
    Top = 57
  end
end
Back to top

Back to the examples page