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 endBack to top |