все константы из библиотеки типов

/p>

{$I worddec.inc} { все константы из библиотеки типов тащим с собой}

Var
myRegistry : TRegistry;GotWord : Boolean;WhereIsWord : String;WordDoneMessage : Integer;Basically : variant;Wordy: Variant;MyDocument : Variant;MyOutlook : Variant;MyNameSpace : Variant;MyFolder : Variant;MyAppointment : Variant;

Function GetWordUp(StartType : string):Boolean;
// Запускаем Word "правильным" на мой взгляд способом
// после старта Word мы сделаем так, чтобы после завершения приложения он остался открытым
var i : integer;
AHwnd : Hwnd;AnAnswer : Integer;temp : string;MyDocumentsCol : Variant;TemplatesDir : Variant;OpenDialog1 : TopenDialog;
begin
result := false;myRegistry := Tregistry.Create;myRegistry.RootKey := HKEY_LOCAL_MACHINE;// никакого "word 8", никакой функции!
If myRegistry.KeyExists('SOFTWARE\Microsoft\Office\8.0\Word')thenGotWord := trueElseGotWord := false;If GotWord then//где он, черт побери?
If myRegistry.OpenKey('SOFTWARE\Microsoft\Office\8.0', false) thenbeginWhereisWord := myRegistry.ReadString('BinDirPath');MyRegistry.CloseKey;endelseGotWord := false;If GotWord then//и где эти надоевшие шаблоны?
BeginMyRegistry.RootKey := HKEY_CURRENT_USER;IfmyRegistry.OpenKey('SOFTWARE\Microsoft\Office\8.0\Common\FileNew\SharedTemplates', false) then
BeginTemplatesDir := myRegistry.ReadString(Nothing);MyRegistry.CloseKey;endElseBeginWarning('Ole инсталляция','Шаблоны рабочей группы не установлены');GotWord := false;end;End;myRegistry.free;If not gotword thenBeginWarning('Ole дескриптор', 'Word не установлен');exit;end;//это имя класса принадлежит главному окну в двух последних версиях Word
temp := 'OpusApp';AHwnd := FindWindow(pchar(temp),nil);If (AHwnd = 0) then//Word не запущен, пробуем запустить пустую оболочку без документа
BeginTemp := WhereisWord + '\winword.exe /n';AnAnswer := WinExec(pchar(temp), 1);If (AnAnswer < 32) thenBeginWarning('Ole дескриптор', 'Не могу найти WinWord.exe');Exit;End;End;
Application.ProcessMessages;{Если вы уже используете Word.Application, вы получаете ваш собственный экземпляр}
{Если вы уже используете Word.Document, вы получаете работающий экземпляр}
{по-моему все понятно и очень удобно (во всяком случае мне)}
try {создаем новый документ}Basically := CreateOleObject('Word.Document.8');exceptWarning('Ole дескриптор', 'Не могу запустить Microsoft Word.');Result := False;Exit;end;Try {ссылаемся в переменной вариантного на вновь созданный документ}Wordy := Basically.Application;ExceptBeginWarning('Ole дескриптор', 'Не могу получить доступ к Microsoft Word.');Wordy := UnAssigned;Basically := UnAssigned;Exit;end;end;
Application.ProcessMessages;
Wordy.visible := false;MyDocumentsCol := Wordy.Documents;{Проверяем количество открытых документов и пытаемся вывести диалог выбора шаблона}
If (MyDocumentsCol.Count = 1) or(StartType = 'New') thenBeginOpenDialog1 := TOpenDialog.Create(Application);OpenDialog1.filter := 'Шаблоны Word|*.dot|Документы Word|*.doc';OpenDialog1.DefaultExt := '*.dot';OpenDialog1.Title := 'Выберите ваш шаблон';OpenDialog1.InitialDir := TemplatesDir;If OpenDialog1.execute thenBeginWordy.ScreenUpdating:= false;MyDocumentsCol := wordy.Documents;MyDocumentsCol.Add(OpenDialog1.Filename, False);OpenDialog1.free;endElsebeginOpenDialog1.Free;Wordy.visible := true;Wordy := Unassigned;Basically := Unassigned;Exit;end;endElse{закрываем документ}
MyDocument.close(wdDoNotSaveChanges);
{теперь мы имеем или новый документ на основе шаблона, выбранного пользователем
или же его текущий документ}MyDocument := Wordy.ActiveDocument;Result := true;Application.ProcessMessages;
end;

