Sample Application: DragURLTest.dpr

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

Design-time form image
Project source: DragURLTest.dpr 

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

{$R *.RES}

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

unit fmDragURLTest;

{ Form for example of dragging URLs to Netscape and Internet Explorer

  Thanks to John Reeve for pointing out the order in which Win2k's desktop
  wants to process the dropped URL formats.

  Last modified:  01/18/2000
}

interface

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

type
  TForm1 = class(TForm)
    UOTextSource1: TUOTextSource;
    edURL: TEdit;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edTitle: TEdit;
    procedure Label2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    function GetFileContents: string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  uoUtil, ShlObj;

{$R *.DFM}

function makeFGDfromURLTitle(const aURL: string): string;
// Build a FileGroupDescriptor structure in a string containing a URL title to be dragged
// This is
var
  aFd: TFileDescriptor;
  aString: string;
begin
  result := uoEncodeDWORDToString(1);

  // The remainder of the structure is a single FILEDESCRIPTOR structure.
  FillChar(aFd, sizeOf(aFd), 0);
  with aFd do
  begin
    // IE 5 and up set the file size for the link file, so
    // let's do that.
    dwFlags := FD_LINKUI or FD_FILESIZE;
    nFileSizeHigh := 0;
    /// ***ALERT*** We've referenced the form global here.
    /// Not great style, so be careful if you re-use this routine.
    nFileSizeLow := length(Form1.GetFileContents);
    strCopy(cFileName, PChar(aURL));
  end;    // with
  // Put the file descriptor on a temp string
  SetLength(aString, sizeOf(TFileDescriptor));
  System.Move(aFd, aString[1], sizeOf(TFileDescriptor));

  // And add that string to the result
  result := result + aString;
end;

function TForm1.GetFileContents: string;
begin
  result := '[InternetShortcut]'#13#10'URL='+edURL.Text+#13#10;
end;

procedure TForm1.Label2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if DragDetect(Handle, POINT(X,Y)) then
  begin
    // A drag has been requested.  Load the necessary formats.
    with UOTextSource1, CustomFormatData do
    begin
      // Clear out the formats from the last drag
      Clear;

      // Make the URL available for Netscape (which takes text)
      AddFormat(IntToStr(CF_TEXT), edURL.Text);

      // Make the URL available for dropping as a shortcut in Windows Explorer
      // Drop formats are iterated in order by the Explorer at drop time.
      // In Win2k, even if the desktop is not set to "web page", the desktop still
      // responds to UniformResourceLocator rather than FileGroupDescriptor, so
      // we put the latter first so we get better behavior and avoid unwanted prompts.
      AddFormat('FileGroupDescriptor', makeFGDFromURLTitle(edTitle.Text+'.URL'));
      AddFormat('FileContents', GetFileContents);
      Items[Count-1].AllowTrailingNull := false;

      // Make the URL available for Internet Explorer
      AddFormat('UniformResourceLocator', edURL.Text);

      // Now run the text source.
      Execute;
    end;    // with
  end;
end;

end.
Back to top
Form source: fmDragURLTest.dfm 

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 361
  Height = 182
  Caption = 'Test of dragging URLs'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 9
    Top = 126
    Width = 25
    Height = 13
    Caption = 'URL:'
  end
  object Label3: TLabel
    Left = 9
    Top = 102
    Width = 23
    Height = 13
    Caption = 'Title:'
  end
  object edURL: TEdit
    Left = 47
    Top = 122
    Width = 298
    Height = 21
    TabOrder = 0
    Text = 'http://localhost/'
  end
  object Panel1: TPanel
    Left = 8
    Top = 8
    Width = 337
    Height = 81
    BorderWidth = 3
    TabOrder = 1
    object Label2: TLabel
      Left = 4
      Top = 4
      Width = 329
      Height = 73
      Align = alClient
      AutoSize = False
      Caption = 
        'Drag from this panel to Netscape or Internet Explorer.  The data' +
        ' dropped will be the URL below, which will then open in the brow' +
        'ser.   If you drop instead on the desktop or Explorer, a shortcu' +
        't will be dropped, with the title entered below.'
      WordWrap = True
      OnMouseDown = Label2MouseDown
    end
  end
  object edTitle: TEdit
    Left = 47
    Top = 98
    Width = 298
    Height = 21
    TabOrder = 2
    Text = 'My Shortcut Title'
  end
  object UOTextSource1: TUOTextSource
    DropEffects = [deCopy, deLink]
    Left = 296
    Top = 112
  end
end
Back to top

Back to the examples page