Project source
Form source (Pascal)
Form source (DFM)
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 endBack to top |