Function InsertPicture(AFileName : String) : Boolean;
var
MyShapes : Variant;MyRange : variant;
begin
Result := True;If GetWordUp('Current')thenTryBeginMyRange := MyDocument.Goto(wdgotoline, wdgotolast);MyRange.EndOf(wdParagraph, wdMove);MyRange.InsertBreak(wdPageBreak);MyShapes := MyDocument.InlineShapes;MyShapes.AddPicture(afilename, false, true, MyRange);end;FinallybeginWordy.ScreenUpdating:= true;Wordy.visible := true;Wordy := Unassigned;Basically := UnAssigned;Application.ProcessMessages;end;endelseResult := False;
end;

Function InsertContactInfo(MyId : TMyId; MyContId : TMyContId) : Boolean;
var
MyCustomProps : Variant;begin
{ лично я сначала сохраняю свою визитку в свойствах документа, а только
потом вывожу панели с инструментами для того, чтобы пользователь мог
"установить" принадлежность шаблона или текущего документа.

на мой взгляд здесь есть три достоинства (здесь нет подвохов, уверяю вас):
1. Пользователь может установить свои свойства документа после того,
как функция отработает
2. Другие свойства могут быть установлены в любом месте
того же документа
3. Пользователь может переслать эти свойства в тот же Outlook или с их
помощью найти документ, используя функции расширенного поиска Word}

Result := true;If GetWordUp('New')thenTryBeginMyCustomProps := MyDocument.CustomDocumentProperties;MyCustomProps.add(cpId, false, msoPropertyTypeString, MyId.Id);MyCustomProps.add(cpOrganizationName,false, msoPropertyTypeString, MyId.OrganizationName);MyCustomProps.add(cpAddress1,false, msoPropertyTypeString,MyId.Address1);MyCustomProps.add(cpAddress2, false,msoPropertyTypeString, MyId.Address2);MyCustomProps.add(cpCity, false,msoPropertyTypeString, MyId.City);MyCustomProps.add(cpStProv, false,msoPropertyTypeString, MyId.StProv);MyCustomProps.add(cpCountry,false, msoPropertyTypeString,MyId.City);MyCustomProps.add(cpPostal, false,msoPropertyTypeString, MyId.Country);MyCustomProps.add(cpAccountId, false,msoPropertyTypeString, MyId.AccountId);MyCustomProps.add(cpFullName, false,msoPropertyTypeString, MyContId.FullName);MyCustomProps.add(cpSalutation, false,msoPropertyTypeString, MyContId.Salutation);MyCustomProps.add(cpTitle, false,msoPropertyTypeString,MyContId.Title);If (MyContId.workPhone = Nothing) or(MycontId.WorkPhone = ASpace) thenMyCustomProps.add(cpPhone, false,msoPropertyTypeString, MyId.Phone )elseMyCustomProps.add(cpPhone, false,msoPropertyTypeString, MyContId.WorkPhone );If (MyContId.Fax = Nothing) or (MycontId.Fax = ASpace) thenMyCustomProps.add(cpFax, false,msoPropertyTypeString, MyId.Fax)elseMyCustomProps.add(cpFax, false,msoPropertyTypeString,MyContId.Fax);If (MyContId.EMail = Nothing) or (MycontId.Email = ASpace) thenMyCustomProps.add(cpEmail, false,msoPropertyTypeString, MyId.Email)elseMyCustomProps.add(cpEmail, false,msoPropertyTypeString, MyContId.Email);MyCustomProps.add(cpFirstName, false,msoPropertyTypeString,MyContId.FirstName);MyCustomProps.add( cpLastName, false,msoPropertyTypeString, MyContId.LastName);MyDocument.Fields.Update;end;FinallybeginWordy.ScreenUpdating:= true;Wordy.visible := true;Wordy := Unassigned;Basically := UnAssigned;Application.ProcessMessages;end;endElseResult := false;end;

