Form source (Pascal)
Form source (DFM)
Project source
Form source (Pascal)
Form source (DFM)
| Project source: OutlookTest3.dpr |
program OutlookTest3;
uses
Forms,
fmOutlookTest3 in 'fmOutlookTest3.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Back to top
|
| Form source: fmOutlookTest3.pas |
unit fmOutlookTest3;
{Demonstrates how to drag stuff from outlook into a list, and then manipulate
(edit) it later (in the actual object store) using automation.
Last modified: 09/29/99}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
uoole, StdCtrls, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
UOTextTarget1: TUOTextTarget;
ListView1: TListView;
Button1: TButton;
ckbOpenFOlder: TCheckBox;
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
X, Y: Integer);
procedure RadioGroup1Click(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
private
{ Private declarations }
ilSmall: TImageList;
ilLarge: TImageList;
FFolderName: string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
ActiveX, uoUtil, ShlObj, ShellAPI, COMObj;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
aSHFi: TSHFileInfo;
begin
// Set up the image lists - small and large separately.
// They are owned by the form, and will be destroyed along with it.
// Share the images so that we won't destroy the system
// image lists.
// Use a dummy wildcard filename for this call.
ilSmall := TImageList.Create(Self);
ilSmall.ShareImages := true;
ilSmall.Handle := SHGetFileInfo('*.*', 0, aSHFi, sizeOf(aSHFi),
SHGFI_ATTRIBUTES // Retrieves the file attribute flags.
or SHGFI_DISPLAYNAME // Retrieves the display name for the file.
or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
or SHGFI_SMALLICON // Causes the large icon to be retrieved
);
ListView1.SmallImages := ilSmall;
ilLarge := TImageList.Create(Self);
ilLarge.ShareImages := true;
ilLarge.Handle := SHGetFileInfo('*.*', 0, aSHFi, sizeOf(aSHFi),
SHGFI_ATTRIBUTES // Retrieves the file attribute flags.
or SHGFI_DISPLAYNAME // Retrieves the display name for the file.
or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
or SHGFI_LARGEICON // Causes the large icon to be retrieved
);
ListView1.LargeImages := ilLarge;
with UOTextTarget1, CustomFormats do
begin
OverrideDropEffects[deMove] := deCopy;
OverrideDropEffects[deLink] := deCopy;
AddObject('Object Descriptor', TObject(TYMED_HGLOBAL));
end;
end;
procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
var
j: integer;
s: string;
aSL: TStringList;
anIStorage: IStorage;
aSHFi: TSHFileInfo;
outlook: OleVariant;
cf: OleVariant;
begin
Screen.Cursor := crHourglass;
try
outlook := GetActiveOleObject('Outlook.Application');
cf := outlook.activeexplorer.currentfolder;
s := '';
while (not (cf.Parent.class = 0)) do // All the way to the application object
begin
s := '|' + cf.name + s;
cf := cf.parent;
end;
FFolderName := s;
s := UOTextTarget1.DataObjectGetFormat('FileGroupDescriptor');
aSL := uoFileListFromFileGroupDescriptor(s);
try
for j := 1 to aSL.Count do
begin
if (AnsiCompareText(ExtractFileExt(aSL[0]), '.msg') <> 0) then break;
// Its content is on an IStream, at lindex j-1
// Global overrides for lindex and tymed
DataObjectLindex := j-1;
DataObjectTymed := TYMED_ISTORAGE;
s := UOTextTarget1.DataObjectGetFormat('FileContents');
// Watch out for nothing at that index...
if (s <> '') then
begin
// Get the IStorage
DWORD(anIStorage) := uoDecodeDWORDFromString(s);
// Are we saving Outlook as MSG files? (A saved .MSG file can be double-
// clicked to start up Outlook editing that message).
// This is just an exercise in putting the IStorage on a file.
// How? Make another storage that IS a file, and copy to there!
// Because the default is direct (as opposed to transacted) mode,
// the change gets saved immediately.
s := uoGetTempFilename('uox');
s := ChangeFileExt(s, '.msg');
// Save to file so we can use SHGetFileInfo()
// uoSaveIStorageToFile() introduced in V1.31
uoSaveIStorageToFile(anIStorage, s);
SHGetFileInfo(PChar(s), 0, aSHFi, sizeOf(aSHFi),
SHGFI_ATTRIBUTES // Retrieves the file attribute flags.
or SHGFI_DISPLAYNAME // Retrieves the display name for the file.
or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
or SHGFI_TYPENAME // Retrieves the type of item
or SHGFI_SMALLICON // Causes the small icon to be retrieved
);
// Delete the file again
DeleteFile(s);
// Add info to the list view
with ListView1.Items.Add do
begin
Caption := ChangeFileExt(aSL[j-1], '');
SubItems.Add( StrPas(aSHFi.szTypeName));
SubItems.Add(FFolderName);
ImageIndex := aSHFi.iIcon;
end;
end;
end;
finally
aSL.Free;
end;
finally
outlook := unassigned;
cf := unassigned;
Screen.Cursor := crDefault;
end;
end;
procedure touch(var x);
begin
// Cute debugging trick. Call touch on any variable and it won't be
// optimized out.
end;
procedure TForm1.Button1Click(Sender: TObject);
// Handle a button click to open the selected item.
var
Outlook: OleVariant;
aNamespace: OleVariant;
aFolder: OleVariant;
j: integer;
aSL: TStringList;
aLi: TListItem;
found: boolean;
s1, s2: string;
expl: OleVariant;
c: integer;
begin
aLi := ListView1.Selected;
if not assigned(aLi) then exit;
// Reconstruct the path to the item in Outlook
aSL := uoTokenize(aLi.SubItems[1], ['|']);
try
Outlook := GetActiveOleObject('Outlook.Application');
aNamespace := Outlook.GetNamespace('MAPI');
aFolder := aNamespace.Folders(aSL[0]);
for j := 2 to aSL.Count do
begin
aFolder := aFolder.Folders(aSL[j-1]);
end;
finally
aSL.Free;
end;
// Now we have a folder. If the checkbox is checked, open the folder too.
// First, though, see if it's already open.
found := false;
c := Outlook.Explorers.Count;
// touch(c);
for j := 1 to c do
begin
try
expl := Outlook.Explorers.Item[j];
s1 := expl.Currentfolder.Name;
s2 := aFolder.Name;
if (AnsiCompareText(s1, s2) = 0) then
begin
found := true;
// It's already open - just activate the open one
if ckbOpenFolder.Checked then
Outlook.Explorers.Item[j].Activate;
break; // No need to search further - we found it
end;
except
// Trap OLE errors
on EOleSysError do;
on EOleError do;
end;
end;
// If it wasn't opened and we want it open, open it.
if ((not found) and ckbOpenFolder.Checked) then
aFolder.Display;
// Open an inspector (editor) for the item.
aFolder.Items(aLi.Caption).Display;
// Finally, clear all of the variants
Outlook := Unassigned;
aNamespace := Unassigned;
aFolder := Unassigned;
expl := Unassigned;
end;
procedure TForm1.UOTextTarget1DragOver(Sender: TObject;
effect: TDropEffect; X, Y: Integer);
begin
// Only show drop cursor if we really want the stuff being dragged
// This doesn't affect the functionality, but it's important to get
// user feedback in the UI right.
with UOTextTarget1 do
begin
DataObjectTymed := TYMED_ISTREAM;
AcceptCustom := DataObjectHasFormat('RenPrivateSourceFolder');
AcceptCustom := AcceptCustom
and DataObjectHasFormat('FileGroupDescriptor')
// don't accept drags of folders
and not DataObjectHasFormat('UniformResourceLocator');
end;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
// Select a new viewstyle for the listview
ListView1.ViewStyle := TViewStyle(RadioGroup1.ItemIndex);
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
begin
// Doubleclick is the same as clicking the button
Button1Click(Button1);
end;
end.
Back to top
|
| Form source: fmOutlookTest3.dfm |
object Form1: TForm1
Left = 192
Top = 107
BorderStyle = bsDialog
Caption = 'Test of dragging items from Outlook'
ClientHeight = 320
ClientWidth = 570
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 8
Width = 351
Height = 13
Caption =
'Drop items from MS Outlook on this list (e-mail, contacts, appoi' +
'ntments, etc'
end
object ListView1: TListView
Left = 8
Top = 64
Width = 554
Height = 249
Columns = <
item
Caption = 'Outlook Item'
Width = 200
end
item
Caption = 'Type'
Width = 150
end
item
Caption = 'Folder name'
Width = 200
end>
ColumnClick = False
ReadOnly = True
TabOrder = 0
ViewStyle = vsReport
OnDblClick = ListView1DblClick
end
object Button1: TButton
Left = 403
Top = 11
Width = 137
Height = 25
Caption = 'Open the item'
TabOrder = 1
OnClick = Button1Click
end
object ckbOpenFOlder: TCheckBox
Left = 403
Top = 39
Width = 137
Height = 17
Caption = 'Open container folder'
TabOrder = 2
end
object RadioGroup1: TRadioGroup
Left = 8
Top = 23
Width = 337
Height = 37
Caption = 'List view style'
Columns = 4
ItemIndex = 3
Items.Strings = (
'Icons'
'Small Icons'
'List'
'Report')
TabOrder = 3
OnClick = RadioGroup1Click
end
object UOTextTarget1: TUOTextTarget
AcceptorControl = ListView1
AcceptTextFormats = [dtfCustom]
OnDragOver = UOTextTarget1DragOver
OnDrop = UOTextTarget1Drop
Left = 264
Top = 144
end
end
Back to top
|