Form source (Pascal)
Form source (DFM)
Project source
Form source (Pascal)
Form source (DFM)
| Project source: OutlookTest.dpr |
program OutlookTest;
{Main program file for test application for UnitOOPS OLE Drag and Drop Components.}
uses
Forms,
fmOutlookTest in 'fmOutlookTest.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Back to top
|
| Form source: fmOutlookTest.pas |
unit fmOutlookTest;
{ UnitOOPS OLE Drag and Drop Components - Example
for accepting drags of attachments from programs including MS Outlook,
which supplies dragged attachments in an unusual format.
Last modified: 09/29/99}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
uoole, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
UOTextTarget1: TUOTextTarget;
Panel1: TPanel;
ListBox1: TListBox;
Panel2: TPanel;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
procedure ListBox1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
ActiveX, ShellAPI, ShlObj, uoUtil;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Register to accept the custom formats that Outlook supplies.
// We've also included dtfCustom in AcceptTextFormats at design time.
with UOTextTarget1, CustomFormats do
begin
OverrideDropEffects[deMove] := deCopy;
Add('FileGroupDescriptor');
AddObject('FileContents', TObject(TYMED_ISTREAM));
end;
end;
procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
// Handle dropping of files and, in particular, the format in which MS Outlook
// passes e-mail attachments to OLE drag and drop (as file contents on an IStream,
// accompanied by a file group descriptor).
var
hasFormats: boolean;
S, t: string;
nFiles: DWORD;
aFd: TFileDescriptor;
j: integer;
anIstream: IStream;
tempFileName, newFileName: string;
begin
with (Sender as TUOTextTarget) do
begin
if (DroppedTextFormat = dtfFiles) then
begin
// It's a plain list of files - do the "usual" thing
ListBox1.Items.AddStrings(DroppedLines);
end
else
begin
// It's not simple files, but MS Outlook's combination of a FileGroupDescriptor
// and FileContents on an IStream. We have to go get the attachments and then
// put them on files ourselves. It appears that Outlook 97 also puts a copy
// of this file in the TEMP directory, but we ignore that here so we can
// demonstrate the principles.
// Do we have fgd?
hasFormats := DataObjectHasFormat('FileGroupDescriptor');
// Global override for tymed - reset automatically by calls to
// DataObjectHasFormat and DataObjectGetFormat
DataObjectTymed := TYMED_ISTREAM;
// Do we have fc? Do the call first, so we're guaranteed that it won't
// be short-circuited, so that the global tymed and lindex get reset properly.
hasFormats := DataObjectHasFormat('FileContents') and hasFormats;
if hasFormats then
begin
// Get the file group descriptors
s := DataObjectGetFormat('FileGroupDescriptor');
// How many fgd's in the returned data? That's a DWORD at the head
// of the string-encoded data
nFiles := uoDecodeDWORDFromString(s);
// Process them all
for j := 1 to nFiles do // Iterate
begin
// Get the j'th file descriptor. It starts after the initial DWORD,
// and has the length of a TFileDescriptor.
System.Move(s[SizeOf(DWORD)+1+(j-1)*SizeOf(TFileDescriptor)], aFd,
SizeOf(TFileDescriptor));
// Its content is on an IStream, at lindex j-1
// Global overrides for lindex and tymed
DataObjectLindex := j-1;
DataObjectTymed := TYMED_ISTREAM;
t := DataObjectGetFormat('FileContents');
// Watch out for nothing at that index...
if (t <> '') then
begin
// Don't use "anIStream := IStream(uoDecodeDWORDFromString(s));" since that
// would add another reference, due to Delphi's automatic reference handling.
// Alternatively, do it that way, but immediately call anIStream._Release;
DWORD(anIStream) := uoDecodeDWORDFromString(t);
// Now, we have a singly-referenced Istream interface that we can read from.
// We put it on a file somewhere. For this example, we're using a
// temporary file name that begins with 'uox' and has the same extension
// as the original and also adding it to the list. Note that
// uoGetTempFileName also creates the file, so we rename it immediately.
tempFileName := uoGetTempFileName('uox');
newFileName := ChangeFileExt(tempFileName, ExtractFileExt(aFd.cFileName));
RenameFile(tempFileName, newFileName);
ListBox1.Items.Add(uoSaveIStreamToFile(anIstream, newFileName));
end;
end; // for
end; // if hasFormats
end // if (DroppedTextFormat = dtfFiles)
end; // with
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
// A double-click on the list will launch the item.
begin
ShellExecute(Handle, 'Open', PChar(ListBox1.Items[ListBox1.ItemIndex]),
'', '', SW_SHOWNORMAL);
end;
end.
Back to top
|
| Form source: fmOutlookTest.dfm |
object Form1: TForm1
Left = 260
Top = 175
Width = 390
Height = 249
Caption =
'Drag attachments or files onto this list box (even from Outlook!' +
')'
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 = 33
Width = 382
Height = 189
Align = alClient
BevelOuter = bvNone
BorderWidth = 3
Caption = 'Panel1'
TabOrder = 0
object ListBox1: TListBox
Left = 3
Top = 3
Width = 376
Height = 183
Align = alClient
ItemHeight = 13
TabOrder = 0
OnDblClick = ListBox1DblClick
end
end
object Panel2: TPanel
Left = 0
Top = 0
Width = 382
Height = 33
Align = alTop
Alignment = taLeftJustify
BevelOuter = bvNone
BorderWidth = 3
TabOrder = 1
object Label1: TLabel
Left = 3
Top = 3
Width = 376
Height = 27
Align = alClient
Caption =
'Drag attachments or files onto this list box from e-mail program' +
's (including Outlook!), Explorer, etc. Double-click any item to' +
' run it via ShellExecute.'
WordWrap = True
end
end
object UOTextTarget1: TUOTextTarget
AcceptorControl = ListBox1
AcceptTextFormats = [dtfFiles, dtfCustom]
OnDrop = UOTextTarget1Drop
Left = 72
Top = 152
end
end
Back to top
|