Function GetOutlookUp(ItemType : Integer): Boolean;
Const
AppointmentItem = 'Calendar';TaskItem = 'Tasks';ContactItem = 'Contacts';JournalItem = 'Journal';NoteItem = 'Notes';var
MyFolders : Variant;MyFolders2 : variant;MyFolders3 : variant;MyFolder2 : Variant;MyFolder3 : variant;MyUser : Variant;MyFolderItems : Variant;MyFolderItems2 : Variant;MyFolderItems3 : Variant;MyContact : Variant;i, i2, i3 : Integer;MyTree : TCreateCont;MyTreeData : TTreeData;RootNode, MyNode, MyNode2 : ttreeNode;ThisName : String;
Begin
{это действительно безобразие........В Outlook несколько странно реализована объектная модель,и такие перлы как folder.folder.folder считаются "верным решением"для получения доступа к папкам этой великолепной программы.}
{пользователь выбирает папку из дерева папок}

Result := False;Case ItemType ofolAppointmentItem : ThisName := AppointmentItem;olContactItem : ThisName := ContactItem;olTaskItem : ThisName := TaskItem;olJournalItem : ThisName := JournalItem;olNoteItem : ThisName := NoteItem;ElseThisName := 'Unknown';End;
tryMyOutlook := CreateOleObject('Outlook.Application');exceptwarning('Ole интерфейс','Не могу запустить Outlook.');Exit;end;{это папка верхнего уровня}MyNameSpace := MyOutlook.GetNamespace('MAPI');MyFolderItems := MyNameSpace.Folders;MyTree := TCreateCont.create(Application);{Действительно неудачно, ведь пользователь может создать что-то другое,
чем папки, предлагаемые по-умолчанию, на которые мы и хотели опереться
в нашей программе, поэтому перемещаемся на нижний уровень в цепочке папок}
MyTree.Caption := 'Выбрана ' + ThisName + ' папка';With MyTree doIf MyFolderItems.Count > 0 thenFor i := 1 to MyFolderItems.Count do beginMyFolder := MyNameSpace.Folders(i);MyTreeData := TTreeData.create;MyTreeData.ItemId := MyFolder.EntryId;RootNode := TreeView1.Items.AddObject(nil, MyFolder.Name, MyTreeData);MyFolders2 := MyNameSpace.folders(i).Folders;If MyFolders2.Count > 0 thenfor i2 := 1 to MyFolders2.Count do beginMyFolder2 := MyNameSpace.folders(i).Folders(i2);If (MyFolder2.DefaultItemType = ItemType)or (MyFolder2.Name = ThisName) thenBeginMyTreeData := TTreeData.create;MyTreeData.ItemId := MyFolder2.EntryId;{вот мы и добрались непосредственно до папок}
MyNode :=Treeview1.Items.addChildObject(RootNode, MyFolder2.Name, MyTreeData);
MyFolders3 :=MyNameSpace.folders(i).Folders(i2).Folders;
If MyFolders3.Count > 0 thenfor i3 := 1 to MyFolders3.Count dobeginMyFolder3 := MyNameSpace.folders(i).Folders(i2).Folders(i3);If (MyFolder3.DefaultItemType = ItemType) thenBeginMyTreeData := TTreeData.create;MyTreeData.ItemId := MyFolder3.EntryId;MyNode2 :=Treeview1.Items.addChildObject(MyNode, MyFolder3.Name, MyTreeData);
end;end;end;end;end;If MyTree.TreeView1.Items.Count = 2 then{есть только корневая папка и папка, определенная мной}
MyFolder :=MyNameSpace.GetFolderFromID(TTreeData(MyTree.TreeView1.Items[1].Data).ItemId
)
ElsebeginMyTree.Treeview1.FullExpand;MyTree.ShowModal;If MyTree.ModalResult = mrOk thenBeginIf MyTree.Treeview1.Selected <> nil thenMyFolder :=MyNameSpace.GetFolderFromID(TTreeData(MyTree.Treeview1.Selected.Data).ItemId
);
endelseBeginMyOutlook := UnAssigned;For i:= MyTree.Treeview1.Items.Count -1 downto 0 doTTreeData(MyTree.Treeview1.Items[i].Data).free;MyTree.release;exit;end;end;For i:= MyTree.Treeview1.Items.Count -1 downto 0 doTTreeData(MyTree.Treeview1.Items[i].Data).free;MyTree.release;Result := true;end;

Function MakeOutlookContact(MyId : TMyId; MyContId : TMyContId) : boolean;
var MyContact : Variant;
begin
Result := false;If not GetOutlookUp(OlContactItem)then exit;MyContact := MyFolder.Items.Add(olContactItem);MyContact.Title := MyContId.Honorific;MyContact.FirstName := MyContId.FirstName;MyContact.MiddleName := MycontId.MiddleInit;MyContact.LastName := MycontId.LastName;MyContact.Suffix := MyContId.Suffix;MyContact.CompanyName := MyId.OrganizationName;MyContact.JobTitle := MyContId.Title;MyContact.OfficeLocation := MyContId.OfficeLocation;MyContact.CustomerId := MyId.ID;MyContact.Account := MyId.AccountId;MyContact.BusinessAddressStreet := MyId.Address1 + CRLF + MyId.Address2;MyContact.BusinessAddressCity := MyId.City;MyContact.BusinessAddressState := MyId.StProv;MyContact.BusinessAddressPostalCode := MyId.Postal;MyContact.BusinessAddressCountry := MyId.Country;If (MyContId.Fax = Nothing) or (MyContId.Fax = ASpace) thenMyContact.BusinessFaxNumber := MyId.FaxElseMyContact.BusinessFaxNumber := MyContId.Fax;If (MyContId.WorkPhone = Nothing) or (MyContId.WorkPhone = ASpace)then
MyContact.BusinessTelephoneNumber := MyId.PhoneElseMyContact.BusinessTelephoneNumber := MyContId.WorkPhone;MyContact.CompanyMainTelephoneNumber := MyId.Phone;MyContact.HomeFaxNumber := MyContId.HomeFax;MyContact.HomeTelephoneNumber := MyContId.HomePhone;MyContact.MobileTelephoneNumber := MyContId.MobilePhone;MyContact.OtherTelephoneNumber := MyContId.OtherPhone;MyContact.PagerNumber := MyContId.Pager;MyContact.Email1Address := MyContId.Email;MyContact.Email2Address := MyId.Email;Result := true;Try MyContact.Save;ExceptResult := false;end;MyOutlook := Unassigned;
end;

Function GetThisOutlookItem(AnIndex : Integer) : Variant;
Begin
Result := myFolder.Items(AnIndex);end;

Function GetOutlookFolderItemCount : Integer;
Var myItems : Variant;
Begin
Try MyItems := MyFolder.Items;ExceptBeginResult := 0;exit;end;end;Result := MyItems.Count;end;

Function FindMyOutlookItem(AFilter : String; var AItem : Variant) :
Boolean;
Begin
{не забудьте предварительно инициализировать AItem значением NIL}
Result := true;TryAItem := myFolder.Items.Find(AFilter);ExceptBeginaItem := MyFolder;Result := false;end;End;
End;

Function FindNextMyOutlookItem(var AItem : Variant) : Boolean;
Begin
Result := true;TryAItem := myFolder.Items.FindNext;ExceptBeginAItem := myFolder;Result := false;end;End;End;

Function CloseOutlook : Boolean;
begin
Try MyOutlook := Unassigned;ExceptEnd;Result := true;
end;

<

Содержание Назад Вперед

Forekc.ru
Рефераты, дипломы, курсовые, выпускные и квалификационные работы, диссертации, учебники, учебные пособия, лекции, методические пособия и рекомендации, программы и курсы обучения, публикации из профильных изданий