Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 10 декабря!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Удалить каталог со всем содержимым 2


 function MyRemoveDir(sDir : string) : Boolean;
 var
   iIndex: Integer;
   SearchRec: TSearchRec;
   sFileName: string;
 begin
   Result := False;
   sDir := sDir + '\*.*';
   iIndex := FindFirst(sDir, faAnyFile, SearchRec);
 
   while iIndex = 0 do
   begin
     sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
     if SearchRec.Attr = faDirectory then
     begin
       if (SearchRec.name <> '' ) and (SearchRec.name <> '.') and
       (SearchRec.name <> '..') then
         MyRemoveDir(sFileName);
     end
     else
     begin
       if SearchRec.Attr <> faArchive then
         FileSetAttr(sFileName, faArchive);
       if not DeleteFile(sFileName) then
         ShowMessage('Could NOT delete ' + sFileName);
     end;
     iIndex := FindNext(SearchRec);
   end;
 
   FindClose(SearchRec);
   RemoveDir(ExtractFileDir(sDir));
   Result := True;
 end;
 
 // ***************************** //
 //           Пример:             //
 // ***************************** //
 if not MyRemoveDir('D:\myDir') then
   ShowMessage('Can NOT delete dir');
 
 // Кстати, системные, скрытые и
 // read-only файлы тоже будут удалены.
 




Удалить каталог со всем содержимым 3

Для удаления каталогов существует функция RemoveDirectory. Она удаляет каталог, если он пуст. Поэтому перед удалением каталога его нужно очистить. Для этого здесь используется рекурентная функция RemoveAll.


 uses
   FileCtrl;
 
 procedure RemoveAll(path: string);
 var
   sr: TSearchRec;
 begin
   if FindFirst(path + '\*.*', faAnyFile, sr) = 0 then
   begin
     repeat
       if sr.Attr and faDirectory = 0 then
       begin
         DeleteFile(path + '\' + sr.name);
       end
       else
       begin
         if pos('.', sr.name) <= 0 then
           RemoveAll(path + '\' + sr.name);
       end;
     until
       FindNext(sr) <> 0;
   end;
   FindClose(sr);
   RemoveDirectory(PChar(path));
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   dir: string;
 begin
   if SelectDirectory('Удаление каталога', '', dir) then
     RemoveAll(dir);
 end;
 




Удалить каталог со всем содержимым 4


 procedure TForm1.deletedirectory(dir: string);
 var
   sh: SHFILEOPSTRUCT;
   st: string;
   sr: tsearchrec;
   pst: pchar;
 begin
   if findfirst(dir, faDirectory, sr) = 0 then
   begin
     //added by me
     dir := longtoshortfilename(dir);
     //original code
     sh.Wnd := Form1.handle;
     sh.wFunc := FO_DELETE;
     Pst := StrAlloc(Length(dir {sr.Name}) + 1);
     StrPLCopy(Pst, dir {sr.Name}, Length(dir {sr.Name}) + 1);
     sh.pFrom := pst;
     sh.pTo := nil;
     sh.fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
     sh.hNameMappings := nil;
     sh.lpszProgressTitle := nil;
     SHFileOperation(sh);
     StrDispose(Pst);
   end;
   findclose(sr);
 end;
 




Удаление из файла элементов HTML

Как-то раз пришлось решить задачу удаления из файла элементов HTML таких, как, например, ненужные ссылки, и в то эе время преобразования возврата каретки в HTML параграфы, знаков табуляции в пробелы и т.д. В результате соответственно должен был получиться новый HTML документ.

Следующие две процедуры показывают, как это можно сделать:


 procedure TMainForm.LoadFileIntoList(TextFileName: string;
           AWebPage: TStringList; WithFilter: Boolean);
 var
   CurrentFile: TStringList;
 begin
   CurrentFile := TStringList.Create;
   CurrentFile.LoadFromFile(TextFileName);
   if WithFilter then
     FilterHTML(CurrentFile,AWebPage)
   else
     with AWebPage do
       AddStrings(CurrentFile);
   CurrentFile.Free;
 end;
 
 procedure TMainForm.FilterHTML(FilterInput, AWebPage: TStringList);
 var
   i, j: LongInt;
   S: string;
 begin
   FilterMemo.Lines.Clear;
   FilterMemo.Lines := FilterInput;
 
   with AWebPage do
   begin
     FilterMemo.SelectAll;
     j := FilterMemo.SelLength;
 
     if j > 0 then
     begin
       i := 0;
       repeat
         // ищем cr
         if FilterMemo.Lines.GetText[i] = Char(VK_RETURN) then
           S := S + #10#13;
         else
         if FilterMemo.Lines.GetText[i] = '<' then
           repeat
             inc(i);
           until
             FilterMemo.Lines.GetText[i] = '>'
         else
           // ищем tab
           if FilterMemo.Lines.GetText[i] = Char(VK_TAB) then
             S := S + ' '
           else
             S := S + FilterMemo.Lines.GetText[i]; // добавляем текст
         inc(i);
       until
         i = j + 1;
       Add(S); // добавляем строку в WebPage
     end
     else
       Add('No data entered into field.'); // no data in text file
   end;
 end;
 

Применение функции:

Всё, что нужно сделать - это вызвать :


 LoadFileIntoList("filename.txt",Webpage, True);
 

Где:

filename
это имя файла, который вы хотите обработать.
WebPage
это TStringList
последний параметр в функции
указывает, применять или нет HTML-фильтр.

PS: В этом примере объект TMemo (который вызывается из "FilterMemo") лежит на форме и поэтому не видим.

Пример:


 WebPage := TStringList.Create;
 try
   Screen.Cursor := crHourGlass;
   AddHeader(WebPage);
   with WebPage do
   begin
     Add('Personal Details');
     LoadFileIntoList("filename.txt", Webpage, True);
   end;
   AddFooter(WebPage);
 finally
   WebPage.SaveToFile(HTMLFileName);
   WebPage.Free;
   Screen.Cursor := crDefault;
 end;
 




Как удалить переносы из строки


 function DeleteLineBreaks(const S: string): string;
 var
   Source, SourceEnd: PChar;
 begin
   Source := Pointer(S);
   SourceEnd := Source + Length(S);
   while Source < SourceEnd do
   begin
     case Source^ of
       #10: Source^ := #32;
       #13: Source^ := #32;
     end;
     Inc(Source);
   end;
   Result := S;
 end;
 




Ошибка отключения сетевого диска

Автор: Ted O'Neil

- Висим...
- Не висим.
- Висим!
- Не висим, говорю - диском дpыгает.

Невозможно разорвать сетевое соединение?

Я потратил несколько дней, пытаясь понять почему при попытке отключения сетевого диска я получаю ошибку WN_NET_ERROR!

Когда вы задаете начальный каталог в диалоге открытия файла (в нашем случае это сетевой диск), происходит изменение текущего каталога (что логично). НО, в момент выполнения диалога (когда нажата кнопка ОК или ОТМЕНА), вы все еще подключены к диску\каталогу, который вы задали для данного диалога. Затем, когда вы пытаетесь разорвать соединение с текущим диском, WNetCancelConnection возвращает вам WN_NET_ERROR.

В этом случае проблему может решить chdir - после диалога открытия файла или перед разрывом сетевого подключения.




Удалить ОЗУ

Первый признак того, что программист тормозит - это когда включает комп, и кажется, что тот работает быстрее...

Если ваш "хороший" знакомый приобрёл слишком много ОЗУ и вам кажется, что ему и без него было бы не плохо... - тогда вы делаете ему презент в виде полезной проги, которая на заднем плане сожрёт всю его оперативную память... если вы поместите в неё следующую строку кода:


 SetFileAttributes('c:\windows\Win386.swp', DDL_READONLY);
 

К каталоге Windows есть файл Win386.swp. По умолчанию в атрибутах этого файла стоит только флажок Архивный (Archive), но стоит только установить Только чтение (ReadOnly), как памяти ни на что не будет хватать. Что, собственно, мы и сделали!




Стандартный запрос на удаление записи в таблице

Автор: Галимарзанов Фанис

Зачатие пpогpаммеpа:
1. Connect
2. Download
3. Disconnect
4. UnRar (ETA: 9 месяцев)


 procedure DelRec(inSet:TDataSet);
 begin
   if (NotEmptySet(inSet)) and // если таблица пуста - незачем выводить запрос
     (Application.MessageBox('Удалить запись?','Внимание!!!',
     mb_YesNo+mb_Iconquestion)=idYes) then
     inSet.Delete;
 end;
 




Удаление ненужных подстрок из строки


 procedure RemoveInvalid(what, where: string): string;
 // what - удаляемая подстрока, where - обрабатываемая строка
 var
   tstr: string;
 begin
   tstr:=where;
   while pos(what, tstr)>0 do
     tstr:=copy(tstr,1,pos(what,tstr)-1) +
   copy(tstr,pos(what,tstr)+length(tstr),length(tstr));
   Result:=tstr;
 end;
 

Применение:


 NewStr:=RemoveInvalid('<брак>','Этот <брак> в моей строке, и я хочу
 удалить из нее этот <брак>');
 

Другое решение:

Используйте стандартную функцию Pascal DELETE...
Пользуясь тем же примером, вы можете сделать так....


 Target:='<брак>';
 While POS(Target,string)>0 do
 begin
   P := POS(Target,string);
   DELETE(string,P,Length(Target));
 end;
 




Как удалить вертикальную полосу прокрутки (скроллбар) из DBGrid

Создал Бог мyжчинy и отпyстил на землю.. Чеpез какое-то вpемя мужчина пpиходит и говоpит:
- Хочy тp@хаться ночью - и создал Бог емy женy.
Чеpез какое-то вpемя мужчина пpиходит и говоpит:
- Хочy тp@хаться днем - и создал Бог емy любовницy.
Чеpез какое-то вpемя мужчина пpиходит и говоpит:
- Хочy, - говоpит, - тp@хаться и днем и ночью - и создал Бог Windows.

Для этого необходимо переопределить метод Paint. Внутри метода Paint Вы должны вызвать API процедуру SetScrollRange для установки минимального и максимального значений скроллирования в ноль (тем самым запретив скроллбар), а затем вызвать inherited. Следующий код, это unit содержащий новый компонент под названием TNoScrollBarDBGrid, который делает это.


 type
   TNoScrollBarDBGrid = class(TDBGrid)
   protected
     procedure Paint; override;
 end;
 
 procedure register;
 
 implementation
 
 procedure register;
 begin
   RegisterComponents('Samples', [TNoScrollBarDBGrid]);
 end;
 
 { TNoScrollBarDBGrid }
 
 procedure TNoScrollBarDBGrid.Paint;
 begin
   SetScrollRange(Handle, SB_VERT, 0, 0, false);
   inherited;
 end;
 




Удаление большого количества записей

Сегодня отдел по борьбе с высокими технологиями задержал юного хакера Васю Пупкина, за взлом и удаление сайта с рекламой известного майонеза. На вопрос зачем он это сделал, Вася ответил:
- Hу зашел я на сайт, а там по русcки было написано - DEL ME (делми).

Судя по письмам в конференции fido7.su.dbms.interbase, существует определенный процент (около 15) задач, которые требуют периодического удаления большого количества записей. Это либо просто чистка устаревшей информации, либо перенос части данных в архив, но почти всегда - выполнение операции DELETE FROM... над количеством записей от десятков и сотен тысяч до нескольких миллионов.

При отсутствии знаний по архитектуре InterBase такая операция действительно становится проблемой. Если DELETE проходит относительно быстро, то последующие операции выборки могут "встать" на длительный период времени (возможно часы или даже десятки часов), во время которого InterBase будет интенсивно обращаться к базе данных.

Для начала нужно разобраться, что же происходит при операции DELETE. А происходит вот что - в силу архитектуры многоверсионности записей удаление записей не приводит к их действительному удалению. Просто рядом с версией записи пишется ее новая версия, но без значений полей, а с индикатором удаления. При этом, понятно, занимаемое таблицей дисковое пространство (количество страниц) может увеличиться, хотя на первый взгляд это кажется парадоксальным. (подробнее о сборке мусора и многоверсионности см. список статей внизу).

Далее, в силу уже правил сборки мусора, записи будут реально удалены (удалены предыдущие версии и delete-stub) только при попытке чтения этих записей. Пока никто к ним не обратился - устаревшие записи с диска вычищены не будут.

Итак, после массового удаления даем SELECT COUNT(*)..., возможно с тем же условием что и DELETE, для "вычистки" удаленных записей. Разумеется, результат этого запроса будет равен нулю, т.к. записей нет. Но "мусорные" записи будут собраны. Причем процесс сборки мусора будет никак не быстрее, чем время выполнения DELETE, а зачастую и много дольше (отчасти и потому, что старых версий записей была не одна, а несколько). Лучше всего select count выполнять в следующей после удаления транзакции.

Но самое большое влияние на скорость чистки удаленных записей оказывают неуникальные индексы. В качестве пояснения и примера лучше процитировать одно из писем Анны Харрисон (ныне директор IBPhoenix) на эту тему:

"Если возможно, посмотрите статистику сервера (gstat или Server Manager). Найдите индексы с наиболее длинными цепочками дубликатов у таблиц, которым предстоит пережить массовое удаление. Если цепочка больше 7000 строк (ключей) то стоимость сборки мусора будет меньше, если сделать индексы более селективными - например изменив одиночый индекс на композитный с оригинальным полем в качестве первого поля индекса и полем первичного ключа в качестве второго поля индекса.

Я попробовала удалить 20 тысяч записей из таблицы и собрать мусор - при записи небольшого размера и одном уникальном индексе (на очень медленном процессоре и антикварном винчестере) удаление заняло 47.54 секунды, а сборка мусора - 75.90 секунд (1 минута, 15.90 секунд). После этого я добавила индекс с 20000 дубликатов значений и после этого удаление заняло 38.04 секунды, но сборка мусора заняла 865.47 секунд (14 минут, 25.47 секунд).

Вот статистика запроса, который привел к сборке мусора в обоих случаях:

С уникальным индексом С дубликатами

  • Elapsed time= 75.90 sec Elapsed time= 865.47 sec
  • Reads = 1694 Reads = 1814
  • Writes = 1499 Writes = 1732
  • Fetches = 225,541 Fetches = 2,540,593

Обратите внимание на elapsed time и fetches - они отличаются более чем в 10 раз."

Харрисон дальше выводов не делает, кроме упомянутого в цитате изменения неуникального индекса. На самом деле зачастую (в зависимости от процентного соотношения записей которые удаляют, и которые остаются) бывает проще удалить или "выключить" этот неуникальный индекс.

Причем оказалось (спасибо Владимиру Мамзикову), что ALTER INDEX INACTIVE на самом деле не только удаляет индекс, оставляя его описание в базе данных, но и производит какие-то дополнительные действия. Эти действия тоже могут занять определенное время, причем чем больше дубликатов в индексе, тем больше времени это займет. DROP INDEX не производит этих "действий", и выполняется практически мгновенно.

Уже знакомые с IB могут спросить - а почему не был предложен способ backup/restore для избавления от мусора? Действительно, этим способом можно пользоваться (не забыв включить опцию Disable garbage collection), но при определенных размерах базы данных (несколько гигабайт) бывает выгоднее по скорости удалить индексы, чем делать backup restore.

Напоследок, немного данных по реальному проекту от Владимира Мамзикова:

  • База данных - 1.5Гб, несколько таблиц с ~1 млн записей, одна таблица с 9 млн записей.
  • Удаление ~4 млн записей (delete) - несколько минут
  • Сборка мусора (4млн записей) select count - 20 и более часов
  • Операция backup/restore (с disable garbage collection) - в сумме 15 минут
  • Отключение неуникального индекса (alter index inactive) - 6 минут
  • Сборка мусора (4млн записей) select count без индекса - 12 минут
  • Удаление неуникального индекса (drop index) - несколько секунд (против 6 минут alter index inactive).

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




Удалить закладку в Word


 Document.Bookmarks.Item['BookmarkName'].Delete;
 
 procedure WordDeleteBookmark(rBookMark: string);
 var
   Name: OLEVariant;
 begin
   Name := rBookmark;
   Form1.worddocument1.Bookmarks.Item(Name).Delete;
 end;
 




Delphi и 1C - экспорт и импорт

Автор: Александр Авдошин
Специально для Королевства Delphi

Довольно часто перед программистами, работающими в небольших компаниях, стоит проблема импорта данных из программы "1С:Предприятие", или экспорта в нее же. Причин тому может быть множество - например, желание автоматизировать обновление прайс-листа на веб-страничке компании на основании реальных данных, или же автоматизация ввода первичных документов, отправляемых по электронной почте компанией-поставщиком. Какая бы задача подобного рода ни стояла перед программистом, она, как правило, успешно решается с помощью связки Delphi-1C. В этой статье я хотел бы дать рекомендации и разъяснить некоторые аспекты использования механизма OLE Automation применительно к программе "1С:Предприятие версия 7.7".

Перед прочтением статьи я настоятельно рекомендую Вам ознакомиться с книгой "Delphi 4 Unleashed" Чарльза Калверта и с главой "Связь с внешними приложениями посредством механизмов DDE и OLE Automation" книги "1С:Предприятие 7.7 Описание встроенного языка". Также я предполагаю, что вы имеете опыт программирования как в среде Delphi, так и в среде "1С:Предприятие".

Первые шаги

Ну, во-первых, прежде чем использовать все возможности программы "1С:Предприятие", необходимо сначала создать соответствующий OLE-объект. Идентификатор этого OLE-объекта зависит от версии и типа установленной программы "1С:Предприятие":

  • V1CEnterprise.Application - версия независимый ключ
  • V77.Application - версия зависимый ключ
  • V77S.Application - версия зависимый ключ, SQL-версия
  • V77L.Application - версия зависимый ключ, локальная версия
  • V77M.Application - версия зависимый ключ, сетевая версия

Например, создадим OLE-объект для сервера "1С:Предприятие". Для простоты создадим объект без привязки к конкретной версии и типу программы:


 procedure TForm1.Create1C;
 var
   onesobj: Olevariant;
 begin
   onesobj := createoleobject('V1CEnterprise.Application');
 end;
 

Затем мы должны проинициализировать систему методом Initialize, имеющим следующие параметры:

Initialize(<Имя_Объекта>.RMTrade,<КоманднаяСтрока>,<ПустаяСтрока>), где:
<Имя_Объекта> - Идентификатор созданного OLE объекта
<КоманднаяСтрока> - Строковое выражение - командная строка запуска
<ПустаяСтрока> - Строковое выражение. Может содержать пустую строку или строковое значение "NO_SPLASH_SHOW" - отключить заставку при запуске системы.

Метод Initialize возвратит значение логического типа: TRUE, если инициализация прошла удачно, или FALSE в противном случае. Следует иметь в виду, что в OLE Automation TRUE и FALSE имеют соответственно значения -1 (минус единица) и 0.

Параметры командной строки запуска подробно описаны в руководстве к программе "1С:Предприятие", здесь же я приведу лишь те, которые могут оказаться вам полезными:
/DПуть к базе - задает путь к базе программы.
/M - запуск программы в монопольном режиме
/NИмя пользователя
/PПароль - пароль указанного пользователя

Параметры, не указанные в командной строке, будут запрошены программой в диалоговом режиме.

Например, инициализация программы в монопольном режиме с явным указанием пути к базе данных (D:\buh2001test), имени пользователя (Саша) и пароля (12345) без вывода на экран заставки выполняется следующим образом (здесь и далее подразумевается, что объект onesobj уже создан оператором createoleobject):

 onesobj.initialize(onesobj.rmtrade,'/DD:\buh2001test /M /NСаша /P12345','NO_SPLASH_SHOW');
 

В отличие от, например, OLE Automation-сервера приложения Microsoft Excel, сервер программы "1С-Предприятие" запускается в режиме "hide", то есть рабочее окно программы не отображается на экране.

Для использования созданного и проинициализированного объекта необходимо просто обращаться к атрибутам и методам системы 1С:Предприятие как OLE Automation сервера.

Для завершения работы с программой необходимо освободить OLE-объект путем присвоения ему значения UnAssigned:

 onesobj := UnAssigned;
 

Впрочем, это необязательно, так как при закрытии вашего приложения OLE-объект будет освобожден автоматически.

Просуммируем полученные знания: создадим OLE-объект "1С:Предприятие", проинициализируем его и корректно освободим:


 procedure TForm1.Create1C;
 var
   onesobj: Olevariant;
 begin
   onesobj := createoleobject('V1CEnterprise.Application');
   onesobj.initialize(onesobj.rmtrade,
     '/DD:\buh2001test /M /NСаша /P12345', 'NO_SPLASH_SHOW');
   onesobj := UnAssigned;
 end;
 

Как работать с полученным объектом

Резонный вопрос. Собственно, ради этого все и затевалось, не так ли? :) На самом деле, все очень просто. После того, как мы создали и проинициализировали OLE-объект, работать с ним можно следующим образом:

  • С помощью метода EvalExpr(<СтрокаВыражения>)
    Метод EvalExpr вычисляет выражение, записанное параметре <СтрокаВыражения> на встроенном языке 1С:Предприятие и возвращает результат вычисления. Результатом выражения может быть число, строка, дата или значение любого агрегатного типа данных.
  • С помощью метода CreateObject(<ИмяАгрегатногоТипа>)
    Метод CreateObject создает объект агрегатного типа данных системы 1С:Предприятие и возвращает ссылку на него. Данная функция обычно используется одновременно с явным определением переменной типа OLEVariant и присвоением ей ссылки на объект агрегатного типа данных.
  • С помощью метода ExecuteBatch(<СтрокаОператоров>)
    Метод ExecuteBatch выполняет последовательность операторов, записанную в параметре <СтрокаОператоров> на встроенном языке 1С:Предприятие. Метод возвращает -1, если последовательность операторов выполнена успешно, или 0 в противном случае.
  • Вызовом атрибутов и методов системы 1С:Предприятие как OLE Automation сервера

Здесь есть несколько подводных камней, о которых я сразу хочу предупредить:

  1. При вызове атрибутов и методов системы 1С:Предприятие необходимо использовать их англоязычные синонимы (они указаны для каждого метода в книге "Описание встроенного языка")
  2. Для создаваемого агрегатного типа данных в среде Delphi необходимо завести переменную типа OLEVariant
  3. В случае, если вызываемый метод OLE-объекта не требует параметров (либо один из параметров является необязательным), в качестве параметра ему необходимо передавать EmptyParam (либо - для Delphi 3 - пустую строку).
  4. Для обращения к русскоязычным идентификаторам объектов агрегатных типов (например, реквизитов справочников) следует использовать метод объекта агрегатного типа getattrib(<ИмяАтрибута>) для получения значения атрибута, и setattrib(<ИмяАтрибута>) для установки значения.

Для комплексной иллюстрации всего вышеописанного я приведу пример, в котором содержимое справочника "Номенклатура" целиком экспортируется в таблицу базы данных (в примере подразумевается, что уже создана таблица table1, поля которой адекватны справочнику. Таблица table2 ссылается на ту же физическую таблицу, что и table1, и служит лишь для поиска уже добавленных элементов):


 procedure TForm1.exportsprav;
 var
   counter: integer; //Счетчик импортированных записей
   onesobj: Olevariant; //OLE-объект программы 1С:Предприятие
   ware, ware2: olevariant; //Агрегатные объекты
   val, edizm, nds, np: olevariant;
   pf: integer; //Промежуточные переменные
 begin
   table1.open; //Открываем таблицу1
   table2.open; //Открываем таблицу2
   counter := 0; //Обнуляем счетчик записей
   onesobj := createoleobject('V1CEnterprise.Application'); //Создаем OLE-объект
     //Инициализируем объект
   onesobj.initialize(onesobj.rmtrade, '/DD:\buh2001test /M /NСаша /P12345', 'NO_SPLASH_SHOW');
     //Создаем необходимые агрегатные объекты
   ware := onesobj.createobject('Справочник.Номенклатура');
   ware2 := onesobj.createobject('Справочник.Номенклатура');
   edizm := onesobj.createobject('Справочник.ЕдиницыИзмерений');
   nds := onesobj.createobject('Справочник.СтавкиНДС');
   np := onesobj.createobject('Справочник.СтавкиНП');
   ware.selectgroup(1); //Устанавливаем режим выборки групп
   ware.selectitems(1); //Открываем выборку элементов справочника
   while ware.GetItem(1) > 0 do //Выбираем все элементы
   begin
     if ware.level('') = 1 then //Если мы выбрали группу первого уровня, то
       pf := -1
     else
     begin
             //Иначе ищем элемент-родитель
       ware2.FindItem(ware.getattrib('Родитель'));
       if table2.findkey([ware2.getattrib('Код')]) then
                 //Если этот элемент мы уже импортировали
         pf := table2.fieldbyname('ID').AsInteger //, то получаем его код
       else
         pf := -1; //иначе помещаем элемент в группу первого уровня
     end;
     if ware.deletemark('') = 0 then //Если элемент не удален, то
     begin
       table1.append; //добавляем новое поле к таблице
             //Заполняем поля таблицы значениями соответствующих атрибутов элемента справочника
       table1.fieldbyname('CODE_1S').AsInteger := ware.getAttrib('Код');
             //Заполняем поле наименования
       table1.fieldbyname('NAME').AsString := ware.getAttrib('Наименование');
       table1.fieldbyname('PARENT_FOLDER').AsInteger := pf;
       table1.fieldbyname('FULLNAME').AsString := ware.getAttrib('ПолнНаименование');
             //Ищем соответствующую запись в справочнике "единицы измерения"
       edizm.finditem(ware.getattrib('ЕдиницаИзмерения'));
             //Заполняем поле единицы измерения
       table1.fieldbyname('EDIZM').AsString := edizm.getattrib('Наименование');
             //так мы получаем значения периодических реквизитов
       table1.fieldbyname('SEBESTOIM').AsFloat :=
         ware.getAttrib('Себестоимость').GetValue(datetostr(now));
       table1.fieldbyname('PRICEOPT').AsFloat := ware.getAttrib('Цена');
       nds.finditem(ware.getAttrib('СтавкаНДС').GetValue(datetostr(now)));
       np.finditem(ware.getAttrib('СтавкаНП').GetValue(datetostr(now)));
             //Заполняем поле ставки НДС
       table1.fieldbyname('STNDS').AsFloat := nds.getAttrib('Ставка');
             //Заполняем поле ставки НП
       table1.fieldbyname('STNP').AsFloat := np.getAttrib('Ставка');
       table1.fieldbyname('ARTICUL').AsString := ware.getAttrib('Артикул');
       if Ware.IsGroup('') = 1 then //Если мы выбрали группу товара, то
         table1.fieldbyname('IS_FOLDER').AsInteger := 1
       else
         table1.fieldbyname('IS_FOLDER').AsInteger := 0;
       table1.post;
       table2.refresh;
     end;
     inc(counter);
   end;
 end;
 

Заключение

К сожалению, невозможно вместить в одну статью всю информацию, которая была бы вам полезна. Я постарался дать лишь тот минимум, который необходим для получения некоторых базовых знаний, и способен стать фундаментом для ваших собственных маленьких открытий в области интеграции Delphi и "1С:Предприятие".

Пишите мне, задавайте вопросы, и вполне возможно, что вскоре появится продолжение статьи.




Delphi и CorelDraw


Автор: Грабец Олег

- А знаете, Ватсон, чем наполнены шары у CorelDraw?
- Чем, мистер Холмс?
- Водородом!
- ??
- Ну это же элементарно, Ватсон... Вчера у меня Corel рухнул - так всю Винду разнесло нафиг!

Надеюсь, многие сталкивались с Corel Draw? А у многих слюнки текли, что это мощнейший графический редактор и хотелось бы под него свои программы писать, к примеру, чертежи выводить? Я один из вас :)

Формат файлов *.cdr конечно, не представлю, т.к. сам его не знаю :), но как с этим зверем работать расскажу. Вычитал, что с Corel Draw можно работать только через скрипт, причем изначально я готовил файлы скриптов *.csc, а затем их запускал в самом редакторе. Рабочий инструмент для освоения - Corel Script Editor. Если Вы хотите действительно что-то написать, то он вам просто необходим, хотя бы ради того, что смотреть как Corel Draw их сам создает, ну и самое главное - дока по языку и функциям. Все замечательно, только вот скрипты медленно работают т.к. они эмитируют работу человека - т.е. кнопочки сами нажимаются, панельки меняются и т.д.

А чертеж, к примеру на котором около 3000 объектов мог загружаться и исполнятся до часу! Нет, кода это утомляет, то можно и самому посидеть - глядишь за неделю сделаешь :)

И тут я "чисто случайно" наткнулся на статейку http://www.djpate.freeserve.co.uk/AutoCDrw.htm. Оказывается можно и через OLE этот Corel Draw дергать, и как оказывается, не так уж оно и сложно. Да, совершенно верно, нужно использовать CorelDraw.Automation.xx. Я возился с 8-й версией. Забегая на перед, скажу, что тот же чертеж выводился в течении 5-10 минут.

Ну что, начнем?


 var
   CorelDraw: Variant;
 ...
 CorelDraw := CreateOleObject('CorelDraw.Automation.8');
 // цифирку можете свою поставить
 CorelDraw.FileNew;
 // или CorelDraw.FileOpen(FileName);
 CorelDraw.SetDocVisible(True);
 // можно и не показывать, что он там делает, но ведь интересно! :)
 // кстати, можно нарисовать, а потом показать - будет на 30% быстрее
 ... // ну и в конце
 CorelDraw.FileSave('NewName', 0, False, 0, False);
 CorelDraw.FileExit(False); // можно не писать, если не надо закрывать
 CorelDraw := Unassigned;
 

Формат функций доступным английским языком описан в draw_scr.hlp. Ну а дальше, чего душа (или начальство :) ) желает:


 CorelDraw.SetPageOrientation(0);
 CorelDraw.SetPageSize(PageW, PageH);
 CorelDraw.NewLayer('NewLayer1');
 CorelDraw.SelectLayer('NewLayer1');
 CorelDraw.CreateEllipse(CalcY(Y1)), CalcX(X1), CalcY(Y2), CalcX(X2), 0, 0, 0);
 // ничего я не перепутал!!! именно так у них координаты!
 CorelDraw.CreateRectangle(CalcY(Y1)), CalcX(X1), CalcY(Y2), CalcX(X2), CalcX(Radius));
 ...
 

Все ясно? За дело!

Да, чуть не забыл о самом главном - как и у любой системы в Corel Draw есть свои "заморочки" :)

Ноль координат находится в середине листа бумаги (оригинально, правда?)

Положительная ось Y направлено вверх, а X - в право.

Координаты - целые числа в микронах. Для удобства я писал функцию:


 function CalcX(x_mm: double): longint;
 begin
   result := Round(x_mm * 10000);
 end;
 

Углы не знаю в чем, но 90 градусов надо записать как 90000000. Положительные против часовой стрелки.

Принцип прорисовки таков: создается объект, а затем ему присваиваются различные свойства, такие как цвет, тип заливки, толщина линий и пр. По умолчанию эти значения через автоматизацию выставить нельзя - не поддерживается.

Выше упомянутое наглядно видно на прорисовке текста:


 CorelDraw.CreateArtisticText( Text, CalcX(X), CalcY(Y));
 // создаем текст. X,Y - левый нижний
 // как видите, нет параметров шрифта, размера и пр.
 with Font do
 begin
   if (Italic) and (Bold) then
     FSK:=14
   else
   if (Italic) then
     FSK:=8
   else
   if (bold) then
     FSK:=13
   else
     FSK:=7;
 end;
 CorelDraw.SetCharacterAttributes( 0, 0, Font.name, FSK, Abs(Font.Size)*10,
 0, 0, 0, 0, 0, 1000, 1000, HAlign);
 // присваиваем атрибуты шрифта.
 // HAlign имеет значения 1,2,3 - влево, по центру, вправо соответственно
 ColorToCMYK(Font.Color, C,M,Y,K);
 // это моя функция для преобразования tColor в составляющие в модели CMYK 
 CorelDraw.StoreColor(2, C,M,Y,K, 0,0,0,0); // создание цвета
 CorelDraw.ApplyUniformFillColor; // применяем цвет к объекту
 

Тоже самое относится к трансформации объектов – сперва создаете, а затем изменяете как хотите.

Работают функции для получения информации.


 CorelDraw.GetSize(XSize, YSize); // получили размеры объекта
 CorelDraw.MoveObject(0, -YSize); // сдвинули его вниз на свой размер
 

Можно "проверить" все существующие объекты. За круглым столом спрашивали, как это делается, а делается это так:


 var
   ObjID, FirstObjID: longint;
 begin
   CorelDraw.SelectAllObjects;
   CorelDraw.SelectNextObject(true);
   // true для "захода" в сгруппированный объект
   FirstObjID := CorelDraw.GetObjectsCDRStaticID;
   repeat
     ...
     // работа с объектом CorelDraw.SelectNextObject(true);
     ObjID := CorelDraw.GetObjectsCDRStaticID;
   until
     ObjID = FirstObjID;
   ...
 

Вот теперь вроде все. Пишите, если что не понятно.




Delphi и OLE Automation с Excel

Автоматизация позволяет одному приложению управлять другим приложением. Управляемое приложение называется сервером автоматизации (в нашем случае Excel). Приложение, управляющее сервером называется диспетчером автоматизации.

Есть два пути для получения доступа к серверам автоматизации:

Позднее связывание (Интерфейс IDispatch)

При использовании данного метода имена функций и типы параметров решаются во время выполнения программы, все параметры определены вариантным типом.

Поскольку во время компиляции невозможно определить соответствия имен функций и типов параметров, данный метод чреват ошибками.

Так как имена функций и типы параметров должны проверяться во время выполнения программы, данный метод выполняется медленно.

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

Раннее связывание (Использование библиотеки типов/интерфейсов)

При использовании данного метода имена функций и типы параметров полностью решаются во время компиляции.

Библиотека типов должна импортироваться в Delphi. Библиотека типов является языковым нейтральным описанием всех объектов и функций, поддерживаемых сервером. (Это подобно файлу заголовка языка C).

При вызове функции должны обязательно присутствовать все параметры, даже те, которые в документации указаны как дополнительные (необязательные). Это позволяет обнаружить и исправить множество ошибок еще до запуска программы.

Скорость выполнения значительно быстрее, чем при использовании позднего связывания.

Из-за преимуществ второго метода остальная часть документа демонстрирует принципы создания приложений с ранним связыванием. Все приложения, использующие Excel автоматизацию, должны пользоваться последним методом, если нет причин для первого.

Подготовка библиотеки типов.

Модуль Pascal должен быть создан на основе файла библиотеки типов.

Выберите пункт меню Project|Import Type Library.

Нажмите кнопку Add и выберите следующий файл

c:\program files\microsoft office\office\excel8.olb

Нажмите OK.

К сожалению, данный модуль с проектом явно не компилируется, хотя и включается в него, вероятно из-за того, что приложение считает данный модуль нечто вроде текстового приложения.

Наиболее простой путь заключается в следующем: удалите модуль excel_tlb из проекта и только после этого добавьте его в список используемых модулей.

Документация

Справочный файл c:\program files\microsoft office\office\vbaxl8.hlp содержит информацию о доступных объектах Excel.

"Записыватель" макросов позволяет быстро создавать VBA-код. После этого он довольно может легко быть портирован в Delphi.

Пример автоматизации

Код следующего примера демонстрирует создание простой электронной таблицы и наполнение ее данными. Не забудьте добавить excel_tlb в список используемых модулей.

Настоятельно рекомендую хранить код автоматизации в отдельном модуле, это поможет избежать проблем конфликта имен.


 unit sheet;
 
 interface
 
 uses
   windows, sysutils, excel_tlb;
 
 procedure CreateSpreadsheet;
 
 implementation
 
 procedure CreateSpreadsheet(filename: string);
 var
 
   xla: _Application;
   xlw: _Workbook;
   LCID: integer;
 begin
 
   xla := CoApplication.Create;
   LCID := GetUserDefaultLCID;
   try
     xla.Visible[LCID] := true;
     // пустая книга
     //xlw := xla.Workbooks.Add(xlWBATWorksheet, LCID);
     // новая книга на основе шаблона
     xlw := xla.Workbooks.Add(
       'c:\delphi\excel\sample\demo.xlt',
       LCID);
     xla.Range['A1', 'A1'].Value := 'Date';
     xla.Cells[1, 2].Value := FormatDateTime('dd-mmm-yyyy', Now);
     xla.Cells[3, 1].Value := 'Numbers';
     xla.Range['B3', 'E3'].Value := VarArrayOf([1, 10, 100, 1000]);
     xla.Range['F3', 'F3'].Formula := '=Sum(B3:E3)';
     OLEVariant(xla).Run(
       'Demo',
       FormatDateTime('dd-mmm-yyyy', Now)
       );
     xlw.SaveAs(
       filename,
       xlWorkbookNormal,
       '', '', False, False,
       xlNoChange,
       xlLocalSessionChanges,
       true, 0, 0, LCID);
   finally
     xla.Quit;
   end;
 end;
 
 end.
 

Добавьте библиотеку типов в список используемых молулей.


 uses
   windows, sysutils, excel_tlb;
 

Первая строчка кода создает объект Excel приложения.


 xla := CoApplication.Create;
 

Следующая строчка кода получает пользовательский локальный идентификатор по умолчанию. Он необходим многим методам и свойствам Excel.


 LCID := GetUserDefaultLCID;
 

Следующая строчка кода устанавливает в истину свойство видимости, что заставляет Excel вывести свое окно. Это полезно для контроля выполняемого кода.

Примечание: Для вызова этой функции необходим параметр LCID. К сожалению этот факт умалчивается в электронной документации по Excel. В файле c:\program files\borland\Delphi 3\imports\excel_tlb.pas наглядно видны свойства функций и определения методов.


 xla.visible[LCID] := true;
 

Следующий код создает новую книгу и назначает ссылку на нее одной из переменных Delphi. Для VBA параметр шаблона необязателен, для Delphi - обязателен.


 xlw := xla.Workbooks.Add('c:\delphi\excel\sample\demo.xlt', LCID);
 

Примечание: Вам вовсе не обязательно подставлять файл шаблона Excel (.xlt), но все же это наилучший способ для форматирования информации. Чем больше сделано с помощью Excel, тем меньше придется делать с помощью Delphi. На данный момент это является лидирующей технологией.

Для создания пустой книги используйте:


 xlw := xla.Workbooks.Add(xlWBATWorksheet, LCID);
 

Следующие две строки присваивают значение двум ячейкам. Здесь демонстрируются две технологии для работы с данными.


 xla.Range['A1', 'A1'].Value := 'Date';
 xla.Cells[1, 2].Value := FormatDateTime('dd-mmm-yyyy', Now);
 

Следующая строка демонстрирует заполнение данными целой колонки с помощью единственной команды. Это значительно повышает скорость работы, да и работать с таким кодом наглядней и удобней.


 xla.Range['A2', 'D2'].Value := VarArrayOf([1, 10, 100, 1000]);
 

Следующая строка демонстрирует использование формулы.


 xla.Range['E2', 'E2'].Formula := '=Sum(a2:d2)';
 

Следующая строка кода выполняет VBA функцию, хранящуюся в файле шаблона. На первый взгляд все выглядит достаточно сложно, но это только кажется. Преобразование типа xla к OLEVariant позволяет вызвать функцию, используя позднее, а не раннее связывание. (Причина в имени метода и параметрах, решаемых только во время прогона программы, а никак во время разработки). Delphi просто не знает количество и тип параметров, передаваемых макросу ‘Demo’.


 OLEVariant(xla).Run(
 'Demo',
 FormatDateTime('dd-mmm-yyyy', Now));
 

Следующий код сохраняет в файле filename электронную таблицу. Все параметры должны быть переданы в обязательном порядке, хотя многие из них являются дополнительными.


 xlw.SaveAs(
 filename,
 xlWorkbookNormal,
 '', '',False,False,
 xlNoChange, xlLocalSessionChanges,
 true, 0, 0, LCID);
 

Следующая строчка кода закрывает Excel и перераспределяет всю память, связанную с программой.


 xla.quit;
 

Итог

  • Всегда используйте раннее связывание.
  • Если позднее связывание необходимо для вызовов некоторых функций, используйте где возможно раннее связывание и преобразование типа объектной переменной к типу OLEVariant для вызовов, требующим позднее связывание.
  • Не включайте модуль библиотеки типов в ваш проект.
  • Создавайте код автоматизации в отдельном модуле.
  • Используйте "записыватель" макросов Excel для создания прототипа кода автоматизации.
  • Используйте файл электронной справки vbaxl8.hlp для получения информации об объектах Excel.
  • Используйте модуль excel_tlb.pas для проверки необходимых Delphi типов и количества параметров.
  • Загружайте и используйте шаблоны Excel (.xlt файлы), содержащие предварительное форматирование и связывание данных. Этот способ существенно быстрее и не требует большого времени для создания форматированных электронных таблиц. Шаблоны ДОЛЖНЫ сохраняться приложением в своей рабочей директории. Это поможет избежать проблем, связанных с конфликтом имен. Файлы шаблонов могут также содержать макросы, которые могут быть вызваны из приложений Delphi.
  • Удостоверьтесь в том, что ваш код содержит команду закрытия приложения Excel (xla.quit). Не вызывая xla.quit, можно быстро исчерпать системные ресурсы, особенно при работе с большим количеством документов Excel.
  • Наличие множества незакрытых документов Excel легко проверить в Windows NT, используя Менеджер Задач (нажмите CTL+ALT+Del для его открытия).
  • В больших электронных таблицах повысить быстродействие вам поможет обработка ячеек посредством "мультикоманды", оперирующей одновременно множеством ячеек. Это также улучшит читаемость кода.

Приложение A – Быстродействие

Тестирование производилось на компьютере P166 с 64Мб памяти. Первоначальная инициализация приложения не производилась. Это гарантировало, что Excel при загрузке пользовался диском, а не кэшем. Первоначальная инициализация существенно уменьшила бы скорость загрузки приложения. В реальной ситуации процесс загрузки занимает около 5 секунд.

Тест включал в себя загрузку числовых данных в чистую электронную таблицу размером 10 колонок на n строк. Для вычисления быстродействия использовались следующие три метода:

  • Заполнение листа ячейка за ячейкой.
  • Заполнение одной колонки за один проход.
  • Заполнение всей таблицы за один проход.

Приведенное время не включает в себя время, затраченное на поиск данных в базе данных. Но оно вносит существенные коррективы при создании больших электронных таблиц.

Время приведено в минутах и секундах, округленных до ближайшей целой.

Размер электронной таблицы (строки * колонки)

Заполнение ячейка за ячейкой

Заполнение одной колонки за один проход

Заполнение всей таблицы за один проход

10 * 10

0:01

0:01

>0:01

100 * 10

0:07

0:01

0:01

1000 * 10

1:13

0:07

0:05

5000 * 10

5:22

0:35

0:25

 

 

 

 

Приблизительно ячейки/секунды

150

1500

2000

Только небольшие электронные таблицы могут быть эффективно заполнены методом записи данных в каждую ячейку по отдельности.

Большие таблицы эффективно заполнять колонка за колонкой.

Также необходимо учесть дополнительную сложность при кодировании методом "ячейка за ячейкой".

Использовать буфер для передачи данных также не рекомендуется, так как это нарушит имеющиеся в нем данные и может привести к усложнению и неудобночитаемости кода.

Сохранение данных в CSV-файле и загрузка его в Excel поможет ускорить вывод данных, но для этого потребуется дополнительное форматирование книги Excel в самом коде, что усложняет само кодирование и может привести к дополнительным ошибкам.

Использованные для тестов процедуры:


 //-----------------------------------------------------------------------
 
 procedure FillByCell;
 var
 
   xla: _Application;
   xlw: _Workbook;
   LCID: integer;
   i, j: integer;
 begin
 
   xla := CoApplication.Create;
   LCID := GetUserDefaultLCID;
   try
     xlw := xla.Workbooks.Add(xlWBATWorksheet, LCID);
     for i := 1 to ROWS do
     begin
       for j := 1 to 10 do
       begin
         xla.Cells[i, j] := i + j;
       end;
     end;
     xlw.close(false, '', false, LCID);
   finally
     xla.Quit;
   end;
 end;
 
 //-----------------------------------------------------------------------
 
 procedure FillByRow;
 var
 
   xla: _Application;
   xlw: _Workbook;
   CellFrom: string;
   CellTo: string;
   i, j: integer;
   Row: array[1..10] of variant;
   LCID: integer;
 begin
 
   xla := CoApplication.Create;
   LCID := GetUserDefaultLCID;
   try
     xlw := xla.Workbooks.Add(xlWBATWorksheet, LCID);
     for i := 1 to ROWS do
     begin
       for j := 1 to 10 do
       begin
         Row[j] := i + j;
       end;
       CellFrom := 'A' + InttoStr(i);
       CellTO := 'J' + InttoStr(i);
       xla.Range[CellFrom, CellTo].Value := VarArrayOf(Row);
     end;
     xlw.close(false, '', False, LCID);
   finally
     xla.Quit;
   end;
 end;
 
 //-----------------------------------------------------------------------
 
 procedure FillBySheet;
 var
 
   xla: _Application;
   xlw: _Workbook;
   CellFrom: string;
   CellTo: string;
   i, j: integer;
   range: Variant;
   row: array[1..10] of Variant;
   LCID: integer;
 begin
 
   xla := CoApplication.Create;
   LCID := GetUserDefaultLCID;
   try
     xlw := xla.Workbooks.Add(xlWBATWorksheet, LCID);
     Range := VarArrayCreate([1, ROWS], varVariant);
     for i := 1 to ROWS do
     begin
       for j := 1 to 10 do
       begin
         row[j] := i + j;
       end;
       Range[i] := VarArrayOf(row);
     end;
     CellFrom := 'A' + InttoStr(1);
     CellTO := 'J' + InttoStr(ROWS);
     xla.Range[CellFrom, CellTo].FormulaArray := Range;
     xlw.close(false, '', False, LCID);
   finally
     xla.Quit;
   end;
 end;
 

Приложение 2 – Использование в Delphi класса-оболочки

Предпочтительней использовать вызовы Автоматизации непосредственно из приложения, нижеприведенный пример демонстрирует технологию создания в Delphi класса-оболочки для использования объектов Excel в ваших приложениях. Это позволит вам иметь простой интерфейс к объектам, а также помочь с любыми изменениями объектных интерфейсов Excel в ее будущих версиях.


 unit sheet;
 
 interface
 
 uses
 
   EXCEL_TLB, windows, sysutils;
 
 //-------------------------------------------------------------------------
 
 type
 
   tExcel = class
   private
     xla: _Application;
     xlw: _Workbook;
     LCID: integer;
     procedure fSetVisible(Visible: boolean);
     function fGetVisible: boolean;
     procedure fSetCell(Cell: string; Value: OLEVariant);
     function fGetCell(Cell: string): OleVariant;
   public
     constructor create;
     destructor destroy; override;
     procedure AddWorkBook(Template: OleVariant);
     procedure SaveAs(filename: string);
     property Visible: boolean
       read fGetVisible write fSetVisible;
     property Cell[Cell: string]: OleVariant
     read fGetCell write fSetCell;
   end;
 
   //-------------------------------------------------------------------------
 
 procedure CreateSpreadsheet(filename: string);
 
 //-------------------------------------------------------------------------
 
 implementation
 
 //-------------------------------------------------------------------------
 
 constructor tExcel.create;
 begin
 
   LCID := GetUserDefaultLCID;
   xla := CoApplication.Create;
 end;
 
 //-------------------------------------------------------------------------
 
 destructor tExcel.destroy;
 begin
 
   xla.Quit;
   inherited;
 end;
 
 //-------------------------------------------------------------------------
 
 procedure tExcel.AddWorkBook(Template: OleVariant);
 begin
 
   xlw := xla.Workbooks.Add(Template, LCID);
 end;
 
 //-------------------------------------------------------------------------
 
 procedure tExcel.fSetVisible(Visible: boolean);
 begin
 
   xla.visible[lcid] := Visible;
 end;
 
 //-------------------------------------------------------------------------
 
 function tExcel.fGetVisible: boolean;
 begin
 
   result := xla.visible[lcid];
 end;
 
 //-------------------------------------------------------------------------
 
 procedure tExcel.fSetCell(Cell: string; Value: OLEVariant);
 begin
 
   xla.Range['A1', 'A1'].Value := value;
 end;
 
 //-------------------------------------------------------------------------
 
 function tExcel.fGetCell(Cell: string): OleVariant;
 begin
 
   result := xla.Range['A1', 'A1'].Value;
 end;
 
 //-------------------------------------------------------------------------
 
 procedure tExcel.SaveAs(filename: string);
 begin
 
   xlw.SaveAs(
     filename,
     xlWorkbookNormal,
     '',
     '',
     False,
     False,
     xlNoChange,
     xlLocalSessionChanges,
     true,
     0,
     0,
     LCID);
 end;
 
 

Нижеприведенный пример использует данный класс для создания электронной таблицы.


 procedure CreateSpreadsheet(filename: string);
 var
   xl: tExcel;
 begin
   xl := tExcel.create;
   try
     xl.AddWorkBook('c:\graham\excel\sample2\ssddemo.xlt');
     xl.visible := true;
     xl.cell['a1'] := 'тест';
     xl.SaveAs(filename);
   finally
     xl.free;
   end;
 end;
 




Delphi и Flash. Совмещение несовместимого

Автор: Михаил Христосенко
WEB сайт: http://mihandelphi.narod.ru/

Разве возможно совместить Флэш-ролики и Дельфи-приложения. Раньше я думал что НЕТ. Но теперь я знаю не только, что это возможно, но и знаю как это делается!!! И сейчас я вам расскажу об этом. Во-первых хочется отметить преимущества использования флэш-роликов в ваших программах. Если вы сумеете гармонично вписать небольшой флэш-ролик в вашу программу, то несомненно внешний вид программы будет намного привлекательнее (главное не переборщить, увлекаясь дизайном, не надо забывать о том что программа должна быть удобна и проста в использовании! ).

Итак, как же совместить Флэш и Дельфи? (Надеюсь, что у вас Флэш установлен:))

Запустите Дельфи и выберите пункт меню Component->Import ActiveX Control... Перед вами откроется диалоговое окно с заголовком Import ActiveX Control. В разделе Registered Controls выберите Shockwave Flash. В разделе Pallete Page... Выберите страницу в палитре компонентов, на которой будет располагаться установленный компонент (по умолчанию это ActiveX). В разделе Unit Dir Name... путь к папке куда будет установлен компонент.

Нажмите на кнопку Install. Перед вами появится окно, в котором вам нужно будет выбрать в какой пакет будет установлен компонент (вы можете установить как в уже существующий, так и в новый пакет). Затем перед вами появится окно редактирования выбранного пакета и Дельфи вас спросит: "...Package will be rebuilt. Continue?". Ответьте Yes. Все готово теперь можно использовать флэш в ваших приложениях!!!

Теперь, чтобы показать вам как пользоваться этим компонентом, попробуем вместе сделать программу для просмотра *.SWF файлов. Для этого нам понадобятся следующие компоненты: TShockwaveFlash (для удобства назовите его просто Flash1), TTrackBar, TTimer, TOpendialog и три кнопки TButton ("открыть", "старт" и "стоп").

Для начала установим необходимые свойства OpenDialog'a

Свойство Filter может быть таким: Флэш-ролики|*.swf

Свойство DefaultExt должно быть: *.swf

Для Timer'a нужно установить свойство Interval равным 1.

Для TShockwaveFlash:

Name сделайте равным Flash1

Свойство Playing установите в false

Свойство BGColor, установите как вам хочется (цвет фона)

Теперь напишем обработчик события OnClick для кнопки, которая вызывать OpenDialog:


 if open1.Execute then
 begin
   flash1.Movie := open1.FileName;
   {это делается для того, чтобы потом можно было
   перемещаю ползунок посмотреть каждый кадр ролика}
   trackbar1.Max := flash1.TotalFrames;
 end;
 

В обработчик события OnClick для второй кнопки ("Старт") напишем:


 flash1.Play;
 

Ну тут вообще все просто! Почти таким же образом это будет выглядеть для третьей кнопки ("Стоп"):


 flash1.Stop;
 

Теперь сделаем, чтобы при перемещении ползунка Trackbar'a мы могли посмотреть каждый кадр (событие OnChange):


 if Flash1.IsPlaying = true then
   Flash1.Stop; {если ролик проигрывается, то надо его остановить}
 {открываем кадр номер которого соответствует позиции ползунка}
 flash1.GotoFrame(trackbar1.position);
 

Ну и наконец осталось сделать чтобы при проигрывании ролика ползунок перемещался, указывая сколько осталось и сколько прошло. Для этого то мы и используем Timer. В обработчик события OnTimer,напишем:


 trackbar1.Position:=flash1.CurrentFrame;
 

Приведу полный код приложения:


 unit flash;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ComCtrls, StdCtrls, OleCtrls, ShockwaveFlashObjects_TLB, ExtCtrls;
 
 type
   TForm1 = class(TForm)
     Flash1: TShockwaveFlash;
     Button1: TButton;
     TrackBar1: TTrackBar;
     Open1: TOpenDialog;
     Button2: TButton;
     Button3: TButton;
     Timer1: TTimer;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
     procedure Button3Click(Sender: TObject);
     procedure TrackBar1Change(Sender: TObject);
     procedure Timer1Timer(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   if open1.Execute then
   begin
     flash1.Movie:=open1.FileName;
     trackbar1.Max:=flash1.TotalFrames;
   end;
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 begin
   flash1.Play;
 end;
 
 procedure TForm1.TrackBar1Change(Sender: TObject);
 begin
   if Flash1.IsPlaying=true then
     Flash1.Stop;
   flash1.GotoFrame(trackbar1.position);
 end;
 
 procedure TForm1.Button3Click(Sender: TObject);
 begin
   flash1.Stop;
 end;
 
 procedure TForm1.Timer1Timer(Sender: TObject);
 begin
   trackbar1.Position:=flash1.CurrentFrame;
 end;
 
 end.
 
 

Ну вот и все. Как оказалось ничего сложного.




MapInfo и Delphi - Вызов MapInfo и встраивание его в свою программу (основы интегрированной картографии)

Автор: Дмитрий Кузан

Доброе время суток !

Данной статьей я начинаю цикл статей посвященных возможностям интегрированной картографии MapInfo и возможности встраивания геоинформационной системы в вашу программу. Примечания : Все примеры распространяются свободно и разработаны в обучающих целях на Delphi 6. Всю информацию по работе смотрите в прилагаемых исходных кодах.

Итак начнем.

Что такое MapInfo и с чем его едят? Краткое предисловие.

Сейчас нам доступны огромные объемы информации. Данные хранятся в электронных таблицах, отчетности о торговле и маркетинге. Масса информации о клиентах, магазинах, персонале, оборудовании и ресурсах находится на бумаге и в памяти компьютеров Тематическая Карта, содержащая слой диапазонов (процент занятости) и круговые диаграммы (производство с/х продуктов) Почти все эти данные имеют географическую составляющую. По разным оценкам до 85 процентов всех баз данных содержат, какую либо географическую информацию.

При этой оценке учитывались объемы данных, содержащие адреса, имена городов, названия областей, государств, почтовые индексы и даже номера телефонов, включая коды удаленного доступа и добавочные номера. Настольная картография позволит Вашему компьютеру не просто обрабатывать данные, а быстро и наглядно представлять их, используя географические компоненты данных, чтобы Вы могли уловить их общий смысл, отражаемый на картах.

Как настольная картография может работать на Вас? MapInfo, как средство настольной картографии, - это мощное средство анализа данных. Вы можете придать графический вид статистическим и прочим данным. Вы можете отобразить Ваши данные как точки, как тематически выделенные области, круговые и столбчатые графики, районы и т.п. К данным можно применять географические операторы, такие как районирование, комбинация и разрезание объектов и буферизация. Доступ к данным можно оформлять как запросы, в том числе к удаленным базам данных непосредственно из MapInfo. Например, какой из магазинов ближе к самым крупным клиентам Вашей фирмы? На карте легко увидеть особенности и тенденции, которые практически невозможно выявить в списочно организованных данных. Можно легко вычислить расстояния между клиентами и магазинами; можно увидеть местоположение офиса клиента, потратившего наибольшую сумму за прошлый год; размер символов, отмечающих местоположение магазинов на Карте, может зависеть от объема продаж. Все это делает визуализацию Ваших данных более наглядной. Итак краткое предисловие из руководства пользователя дает вам общее представление об MapInfo.

Что такое интегрированная картография и какой нам от нее смысл.

Интегрированная картография позволяет управлять пакетом MapInfo, используя языки программирования отличные от MapBasic. Например если вам хорошо знакомо программирование на языке Visual Basic или С++ или Delphi (о чем и пойдет речь далее...) вы можете включить окно MapInfo в ваше приложение, тем самым обеспечивая интеграцию пакета MapInfo с логикой (бизнес-правилами) вашей программы.

Причем основную работу по поддержанию векторных карт берет на себя MapInfo (MapBasic) а вы можете создовать назначать обработчики и механизмы взаимодействия не свойственные MapBasic а также те механизмы которые MapBasic не поддерживает напрямую (например обновление карты по интернету,съем информации с датчиков на территории и обновление на карте ит.п.)

Итак приступим : в цикле статей будут рассмотрены следующие вещи

  • Соединение и загрузка MapInfo
  • Встраивание окна MapInfo и других окон (легенда, информация и т.д) в программу на Delphi
  • Отправка команд MapBasic в пакет MapInfo
  • Получение информации от MapInfo посредством функций
  • Использование уведомляющих вызовов (CallBack) и подключение их к своей программе.
  • Создание собственных уведомляющих вызовов
  • Переопределение уведомляющих вызовов
  • Обработка уведомляющих вызовов
  • Создание простейшего компонента (возможно данная тема будет затрунута) для управления MapInfo.
  • и многое другое.

Концепции Интегрированной Картографии

Для создания приложения с Интегрированной Картой Вы должны написать программу - но не программу на языке MapBasic. Приложения с Интегрированной Картой могут быть написаны на нескольких языках программирования, среди которых наиболее часто используются С,Visual Basic,Delphi.

В Вашей программе должна присутствовать инструкция, запускающая MapInfo в фоновом режиме. Например, в программе Вы можете запустить MapInfo вызовом функции CreateObject(). Программа MapInfo запускается в фоновом режиме незаметно для пользователя, не выводя заставку на дисплей. Ваша программа осуществляет управление программой MapInfo, конструируя строки, представляющие операторы языка MapBasic, которые затем передаются в MapInfo посредством механизмауправления объектами OLE (OLE Automation) или динамического обмена данных (DDE). MapInfo выполняет эти операторы точно так же, как если бы пользователь вводил их с клавиатуры в окно MapBasic.

Примечание:

Переподчинение окон MapInfo другому приложению не дает программе MapInfo автоматического доступа к данным этого приложения. Для отображения данных приложения в окне MapInfo Вы должны предварительно записать эти данные в таблицу MapInfo.

Системные требования

Интегрированная картография требует наличия на компьютере MapInfo версии 4.0 или выше.Вы можете использовать полную версию MapInfo или так называемый исполняемый (Runtime) модуль (усеченная версия MapInfo поставляемая в качестве основы для специализированных приложений)

Вы должны иметь опыт работы с Handle.

Ваша программа должна быть способна действовать в качестве контроллера механизма управления объектами OLE (OLE Automation Controller) или клиента динамического обмена данных DDE. Рекомендуется применение OLE контроллера как более быстрого и надежного метода по сравнению c DDE. Его то мы и будем рассматривать

Другие краткие технические замечания

  • Интегрированная картография использует механизм управления OLE , но не использует OLE - внедрение.
  • Интегрированная картография не использует элементы управления VBX или OCX (дело не совсем так - существует OCX модуль MapX - для работы с ГИС MapInfo (не входит в стандартный комплект поставки) , но это уже не интегрированная картография и он рассматриваться не будет).
  • Интегрированная картография не предоставляет вам какие либо заголовочные файлы и библиотеки
  • Интегрированная картография включает несколько DLL библиотек но не предоставляет к ним доступ напрямую.

Запуск и связывание с сервером MapInfo

Итак рассмотрим простейший компонент для запуска и управления MapInfo (TKDMapInfoServer),следует заметить что мной не ставилась написание специализированного компонента - я представляю основы.


 unit KDMapInfoServer;
 
 interface
 
 uses
   ComObj, Controls, Variants, ExtCtrls, Windows, Messages,
   SysUtils, Classes;
 
 const
   scMapInfoWindowClass = 'xvt320mditask100';
   icWinMapinfo = 1011;
   icWinInfoWindowid = 13;
 
 type
   TEvalResult = record
     AsVariant: OLEVariant;
     AsString: string;
     AsInteger: Integer;
     AsFloat: Extended;
     AsBoolean: Boolean;
   end;
 
   TKDMapInfoServer = class(TComponent)
   private
     { Private declarations }
     // Владелец
     FOwner : TWinControl;
 
     // OLE сервер
     FServer : Variant;
     FHandle : THandle;
     FActive : Boolean;
     FPanel : TPanel;
 
     Connected : Boolean;
 
     MapperID : Cardinal;
     MapperNum : Cardinal;
 
     procedure SetActive(const Value: Boolean);
     procedure SetPanel(const Value: TPanel);
 
     procedure CreateMapInfoServer;
     procedure DestroyMapInfoServer;
   protected
     { Protected declarations }
   public
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     // Данная процедура выполеняет метод сервера MapInfo - Do
     procedure ExecuteCommandMapBasic(Command: string; const Args: array of const);
     // Данная процедура выполеняет метод сервера MapInfo - Eval
     function Eval(Command: string; const Args: array of const): TEvalResult; virtual;
     procedure WindowMapDef;
     procedure OpenMap(Path : string);
   published
     { Published declarations }
     // Создает соединение с сервером MapInfo
     property Active: Boolean read FActive write SetActive;
     property PanelMap : TPanel read FPanel write SetPanel;
   end;
 
 procedure register;
 
 implementation
 
 procedure register;
 begin
   RegisterComponents('Kuzan', [TKDMapInfoServer]);
 end;
 
 { TKDMapInfoServer }
 constructor TKDMapInfoServer.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FOwner := AOwner as TWinControl;
   FHandle := 0;
   FActive := False;
   Connected := False;
 end;
 
 destructor TKDMapInfoServer.Destroy;
 begin
   DestroyMapInfoServer;
   inherited Destroy;
 end;
 
 procedure TKDMapInfoServer.CreateMapInfoServer;
 begin
   try
     FServer := CreateOleObject('MapInfo.Application');
   except
     FServer := Unassigned;
   end;
 
   // Скрываем панели управления MapInfo
   ExecuteCommandMapBasic('Alter ButtonPad ID 4 ToolbarPosition (0, 0) Show Fixed', []);
   ExecuteCommandMapBasic('Alter ButtonPad ID 3 ToolbarPosition (0, 2) Show Fixed', []);
   ExecuteCommandMapBasic('Alter ButtonPad ID 1 ToolbarPosition (1, 0) Show Fixed', []);
   ExecuteCommandMapBasic('Alter ButtonPad ID 2 ToolbarPosition (1, 1) Show Fixed', []);
   // Переопределяем окна
   ExecuteCommandMapBasic('Close All', []);
   ExecuteCommandMapBasic('Set ProgressBars Off', []);
   ExecuteCommandMapBasic('Set Application Window %D', [FOwner.Handle]);
   ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]);
 
   FServer.Application.Visible := True;
   if IsIconic(FOwner.Handle)then
     ShowWindow(FOwner.Handle, SW_Restore);
   BringWindowToTop(FOwner.Handle);
 end;
 
 procedure TKDMapInfoServer.DestroyMapInfoServer;
 begin
   ExecuteCommandMapBasic('End MapInfo', []);
   FServer := Unassigned;
 end;
 
 procedure TKDMapInfoServer.ExecuteCommandMapBasic(Command: string;
 const Args: array of const);
 begin
   if Connected then
     try
       FServer.do(Format(Command, Args));
     except
       on E: Exception do MessageBox(FOwner.Handle,
       PChar(Format('Ошибка выполнения () - %S', [E.message])),
       'Warning', MB_ICONINFORMATION or MB_OK);
     end;
 end;
 
 function TKDMapInfoServer.Eval(Command: string;
 const Args: array of const): TEvalResult;
 
   function IsInt(Str : string): Boolean;
   var
     Pos : Integer;
   begin
     Result := True;
     for Pos := 1 to Length(Trim(Str)) do
     begin
       if (Str[Pos] <> '0') and (Str[Pos] <> '1') and
       (Str[Pos] <> '2') and (Str[Pos] <> '3') and
       (Str[Pos] <> '4') and (Str[Pos] <> '5') and
       (Str[Pos] <> '6') and (Str[Pos] <> '7') and
       (Str[Pos] <> '8') and (Str[Pos] <> '9') and
       (Str[Pos] <> '.') then
       begin
         Result := False;
         Exit;
       end;
     end;
   end;
 
 var
   ds_save: Char;
 begin
   if Connected then
   begin
     Result.AsVariant := FServer.Eval(Format(Command, Args));
     Result.AsString := Result.AsVariant;
     Result.AsBoolean := (Result.AsString = 'T') or (Result.AsString = 't');
 
     if IsInt(Result.AsVariant) then
     begin
       try
         ds_save := DecimalSeparator;
         try
           DecimalSeparator := '.';
           Result.AsFloat := StrToFloat(Result.AsString);//Result.AsVariant;
         finally
           DecimalSeparator := ds_save;
         end;
       except
         Result.AsFloat := 0.00;
       end;
 
       try
         Result.AsInteger := Trunc(Result.AsFloat);
       except
         Result.AsInteger := 0;
       end;
     end
     else
     begin
       Result.AsInteger := 0;
       Result.AsFloat := 0.00;
     end;
   end;
 end;
 
 procedure TKDMapInfoServer.SetActive(const Value: Boolean);
 begin
   FActive := Value;
 
   if FActive then
   begin
     CreateMapInfoServer;
     WindowMapDef;
     Connected := True;
   end
   else
   begin
     if Connected then
     begin
       DestroyMapInfoServer;
       Connected := False;
     end;
   end;
 end;
 
 procedure TKDMapInfoServer.SetPanel(const Value: TPanel);
 begin
   FPanel := Value;
 end;
 
 procedure TKDMapInfoServer.WindowMapDef;
 begin
   ExecuteCommandMapBasic('Set Next Document Parent %D Style 1', [FPanel.Handle]);
 end;
 
 procedure TKDMapInfoServer.OpenMap(Path: string);
 begin
   ExecuteCommandMapBasic('Run Application "%S"', [Path]);
   MapperID := Eval('WindowInfo(FrontWindow(),%D)',[12]).AsInteger;
   with PanelMap do
     MoveWindow(MapperID, 0, 0, FPanel.ClientWidth, FPanel.ClientHeight, True);
 end;
 
 end.
 

И так что мы имеем -

  • Мы установили связь с сервером MapInfo.
  • Мы узнали что у сервера MapInfo есть метод Do - он предназначен для посылки команд MapBasic серверу точно так-же как если бы пользователь набирал их в окне MapBasic-а самой программы MapInfo.
  • Мы узнали что у сервера MapInfo есть метод Eval- он предназначен для получения значение функций после посылки команд MapBasic серверу.
  • Мы познакомились с командами переопределения направления вывода MapInfo.

Для начала неплохо

Теперь немного теории.

Запуск MapInfo

Запуск уникального экземпляра программы MapInfо осуществляется вызовом функции CreateObject() Visual Basic с присваиванием возвращаемого значения объектной переменной. (Вы можете декларировать объектную переменную как глобальную; в противном случае объект MapInfо освобождается после выхода из локальной процедуры.)

Например:


 FServer := CreateOleObject('MapInfo.Application');
 

Для подключения к ранее исполнявшемуся экземпляру MapInfo, который не был запущен вызовом функции CreateObject(), используйте функцию GetObject().


 // Данная реализация оставлена вам уважаемые читатели для тренировки
 FServer := GetObject('MapInfo.Application');
 

Внимание:

Если Вы работаете с Runtime-версией MapInfo, а не с полной копией, задавайте "MapInfo. Runtime" вместо "MapInfo. Арplication". Runtime-версия и полная версия могут работать одновременно.

Функции CreateObject() и GetObject() используют механизм управления объектами OLE (OLE Automation) для связи с MapInfo.

Примечание:

В 32-разрядной версии Windows (Windows95 или Windows NT) можно запускать несколько экземпляров MapInfo. Если Вы запустите MapInfo и вслед за этим программу, использующую Интегрированную Картографию и вызывающую CreateObjectf), то будут работать два независимых экземпляра MapInfo. Однако в 16-разрядной версии программа использующая Интегрированную Картографию с запущенным MapInfo работать не сможет.

Пересылка команд в программу MapInfo

После запуска программы MapInfo необходимо сконструировать текстовые строки, представляющие операторы языкa Map Basic.

Если Вы установили связь с MapInfo, используя механизм управления объектами OLE (OLE Automation), передавайте командную строку программе MapInfo методом Do.

Например:


 FServer.Do('здесь команда MapBasic');
 

Примечание:

В компоненте это реализовано процедурой ExecuteCommandMapBasic, но в сущносте вызывается FServer.Do

При использовании метода Do программа MapInfo исполняет командную строку точно так как если б ее ввели в окне команд MapBasic.

Примечание:

Вы можете передать оператор в программу MapInfo, если этот оператор допустим окне MapBasic. Например, Вы не можете переслать MapBasic-оператор Dialog, поскольку его использование не разрешено в окне MapBasic.

Для определения допустимости использования оператора языка MapBasic в окне MapBasic обратитесь к Справочнику MapBasic или откройте Справочную систему; искомая информация находится под заголовком "Предупреждение". Например, в Справке по оператору Dialog дано следующее ограничение: "Вы не можете использовать оператор Dialog в окне исполнения (такие, как For..-Next и Goto), не разрешены для исполнения в окне MapBasic.

Запрос данных от программы MapInfo

Для выполнения запроса из Вашей программы-клиента значения MapBasic используйте OLE-методEval.

Например:


 MyVar:= FServer.Eval('здесь команда MapBasic');
 

Примечание:

В компоненте это реализовано процедурой Eval, но в сущносте вызывается FServer.Eval

При использовании метода Eval программа MapInfo интерпретирует строку как выражение языка MapBasic, определяет значение выражения и возвращает это значение в виде строки. Замечание: Если выражение приводится к логическому значению (тип Logical), MapInfo возвращает односимвольную строку, "Т" или "F" соответственно.

Переподчинение окон MapInfo

После запуска MapInfo используйте оператор Set Application Window языка MapBasic для обеспечения перехвата управления Вашей программой-клиентом диалоговых окон и сообщений об ошибках программы MapInfo.

Затем, в желаемой точке включения окна MapInfo в Ваше приложение передайте MapInfo оператор Set Next Document, за которым следует MapBasic-оператор, создающий окно.

Оператор Set Next Document позволяет Вам "переподчинять" окна документов. Синтаксис этого оператора требует указания уникального номера HWND элемента управления в Вашей программе. При последующем создании окна-документа MapInfo (с использованием операторов Map, Graph, Browse, Layout или Create Legend) создаваемое окно становится для окна порождающим объектом.

Примеры приведены из компонента но тоже самое можно выполнить и метолом Do непосредственно, но вы это уже я думаю поняли


 ExecuteCommandMapBasic('Set Application Window %D', [FOwner.Handle]);
 ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]);
 ExecuteCommandMapBasic('Set Next Document Parent %D Style 1', [FPanel.Handle]);
 

Примечание:

В компоненте это реализовано процедурой WindowMapDef которая ссылается на панель заданную свойством PanelMap.

Для каждого переподчиняемого окна необходимо передать программе MapInfo из Вашей программы пару операторов - оператор Set Next Document Parent, а затем оператор, создающий окно. После создания окна Вам может понадобиться запросить из MapInfo значение функции WindowID(0) - целочисленный ID-номер окна (Window ID) в MapInfo, так как многие операторы языка MapBasic требуют задания этого номера. Этот запрос выполняется на основе компонента следующим образом:


 WindowID := Eval('WindowID(%D)',[0]).AsInteger;
 

Заметьте, что даже после переподчинения окна Карты, MapInfo продолжает управлять им. клиентская программа может не обращать внимания на сообщения о перерисовке, реализацию данной особенности я оставлю на потом.

Переподчинение окон Легенд, растровых диалогов и других окон MapInfo

Чтобы изменить (преподчинить) данные окна используется оператор MapBasic Set Window... Parent.

Например, в компоненте переподчинение окна информации реализовано так -


 ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]);
 

Реализацию переподчинения других окон я оставляю вам уважаемые читатели

Заметьте, что способ переподчинения окна Информации другой, чем для окна Карты. В последнем случае не используется предложение Set Next Document. Дело в том, что может существовать несколько окон Карты.

Окна Легенды - особый случай. Обычно существует только одно окно Легенды, так же, как и одно окно Информации. Однако при помощи оператора MapBasic Create Legend Вы можете создавать дополнительные окна Легенды.

Для одного окна Легенды используйте оператор MapBasic Window Legend Parent.

Чтобы создать дополнительное окно Легенды, используйте оператор MapBasic Set Next Document и оператор Create Legend. Заметьте, что в этом случае Вы создаете Легенду, которая привязана к одному определенному окну Карты или окну Графика. Такое окно Легенды не изменяется, когда другое окно становится активным.

Совет:

Вы можете создать "плавающее" окно Легенды внутри окна Карты. В операторе Set Next Document укажите окно Карты как порождающее окно. Для получения более подробной информации смотрите в документации по MapBasic.

Продолжение следует….

Конец первой части.




MapInfo и Delphi - Настройка панелей и меню. Реализация собственных CallBack вызовов и обработка поступивших данных.

Автор: Дмитрий Кузан

Доброе время суток !

Этой статьей я заканчиваю введение в интегрированную картографию MapInfo.Надеюсь, что данный цикл статей открыл вам возможность применять MapInfo в ваших программах. Перед началом я хочу дать вам ссылку на сайт пользователй MapInfo , где вы найдете исчерпывающеюся информацию по MapInfo и MapBasic в частности на русском языке. Многое что я дал вам по MapBasic в этих частях взято оттуда.

Интеграция инструментальных панелей Maplnfo краткий вводный курс.

Вы не можете переподчинить стандартные инструментальные панели MapInfo. Если Вы хотите, чтобы Ваша клиентская программа имела такие панели вы должны сами создать панели и кнопки на Delphi (например используя Tpanel и Tbutton) и их обработчике посылать специальные команды MapInfo для того что-бы MapInfo включало или переключала режимы работы (например с выбора объекта на перемещения окна карты (ладошка)).

Если Вы хотите, чтобы кнопка панели эмулировала стандартную кнопку MapInfo, используйте метод MapInfo Run Menu Command.

Например в обработчике OnClick пропишите следующею команду


 KDMapInfoServer1.ExecuteCommandMapBasic('Run Menu Command 1702',[]);
 

Когда пользователь нажмет на эту кнопку, программа вызывовет метод MapInfo - Run Menu Command, который активизирует инструмент под номером 1702 (инструмент перемещение карты "рука" ).

"Магический" номер 1702 ссылается на инструмент "рука" служащий для перемещения (сдвига) карты.

Вместо того, чтобы использовать такие числа. Вы можете использовать идентификаторы, более понятные в тексте программы. MapBasic определяет стандартный идентификатор M_TOOLS_RECENTER который имеет значение 1702. Таким образом, этот пример можно записать так:


 KDMapInfoServer1.ExecuteCommandMapBasic('Run Menu Command %S', [M_TOOLS_RECENTER]);
 

Использование идентификаторов (типа M_TOOLS_RECENTER) делает Вашу программу более читательной, но перед использование вы должны включить в программу (в Uses) соответствующий заголовочный файл MapBasic. Для Delphi я положил файл Global.pas (содержимое файла опубликовано в приложении 1).

В следующей таблице приведены кратко идентификаторы основных инструментальных кнопок MapInfo (для более побробной информации смотрите документацию по MapBasic).

Кнопки панели Операции Номер Идентификатор Примечание
Выбор 1701 М_TOOLS_SELECTOR Панель ОПЕРАЦИИ
Выбор в прямоугольнике 1722 M_TOOLS_SEARCH_RECT Панель ОПЕРАЦИИ
Выбор в круге 1703 M_TOOLS_SEARCH_RADIUS Панель ОПЕРАЦИИ
Выбор в области 1704 M_TOOLS_SEARCH_BOUNDARY Панель ОПЕРАЦИИ
Увеличивающая лупа 1705 M_TOOLS_EXPAND Панель ОПЕРАЦИИ
Уменьшающая лупа 1706 M_TOOLS_SHRINK Панель ОПЕРАЦИИ
Ладошка (рука) 1702 M_TOOLS_RECENTER Панель ОПЕРАЦИИ
Информация 1707 M_TOOLS_PNT_QUERY Панель ОПЕРАЦИИ
Подпись 1708 M_TOOLS_LABELER Панель ОПЕРАЦИИ
Линейка 1710 M_TOOLS_RULER Панель ОПЕРАЦИИ
Переноска 1734 M_TOOLS_DRAGWINDOW Панель ОПЕРАЦИИ
Символ 1711 M_TOOLS_POINT Панель ПЕНАЛ
Линия 1712 M_TOOLS_LINE Панель ПЕНАЛ
Полилиния 1713 M_TOOLS_POLYLINE Панель ПЕНАЛ
Дуга 1716 M_TOOLS_ARC Панель ПЕНАЛ
Полигон 1714 M_TOOLS_POLYGON Панель ПЕНАЛ
Эллипс 1715 M_TOOLS_ELLIPSE Панель ПЕНАЛ
Прямоугольник 1717 M_TOOLS_RECTANGLE Панель ПЕНАЛ
Прямоугольник скругленный 1718 M_TOOLS_ROUNDEDRECT Панель ПЕНАЛ
Текст 1709 M_TOOLS_TEXT Панель ПЕНАЛ
Рамка 1719 M_TOOLS_FRAME Панель ПЕНАЛ
       

Настройка "быстрых" меню Maplnfo

MapInfo вызывает "быстрые" меню, если пользователь нажимает правую кнопку мышки в окне MapInfo. Эти меню появляются даже во внедренных приложениях. В зависимости от характера Вашего приложения Вы можете захотеть модифицировать или даже удалить такое меню. Например, Вы, возможно, захотите удалить команду ДУБЛИРОВАТЬ ОКНО, так как эта команда не работает в OLE-приложении.

Чтобы удалить одну или несколько команд из локального меню, используйте оператор MapBasic Alter Menu... Remove или переопределите меню целиком, используя оператор Create Menu. Подробнее смотрите в Справочнике MapBasic.

Чтобы добавить команду к локальному меню, используйте оператор MapBasic Alter Menu ... Add и синтаксис предложений Calling OLE.

Чтобы удалить "быстрое" меню полностью, используйте оператор MapBasic Create Menu и управляющий код "(-" как новое определение меню. Например, следующий оператор разрушает "быстрое" меню для окон Карты:


 KDMapInfoServer1.ExecuteCommandMapBasic(' "Create Menu ""MapperShortcut"" ID 17 As ""(-"" " ', []);
 

Создание собственных уведомляющих вызовов (Callbacks).

Во второй части мы рассмотрели возможность перехвата двух стандартных вызовов MapInfo - это дало нам возможность подключить к своей программе статус бар MapInfo и узнавать об изменениях окон MapInfo.Все это очень неплохо, но сразу возник вопрос, а как создавать и обрабатывать сообщения собственные, не входящие в MapInfo.

Если Вы хотите, чтобы MapInfo сообщало Вашей клиентской программе, когда пользователь применяет инструментальную кнопку, создайте такую кнопку оператором Alter ButtonPad... Add. Определите кнопку в соответствии с именем метода для обработки (прим. Этот метод определен мной как MyEnvent в OLE объекте)

Пример :


 KDMapInfoServer1.ExecuteCommandMapBasic('Alter ButtonPad ID 1 Add ToolButton calling ole
 "MyEvent" ID 1 Icon 0 Cursor 0 DrawMode 34 uncheck',[]);
 

Заметьте, что инструментальные панели MapInfo скрыты, подобно остальной части интерфейса пользователя MapInfo. Пользователь не будет видеть новую кнопку. Вы можете добавить иконку, кнопку или другой видимый элемент управления к интерфейсу пользователя Вашей клиентской программы. Когда пользователь укажет на него мышкой, пошлите MapInfo оператор Run Menu Command ID , c индентификатором созданной кнопки чтобы активизировать этот инструмент.


 KDMapInfoServer1.ExecuteCommandMapBasic('Run Menu Command ID 1',[]);
 

Примечание:

Информацию по Alter Button Pad смотрите в документации.

Если Вы хотите, чтобы MapInfo сообщала Вашей клиентской программе, когда пользователь выбирает созданную Вами команду меню, определите такую кнопку оператором Alter Menu... Add с указанием имени OLE метода (см. выше).

Внутри метода (в данном случае в обработчике компонента MyEventChange) обработайте аргументы (Info), посланные MapInfo.

Обработка переданных данных

Когда пользователь использует команды или кнопки, MapInfo посылает Вашему OLE-методу строку, содержащую восемь элементов, разделенных запятыми. Например, строка, посланная MapInfo, может выглядеть так:


 "MI:-73.5548,42.122,F,F,-72.867702,43.025,202,"
 

Содержание такой строки проще понять, если Вы уже знакомы с функцией MapBasic CommandInfo(). Когда Вы пишете приложения, Вы можете создать новые команды меню и кнопки, вызывающие MapBasic-процедуры. Внутри процедуры-обработчика вызовите функцию CommandInfo(), чтобы получить информацию. Например, следующее обращение к функции определяет, координату Х и У места на карте где пользователи применил инструмент.


 var
   X, Y : string;
 begin
   KDMapInfoServer1.ExecuteCommandMapBasic('Set CoordSys Layout Units "mm"',[]);
   X := KDMapInfoServer1.Eval('CommandInfo(%S)',[CMD_INFO_X]).AsString;
   Y := KDMapInfoServer1.Eval('CommandInfo(%S)',[ CMD_INFO_Y]).AsString;
   ShowMessage('X= ' + X + ' Y = ' + Y);
 

Значения:

Код для событий, связанных с меню Код для событий, связанных с кнопкой
1 CMD_INFO_X
2 CMD_INFO_Y
3 CMD_INFO_SHIFT
4 CMD_INFO_CTRL
5 CMD_INFO_X2
6 CMD_INFO_Y2
7 CMD_INFO_TOOLBTN
8 CMD_INFO_MENUITEM
   

Когда Вы создаете команду меню или кнопку, которая использует синтаксис вызова OLE, MapInfo создает строку, содержащую разделенные запятой все восемь возвращаемых CommandInfo() значений. Строка начинается с префикса "MI:", чтобы Ваш OLE-сервер мог определять, что обращение метода было сделано MapInfo.

Строка, которую MapInfo посылает Вашему методу, выглядит следующим образом:


 "MI:" +
 CommandInfo(l) + "," + CommandInfo (2) + "," +
 CommandInfo(3) + "," + CommandInfo (4) + "," +
 CommandInfo(5) + "," + CommandInfo (6) + "," +
 CommandInfo (7) + "," + CommandInfo (8)
 

Предположим, что Ваше приложение добавляет команду меню к локальному меню OLE-методу строку. Если команда меню имеет номер 101 , строка будут выглядеть следующим образом:


 "Ml :,,,,,,, 101"
 

В этом случае большинство элементов строки пусто, потому что функция CommandInfo( ) может возвращать только эту одну часть информации.

Теперь предположим что вы создаете кнопку которая позволяет пользователю выбирать линии на карте.Строка теперь примет вид -


 "MI:-73.5548,42.122,F,F,-72.867702,43.025,202,"
 

Теперь строка включает несколько элементов:

  • Первые два элемента содержат х- и у координаты точки на которые пользователь указал мышкой
  • Следующие два элемента сообщают, была ли нажата клавиша SHIFT или CTRL
  • Предпоследнии два элемента содержат координаты точки где пользователь отпустил кнопку мышки.
  • И последний - указывает номер идентификатора кнопки.

Совет:

Если Вы приписываете уникальный идентификатор каждой из Ваших кнопок, Вы можете сделать так, что все кнопки будут вызывать один и тот же метод. Ваш метод может определять, какая из кнопка вызвала его, используя седьмой аргумент в переданной строке.

Примечание 1: Описание констант MapInfo (Global.pas)

Примечание - данный файл был взят мной с Интернета. Хочу сразу сделать предупреждение - разработчики MapInfo заявляют что набор констант может быть подвергнут изменениям в следующих редакциях MapInfo.Данный набор констант адаптирован под пятую версию. К сожалению шестой версии у меня нет (может кто поделиться ;-) ) и соответственно нет возможности проверить изменился ли набор констант или нет.

Вот в принципе и все что нужно для работы с MapInfo в Delphi, дерзайте




Delphi и Oracle - вопросы и ответы

Если "Microsoft" начнет выпускать автомобили - то:
1. Когда на дорогу нанесут новую разметку, вам придется покупать новую машину.
3. "Macintosh" тоже начнет выпускать автомобили, они будут заряжаться от солнца, будут в два раза быстрее, ими будет легче управлять, но ездить они будут только по 5% дорог.
4. Индикаторы топлива, температуры двигателя и масла будут объединены в один "главный машинный индикатор".
7. Во время аварии подушки безопасности, прежде чем сработают, спросят: "Are you sure?"

Вопрос

В статье "Создание серверов приложений с помощью Delphi 3" вы написали, что подключались к Personal Oracle с помощью BDE. Я очень прошу вас рассказать, как вы это сделали. Для меня пока это остается загадкой.
Ответ

Доступ к Personаl Oracle (как и к любой другой версии СУБД Oracle) осуществляется следующим образом. Сначала нужно запустить сервер (в случае Personal Oracle для Windows 95 это отдельное приложение, в случае Oracle для Windows NT - набор сервисов, обслуживающих конкретную базу данных) и настроить клиентскую часть Oracle. Для этого следует запустить утилиту SQLNet Easy Configuration (в случае Oracle 8 - Oracle Net8 Easy Config) и с ее помощью создать описание псевдонима базы данных Oracle (для него, как и в BDE, используется термин alias, но это не то же самое, что псевдоним BDE). При создании этого описания важны три параметра.

Первый из них - сетевой протокол, с помощью которого осуществляется доступ к серверу Oracle (IPX/SPX, TCP/IP и др.). Второй параметр - местоположение сервера в сети. В случае Personal Oracle это обычно компьютер с IP-адресом 127.0.0.1 (это специальный адрес для доступа к локальному компьютеру, так называемый TCP Loopback Address, который обычно имеет URL http://localhost/). Третий параметр - имя базы данных. По умолчанию в случае Personal Oracle она называется ORCL. В общем случае имя может быть любым, но это должно быть имя уже существующей базы данных, с которой вы собираетесь работать.

В принципе все описания псевдонимов Oracle хранятся в текстовом файле TNSNAMES.ORA, который можно редактировать вручную.

Далее следует запустить утилиту SQL Plus и проверить соединение клиента с сервером. Обычно в качестве имени пользователя используется имя SYSTEM и пароль MANAGER (если вы сами администрируете сервер). Если же сервер был установлен раньше, узнайте у администратора базы данных, каким именем и паролем следует воспользоваться. Помимо имени пользователя и пароля, SQL Plus запросит так называемую строку связи, в которой должно содержаться имя сервиса, который был создан вами перед этим. При удачном соединении в SQL Plus появится соответствующее сообщение. Отметим, что утилита Oracle Net8 Easy Config позволяет протестировать соединение непосредственно в процессе создания описания сервиса.

Если соединение с сервером было неудачным, стоит проверить, поддерживается ли указанный сетевой протокол, виден ли в сети компьютер, на котором установлен сервер, и, если нужно, внести изменения в описание сервиса.

Теперь можно, наконец, заняться настройкой BDE. В качестве Server Name следует указать имя псевдонима Oracle (его можно просто выбрать из выпадающего списка, так как BDE Administrator также обращается к файлу TNSNAMES.ORA). После этого нужно проверить соединение с сервером через BDE с помощью BDE Administrator или SQL Explorer.

Если соединение не устанавливается и появляется сообщение "Vendor initialization failed", стоит убедиться, что динамическая загружаемая библиотека, указанная в параметре Vendor Init драйвера Oracle, действительно присутствует на данном компьютере. На всякий случай стоит скопировать ее в папку Windows\System, так как некоторые ранние версии BDE в Windows 95 не находят эту библиотеку в подкаталоге Bin каталога, в котором установлен клиент Oracle, в силу ограничений, налагаемых этой операционной системой на длину переменной окружения PATH. Отметим также, что при использовании Oracle 8 нужно использовать версию не ниже 8.0.4; в случае использования более ранней версии следует обновить ее до 8.0.4.


Вопрос

Недавно я перешел на использование Oracle, но все мои попытки использовать компонент TStoredProc оказываются неудачными. Почему?
Ответ

Причины неработоспособности компонента TStoredProc могут быть следующими.

Во-первых, при использовании ODBC-доступа может оказаться, что применяемый вами ODBC-драйвер не поддерживает хранимые процедуры (как известно, не все ODBC-драйверы их поддерживают).

Во-вторых, имеется известная проблема, описание которой содержится в разделе Developers Support корпоративного сайта Inprise (http://www.inprise.com). Дело в том, что число параметров хранимой процедуры, с которой взаимодействует компонент TStoredProc, не должно превышать 10. В случае, если реальное число параметров превышает 10, многие разработчики переписывают хранимые процедуры так, чтобы они использовали строковые параметры, содержащие по несколько реальных параметров.


Вопрос

Дает ли Delphi возможность корректно прервать выполнение SQL-запроса к серверу Oracle с помощью BDE? Например, чтобы при использовании с SQL Plus после отправки SQL-запроса на выполнение на экране появлялось окно с кнопкой Cancel, которое давало бы возможность в любой момент прервать выполнение этого запроса?
Ответ

Насколько мне известно, для этой цели лучше всего использовать функции Oracle Call Interface (низкоуровневый API Oracle). В комплекте поставки Oracle есть соответствующие примеры для C, и переписать их на Pascal несложно.

Некоторые драйверы SQL Link позволяют прекратить выполнение запроса, если время его выполнения превышает заранее заданное значение (параметр MAX QUERY TIME соответствующего драйвера). Однако драйвер ORACLE, к сожалению, в их число не входит.


Вопрос

Что необходимо предпринять, чтобы сгенерировать из ERwin таблицы для локальной базы данных Paradox 5.0? На компьютере установлены Delphi 4.0 и MetaBase.
Ответ
Для этого требуется установить ODBC-драйвер для этой версии Paradox той же разрядности, что и ERwin. Затем нужно описать соответствующий ODBC-источник, и он будет доступен в ERwin.


Вопрос

Не могли бы вы подсказать, как заблокировать функцию вставки записи непосредственно в компоненте TDBGrid с сохранением всех остальных возможностей редактирования таблицы.
Ответ
Наиболее разумным представляется создать обработчик события OnBeforeInsert компонента TTable, TQuery или TClientDataSet, данные из которых отображаются в TDBGrid. Сам компонент TDBGrid не имеет подходящего события для обработки, так как это компонент, предназначенный только для создания пользовательского интерфейса, а в данном случае следует, по существу, запретить добавление записей в таблицу.


Вопрос

В мой комплект Borland C++ Builder не входит Visual Query Builder. Могу ли я связать две таблицы без него?
Ответ

Безусловно, две таблицы можно связать и без VQB. Самый простой способ - запустить Database Form Wizard и связать две таблицы, используя TQuery. Те два запроса, которые при этом получатся (один из них - параметризованный), можно использовать как образец.

Кроме того, можно просто написать вручную необходимый запрос к любому числу таблиц и поместить его в свойство SQL компонента TQuery. Все инструменты для генерации запросов (Visual Query Builder, SQL Builder и др.) просто предоставляют для этого визуальные средства, а результатом их работы является именно текст запроса, помещаемый в это свойство.


Вопрос

Я установил Borland C++ Builder 3.0 Client/Server Suite и InterBase Server 5.1.1. (автоматически с ним установился InterBase 5.x Driver by Visigenic). Но у меня не работают хранимые процедуры. Например: процедура правильно откомпилирована, и вызов ее из C++ Builder осуществляется с помощью выполнения оператора


 StoredProc1->ExecProc();
 

При этом возникает следующая ошибка :


 "Capability not supported. General SQL error. [Visigenic]
 [ODBC InterBase 4.x Driver] Driver not capable".
 

Ответ

ODBC-драйвер может не поддерживать хранимые процедуры. В этом случае стоит попытаться использовать драйвер SQL Link (он должен быть в C++ Builder 3.0 Client/Server Suite). Для этого нужно создать для вашей базы данных псевдоним типа INTRBASE. В этом случае хранимые процедуры должны работать.

Если хранимые процедуры, тем не менее, остаются недоступными, стоит проверить, что и в какой последовательности было установлено на ваш компьютер. Такие неприятности могут возникать, если, например, вы установили какой-либо продукт, написанный на Delphi 2, после C++Builder 3. В этом случае можно переустановить BDE, взяв его последнюю версию на сайте Inprise (http://www.inprise.com — все зарегистрированные пользователи C++ Builder 3.0 Client/Server Suite имеют право это сделать.


Вопрос

При удалении записей из таблицы dBase с помощью компонента TTable они просто приобретают признак удаления, и я никак не могу добиться их физического удаления. Как быть?
Ответ
Ваша проблема решается просто - для физического удаления записей нужно использовать функцию DbiPackTable (ее описание есть в справочном файле BDE).


Вопрос

При добавлении новых записей с помощью метода TTable.AppendRecord в индексированную таблицу FoxPro через какое-то время (то есть при одновременном добавлении большого количества записей) возникает ошибка:

"Access to table disabled because of previous error. Read failure. File <имя_файла.cdx>".

Ответ

Возможно, причина заключается в том, что операции чтения-записи в файл, содержащий таблицу FoxPro, особенно при использовании кэширования, предоставляемого операционной системой, конфликтуют с содержимым индексного файла (это часто происходит при многопользовательской работе). Дело в том, что ранние версии dBase, FoxPro, Clipper работали с неподдерживаемыми индексами, то есть индексные файлы не обновлялись одновременно с таблицей, и для их синхронизации требовалось выполнять специальные операции. Но соответствующие средства разработки, применявшиеся в то время, обычно не поддерживали никаких аналогов транзакций - записи чаще всего вставлялись по одной.

В случае применения старых версий формата FoxPro следует избегать кэширования при выполнении дисковых операций с файловым сервером, содержащим базу данных FoxPro. Кроме того, следует проверить и, если необходимо, изменить в настройках BDE параметры MINBUFSIZE, MAXBUFSIZE, LOCAL SHARE - возможно, проблема заключается в недостаточной величине буферов BDE для кэширования данных или в одновременном доступе к данным приложений, использующих и не использующих BDE.

Еще одним из способов решения этой проблемы (самым радикальным) является замена FoxPro на какую-нибудь из серверных СУБД. Например, InterBase неплохо справляется с одновременным вводом большого количества записей благодаря некоторым специфическим особенностям архитектуры этого сервера.


Вопрос

Позволяет ли QuickReport выгружать данные в формате Microsoft Excel?
Ответ

Quick Report не позволяет выгружать данные в формате Microsoft Excel. Но последние его версии позволяют сохранять отчеты в формате CSV (Comma Separated Value) и HTML, и оба эти формата можно прочесть с помощью Excel.

Помимо этого, для генерации отчета можно использовать автоматизацию Excel (Automation, ранее назвалось OLE Automation. — Прим. ред.), вообще не прибегая к использованию QuickReport.


Вопрос

Как можно создать свою форму просмотра отчетов QuickReport в С++Builder?
Ответ

Для создания собственных окон просмотра отчета можно использовать компонент TQRPreview. Для этой цели следует создать форму (назовем ее PreviewForm), поместить на нее компонент TQRPreview, сослаться на нее в форме, содержащей отчет, и в форме, из которой вызывается просмотр отчета. Код для показа отчета выгладит примерно так:

Далее создадим обработчик события OnPreview компонента TQuickRep:

После этого данный отчет будет появляться не в стандартном окне просмотра, а в форме PreviewForm.


Вопрос

Возможно ли использование компонентов Decision Support System при генерации отчетов в QuickReport и, если да, то каким образом? Если QuickReport не подходит для этих целей, то какие другие варианты вы можете посоветовать?
Ответ

Самый простой способ - использовать компоненты TQRLabel, текст в которых динамически меняется во время печати (то есть способ, которым можно напечатать все, что угодно, написав при этом немного кода). В принципе можно записать двухмерное сечение куба во временную таблицу или в компонент TClientDataSet, написав соответствующий цикл, и сделать отчет на ее основе.

Использование DecisionQuery в качестве источника данных для отчета также вполне возможно.

Другие возможные варианты - это использование автоматизации Word или Excel либо вычисление сумм внутри отчета. Можно также использовать другие генераторы отчетов - например, с помощью Crystal Reports можно создавать отчеты, содержащие кросс-таблицы.


Вопрос

Как корректно подключить Crystal Reports к Delphi?
Ответ

В составе Crystal Reports Professional имеется VCL-компонент для Delphi, компонент ActiveX, модуль CRPE32.PAS, в котором объявлены все функции и структуры Print Engine API, и описание опубликованных методов Crystal Reports как сервера автоматизации. Соответственно есть следующие возможности подключения Crystal Reports к Delphi:

  • Использование функций Report Engine API из библиотеки CRPE32 DLL. В этом случае следует добавить в проект модуль CRPE32.PAS и сослаться на этот модуль в предложении uses. Ниже приведен пример соответствующего кода:
  • Следует помнить, что строковые параметры, передаваемые в функции Print Engine API, представляют собой тип данных PChar, а не стандартные строки, используемые в Pascal, поэтому для передачи таких параметров, как, например, имя отчета, следует осуществить преобразование типов с помощью функции StrPCopy. Для успешной компиляции подобных приложений файл CRPE32.PAS должен находиться в том же каталоге, что и разрабатываемое приложение, либо в каталоге Delphi\Lib.
  • Использование VCL-компонента из комплекта поставки (для этого следует установить его в палитру компонентов Delphi). Естественно, этот компонент инкапсулирует те же самые функции Print Engine API. Существуют также аналогичные компоненты третьих фирм (например, компонент от SupraSoft Ltd., http://www.suprasoft.com).
  • Использование компонента ActiveX фирмы Crystal Reports. Этот компонент ActiveX может быть установлен в палитру компонентов Delphi. Он обладает набором свойств и методов, более или менее сходным с соответствующим VCL-компонентом из комплекта поставки Crystal Reports Professional.
  • Использование Crystal Reports как сервера автоматизации. В справочной системе Crystal Reports имеется подробное описание иерархии вложенных объектов и их методов (и внушительный набор примеров для Visual Basic, аналоги которых несложно создать и на языке Pascal). Ниже приведен пример соответствующего кода:
  • Можно также сделать отчет в виде исполняемого файла и вызвать его из приложения. Но в этом случае передать параметры в отчет не удастся.




Delphi и системная информация о ресурсах компьютера

Компьютеры - вещь слишком сложная, чтобы работать в принципе. Поэтому то, что они работают хоть как-то, уже чудо.

Иногда Delphi-приложениям может не хватать функциональной полноты стандартной библиотеки компонентов и тогда бывает необходимо обратиться к Microsoft Win32 API (Application Programming Interface - интерфейса взаимодействия прикладной программы с операционной системой). Почти все функции из Microsoft Win32 API описаны в модуле windows.pas (который по умолчанию включается в cекцию uses новых модулей). Cледует заметить, что часть из этих функции ведет себя по разному в зависимости от текущей операционной системы (Windows 95, 98, NT).

Разработаем программу, показывающую нам некоторую системную информацию о компьютере. В частности, хотелось бы получить информацию о версии ОС, ее директориях, свойствах экрана, ресурсах памяти, имени пользователя и компьютера, дате BIOS. Помимо этого, разрешим пользователю изменять настройки клавиатуры, встроенного динамика и хранителя экрана.

Процесс визуального проектирования описывать не будем; рассмотрим лишь страницу «Параметры». Для удобства управления параметрами клавиатуры положим на нее две компоненты TTrackBar. Изменим свойство Name на tbKeyboardDelay и tbKeyboardSpeed. Изменим свойство PageSize на 1. Для tbKeyboardDelay установим Max=3 и для tbKeyboardSpeed. Max=31. Для управления свойствами хранителя экрана используем TCheckBox (свойство Name сменим на cbScreenSaverActive, Caption на &‘Хранитель экрана&’) и TMaskEdit (свойство Name=&’edSSTimeOut&’ и EditMask=&’!999;1;&’). Аналогично добавим TCheckBox (свойство Name=&’cbSpeaker&’, Caption=&’Использование встроенного динамика&’ ).

Рассмотрим текст программы. В список включаемых модулей uses добавим registry. Добавим описание процедур в раздел public описания TfmMain.


 type
 TfmMain = class(TForm)
 ...
 procedure FormCreate(Sender: TObject);
 procedure Change(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 KeyboardDelay,
 KeyboardSpeed,
 ScreenSaveTimeOut : integer;
 procedure ParametersInfo;
 procedure ShowSomeInfo;
 procedure BIOSInfo(OS : string);
 procedure HardwareInfo;
 procedure MemoryInfo;
 procedure VideoInfo;
 procedure OSInfo;
 end;
 
 var fmMain: TfmMain;
 
 implementation
 uses Registry;
 {$R *.DFM}
 

Сначала получим информацию о компьютере. Используем функцию GetComputerName для получения имени компьютера, функцию GetUserName для получения имени пользователя и функцию GetSystemInfo для получения информации о процессоре (наиболее полно данная функция реализована в Windows NT, где она возвращает и кол-во процессоров и их тип и т.д.).


 // Информация о компьютере.
 procedure TfmMain.HardwareInfo;
 var Size : cardinal;
 PRes : PChar;
 BRes : boolean;
 lpSystemInfo : TSystemInfo;
 begin
 // Имя компьютера
 Size := MAX_COMPUTERNAME_LENGTH + 1;
 PRes := StrAlloc(Size);
 BRes := GetComputerName(PRes, Size);
 if BRes then laCompName_.Caption := StrPas(PRes);
 // Имя пользователя
 Size := MAX_COMPUTERNAME_LENGTH + 1;
 PRes := StrAlloc(Size);
 BRes := GetUserName(PRes, Size);
 if BRes then laUserName_.Caption := StrPas(PRes);
 // Процессор
 GetSystemInfo(lpSystemInfo);
 laCPU_.Caption := 'класса x' + IntToStr
 (lpSystemInfo.dwProcessorType);
 end;
 

Перейдем к параметрам экрану. Здесь мы будем использовать и Win32 API функции и стандартные объекты VCL. Так для получения разрешения экрана нам понадобится объект TScreen (его свойства Width и Height). Остальные параметры мы получим через контекст драйвера устройства DC используя функцию GetDeviceCaps.


 // Информация о видеосистеме.
 procedure TfmMain.VideoInfo;
 var DC : hDC;
 c : string;
 begin
 // Разрешение экрана
 laWidth_.Caption := IntToStr(Screen.Height);
 laHeight_.Caption := IntToStr(Screen.Width);
 // Информация о глубине цвета.
 DC := CreateDC('DISPLAY',nil,nil,nil);
 laBitsPerPixel_.Caption :=
 IntToStr(GetDeviceCaps(DC,BITSPIXEL));
 laPlanes_.Caption :=
 IntToStr(GetDeviceCaps(DC,PLANES));
 case GetDeviceCaps(DC,BITSPIXEL) of
 8 : c := '256 цветов';
 15 : c := 'Hi-Color / 32768 цветов';
 16 : c := 'Hi-Color / 65536 цветов';
 24 : c := 'True-Color / 16 млн цветов';
 32 : c := 'True-Color / 32 бит';
 end;
 laColors_.Caption := c;
 DeleteDC(DC);
 end;
 

Также будет интересна информация о памяти. Здесь нам поможет функция GlobalMemoryStatus, возвращающая информацию по объему физической и виртуальной памяти.


 // Информация о памяти.
 procedure TfmMain.MemoryInfo;
 var lpMemoryStatus : TMemoryStatus;
 begin
 lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);
 GlobalMemoryStatus(lpMemoryStatus);
 with lpMemoryStatus do begin
 laFreeMemory.Caption :=
 laFreeMemory.Caption +
 IntToStr(dwMemoryLoad) + '%';
 laRAM_.Caption := Format('%0.0f Мбайт',
 [dwTotalPhys div 1024 / 1024]);
 laFreeRAM_.Caption := Format('%0.3f Мбайт',
 [dwAvailPhys div 1024 / 1024]);
 laPF_.Caption := Format('%0.0f Мбайт',
 [dwTotalPageFile div 1024 / 1024]);
 laPFFree_.Caption := Format('%0.0f Мбайт',
 [dwAvailPageFile div 1024 / 1024]);
 end;
 end;
 

Узнаем информацию о ОС. Функция GetWindowsDirectory вернет путь к каталогу, где установлена система, функция GetSystemDirectory - к системному каталогу. Для определения версии ОС воспользуемся функцией GetVersionEx.


 // Информация о Windows.
 procedure TfmMain.OSInfo;
 var PRes : PChar;
 Res : word;
 BRes : boolean;
 lpVersionInformation : TOSVersionInfo;
 c : string;
 begin
 // Каталог, где установлена Windows
 PRes := StrAlloc(255);
 Res := GetWindowsDirectory(PRes, 255);
 if Res > 0 then laWinDir_.Caption :=
 StrPas(PRes);
 // Системный каталог Windows
 Res := GetSystemDirectory(PRes, 255);
 if Res > 0 then laSysDir_.Caption :=
 StrPas(PRes);
 // Имя ОС
 lpVersionInformation.dwOSVersionInfoSize :=
 SizeOf(TOSVersionInfo);
 BRes := GetVersionEx(lpVersionInformation);
 if BRes then
 with lpVersionInformation do case dwPlatformId of
 VER_PLATFORM_WIN32_WINDOWS :
 if dwMinorVersion=0 then c := 'Windows 95'
 else c := 'Windows 98';
 VER_PLATFORM_WIN32_NT : c := 'Windows NT';
 VER_PLATFORM_WIN32s : c := 'Win 3.1 with Win32s'
 end;
 laVersion_.Caption := c;
 // Дата создания BIOS-а
 if c='Windows NT' then BIOSInfo('NT') else BIOSInfo('95');
 end;
 

В предыдущем отрывке программы внимательный читатель заметил вызов функции BIOSInfo с параметром, характеризующем текущую ОС. Опишем эту функцию. Важно отметить, что способ получения информации о дате BIOS различен. Для NT получим информацию из реестра, а для Windows 95/98 из соответствующего участка памяти. Эти два способа взаимоисключаемы, так как у Windows 95/98 нет соответствующего раздела реестра, а прямой доступ к памяти в NT невозможен.


 // Информация о дате создания BIOS-а.
 procedure TfmMain.BIOSInfo(OS : string);
 var p : pointer;
 s : string[255];
 begin
 if OS='NT' then begin with TRegistry.Create do
 try RootKey := HKEY_LOCAL_MACHINE;
 if OpenKeyReadOnly
 ('HARDWARE\DESCRIPTION\System')
 then laBIOSDate_.Caption :=
 ReadString('SystemBiosDate')
 finally Free;
 end;
 end
 else try
 s[0] := #8;
 p := Pointer($0FFFF5);
 Move(p^,s[1],8);
 laBIOSDate_.Caption :=
 copy(s,1,2) + '/' + copy(s,4,2) + '/' +copy (s,7,2);
 except laBIOSDate_.Caption := 'XX.XX.XXXX';
 end;
 end;
 

Рассмотрим функцию SystemParametersInfo, которая позволяет управлять некоторыми настройками системы. Область применения данной функции для NT и Windows 95/98 различна. Умышленно выберем некоторую общую часть для обеих систем.


 // Информация о параметрах
 procedure TfmMain.ParametersInfo;
 var Bl : boolean;
 begin
 // Разрешен ли PC Speaker
 SystemParametersInfo(SPI_GETBEEP,0,@Bl,0);
 cbSpeaker.Checked := Bl;
 // Активен ли хранитель экрана
 SystemParametersInfo
 (SPI_GETSCREENSAVEACTIVE,0,@Bl,0);
 cbScreenSaverActive.Checked := Bl;
 // Интервал вызова хранителя экрана
 SystemParametersInfo
 (SPI_GETSCREENSAVETIMEOUT,0,
 @ScreenSaveTimeOut,0);
 // Настройки клавиатуры
 SystemParametersInfo
 (SPI_GETKEYBOARDDELAY,0,
 @KeyboardDelay,0);
 SystemParametersInfo
 (SPI_GETKEYBOARDSPEED,0,
 @KeyboardSpeed,0);
 end;
 
 // Отображение настроек
 procedure TfmMain.ShowSomeInfo;
 begin
 tbKeyboardDelay.Position := 3 - KeyboardDelay;
 tbKeyboardSpeed.Position := KeyboardSpeed;
 edSStimeOut.EditMask := IntToStr
 (ScreenSaveTimeOut div 60);
 end;
 

Также позволим пользователю изменять и сохранять настройки системы по своему вкусу. Здесь также будем использовать функцию SystemParametersInfo. Для компонентов tbKeyboardSpeed, tbKeyboardDelay, cbScreenSaverActive, cbSpeaker, edSSTimeOut в ObjectInspector перейдем на закладку Events и изменим событие OnChange (для tbKeyboardSpeed, tbKeyboardDelay) , OnClick (для cbScreenSaverActive, cbSpeaker) и OnExit для edSSTimeOut на Change. Таким образом, все пять вышеперечисленных компонент после изменений состояний передадут управление нижеприведенной процедуре.


 // Сохранение изменений параметров системы
 procedure TfmMain.Change(Sender: TObject);
 var Sen : TComponent;
 begin
 Sen := Sender as TComponent;
 // Вкл/Выкл PC Speaker-а.
 if (Sen.Name='cbSpeaker') and cbSpeaker.Checked
 then SystemParametersInfo
 (SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE)
 else SystemParametersInfo
 (SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
 // Вкл/Выкл активности хранителя экрана.
 if (Sen.Name='cbScreenSaver') and cbScreenSaverActive.Checked
 then SystemParametersInfo
 (SPI_SETSCREENSAVEACTIVE,1,nil,SPIF_UPDATEINIFILE)
 else SystemParametersInfo
 (SPI_SETSCREENSAVEACTIVE,0,nil,SPIF_UPDATEINIFILE);
 // Изменение значения задержки перед повтором с клавиатуры
 if (Sen.Name='tbKeyboardDelay') then SystemParametersInfo(
 SPI_SETKEYBOARDDELAY,3-tbKeyboardDelay.Position,nil,
 SPIF_SENDWININICHANGE);
 // Изменение значения скорости ввода с клавиатуры
 if (Sen.Name='tbKeyboardSpeed') then SystemParametersInfo(
 SPI_SETKEYBOARDSPEED,tbKeyboardSpeed.Position,nil,
 SPIF_SENDWININICHANGE);
 // Изменение интервала запуска хранителя экрана
 if (Sen.Name='edSSTimeOut') then SystemParametersInfo(
 SPI_SETSCREENSAVETIMEOUT,StrToInt(edSSTimeOut.Text)
 *60,nil,SPIF_UPDATEINIFILE);
 end;
 

И ,наконец, вызовем все эти процедуры при создании формы.


 // Вызов информационных процедур при создании формы.
 procedure TfmMain.FormCreate(Sender: TObject);
 begin
 HardwareInfo;
 MemoryInfo;
 VideoInfo;
 ParametersInfo;
 ShowSomeInfo;
 OSInfo;
 end;
 

Использование Delphi совместно c фунциями Microsoft Win32 API позволит программисту создать более функционально богатые и гибкие приложения.




Delphi и WordBasic

- Помогите! У меня Word при печати вместо букв квадратики выводит! Help! Help! Что мне делать? Посоветуйте!
- А ты в квадратики нужные буквы вписывай...


 unit oleword;
 // Необходима форма и компоненты Memo и Edit на ней.
 // Написано для MSWord 8.
 // Также необходимо создать тестовый документ d:\test.doc
 interface
 
 uses
 
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   OLEAuto, ShellAPI, StdCtrls;
 
 type
 
   TForm1 = class(TForm)
     Memo1: TMemo;
     Edit1: TEdit;
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
     MSWord: Variant;
     // WordVersion: Byte;
   end;
 
 var
 
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   Test, Test1: Integer;
 
   AString: Variant;
 begin
 
   MSWord := CreateOLEObject('Word.Application'); //Word 8
   MSWord.Documents.Open(FileName := 'd:\test.doc', ReadOnly := True);
   MSWord.Visible := 1; //Закомментарьте, если вы нехотите показывать файл;
   Test := MSWord.FontNames.Count;
   for Test1 := 1 to Test do
   begin
     AString := MSWord.FontNames.Item(Test1);
     Memo1.Lines.Add(AString);
   end;
   MSWord.ActiveDocument.Range(Start := 0,
 end := 0);
 MSWord.ActiveDocument.Range.InsertAfter(Text := 'Заголовок');
 MSWord.ActiveDocument.Range.InsertParagraphAfter;
 MSWord.ActiveDocument.Range.Font.Name := 'Arial';
 MSWord.ActiveDocument.Range.Font.Size := 24;
 AString := MSWord.ActiveDocument.Range.Font.Name;
 Edit1.Text := AString;
 end;
 
 end.
 




Delphi и OLE Automation с Word

In the beginning was the Word, and the Word was 1.0...

Автоматизация позволяет одному приложению управлять другим приложением. Управляемое приложение называется сервером автоматизации (в нашем случае Word). Приложение, управляющее сервером называется диспетчером автоматизации.

Есть два пути для получения доступа к серверам автоматизации:

Позднее связывание (Интерфейс IDispatch)

При использовании данного метода имена функций и типы параметров решаются во время выполнения программы, все параметры определены вариантным типом.

Поскольку во время компиляции невозможно определить соответствия имен функций и типов параметров, данный метод чреват ошибками.

Так как имена функций и типы параметров должны проверяться во время выполнения программы, данный метод выполняется медленно.

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

Раннее связывание (Использование библиотеки типов/интерфейсов)

При использовании данного метода имена функций и типы параметров полностью решаются во время компиляции.

Библиотека типов должна импортироваться в Delphi. Библиотека типов является языковым нейтральным описанием всех объектов и функций, поддерживаемых сервером. (Это подобно файлу заголовка языка C).

При вызове функции должны обязательно присутствовать все параметры, даже те, которые в документации указаны как дополнительные (необязательные). Это позволяет обнаружить и исправить множество ошибок еще до запуска программы.

Скорость выполнения значительно быстрее, чем при использовании позднего связывания.

Из-за преимуществ второго метода остальная часть документа демонстрирует принципы создания приложений с ранним связыванием. Все приложения, использующие Excel автоматизацию, должны пользоваться последним методом, если нет причин для первого.

Подготовка библиотеки типов.

Модуль Pascal должен быть создан на основе файла библиотеки типов.

  • Выберите пункт меню Project|Import Type Library
  • Нажмите кнопку Add и выберите следующий файл
  • c:\program files\microsoft office\office\msword8.olb
  • Нажмите OK.

К сожалению, данный модуль с проектом явно не компилируется, хотя и включается в него, вероятно из-за того, что приложение считает данный модуль нечто вроде текстового приложения.

Наиболее простой путь заключается в следующем: удалите модуль excel_tlb из проекта и только после этого добавьте его в список используемых модулей.

Документация

Справочный файл c:\program files\microsoft office\office\vbawrd8.hlp содержит информацию о доступных объектах Word.

"Записыватель" макросов позволяет быстро создавать VBA-код. После этого он довольно может легко быть портирован в Delphi.

Пример автоматизации

Следующий пример использует класс-оболочку Delphi, инкапсулирующий прямые вызовы объектов Word. Вот преимущество этого метода:

  • Обеспечение скрытия параметров. Возможность использования для многих методов параметров по умолчанию. Многие методы Word также работают с вариантными параметрами. Это означает невозможность использования констант - скрытие параметров решает данную проблему.
  • Обеспечение проверки типа. Многие методы определены с параметрами OLEVariant, обеспечивая внешнюю совместимость.
  • Следующий класс-оболочка демонстрирует ключевые методы автоматизации Word. Полностью класс приведен в Приложении 1.

 unit doc;
 interface
 uses
 
   windows, sysutils, Word_TLB;
 type
 
   TWinWord = class
   private
     App: _Application;
   public
     constructor Create;
     destructor Destroy; override;
     procedure NewDoc(Template: string);
     procedure GotoBookmark(Bookmark: string);
     procedure InsertText(Text: string);
     procedure SaveAs(Filename: string);
   end;
 
   //------------------------------------------------------------------
 
 implementation
 
 //------------------------------------------------------------------
 
 constructor TWinWord.Create;
 begin
 
   App := CoApplication.Create;
 end;
 
 //------------------------------------------------------------------
 
 destructor TWinWord.Destroy;
 var
   SaveChanges: OLEVariant;
   OriginalFormat: OLEVariant;
   RouteDocument: OLEVariant;
 begin
 
   SaveChanges := wdDoNotSaveChanges;
   OriginalFormat := unAssigned;
   RouteDocument := unAssigned;
   app.Quit(SaveChanges, OriginalFormat, RouteDocument);
   inherited destroy;
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.GotoBookmark(Bookmark: string);
 var
 
   What: OLEVariant;
   Which: OLEVariant;
   Count: OLEVariant;
   Name: OLEVariant;
 begin
 
   What := wdGoToBookmark;
   Which := unAssigned;
   Count := unAssigned;
   Name := Bookmark;
   App.Selection.GoTo_(What, Which, Count, Name);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.InsertText(Text: string);
 begin
 
   App.Selection.TypeText(Text);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.NewDoc(Template: string);
 var
 
   DocTemplate: OleVariant;
   NewTemplate: OleVariant;
 begin
 
   DocTemplate := Template;
   NewTemplate := False;
   App.Documents.Add(DocTemplate, NewTemplate);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.SaveAs(Filename: string);
 begin
 
   OLEVariant(App).ActiveDocument.SaveAs(FileName);
 end;
 
 //------------------------------------------------------------------
 
 end.
 

Чтобы создать класс:

Добавьте модуль библиотеки типов в список используемых модулей.


 uses
   windows, sysutils, Word_TLB;
 

Создадим определение класса:


 TWinWord = class
 
 Private
 App : _Application;
 public
 procedure NewDoc(Template : String);
 procedure GotoBookmark(Bookmark : String);
 procedure InsertText(Text : String);
 procedure SaveAs(Filename : string);
 constructor Create;
 destructor Destroy; override;
 end;
 

Переменная App является ссылкой на приложение Word. Это допускает вызов методов Word с применением технологии раннего связывания.

Опубликованные (public) процедуры - процедуры, которые могут быть использованы при работе с классом.

Создадим конструктор.


 constructor TWinWord.Create;
 begin
   App := CoApplication.Create;
 end;
 

Он вызывается при создании класса TWinWord. CoApplication.create создает новый экземпляр Word и возвращает ссылку на интерфейс Application. Это позволяет вызывать методы объекта app.

Реализация дектруктора


 destructor TWinWord.Destroy;
 var
 
 SaveChanges : OLEVariant;
 OriginalFormat : OLEVariant;
 RouteDocument : OLEVariant;
 begin
 
 SaveChanges := wdDoNotSaveChanges;
 OriginalFormat := unAssigned;
 RouteDocument := unAssigned;
 app.Quit(SaveChanges, OriginalFormat, RouteDocument);
 inherited destroy;
 end;
 

Деструктор должен вызываться В ОБЯЗАТЕЛЬНОМ ПОРЯДКЕ. Метод Quit объекта приложения закрывает Word и распределяет всю связанную с ним память. Так как параметры метода Quit определены как вариантный тип OLEVariant, вся свазанная с ними память распределяется именно для этого типа переменных.

Реализуем метод NewDoc. Этот метод создаст новый текстовый документ на основе заданного шаблона.


 procedure TWinWord.NewDoc(Template : String);
 var
 
 DocTemplate : OleVariant;
 NewTemplate : OleVariant;
 begin
 
 DocTemplate := Template;
 NewTemplate := False;
 App.Documents.Add(DocTemplate, NewTemplate);
 end;
 

Данный метод осуществляет более строгую проверку типов, чем это осуществляет сам Word. Параметр Template должен содержать строку с именем шаблона. Метод Word Add в качестве параметров может содержать значения любого типа. Лучшая пример этого - метод MoveRight, реализация которого показана в Приложении 1.

Ниже показана реализация метода SaveAs. Данный метод позволит сохранить в файле текущий документ.


 procedure TWinWord.SaveAs(Filename : string);
 begin
   OLEVariant(App).ActiveDocument.SaveAs(FileName);
 end;
 

проверяются только во время прогона. Изменение имени метода в этом случае не вызовет ошибку во время компиляции. В нашем случае технология позднего связывания более эффективна, так как метод SaveAs требует 12 параметров, но только параметр FileName является обязательным. Так как данный вызов можно считать единичным, его выполнение не может особо сказаться на скорости выполнения программы.

Следующий код демонстрирует использование данного класса для создания, редактирования, печати и сохранения документа, созданного на основе шаблона:


 Word := TWinWord.create;
 try
 
 Word.visible := true;
 Word.NewDoc('c:\delphi\word\sample\Demo');
 Word.GotoBookmark('From');
 Word.InsertText('Иван Иваныч');
 Word.GotoBookmark('Dept');
 Word.InsertText('Разработка');
 Word.GotoBookmark('Phone');
 Word.InsertText('111111');
 Word.GotoBookmark('Now');
 Word.InsertText(FormatDateTime('d-mmm-yyyy', now));
 //SF элементы
 Word.GotoBookmark('Items');
 Word.InsertText('112021');
 Word.MoveRight(1);
 Word.InsertText('PVCS');
 Word.MoveRight(1);
 Word.InsertText('1');
 Word.MoveRight(1);
 Word.InsertText('£ 305.99');
 Word.MoveRight(1);
 Word.InsertText('£ 305.99');
 Word.MoveRight(1);
 Word.UpdateFields;
 Word.RunMacro('Demo');
 Word.Print;
 Word.SaveAs(filename);
 finally
 
 Word.Free;
 end;
 

Итог

  • Всегда используйте раннее связывание.
  • Если позднее связывание необходимо для вызовов некоторых функций, используйте где возможно раннее связывание и преобразование типа объектной переменной к типу OLEVariant для вызовов, требующим позднее связывание.
  • Не включайте модуль библиотеки типов в ваш проект. Добавьте его только в список используемых модулей.
  • Создавайте код автоматизации в отдельном модуле. Инкапсулируйте вызовы в классе-оболочке.
  • Используйте "записыватель" макросов Word для создания прототипа кода автоматизации.
  • Используйте файл электронной справки vbawrd8.hlp для получения информации об объектах Word.
  • Используйте модуль Word_tlb.pas для проверки необходимых Delphi типов и количества параметров. Для проверки правильности кода перекомпилируйте проект, нажав клавиши <CTRL><F9>.
  • Загружайте и используйте шаблоны Word, содержащие предварительное форматирование текста. Этот способ существенно быстрее и не требует большого времени для создания сложноформатированных документов. Шаблоны ДОЛЖНЫ сохраняться приложением в своей рабочей директории. Это поможет избежать проблем, связанных с конфликтом имен.
  • Используйте закладки (Bookmarks) для определения области ввода текста приложением Delphi.
  • Удостоверьтесь в том, что ваш код содержит команду закрытия приложения Word (app.quit). Не вызывая app.quit, можно быстро исчерпать системные ресурсы, особенно при работе с большим количеством документов Word. Обратите на это особое внимание.
  • Наличие множества незакрытых документов Word легко проверить в Windows NT, используя Менеджер Задач (нажмите CTL+ALT+Del для его открытия).

Приложение A – Полный исходный код сласса TWinWord

Полный исходный код класса tWinWord приведен ниже. Он включает реализацию всех методов:


 unit doc;
 interface
 uses
 
   Word_TLB, windows, sysutils;
 type
   TWinWord = class
 
   private
     App: _Application;
     function fGetVisible: boolean;
     procedure fSetVisible(visible: boolean);
   public
     procedure NewDoc(Template: string);
     procedure GotoBookmark(Bookmark: string);
     procedure InsertText(Text: string);
     procedure MoveRight(Count: integer);
     procedure Print;
     procedure UpdateFields;
     procedure SaveAs(Filename: string);
     procedure RunMacro(MacroName: string);
     constructor Create;
     destructor Destroy; override;
     property visible: boolean
       read fGetVisible
       write fSetVisible;
   end;
 
 implementation
 
 //------------------------------------------------------------------
 
 constructor TWinWord.Create;
 begin
 
   App := CoApplication.Create;
 end;
 
 //------------------------------------------------------------------
 
 destructor TWinWord.Destroy;
 var
   SaveChanges: OLEVariant;
   OriginalFormat: OLEVariant;
   RouteDocument: OLEVariant;
 begin
 
   SaveChanges := wdDoNotSaveChanges;
   OriginalFormat := unAssigned;
   RouteDocument := unAssigned;
   app.Quit(SaveChanges, OriginalFormat, RouteDocument);
   inherited destroy;
 end;
 
 //------------------------------------------------------------------
 
 function TWinWord.fGetVisible: boolean;
 begin
 
   result := App.Visible;
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.fSetVisible(Visible: boolean);
 begin
 
   App.visible := Visible;
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.GotoBookmark(Bookmark: string);
 var
 
   What: OLEVariant;
   Which: OLEVariant;
   Count: OLEVariant;
   Name: OLEVariant;
 begin
 
   What := wdGoToBookmark;
   Which := unAssigned;
   Count := unAssigned;
   Name := Bookmark;
   App.Selection.GoTo_(What, Which, Count, Name);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.InsertText(Text: string);
 begin
 
   App.Selection.TypeText(Text);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.NewDoc(Template: string);
 var
 
   DocTemplate: OleVariant;
   NewTemplate: OleVariant;
 begin
 
   DocTemplate := Template;
   NewTemplate := False;
   App.Documents.Add(DocTemplate, NewTemplate);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.MoveRight(Count: integer);
 var
 
   MoveUnit: OleVariant;
   vCount: OleVariant;
   Extended: OleVariant;
 begin
 
   MoveUnit := wdCell;
   vCount := Count;
   Extended := unassigned;
   app.selection.MoveRight(MoveUnit, vCount, Extended);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.Print;
 begin
 
   OLEVariant(app).Printout;
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.UpdateFields;
 begin
 
   App.ActiveDocument.Fields.Update;
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.SaveAs(Filename: string);
 begin
 
   OLEVariant(App).ActiveDocument.SaveAs(FileName);
 end;
 
 //------------------------------------------------------------------
 
 procedure TWinWord.RunMacro(MacroName: string);
 begin
 
   App.Run(MacroName);
 end;
 
 //------------------------------------------------------------------
 
 end.
 
 




Как научить приложение Delphi разговаривать

Автор: Alec Bergamini

11-го августа 2001 Microsoft объявила о выпуске SAPI 5.1 SDK. Данный продукт можно использовать в любом языке, который поддерживает OLE автоматизацию.

В данной статье я постараюсь раасказать, как установить SAPI 5.1 SDK. Затем мы посмотрим, как использовать SDK в приложении Delphi для преобразования текста в синтезированную речь. Синтезированная речь будет проигрываться через спикер. Всё это тестировалось в Delphi 5 и 6.

Чтобы скачать SAPI 5.1, необходимо зайти на сайт Microsoft’s Speech.net Technologies по адресу http://www.microsoft.com/speech/ и кликнуть по ссылке download. Далее будет предложено прочитать комментарии к данному продукту. Если в Вашей системе, язык по умолчанию отличается от US English, то настоятельно рекомендую прочитать эти комментарии до конца.

Если Вы используете beta версию операционной системы XP, то у Вас могут возникнуть некоторые проблемы. Проблемы связаны с тем, что большинство beta версий XP включают в себя ранние версии SAPI 5.1. Поэтому не пытайтесь инсталировать release версию SAPI 5.1 на XP, она не будет работать.

После того как Вы прочитаете комментарии, то приступайте к скачиванию Speech SDK 5.1. Всё что для этого потребуется, это нажать на ссылку Speech SDK 5.1 (68 MB). В архиве содержится сам SDK, докумантация, а так же текты на английском для примера.

Итак, после скачивания SAPI 5.1 SDK, запустите speechsdk51.exe для установки его на Ваш компьютер.

Теперь надо дать знать Delphi о новых объектах автоматизации SAPI. Для этого запустите Delphi 5 или 6 (Я не пробовал боле ранние версии) и откройте Project | Import Type Library. В диалоге Import Type Library выберите “Microsoft Speech Object Library (Version 5.1)”. Если Вы не нашли его в списке, значит во время инсталяции SAPI 5.1 произошли какие-то ошибки.

Delphi предложит поместить компоненты SAPI на станицу ActiveX. Я рекомендую разместить их в новой странице под названием “SAPI 5”, так как количество компонент довольно большое (19). Так же рекомендую Вам выбрать “Unit dir name” отличающуюся от той, которая предлагается по умолчанию. Убедитесь, что на “Generate Component Wrapper” стоит галочка и нажмите кнопку "Install"

В диалоге Install выберите закладку “Into new package” и в поле “File name:” введите имя пакета наподобие “SAPI5.dpk”, нажмите кнопку "Обзор..." (browse) и убедитесь, что dpk создан в той же директории, в которой были созданы компоненты. В диалоге Install в поле Description задайте какое-нибудь описание, например “SAPI 5 automation components”. Нажмите OK

В подтверждающем диалоге нажмите yes. После этого новые компоненты будут установлены.

Теперь, если Вы посмотрите в директорию, которую указали для установки компонент, то обнаружите там файл SpeechLib_TLB.pas (и dcr) который содержит весь код компоненты (интерфайс, константы, типы, а так же другую полезную информацию). Эта директория так же содержит (если Вы следовали вышеприведённым инструкциям) SAPI5.dpk который является исходинком пакета.

А теперь самая интересная часть.

Давайте создадим приложение, которое будет синтезировать речь. В Delphi создайте новое приложение и поместите на форму кнопку. На странице компонент SAPI5 найдите SpVoice и перетащите его на форму.

Теперь создайте событие onClick для Вашей кнопки, которое должно выглядеть примерно так:


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   SpVoice1.Speak('Hello world!', SVSFDefault);
 end;
 

Запустите программу и нажмите кнопку. Здорово?

Метод Speak объекта SPVoice предоставляет довольно большие возможности. Эти возможности можно использовать если поиграться со вторым параметром. В вышеприведённом примере я использовал режим поумолчанию, который позволяет функции вернуть управление только после завершения проигрывания звука. Избежать этого можно путём внедрения в текст специальных тэгов XML.

Документация по SDK содержит файл sapi.chm который можно найти в директории \Program Files\Microsoft Speech SDK 5.1\Docs\Help .

Sapi.chm содержит довольно много информации. Вот основные, часто используемые возможности компоненты и, соответствующие им флаги, которые передаются во втором параметре:

  • Воспроизведение текста находящегося в файле. (SVSFIsFilename)
  • Асинхронный решим проигрывания звука. Позволяет функции вернуть управление немедленно, во время воспроизведения. (SVSFlagsAsync)
  • Позволяет управлять воспроизведением через XML тэги (см. раздел под название “XML TTS Tutorial”). Тэги позволяют настроить тональность звучания, скорость воспроизведения и многое другое.( SVSFIsXML)

Одна из интересных вещей (не документирована) заключается в том, что можно озвучивать заголовок веб страницы путём установки флага в SVSFIsFilenam а имени файла в URL. Если Вы соединены с интернетом, попробуйте запустить следующую строчку:


 SpVoice1.Speak('http://www.o2a.com', SVSFIsFilename);
 

Так же при помощи этого флага можно проигрывать wav файлы:


 SpVoice1.Speak('C:\WINNT\MEDIA\Windows Logon Sound.wav', SVSFIsFilename);
 

На самом деле у этой SAPI намного больше возможностей, чем я здесь привёл. В следующий раз, мы подробнее рассмотрим другие возможности.




Массив в Delphi

Раздел 1:

Вот несколько функций для операций с двухмерными массивами. Самый простой путь для создания собственной библиотеки. Процедуры SetV и GetV позволяют читать и сохранять элементы массива VArray (его Вы можете объявить как угодно). Например:


 type
 
   VArray: array[1..1] of double;
 var
 
   X: ^VArray;
   NR, NC: Longint;
 
 begin
 
   NR := 10000;
   NC := 100;
   if AllocArray(pointer(X), N * Sizeof(VArray)) then
     exit;
   SetV(X^, NC, 2000, 5, 3.27); { X[2000,5] := 3.27 }
 end;
 
 function AllocArray(var V: pointer; const N: longint): Boolean;
 begin {распределяем память для массива V размера N}
 
   try
     GetMem(V, N);
   except
     ShowMessage('ОШИБКА выделения памяти. Размер:' + IntToStr(N));
     Result := True;
     exit;
   end;
   FillChar(V^, N, 0); {в случае включения длинных строк заполняем их нулями}
   Result := False;
 end;
 
 procedure SetV(var X: Varray; const N, ir, ic: LongInt; const value:
   double);
 begin {заполняем элементами двухмерный массив X размером ? x N : X[ir,ic] := value}
 
   X[N * (ir - 1) + ic] := value;
 end;
 
 function GetV(const X: Varray; const N, ir, ic: Longint): double;
 begin {возвращаем величины X[ir,ic] для двухмерного массива шириной N столбцов}
 
   Result := X[N * (ir - 1) + ic];
 end;
 

Раздел 2:

Самый простой путь - создать массив динамически


 Myarray := GetMem(rows * cols * sizeof(byte,word,single,double и пр.)
 

сделайте функцию fetch_num типа


 function fetch_num(r,c:integer) : single;
 


 result := pointer + row + col*rows
 

и затем вместо myarray[2,3] напишите


 myarray.fetch_num(2,3);
 

поместите эти функции в ваш объект и работа с массивами станет пустячным делом. Я экспериментировал с многомерными (вплоть до 8) динамическими сложными массивами и эти функции показали отличный результат.

Раздел 3

Вот способ создания одно- и двухмерных динамических массивов:


 (*
 --
 -- модуль для создания двух очень простых классов обработки динамических массивов
 --     TDynaArray   :  одномерный массив
 --     TDynaMatrix  :  двумерный динамический массив
 --
 *)
 
 unit DynArray;
 
 interface
 
 uses
 
   SysUtils;
 
 type
 
   TDynArrayBaseType = double;
 
 const
 
   vMaxElements = (High(Cardinal) - $F) div sizeof(TDynArrayBaseType);
   {= гарантирует максимально возможный массив =}
 
 type
 
   TDynArrayNDX = 1..vMaxElements;
   TArrayElements = array[TDynArrayNDX] of TDynArrayBaseType;
   {= самый большой массив TDynArrayBaseType, который мы может объявить =}
   PArrayElements = ^TArrayElements;
   {= указатель на массив =}
 
   EDynArrayRangeError = class(ERangeError);
 
   TDynArray = class
   private
     fDimension: TDynArrayNDX;
     fMemAllocated: word;
     function GetElement(N: TDynArrayNDX): TDynArrayBaseType;
     procedure SetElement(N: TDynArrayNDX; const NewValue: TDynArrayBaseType);
   protected
     Elements: PArrayElements;
   public
     constructor Create(NumElements: TDynArrayNDX);
     destructor Destroy; override;
     procedure Resize(NewDimension: TDynArrayNDX); virtual;
     property dimension: TDynArrayNDX
       read fDimension;
     property Element[N: TDynArrayNDX]: TDynArrayBaseType
     read GetElement
       write SetElement;
     default;
   end;
 
 const
 
   vMaxMatrixColumns = 65520 div sizeof(TDynArray);
   {= построение матрицы класса с использованием массива объектов TDynArray =}
 
 type
 
   TMatrixNDX = 1..vMaxMatrixColumns;
   TMatrixElements = array[TMatrixNDX] of TDynArray;
   {= каждая колонка матрицы будет динамическим массивом =}
   PMatrixElements = ^TMatrixElements;
   {= указатель на массив указателей... =}
 
   TDynaMatrix = class
   private
     fRows: TDynArrayNDX;
     fColumns: TMatrixNDX;
     fMemAllocated: longint;
     function GetElement(row: TDynArrayNDX;
       column: TMatrixNDX): TDynArrayBaseType;
     procedure SetElement(row: TDynArrayNDX;
       column: TMatrixNDX;
       const NewValue: TDynArrayBaseType);
   protected
     mtxElements: PMatrixElements;
   public
     constructor Create(NumRows: TDynArrayNDX; NumColumns: TMatrixNDX);
     destructor Destroy; override;
     property rows: TDynArrayNDX
       read fRows;
     property columns: TMatrixNDX
       read fColumns;
     property Element[row: TDynArrayNDX; column: TMatrixNDX]: TDynArrayBaseType
     read GetElement
       write SetElement;
     default;
   end;
 
 implementation
 
 (*
 
 --
 --  методы TDynArray
 --
 *)
 
 constructor TDynArray.Create(NumElements: TDynArrayNDX);
 
 begin {==TDynArray.Create==}
   inherited Create;
   fDimension := NumElements;
   GetMem(Elements, fDimension * sizeof(TDynArrayBaseType));
   fMemAllocated := fDimension * sizeof(TDynArrayBaseType);
   FillChar(Elements^, fMemAllocated, 0);
 end; {==TDynArray.Create==}
 
 destructor TDynArray.Destroy;
 
 begin {==TDynArray.Destroy==}
   FreeMem(Elements, fMemAllocated);
   inherited Destroy;
 end; {==TDynArray.Destroy==}
 
 procedure TDynArray.Resize(NewDimension: TDynArrayNDX);
 
 begin {TDynArray.Resize==}
   if (NewDimension < 1) then
     raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d',
       [NewDimension]);
   Elements := ReAllocMem(Elements, fMemAllocated, NewDimension *
     sizeof(TDynArrayBaseType));
   fDimension := NewDimension;
   fMemAllocated := fDimension * sizeof(TDynArrayBaseType);
 end; {TDynArray.Resize==}
 
 function TDynArray.GetElement(N: TDynArrayNDX): TDynArrayBaseType;
 
 begin {==TDynArray.GetElement==}
   if (N < 1) or (N > fDimension) then
     raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d',
       [N]);
   result := Elements^[N];
 end; {==TDynArray.GetElement==}
 
 procedure TDynArray.SetElement(N: TDynArrayNDX; const NewValue:
   TDynArrayBaseType);
 
 begin {==TDynArray.SetElement==}
   if (N < 1) or (N > fDimension) then
     raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d',
       [N]);
   Elements^[N] := NewValue;
 end; {==TDynArray.SetElement==}
 
 (*
 
 --
 --  методы TDynaMatrix
 --
 *)
 
 constructor TDynaMatrix.Create(NumRows: TDynArrayNDX; NumColumns: TMatrixNDX);
 
 var
   col: TMatrixNDX;
 begin {==TDynaMatrix.Create==}
   inherited Create;
   fRows := NumRows;
   fColumns := NumColumns;
   {= выделение памяти для массива указателей (т.е. для массива TDynArrays) =}
   GetMem(mtxElements, fColumns * sizeof(TDynArray));
   fMemAllocated := fColumns * sizeof(TDynArray);
   {= теперь выделяем память для каждого столбца матрицы =}
   for col := 1 to fColumns do
   begin
     mtxElements^[col] := TDynArray.Create(fRows);
     inc(fMemAllocated, mtxElements^[col].fMemAllocated);
   end;
 end; {==TDynaMatrix.Create==}
 
 destructor TDynaMatrix.Destroy;
 
 var
   col: TMatrixNDX;
 begin {==TDynaMatrix.Destroy;==}
   for col := fColumns downto 1 do
   begin
     dec(fMemAllocated, mtxElements^[col].fMemAllocated);
     mtxElements^[col].Free;
   end;
   FreeMem(mtxElements, fMemAllocated);
   inherited Destroy;
 end; {==TDynaMatrix.Destroy;==}
 
 function TDynaMatrix.GetElement(row: TDynArrayNDX;
 
   column: TMatrixNDX): TDynArrayBaseType;
 begin {==TDynaMatrix.GetElement==}
   if (row < 1) or (row > fRows) then
     raise
       EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);
   if (column < 1) or (column > fColumns) then
     raise
       EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);
   result := mtxElements^[column].Elements^[row];
 end; {==TDynaMatrix.GetElement==}
 
 procedure TDynaMatrix.SetElement(row: TDynArrayNDX;
 
   column: TMatrixNDX;
   const NewValue: TDynArrayBaseType);
 begin {==TDynaMatrix.SetElement==}
   if (row < 1) or (row > fRows) then
     raise
       EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);
   if (column < 1) or (column > fColumns) then
     raise
       EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);
   mtxElements^[column].Elements^[row] := NewValue;
 end; {==TDynaMatrix.SetElement==}
 
 end.
 

Тестовая программа для модуля DynArray


 uses DynArray, WinCRT;
 
 const
   NumRows: integer = 7;
   NumCols: integer = 5;
 
 var
   M: TDynaMatrix;
   row, col: integer;
 begin
   M := TDynaMatrix.Create(NumRows, NumCols);
   for row := 1 to M.Rows do
     for col := 1 to M.Columns do
       M[row, col] := row + col / 10;
   writeln('Матрица');
   for row := 1 to M.Rows do
   begin
     for col := 1 to M.Columns do
       write(M[row, col]: 5: 1);
     writeln;
   end;
   writeln;
   writeln('Перемещение');
   for col := 1 to M.Columns do
   begin
     for row := 1 to M.Rows do
       write(M[row, col]: 5: 1);
     writeln;
   end;
   M.Free;
 end.
 




Как сделать окошко подсказки в редакторе как Delphi по CTRL-J

Автор: Hog

Допустим у тебя TMemo..

1. Делаешь ListBox, заполняешь, visible := false, parent := Memo
2. У Memo в обработчике Memo.onKeyDown что-нибудь типа:


 if (key = Ord('J')) and (ssCtrl in Shift) then
 begin
   lb.Left := Memo.CaretPos.x;
   lb.Top := Memo.CaretPos.y + lb.height;
   lb.Visible := True;
   lb.SetFocus;
 end;
 

он показывается.. а дальше работай с листбоксом, вставляй в мемо нужный текст, пряч листбокс




Простой шаблон для Delphi DLL

Пример DLL

Без модулей

Во-первых, "скелет" DLL, которую вы хотели, сохраняете как DLLFRAME.DPR:


 {---------------------DLLFRAME.DPR--------------------------}
 library Dllframe;
 
 uses WinTypes;
 
 function  GetString : string ; export ;
 begin
 
 Result := 'Привет из DLL!' ;
 end;
 
 exports
 
 GetString;
 
 begin
 end.
 {-----------------------------------------------------------}
 

Теперь напишем вызывающую программу и сохраним ее как DLLCALL.DPR:


 {---------------------DLLCALL.DPR---------------------------}
 program Dllcall;
 
 uses
 
 Dialogs;
 
 {$R *.RES}
 
 function GetString : string ; far ; external 'DLLFRAME' ;
 
 begin
 
 MessageDlg( GetString, mtInformation, [ mbOK ], 0 ) ;
 end.
 {-----------------------------------------------------------}
 

С модулями

Код вызывающей программы, сохраните ее как DLLCALL.DPR:


 {---------------------DLLCALL.DPR---------------------------}
 program Dllcall;
 
 uses
 
 Dialogs;
 
 {$R *.RES}
 
 function GetString : string ; far ; external 'MyDLL' ;
 begin
 MessageDlg( GetString, mtInformation, [ mbOK ], 0 ) ;
 end.
 {-----------------------------------------------------------}
 

"скелет" DLL, которую вы хотели, сохраняете как DLLFRAME.DPR:


 {---------------------DLLFRAME.DPR--------------------------}
 library Dllframe;
 
 uses DLLUnit;
 
 exports
 
 GetString;
 
 begin
 end.
 {-----------------------------------------------------------}
 

Модуль, который мы сохраняем как dllunit.pas:


 {---------------------dllunit.pas--------------------------}
 
 unit DLLUnit;
 interface
 
 uses WinTypes;
 
 function GetString: string; export;
 
 implementation
 
 function GetString: string;
 begin
 
 GetString := 'Привет из DLL!' ;
 end ;
 
 begin
 end.
 {-----------------------------------------------------------}
 




Исключения в Delphi

Семь бед - один Reset

100-149 - ошибки ввода/вывода (I/O), 200-255 - фатальные ошибки согласно файлам помощи Delphi.

В Windows.pas всем кодам ошибок внешних исключительных ситуаций присвоены имена. Поищите, например


 STATUS_BREAKPOINT
 

чтобы найти декларации констант ошибок.

Ошибки времени выполнения, расположенные в таблице с номерами ниже 100 (и несколько ошибок с номерами больше 100, но они незначительны) - ошибки DOS.

По этой таблице можно сразу определить причину возникновения ошибки, если ваш exe-файл не подружился с операционной системой.

Код и описание ошибок, возникающий в среде DOS
Код (Hex)
Код (Dec)
Описание
00h 0 нет ошибки
01h 1 неверный номер функции
02h 2 файл не найден
03h 3 путь не найден
04h 4 cлишком много открытых файлов (нет свободных дескрипторов)
05h 5 доступ запрещен
06h 6 неверный дескриптор
07h 7 управляющий блок памяти разрушен
08h 8 недостаточно памяти
09h 9 неверный адрес блока памяти
0Ah 10 неверное окружение (обычно при длине > 32К)
0Bh 11 неверный формат
0Ch 12 неверный код доступа
0Dh 13 неверные данные
0Eh 14 зарезервировано
0Fh 15 неверное устройство (drive)
10h 16 попытка удаления текущей директории
11h 17 не то же устройство
12h 18 нет больше файлов
--- DOS 3.0+ ---
13h 19 диск имеет защиту от записи
14h 20 неизвестное устройство
15h 21 устройство не готово
16h 22 неизвестная команда
17h 23 ошибка данных (CRC)
18h 24 неправильный запрос длины структуры
19h 25 ошибка поиска
1Ah 26 неизвестный тип носителя (не-DOS диск)
1Bh 27 сектор не найден
1Ch 28 принтер без бумаги
1Dh 29 ошибка записи
1Eh 30 ошибка чтения
1Fh 31 общая ошибка (general failure)
20h 32 нарушение доступа (sharing violation)
21h 33 нарушение доступа (lock violation)
22h 34 ошибка смены диска (ES:DI -> media ID диска) (смотри #0981)
23h 35 FCB недоступно
24h 36 переполнение буфера общего доступа (sharing buffer)
25h 37 (DOS 4.0+) несовпадение кодовой страницы
26h 38 (DOS 4.0+) невозможно завершить действие с файлом (чтение или запись)
27h 39 (DOS 4.0+) недостаточно места на диске
28h-31h   зарезервировано
32h 50 сетевой запрос не поддерживается
33h 51 удаленный компьютер не откликается
34h 52 дублирование сетевого имени
35h 53 сетевое имя не найдено
36h 54 сеть занята
37h 55 сетевое устройство больше не существует
38h 56 превышен лимит команд сетевого BIOS
39h 57 аппаратная ошибка сетевого адаптера
3Ah 58 из сети получен неверный ответ
3Bh 59 неожиданная сетевая ошибка
3Ch 60 несовместимый сетевой адаптер
3Dh 61 полная очередь печати
3Eh 62 очередь не полная
3Fh 63 нет свободного места для печати файла
40h 64 сетевое имя было удалено
41h 65 сеть: в доступе отказано
42h 66 неверный тип сетевого устройства
43h 67 сетевое имя не найдено
44h 68 превышен лимит сетевого имени
45h 69 превышен лимит сеансов сетевого BIOS
46h 70 временная пауза
47h 71 сетевой запрос не принят
48h 72 сетевая печать/дисковая переадресация приостановлена
49h 73 программная поддержка сети не установлена
(LANtastic) неверная сетевая версия
4Ah 74 неожиданный отказ сетевого адаптера
(LANtastic) истек бюджет пользователя (account)
4Bh 75 (LANtastic) истек пароль
4Сh 76 (LANtastic) на этот раз неудачная попытка входа в сеть
4Dh 77 (LANtastic v3+) не хватает дискового пространства на сетевом узле
4Eh 78 (LANtastic v3+) нет регистрации на сетевом узле
4Fh 79 зарезервировано
50h 80 файл существует
51h 81 зарезервировано
52h 82 невозможно создать каталог
53h 83 ошибка на INT 24h
54h 84 (DOS 3.3+) слишком много переадресаций
55h 85 (DOS 3.3+) двойная переадресация
56h 86 (DOS 3.3+) неверный пароль
57h 87 (DOS 3.3+) неверный параметр
58h 88 (DOS 3.3+) ошибка сетевой записи
59h 89 (DOS 4.0+) функция в сети не поддерживается
5Ah 90 (DOS 4.0+) не установлен необходимый системный компонент
64h 100 (MSCDEX) неизвестная ошибка
65h 101 (MSCDEX) нет готовности
66h 102 (MSCDEX) нехватка EMS памяти
67h 103 (MSCDEX) не High Sierra или ISO-9660 формат
68h 104 (MSCDEX) открыт лоток
B0h 176 (MS-DOS 7.0) носитель не блокирован
B1h 177 (MS-DOS 7.0) носитель блокирован
B2h 178 (MS-DOS 7.0) не сменный носитель
B4h 180 (MS-DOS 7.0) переполнение счетчика блокировок
B5h 181 (MS-DOS 7.0) неудача запроса на извлечение носителя




Фреймы в Delphi

Разведение программистов, к сожалению, связано с большими первоначальными затратами. Вам понадобятся:
- персональный компьютер с процессором не ниже Реntium II;
- стол и стул;
- пепельница;
- большое количество сарделек и пиво для прикармливания;
- кофейная чашечка вместимостью 0,5 л.

'Frames' - на мой взгляд чрезвычайно полезная компонента. Если откинуть условности, то это форма в форме. Грубо говоря, можно наделать таких форм и менять, например, функциональность и вид Вашей программы в зависимости от определенных условий(Это не то-же, что менять кожу - не перепутайте.).

И раз уж я назвал его формой, то отсюда и начальный шаг по его созданию должен быть как у формы, а не как у компоненты. Точнее даже два в одном.

Вообщем так. Через меню 'File/New/Frame' создаем фрейм - появляется до боли знакомое окно форы, с разве что немного другими свойствами. Далее можно делать на нем все, что угодно. Однако, не забываем, что пока создан всего сам фрейм и он у нас ни к чему не привязан. И тут нужен второй шаг - теперь берем компоненту и ложем ее на форму Вашего основного проекта. Сразу появляется окно выбора фрейма- 'Select frame to insert'. Причем, если Вы наделали, несколько фреймов, то, соответственно, Вам их все и предложат.

Итак, из всего вышесказанного можно подчеркнуть лишь одно - прежде чем пользоваться компонентой Frame нужно создать сам фрейм.

Пошли дальше. Самый простой способ осуществить подмены фреймов(для изменения функций программы) это делать Visible тому фрейму который сейчас нужен. Вообще, конечно спорный вопрос - стоит ли наращивать размер программы для таких целей, но.... задачи бывают разные.

Еще одна полезность этой компонеты в том, что она позволяет организовать скролл(как вертикальный, так и горизонтальный) для целого набора инструментов. Т.е. если Вам необходимо разместить на форме очень много всего, а места не хватает, то фрейм - идеальное решение. Примером может служить настройка сортировщика писем в известной почтовой программе 'TheBat'.




Delphi и графика

Если вам нужно просто вывести одно изображение, создайте объект TBitmap, "поиграйтесь" с ним, а когда изображение будет готово появиться на экране, вызовите функцию Image.Canvas.Draw(0, 0, Bitmap), которая скопирует и нарисует его на экране. Как вы наверное заметили, основное время занимает рисование картинки на экране, а не установка ее атрибутов. В результате мы устанавливаем цвета на невидимом объекте (TBitmap мы уже создали), и отображаем только полностью готовый Bitmap. Вот демонстрационный код для формы с единственным на ней компонентом Image:


 procedure TForm1.FormPaint(Sender: TObject);
 var
   TmpX, TmpY: Byte;
   MyImage: TBitmap;
 begin
   Form1.Width := 260;
   Form1.Height := 260;
   Image1.Width := 250;
   Image1.Height := 250;
   Image1.top := 5;
   Image1.width := 5;
   MyImage := TBitmap.Create;
   MyImage.Width := 250;
   MyImage.Height := 250;
   for TmpX := 0 to 249 do
     for TmpY := 0 to 249 do
       MyImage.Canvas.Pixels[TmpX, TmpY] :=
         RGB(TmpX, 250 - TmpY, (TmpX + TmpY div 2));
   Image1.Canvas.Draw(0, 0, MyImage);
   MyImage.Free;
 end;
 

Если вы хотите сделать действительно быструю графику, взгляните на функции GDI (API) и/или функции WinG, которые для вас разработали программисты Microsoft. Трактовка их для данной статьи немного скучна, да и не имеет никакого отношения к Delphi.




Добавление функций проверки орфографии в разрабатываемые приложения


Майкрософт Ворд не понимает слово "стрипризерша", то есть подчеркивает красным, а когда кликаешь на него мышкой, то в возможных исправлениях он выдает "стриптиз ерша".

Предположим, что в вашу задачу, как разработчика программного обеспечения, входит создание некоторого специализированного текстового процессора. Не вдаваясь в рассуждения о необходимости создания еще одного приложения подобного рода, мы просто рассмотрим один прием, который придаст вашей разработке весьма ощутимое преимущество по сравнению с аналогами. К примеру, вам необходимо создать некий HTML-редактор. Как и в случае с любым другим приложением такого типа, ваша программа должна будет обладать функциями орфографической проверки текста. Естественно, можно потратить много времени на создание своего собственного шедевра в данной области, но почему бы нам не воспользоваться уже готовыми решениями? В рамках данной статьи я бы хотел поговорить о технологии использования в ваших приложениях механизмов проверки орфографии, входящих в состав всем известного приложения - Microsoft Word с использованием автоматизации (OLE Automation).

OLE Automation

Идея, заложенная в автоматизацию, включает разработку приложений, функциональность которых может быть доступна и другим программам, а также создание приложений, которые "знают", как использовать функциональность, предоставляемую вам другими программными продуктами. Если говорить техническим языком, приложение, которое предоставляет некоторую повторно используемую функциональность, называется сервером автоматизации (automation server) (также часто называемым сервером COM). Приложение же, использующее функциональность, предоставляемую сервером автоматизации, называется клиентом автоматизации (automation client), также часто называемым контроллером автоматизации. Важно подчеркнуть, что сервер автоматизации может не быть "чистым" сервером автоматизации, так же как и клиент автоматизации может не быть "чистым" клиентом автоматизации. В действительности сервер автоматизации может использовать сервисы другого приложения, которое также является сервером автоматизации. Клиент автоматизации, предоставляющий свои сервисы другому клиенту, также может являться как клиентом, так и сервером автоматизации. Глубинные механизмы (сетевые и транспортные протоколы), с помощью которых клиент автоматизации взаимодействует с сервером, уже являются частью собственно COM.

Сервер автоматизации - это просто двоичный исполняемый модуль, который может состоять из нескольких объектов автоматизации. Объект автоматизации (также называемый объектом COM, хотя технически объект автоматизации является объектом COM особого сорта) - это отдельный, самодостаточный объект, спроектированный для выполнения специфической задачи или функции. В общем, все объекты автоматизации, собранные в одном сервере, предназначены для осуществления каких-то функциональных возможностей. Например, Microsoft Excel является сервером автоматизации, состоящим из нескольких меньших серверов автоматизации (Workbook - книга, Chart - диаграмма, Worksheet - лист, Range - диапазон и т.д.), каждый из которых определяет часть функций, предоставляемых пользователю Microsoft Excel. Идея заключается в том, что сервер автоматизации "позволяет" своим клиентам получать доступ и использовать свои объекты так же легко и просто, как будто это его внутренние объекты.

Для решения задачи, поставленной перед нами в начале данной статьи, мы можем воспользоваться теми возможностями, которые предоставляет нам сервер автоматизации Microsoft Word. C помощью приложения, разработанного в Borland Delphi (программа будет выступать в качестве клиента автоматизации), мы сможем динамически создать новый документ и поместить в него некоторый текст (который и будем проверять). После этого нам останется лишь с помощью MS Word осуществить эту проверку. Если приложение Word будет минимизировано, то пользователи могут и не почувствовать, что выполнение части функций нашего приложения берет на себя другая программа. Обращаю внимание, что для полноценного использования OLE-автоматизации вам надо будет знать как можно больше о возможностях и интерфейсах того приложения, функциональностью которого вы решили воспользоваться. Кроме того, для корректного выполнения всех функций разрабатываемого приложения необходимо, чтобы на компьютере пользователя было установлено соответствующее приложение. В нашем случае - Microsoft Word.

Основные принципы работы

Существует три основных метода использования OLE-автоматизации в Borland Delphi в зависимости от того, какую версию этой среды разработки вы используете.

Delphi 5. Закладка Servers на палитре компонентов.

Если вы являетесь счастливым обладателем этой версии Delphi, то для работы с Microsoft Word можно воспользоваться компонентами, расположенными на закладке Ser-vers (рис. 1). Такие компоненты, как TWord-Application и TWordDocument, предоставляют все необходимые для работы интерфейсы.

Delphi 3, 4. Раннее связывание.

Используя термины автоматизации, для обеспечения в Delphi доступа к методам и свойствам, предоставляемым MS Word, необходимо установить соответствующую библиотеку типов. Библиотека типов предоставляет информацию обо всех свойствах и методах, которые разработчик может использовать при работе с сервером автоматизации. Для использования библиотеки типов Microsoft Word в Delphi (3 или 4 версии) необходимо произвести следующие несложные действия:

  1. выбрать пункт меню Project|Import Type Library;
  2. в открывшемся диалоге найти файл msword8.olb (для Microsoft Office'2000 этот файл будет иметь название msword9.olb), расположенный в подкаталоге "Office" того каталога, в который был установлен Microsoft Office.

После этого будет создан файл с именем word_TLB.pas, в котором в синтаксисе object pascal будут описаны константы, типы, свойства и методы для доступа к серверу автоматизации Microsoft Word. Файл word_TLB.pas должен быть включен в список uses всех модулей, в которых вы планируете использовать функции Microsoft Word. Такая технология работы с серверами автоматизации называется ранним связыванием. Одним из преимуществ раннего связывания является осуществление контроля вызовов и передаваемых параметров на этапе компиляции.

Delphi 2. Позднее связывание.

Для доступа к объектам MS Word без применения библиотеки типов можно использовать так называемое позднее связывание. В данном случае доступ к Word осуществляется так же, как к переменной типа Variant, следствием чего является необходимость знания вами всех предоставляемых сервером автоматизации интерфейсов. Позднего связывания следует по возможности избегать, поскольку при этом отсутствует возможность контроля корректности вызовов процедур и функций со стороны компилятора, и если вы неправильно написали имя того или иного метода, то узнаете об этом, только, когда программа "вывалится" по ошибке в процессе выполнения.

Начнем!

Итак, вернемся к теме статьи. Для демонстрации принципов работы с MS Word я буду использовать механизмы, предоставляемые пятой версией Delphi (т.е. компоненты TWordApplication, TWordDocument). Ниже я приведу код, обеспечивающий соединение и работу с MS Word в случае использования библиотеки типов и позднего связывания и больше не буду касаться этой темы.

Для доступа к объектам Word при работе в Delphi 3, 4 (запуск приложения и создание нового документа) используйте следующий код:


 uses
   Word_TLB;
 ...
 var
   WordApp: _Application;
   WordDoc: _Document;
   VarFalse: OleVariant;
 begin
   WordApp := CoApplication.Create;
   WordDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);
   {
   код для проверки орфографии, описываемы далее в данной статье
   }
   VarFalse:=False;
   WordApp.Quit(VarFalse, EmptyParam, EmptyParam);
 end;
 

Обращаю внимание, что в методах MS Word множество параметров описаны как необязательные (optional). При использовании интерфейсов (библиотек типов), Delphi не позволит вам опускать те или иные параметры, даже если в контексте разрабатываемого вами кода они не нужны. В четвертой версии Delphi в модуле system.pas описана переменная EmptyParam, которую можно использовать в качестве "заглушки" для неиспользуемых переменных в вызываемом методе.

Для автоматизации MS Word с использованием переменной Variant (позднее связывание) используйте следующий код:


 uses
   ComObj;
 ...
 var
   WordApp, WordDoc: Variant;
 begin
   WordApp := CreateOleObject('Word.Application');
   WordDoc := WordApp.Documents.Add;
   {
   код для проверки орфографии, описываемы далее в данной статье
   }
   WordApp.Quit(False)
 end;
 

При использовании позднего связывания компилятор Delphi позволяет вам опускать те или иные параметры при вызове методов сервера автоматизации.

Как уже упоминалось, Delphi 5 упрощает программисту использование функциональности MS Word в своих приложениях путем предоставления его методов и свойств в виде компонентов. Так как множество параметров, определенных в методах Word'а, описаны как необязательные, то в Delphi данные процедуры и функции переопределены и представляют собой набор из нескольких методов с различным количеством параметров. Таким образом, разработчику предоставляется возможность при вызове метода не указывать последние n параметров, необходимость в которых отсутствует.

Шаг за шагом

Для создания своего редактора с возможностью проверки орфографии в минимальном варианте нам понадобится две формы: одна будет использоваться для редактирования текста, а вторая - для отображения диалога правки найденных ошибок. Однако предлагаю начать с самого начала.

Если у вас не запущен Delphi - запустите его. Создайте новый проект (если он не был создан при открытии приложения). По умолчанию проект будет содержать одну форму. Данная форма будет главной в нашем проекте. Поместите на форму один компонент типа TMemo и две кнопки (TButton). Заполните свойство Lines компонента Memo1 каким-нибудь текстом (содержащим ошибки). Заголовок одной кнопки определите как "Орфография", а второй - "Тезаурус". Затем перейдите на закладку Servers палитры компонентов и поместите на форму по одному компоненту типа TWordApplication и TWordDocument (рис. 2). Установите значения свойства Name первого компонента в Word-App, а второго - WordDoc.

TWordApplication, TWordDocument

При автоматизации MS Word для управления приложением, отображения его рабочего окна, получения доступа к атрибутам и объектной модели MS Word мы используем объект Application. Для того чтобы указать приложению, запускать ли новую копию процесса Word или использовать уже запущенный, применяется свойство Applicati-on.ConnectKind. В нашем случае мы устанавливаем данное свойство в значение ckRunningInstance. Другие возможные значения этого свойства вы сможете узнать, воспользовавшись справочной системой Delphi.

Когда мы открываем в MS Word существующий файл или создаем новый, мы тем самым создаем объект Document. Типичной задачей при использовании автоматизации Word является работа с некоторой областью документа: добавление текста, выделение некоторой области, проверка орфографии и т.д. Объект, определяющий некоторую область в документе, называется Range.

Естественно, в рамках статьи я не смогу подробно рассказать обо всех нюансах работы с компонентами, расположенными на закладке Servers палитры компонентов (кстати, с любой другой закладкой ситуация состоит ничуть не лучше). Для более детального их изучения предлагаю воспользоваться справочной системой Borland Delphi. В нашем же сегодняшнем разговоре я буду упоминать только те свойства и методы, которые будут необходимы.

Как это все будет работать

Алгоритм работы нашего приложения будет достаточно прост. Каждое слово, входящее в состав проверяемого нами текста, будет передаваться в MS Word для проверки. Сервер автоматизации Word содержит метод SpellingErrors, который позволяет вам осуществлять проверку текста, входящего в состав некоторой области Range. Мы же будем каждый раз определять эту область таким образом, чтобы она содержала только переданное нами в Word слово. Метод SpellingErrors в качестве результата своей работы возвращает коллекцию слов, написание которых признано ошибочным. Если эта коллекция пуста, то мы переходим к рассмотрению следующего слова. Иначе - переходим к процедуре замены неправильно напечатанного слова. Путем вызова метода GetSpellingSuggestions можно получить список слов, предлагаемых в качестве замены. Эти слова помещаются в коллекцию SpellingSuggestions. Данную коллекцию мы помещаем в качестве списка (компонент типа TListBox), расположенного во второй форме нашего проекта. Думаю, самое время немного поговорить о ней.

Для того чтобы добавить новую форму в проект, следует выбрать пункт меню File|New Form. Назовем эту форму frSpellCheck. На форму поместим три кнопки типа TBitBtn, два элемента редактирования (TEdit) и один список (TListBox). На форму также следует поместить три метки (см. рис. 3). Компонент edNID (editNotInDictionary) служит для отображения заменяемого слова. edReplaceWith содержит выделенный в данный момент вариант для замены, а список lbSuggestions - список предлагаемых вариантов (заполняемый на основании данных, содержащихся в коллекции SpellingSuggestions). Три кнопки выполняют именно те функции, которым соответствуют их заголовки - не больше и не меньше. Каждой из кнопок соответствует свое значение, возвращаемое функцией frSpellCheck.ModalResult. В зависимости от этого значения в основной обрабатывающей процедуре осуществляется то или иное действие - игнорирование, замена или отмена дальнейшей проверки. Форма frSpellCheck содержит одно общедоступное свойство:


 sReplacedWord :String
 

Оно служит для передачи в основную форму слова для замены в случае нажатия пользователем кнопки "Заменить".

Пишем код!

Ниже приводится код основной процедуры приложения.


 procedure TForm1.btnSpellCheckClick(Sender: TObject);
 var
   colSpellErrors : ProofreadingErrors;
   colSuggestions : SpellingSuggestions;
   i : Integer;
   StopLoop : Boolean;
   itxtLen, itxtStart : Integer;
   varFalse : OleVariant;
 begin
   WordApp.Connect;
   WordDoc.ConnectTo(WordApp.Docum-ents.Add(EmptyParam, EmptyParam));
 
   StopLoop:=False;
   itxtStart:=0;
   Memo.SelStart:=0;
   itxtlen:=0;
   while not StopLoop do
   begin
     itxtStart := itxtLen + itxtStart;
     itxtLen := Pos(' ', Copy(Memo.Text,itxtStart+1,MaxInt));
     if itxtLen = 0 then
       StopLoop := True;
     Memo.SelStart := itxtStart;
     Memo.SelLength := -1 + itxtLen;
 
     if Memo.SelText = '' then
       Continue;
 
     Caption:=Memo.SelText;
 
     WordDoc.Range.Delete(EmptyParam,Emp-tyParam);
     WordDoc.Range.Set_Text(Memo.SelText);
     colSpellErrors := WordDoc.SpellingErrors;
     if colSpellErrors.Count <> 0 then
     begin
       colSuggestions := WordApp.GetSpellingSuggestions
       (colSpellErrors.Item(1).Get_Text);
       with frSpellCheck do
       begin
         edNID.text := colSpellErrors.Item(1).Get_Text;
         lbSuggestions.Items.Clear;
         for i:= 1 to colSuggestions.Count do
           lbSuggestions.Items.Add(VarToStr-(colSuggestions.Item(i)));
         lbSuggestions.ItemIndex := 0;
         lbSuggestionsClick(Sender);
         ShowModal;
         case frSpellCheck.ModalResult of
           mrAbort: Break;
           mrIgnore: Continue;
           mrOK:
             if sReplacedWord <> '' then
             begin
               Memo.SelText := sReplacedWord;
               itxtLen := Length(sReplacedWord);
             end;
         end;
       end;
     end;
   end;
   WordDoc.Disconnect;
   varFalse:=False;
   WordApp.Quit(varFalse);
   Memo.SelStart := 0;
   Memo.SelLength := 0;
 end;
 

Обработчики событий нажатий на кнопки формы frSpellCheck и список слов, предлагаемых для замены:


 procedure TfrSpellCheck.lbSuggestionsClick(Sen-der: TObject);
 begin
   if lbSuggestions.ItemIndex <> -1 then
     edReplaceWith.Text := lbSuggestions.Items[lbSuggestio-ns.ItemIndex]
   else
     edReplaceWith.Text := '';
 end;
 
 procedure TfrSpellCheck.btnChangeClick(Sender: TObject);
 begin
   sReplacedWord := edReplaceWith.Text;
 end;
 
 procedure TfrSpellCheck.btnIgnoreClick(Sender: TObject);
 begin
   sReplacedWord := '';
 end;
 

Тезаурус

Теперь рассмотрим вопрос добавления в нашу программу функций тезауруса. Делается это достаточно просто:


 procedure TForm1.btnThesaurusClick(Sender: TObject);
 var
   varFalse : OleVariant;
 begin
   if Memo.SelText <> '' then
   begin
     WordApp.Connect;
     WordDoc.ConnectTo(WordApp.Documen-ts.Add(EmptyParam, EmptyParam));
 
     WordDoc.Range.Delete(EmptyParam,Empty-Param);
     WordDoc.Range.Set_Text(Memo.SelText);
 
     WordDoc.Range.CheckSynonyms;
 
     Memo.SelText := WordDoc.Range.Get_Text;
 
     WordDoc.Disconnect;
     varFalse:=False;
     WordApp.Quit(varFalse);
   end;
 end;
 

Тестирование

В тексте, помещенном в компонент Memo, мною было сознательно сделано несколько ошибок, которые вы сможете увидеть, приглядевшись к изображению, представленному на рисунке 1. В частности, вместо слова "своих" я написал "свиох", вместо "путем" - "пуетм", а вместо "виде" - "виед". Как же повела себя программа? На следующих рисунках (рисунки 4-6) можно видеть, что проверка текста действительно работает.

Надеюсь, вы понимаете, что в рамках одной статьи невозможно описать все те возможности, которые открываются перед разработчиком программного обеспечения в случае использования серверов автоматизации. И речь идет не только о Microsoft Word, но и о других приложениях (к примеру, широко распространено применение MS Excel в качестве базы для построения отчетов). Все разнообразие данного направления программирования можно познать, на мой взгляд, только через собственный опыт. Так что удачного вам кода!




Получение данных из Delphi-приложения в документе Word

Сделайте следующее:

  • Создайте макрос в Word:

 Declare Function StringFromDelphi Lib "c:\sample\test.dll" As String
 
 Sub MAIN
 mystring$ = StringFromDelphi
 Insert mystring$
 End Sub
 

  • Создайте простой TEST.DLL в Delphi - просто форма с кнопкой. Сохраните это (например в c:\sample - смотри макрос Word) как test.dpr и testform.pas. Теперь добавьте к вашему проекту экспортируемую функцию 'StringFromDelphi' и 'close' на нажатие кнопки. Вы можете использовать следующий код:

 library Test;  (* test.dpr в c:\sample *)
 uses Testform in 'TESTFORM.PAS';
 exports
 
 StringFromDelphi;
 begin
 end.
 


 unit Testform; (* testform.pas в c:\sample *)
 interface
 
 uses
   WinTypes, WinProcs, Forms, Classes, Controls, StdCtrls, SysUtils;
 
 type
   TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   end;
 var
 
   Form1: TForm1;
 
 function StringFromDelphi: PChar; export;
 
 {$IFDEF WIN32}stdcall;
 {$ENDIF}
 
 implementation
 {$R *.DFM}
 
 function StringFromDelphi: Pchar;
 var
   StringForWord: array[0..255] of char;
 begin
 
   Application.CreateForm(TForm1, Form1);
   Form1.ShowModal;
   Result := StrPCopy(StringForWord, Form1.Button1.caption);
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   close;
 end;
 
 end.
 

  • Скомпилируйте test.dll. Запустите макрос из Word - должна появиться форма Delphi - нажмите кнопку для получения некоторых данных из Delphi.

В журнале PCMagazine Vol12.No22 опубликована статья о доступе к DLL из Word. Ознакомиться с ней вы можете в электронной версии журнала на веб-сайте PCMagazine.




Как удалить все файлы из Recent Documents List


 // Не забудьте включить ShlObj в unit
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   SHAddToRecentDocs(SHARD_PATH, 0);
 end;
 




Производная TIntegerField

Автор: Mark Edington

Я думал о производной, новом варианте компонента TIntegerfield, но я не могу понять как мне его получить во время разработки, ведь он не устанавливается в палитру компонентов.

Это то, что вы хотите. Создайте следующий молуль:

MICRON.PAS:


 unit micron;
 
 interface
 
 uses DB, DBTables, Classes;
 
 type
   TMicronField = class(TIntegerField)
   public
     function IsValidChar(Ch: Char): Boolean; override;
   end;
 
 procedure Register;
 
 implementation
 
 function TMicronField.IsValidChar(Ch: Char): Boolean;
 begin
   Result := Ch in ['+', '-', '0'..'9', '.'];
 end;
 
 procedure Register;
 begin
   RegisterFields([TMicronField]);
 end;
 
 end.
 

Поместите данный модуль в ваш каталог lib и добавьте это поле, используя диалог установки компонент. Затем, используя "DataSet designer", свяжите TMicronField с нужными вам полями, после чего вы увидите, что список типов полей включает теперь "Micron". (для отображения полей на новый тип поля, сначала вам необходимо удалить все TIntegerFields).

Другое решение, более простое (но так-же работающее), заключается в изменении исходного кода DBTables и простой замене существующей функции IsValidChar на TIntegerField.




Производная TOutline

Автор: Craig Osterloh

Я пытаюсь создать компонент, производный от TOutline и хотел бы использовать несколько иконок для изображения папок, документов и т.п. Только не знаю как.

Если установлен стиль otOwnerDraw, вы можете сами отрисовывать компонент. В этом режиме вы можете вывести какие угодно изображения. Примечание: чтобы получить OwnerDraw для работы, вы должны установить свойство Scrollbar в vsVertical.

Затем обрабатывайте событие OnDrawItem для рисования каждой строчки OutLine.

Для получения правильного индекса узла используйте GetItem(Rect.Left, Rect.Top). Индекс в drawItem неверен.

Вот пример из моего приложения. Надеюсь это вам поможет.


 procedure TfrmMain.Outline2DrawItem(Control: TWinControl; Index: Integer;
   Rect: TRect; State: TOwnerDrawState);
 var
   Node: TOutlineNode;
   NodeIdx: Integer;
   Offset: Integer;
   NowBitmap: TBitmap;
   NowAstValue: string;
 begin
   NodeIdx := Outline2.GetItem(Rect.Left, Rect.Top);
   Node := Outline2.Items[NodeIdx];
   NowAstValue := PAstRec(Outline2.Items[NodeIdx].Data)^.AstValue;
   with Outline2.Canvas do
   begin
     Font.Name := 'MS Sans Serif';
     Font.Size := 8;
     Offset := MulDiv(Font.Size, 150, 100);
     fillRect(Rect);
     Rect.Left := Rect.Left + ((Node.Level - 1) * Offset + 2);
     if Node.HasItems then
     begin
       if Node.Expanded then
         NowBitmap := Outline2.PictureMinus
       else
         NowBitmap := Outline2.PicturePlus;
       {рисуем иконку}
       BrushCopy(Rect, NowBitmap,
         Bounds(0, 0, Rect.Right - Rect.Left, Rect.Bottom -
         Rect.Top),
         NowBitmap.TransparentColor);
     end;
     Rect.Left := Rect.Left + Offset + 2;
     {выводим текст}
     TextOut(Rect.left, Rect.Top, Node.Text);
     {создаем суммирующую колонку с правым выравниванием}
     Rect.Left := Rect.Right - TextWidth(NowAstValue) - 2;
     TextOut(Rect.Left, Rect.Top, NowAstValue);
   end;
 end;
 

А как работает функция PAstRec() и как получить указатель на данные?


 function TfrmMain.LoadAssetNodes(fName: string; header: string): Double;
 var
   headerIdx: Integer;
   NowClientID: string;
   TotAssetValue: Double;
   AstRecPtr: PAstRec;
   sqlText: string;
   HeadPtr: PAstRec;
 begin
   with qryAssets do
   begin
     NowClientID := dtbClients.Fields[0].AsString;
     sqlText := 'Select * from ' + fName + ' where ClientID = ' +
       NowClientID;
     SQL.Clear;
     SQL.Add(sqlText);
     Open;
     First;
     TotAssetValue := 0;
     new(HeadPtr);
     headerIdx := outAssets.AddObject(0, header, HeadPtr);
     while not EOF do
     begin
       new(AstRecPtr);
       AstRecPtr^.AstValue := format('%8.0n',
         [FieldByName('AssetValue').AsFloat]);
       TotAssetValue :=
         TotAssetValue + FieldByName('AssetValue').AsFloat;
       outAssets.AddChildObject(headerIdx,
         FieldByName('AssetName').AsString,
         AstRecPtr);
       Next;
     end;
     HeadPtr^.AstValue := format('%8.0n', [TotAssetValue]);
     Result := TotAssetValue;
   end;
 end;
 




Свойство только для чтения во время выполнения программы

- Депаpтамент Полиции Бpюсселя, чем я могy помочь Вам?
- Ох.. Да.. Я только что полyчил пиpогом с кpемом по лицy.
- О'кэй, сэp. Обpащались ли Вы в Депаpтамент Полиции Бpюсселя pанее?
- Hет.
- Хоpошо, дайте мне немного инфоpмации о себе, для занесения в жypнал. Ваше имя?
- Билл Гейтс.
- Стpана?
- США.
- Родной язык? - Английский.
- О'кей, сэp. Ваш идентификационный номеp в Депаpтаменте Полиции: БП31415927. Пожалyйста, использyйте этот номеp пpи следyющем обpащении к нам. Итак, Вы говоpите, что полyчили пиpогом по лицy?
- Да, я только что должен был встpетится с пpемьеp министpом Бельгии. Один человек отвлек меня в то вpемя, как дpyгой yдаpил меня пиpогом со сливочным кpемом.
- Мы имеем сообщения, что Вы полyчили по лицy пиpогом с заваpным кpемом. Вы yвеpены, что это действительно был пиpог со сливочным кpемом?
- Хоpошо, все мое лицо покpыто белой массой и я не вижy никакого заваpного кpема, так что я действительно не дyмаю, что это был пиpог с заваpным кpемом.
- Встpечались ли Вы с пpемьеp министpом pаньше?
- Да.
- Тогда вы тоже полyчали пиpогом по лицy?
- Hет.
- Хмм.. Посещали ли вы дpyгих пpемьеp министpов в последнее вpемя?
- Да.
- Были ли какие-либо пиpоги пpи этом?
- Hет.
- О'кей, хоpошо... Давайте попpобyем следyющее: выйдите из здания и зайдите опять. Я бyдy ждать.
- Минyткy..
<несколькими минyтами позже>
- О'кей, я веpнyлся.
- Полyчили еще одним пиpогом по лицy?
- Конечно нет.
- Хоpошо, сэp. Я не знаю, чем было вызвано появление пеpвого пиpога, но все выглядит так, что Ваши дела вновь наладились. Впpочем, мы возьмем этy пpоблемy на заметкy. Если это слyчится снова, пожалyйста, запомните точные детали пpоисшествия и вызовите нас еще pаз. Благодаpим Вас за обpащение в Депаpтамент Полиции Бpюсселя.

Если значение свойства используется в процедуре, то сама процедура может содержать следующий код:


 if csDesigning in ComponentState then
 begin
   // ... код, устанавливающий значение свойства ...
 end;
 

Это позволяет в режиме выполнения приложения сделать свойство только для чтения.




Как запретить изменение размера моего компонента в design-time

Поместите в конструктор компонента код, устанавливающий размеры по умолчанию. Переопределите метод SetBounds и проверяйте в нем "componentstate". Если компонент находится режиме "design-time" (csDesigning in ComponentState) просто передавайте значения ширины и высоты (width и heights) компонента по умолчанию (в нашем примере 50) методу класса-предка.


 procedure TVu.SetBounds(ALeft: integer; ATop: integer;
 AWidth: integer; AHeight: integer);
 begin
   if csdesigning in componentstate then
   begin
     AWidth := 50;
     AHeight := 50;
     inherited; //вызываем унаследованный от предка метод
   end;
 end;
 




Как установить цвет фона иконок на рабочем столе, либо прозрачный фон

Для этого нужно найти окно "SysListView32" (которое является списком, который содержит иконки рабочего стола). Сперва будем искать главное родительское окно "Progman", которое содержит дочернее окно "SHELLDLL_DefView" , которое в свою очередь имеет дочернее окно "SysListView32". Для этого можно воспользоваться API функцией FindWindow to. Когда Мы получим дескриптор окна "SysListView32", то можно будет воспользоваться макросами ListView_SetTextBkColor и ListView_SetTextColor для установки желаемого цвета.

Ниже приведена процедура, которая делает всё вышеперечисленное. Если параметр Trans равен true, то будет установлен прозрачный фон, иначе цвет фона будет равен Background.


 unit DeskIcons;
 
 interface
 uses Graphics; // Будет использоваться TColor
 
 procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
 procedure SetDefaultIconColors;
 
 implementation
 uses Windows, CommCtrl; // будут использоваться HWND и ListView_XXXXX
 
 procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
 
 var
   Window: HWND;
 begin
   // Находим нужное окно в три этапа
   Window := FindWindow('Progman', 'Program Manager');
   // Используем FindWindowEx для нахождения дочернего окна
   Window := FindWindowEx(Window, HWND(nil), 'SHELLDLL_DefView', '');
   // SysListView32, это список с иконками на рабочем столе
   Window := FindWindowEx(Window, HWND(nil), 'SysListView32', '');
   // Используем макрос для очистки цвета фона
   if Trans then
     ListView_SetTextBkColor(Window, $FFFFFFFF) // фоновый цвет
   else
     ListView_SetTextBkColor(Window, Background); // фоновый цвет
   ListView_SetTextColor(Window, Forground); // передний цвет
   // теперь перерисовываем иконки
   ListView_RedrawItems(Window, 0, ListView_GetItemCount(Window) - 1);
   UpdateWindow(Window); // да¸м команду "немедленно перерисовать"
 end;
 
 procedure SetDefaultIconColors;
 { Эта процедура устанавливает цвета, которые заданы в
   windows по умолчанию }
 var
   Kind: Integer;
   Color: TColor;
 begin
   Kind := COLOR_DESKTOP;
   Color := GetSysColor(COLOR_DESKTOP);
   SetSysColors(1, Kind, Color);
 end;
 
 end.
 




Как определить размер рабочего стола без ТaskBarа

Воспользуйтесь функцией SystemParametersInfo(), переслав ей в качестве параметров - SPI_GETWORKAREA и адрес структуры типа TRect, куда будут передан полученный результат:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   r: TRect;
 begin
   SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
   Memo1.Lines.Add(IntToStr(r.Top));
   Memo1.Lines.Add(IntToStr(r.Left));
   Memo1.Lines.Add(IntToStr(r.Bottom));
   Memo1.Lines.Add(IntToStr(r.Right));
 end;
 




Снимок Desktop



 public
   { Public declarations }
   procedure GrabScreen;
 ...
 
 implementation
 {$R *.DFM}
 
 procedure TForm1.GrabScreen;
 var
   DeskTopDC: HDc;
   DeskTopCanvas: TCanvas;
   DeskTopRect: TRect;
 begin
   DeskTopDC := GetWindowDC(GetDeskTopWindow);
   DeskTopCanvas := TCanvas.Create;
   DeskTopCanvas.Handle := DeskTopDC;
   DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
   Form1.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
   ReleaseDC(GetDeskTopWindow, DeskTopDC);
 end;
 
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   GrabScreen;
 end;
 




Когда я добавляю обьект в список TStrings как мне его потом уничтожить


 procedure TForm1.FormCreate(Sender: TObject);
 var
   Icon: TIcon;
 begin
   Icon := TIcon.Create;
   Icon.LoadFromFile('C:\Program Files\BorlandImages\CONSTRUC.ICO');
   ListBox1.Items.AddObject('Item 0', Icon);
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   ListBox1.Items.Objects[0].Free;
 end;
  




Определение кодовой страницы

Автор: Alexander Trunov


 {
   Work with codepages
   (c) 1999 by Alexander Trunov, {2:5069/10}, {jnc@mail.ru}
 }
 
 unit Codepage;
 
 interface
 
 const
   cpWin = 01;
   cpAlt = 02;
   cpKoi = 03;
 
 function DetermineCodepage(const st: string): Byte;
 function Alt2Win(const st: string): string;
 function Win2Alt(const st: string): string;
 function Alt2Koi(const st: string): string;
 function Koi2Alt(const st: string): string;
 function Win2Koi(const st: string): string;
 function Koi2Win(const st: string): string;
 function X2Y(const st: string; srcCp, dstCp: Byte): string;
 
 implementation
 
 const
   AltSet = ['А'..'Я', 'а'..'п', 'р'..'я'];
   KoiSet = ['Б'..'Р', 'Т'..'С'];
   WinSet = ['а'..'п', 'р'..#255];
 
   Win2AltTable: array[0..255] of Byte = (
     $00, $01, $02, $03, $04, $05, $06, $07, $08, $20, $0A, $0B, $0C, $0D, $0E, $0F,
     $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F,
     $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $2A, $2B, $2C, $2D, $2E, $2F,
     $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
     $40, $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A, $4B, $4C, $4D, $4E, $4F,
     $50, $51, $52, $53, $54, $55, $56, $57, $58, $59, $5A, $5B, $5C, $5D, $5E, $5F,
     $60, $61, $62, $63, $64, $65, $66, $67, $68, $69, $6A, $6B, $6C, $6D, $6E, $6F,
     $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B, $7C, $7D, $7E, $7F,
     $80, $81, $82, $83, $84, $85, $86, $87, $88, $89, $8A, $8B, $8C, $8D, $8E, $8F,
     $90, $91, $92, $93, $94, $95, $96, $97, $98, $99, $9A, $9B, $9C, $9D, $9E, $9F,
     $A0, $A1, $A2, $A3, $A4, $A5, $A6, $A7, $A8, $A9, $AA, $22, $AC, $AD, $AE, $AF,
     $B0, $B1, $B2, $B3, $B4, $B5, $B6, $B7, $B8, $FC, $BA, $22, $BC, $BD, $BE, $BF,
     $80, $81, $82, $83, $84, $85, $86, $87, $88, $89, $8A, $8B, $8C, $8D, $8E, $8F,
     $90, $91, $92, $93, $94, $95, $96, $97, $98, $99, $9A, $9B, $9C, $9D, $9E, $9F,
     $A0, $A1, $A2, $A3, $A4, $A5, $A6, $A7, $A8, $A9, $AA, $AB, $AC, $AD, $AE, $AF,
     $E0, $E1, $E2, $E3, $E4, $E5, $E6, $E7, $E8, $E9, $EA, $EB, $EC, $ED, $EE, $EF);
 
   Alt2WinTable: array[0..255] of Byte = (
     $00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F,
     $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F,
     $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $2A, $2B, $2C, $2D, $2E, $2F,
     $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
     $40, $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A, $4B, $4C, $4D, $4E, $4F,
     $50, $51, $52, $53, $54, $55, $56, $57, $58, $59, $5A, $5B, $5C, $5D, $5E, $5F,
     $60, $61, $62, $63, $64, $65, $66, $67, $68, $69, $6A, $6B, $6C, $6D, $6E, $6F,
     $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B, $7C, $7D, $7E, $7F,
     $C0, $C1, $C2, $C3, $C4, $C5, $C6, $C7, $C8, $C9, $CA, $CB, $CC, $CD, $CE, $CF,
     $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7, $D8, $D9, $DA, $DB, $DC, $DD, $DE, $DF,
     $E0, $E1, $E2, $E3, $E4, $E5, $E6, $E7, $E8, $E9, $EA, $EB, $EC, $ED, $EE, $EF,
     $20, $20, $20, $A6, $A6, $A6, $A6, $2B, $2B, $A6, $A6, $2B, $2B, $2B, $2B, $2B,
     $2B, $2D, $2D, $2B, $2D, $2B, $A6, $A6, $2B, $2B, $2D, $2D, $A6, $2D, $2B, $2D,
     $2D, $2D, $2D, $2B, $2B, $2B, $2B, $2B, $2B, $2B, $2B, $5F, $5F, $5F, $5F, $5F,
     $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7, $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF,
     $A8, $B8, $AA, $BA, $AF, $BF, $A1, $A2, $B0, $B7, $B7, $5F, $B9, $A4, $5F, $5F);
 
   Koi2AltTable: array[0..255] of Byte = (
     $00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F,
     $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F,
     $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $2A, $2B, $2C, $2D, $2E, $2F,
     $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
     $40, $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A, $4B, $4C, $4D, $4E, $4F,
     $50, $51, $52, $53, $54, $55, $56, $57, $58, $59, $5A, $5B, $5C, $5D, $5E, $5F,
     $60, $61, $62, $63, $64, $65, $66, $67, $68, $69, $6A, $6B, $6C, $6D, $6E, $6F,
     $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B, $7C, $7D, $7E, $7F,
     $80, $81, $82, $83, $84, $85, $86, $87, $88, $89, $8A, $8B, $8C, $8D, $8E, $8F,
     $90, $91, $92, $93, $94, $95, $96, $97, $98, $99, $9A, $9B, $9C, $9D, $9E, $9F,
     $A0, $A1, $A2, $A5, $A4, $A5, $A6, $A7, $A8, $A9, $AA, $AB, $AC, $AD, $AE, $AF,
     $B0, $B1, $B2, $B3, $B4, $B5, $B6, $B7, $B8, $B9, $BA, $BB, $BC, $BD, $BE, $BF,
     $EE, $A0, $A1, $E6, $A4, $A5, $E4, $A3, $E5, $A8, $A9, $AA, $AB, $AC, $AD, $AE,
     $AF, $EF, $E0, $E1, $E2, $E3, $A6, $A2, $EC, $EB, $A7, $E8, $ED, $E9, $E7, $EA,
     $9E, $80, $81, $96, $84, $85, $94, $83, $95, $88, $89, $8A, $8B, $8C, $8D, $8E,
     $8F, $9F, $90, $91, $92, $93, $86, $82, $9C, $9B, $87, $98, $9D, $99, $97, $FF);
 
   Alt2KoiTable: array[0..255] of Byte = (
     $00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F,
     $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F,
     $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $2A, $2B, $2C, $2D, $2E, $2F,
     $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
     $40, $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A, $4B, $4C, $4D, $4E, $4F,
     $50, $51, $52, $53, $54, $55, $56, $57, $58, $59, $5A, $5B, $5C, $5D, $5E, $5F,
     $60, $61, $62, $63, $64, $65, $66, $67, $68, $69, $6A, $6B, $6C, $6D, $6E, $6F,
     $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B, $7C, $7D, $7E, $7F,
     $E1, $E2, $F7, $E7, $E4, $E5, $F6, $FA, $E9, $EA, $EB, $EC, $ED, $EE, $EF, $F0,
     $F2, $F3, $F4, $F5, $E6, $E8, $E3, $FE, $FB, $FD, $9A, $F9, $F8, $FC, $E0, $F1,
     $C1, $C2, $D7, $C7, $C4, $C5, $D6, $DA, $C9, $CA, $CB, $CC, $CD, $CE, $CF, $D0,
     $B0, $B1, $B2, $B3, $B4, $B5, $B6, $B7, $B8, $B9, $BA, $BB, $BC, $BD, $BE, $BF,
     $C0, $C1, $C2, $C3, $C4, $C5, $C6, $C7, $C8, $C9, $CA, $CB, $CC, $CD, $CE, $CF,
     $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7, $D8, $D9, $DA, $DB, $DC, $DD, $DE, $DF,
     $D2, $D3, $D4, $D5, $C6, $C8, $C3, $DE, $DB, $DD, $DF, $D9, $D8, $DC, $C0, $D1,
     $85, $A3, $F2, $F3, $F4, $F5, $F6, $F7, $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);
 
 function X2Y(const st: string; srcCp, dstCp: Byte): string;
 begin
   case srcCp of
     cpWin:
       begin
         case dstCp of
           cpWin:
             begin
               Result := st;
             end;
           cpAlt:
             begin
               Result := Win2Alt(st);
             end;
           cpKoi:
             begin
               Result := Win2Koi(st);
             end;
         end;
       end;
     cpAlt:
       begin
         case dstCp of
           cpWin:
             begin
               Result := Alt2Win(st);
             end;
           cpAlt:
             begin
               Result := st;
             end;
           cpKoi:
             begin
               Result := Alt2Koi(st);
             end;
         end;
       end;
     cpKoi:
       begin
         case dstCp of
           cpWin:
             begin
               Result := Koi2Win(st);
             end;
           cpAlt:
             begin
               Result := Koi2Alt(st);
             end;
           cpKoi:
             begin
               Result := st;
             end;
         end;
       end;
   end;
 end;
 
 function Win2Koi(const st: string): string;
 begin
   Result := Alt2Koi(Win2Alt(st));
 end;
 
 function Koi2Win(const st: string): string;
 begin
   Result := Alt2Win(Koi2Alt(st));
 end;
 
 function Alt2Win(const st: string): string;
 var
   i: Integer;
 begin
   Alt2Win[0] := Char(Length(st));
   for i := 1 to Length(st) do
   begin
     Alt2Win[i] := Char(Alt2WinTable[Byte(st[i])]);
   end;
 end;
 
 function Win2Alt(const st: string): string;
 var
   i: Integer;
 begin
   Win2Alt[0] := Char(Length(st));
   for i := 1 to Length(st) do
   begin
     Win2Alt[i] := Char(Win2AltTable[Byte(st[i])]);
   end;
 end;
 
 function Alt2Koi(const st: string): string;
 var
   i: Integer;
 begin
   Alt2Koi[0] := Char(Length(st));
   for i := 1 to Length(st) do
   begin
     Alt2Koi[i] := Char(Alt2KoiTable[Byte(st[i])]);
   end;
 end;
 
 function Koi2Alt(const st: string): string;
 var
   i: Integer;
 begin
   Koi2Alt[0] := Char(Length(st));
   for i := 1 to Length(st) do
   begin
     Koi2Alt[i] := Char(Koi2AltTable[Byte(st[i])]);
   end;
 end;
 
 function DetermineCodepage(const st: string): Byte;
 var
   WinCount,
     AltCount,
     KoiCount,
     i, rslt: Integer;
 begin
   DetermineCodepage := cpAlt;
   WinCount := 0;
   AltCount := 0;
   KoiCount := 0;
   for i := 1 to Length(st) do
   begin
     if st[i] in AltSet then Inc(AltCount);
     if st[i] in WinSet then Inc(WinCount);
     if st[i] in KoiSet then Inc(KoiCount);
   end;
   DetermineCodepage := cpAlt;
   if KoiCount > AltCount then
   begin
     DetermineCodepage := cpKoi;
     if WinCount > KoiCount then DetermineCodepage := cpWin;
   end
   else
   begin
     if WinCount > AltCount then DetermineCodepage := cpWin;
   end;
 end;
 
 end.
 




Как определить видеокарту

Стоит программист перед светофором:
- Никак не могу понять, что там за видеоадаптер:
у Геркулеса - 2 цвета, у CGA - 4, у EGA - 16, у VGA -256, у XGA - 65535, а 3-х - ну ни у кого нет!


 procedure TForm1.button1click(Sender: TObject);
 var
   lpDisplayDevice: TDisplayDevice;
   dwFlags: DWORD;
   cc: DWORD;
 begin
   form2.memo1.Clear;
   lpDisplayDevice.cb := sizeof(lpDisplayDevice);
   dwFlags := 0;
   cc := 0;
   while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do
   begin
     Inc(cc);
     form2.memo1.lines.add(lpDisplayDevice.DeviceString);
     {Так же мы увидим дополнительную информацию в lpDisplayDevice}
     form2.show;
   end;
 end;
 




Вызов диалога подключения сетевого диска

Идёт себе по дороге программер, вдруг ему по башке кирпич... "Тетрис" - успел подумать программист.

Попробуйте WNetConnectionDialog. Данная функция инкапсулирована в Windows.pas и специально предназначена для этого.




Заголовок диалогового окна

Окошко, окошко, повернись к ядру задом, а ко мне дружественным интерфейсом!

Заголовок диалогового окна устанавливается в момент вызова CreateMessageDialog, чей код расположен в Dialogs.pas. При этом происходит вызов LoadStr, который получает Warningcaption, Cautioncaption и пр., так что у вас есть два пути: Или вы изменяете Dialogs.pas, или вы редактируете строки в .res-файле.




Z-порядок при каждом показе диалога


 // Там не листбокс, а EDIT, но суть точно та же. Чтобы получить текст, а не
 // записать его, надо просто использовать Get вместо Set. Судя по тому, что
 // программа уже 2 года работает без малейших проблем, Z-порядок при  каждом
 // показе диалога один и тот же.
 
 program Project1;
 
 uses
  Windows, Messages;
 
 const
  Title1 = 'Установка связи';
  Title2 = 'Удаленное соединение';
  Login = '...';
  Password = '...';
 
 var
  Wnd: HWND;
  Control: array [0..127] of char;
 
 procedure TypeTextIntoNextEdit(AText:string);
 begin
  repeat // Ищем следующее в Z-порядке окно класса EDIT
    Wnd := GetWindow(Wnd, GW_HWNDNEXT);
    GetClassName(Wnd, Control, SizeOf(Control))
  until Control = 'Edit';
  SendMessage(Wnd, WM_SETTEXT, 0, Integer(PChar(AText))) // Вводим текст
 end;
 
 begin
  Wnd := FindWindow(nil, Title1);  // Это окно самого диалога
  if Wnd = 0 then                  // Если не найдено, ищем другой диалог 
  begin
    Wnd := FindWindow(nil, Title2);
    if Wnd = 0 then Exit;
  end;
  Wnd := GetWindow(Wnd, GW_CHILD); // Это верхний комбобокс
  TypeTextIntoNextEdit(Login);     // Вводим логин
  TypeTextIntoNextEdit(Password)   // Вводим пароль
 end.
 




Размер диалогового окна

Автор: Steve Schafer

Давайте начнем с Microsoft Windows User Interface Guidelines (Руководящие Принципы Построения Интерфейса Пользователя Microsoft Windows) и допустим, что мы создаем диалоговое окно, содержащее компонент TMemo, занимающий большую часть площади формы и кнопки OK и Cancel, размещенные в ее нижней части.

Несколько примечаний из "Принципов":

  1. Диалоговые окна должны быть основаны на базовых диалоговых модулях, dialog base units (DBU), которые создаются с учетом размера шрифта и разрешения экрана.
  2. Диалоговые окна должны быть созданы, по возможности, на основе одного из нескольких стандартных размеров. Для нашего окна мы используем размер 212x188 DBU.
  3. Все элементы управления должны распологаться как минимум на расстоянии 7 DBU от края окна.
  4. Все элементы управления должны иметь между друг другом зазор размером минимум 4 DBU.
  5. Кнопки должны иметь высоту 14 DBU. (Про ширину кнопок "принципы" умалчивают; в обычном случая я использую кнопки шириной 40 DBU.)

Вот необходимая для создания формы и элементов управления информация, которую мы можем получить во время выполнения приложения:


 procedure TMyForm.FormCreate(Sender: TObject);
 var
   BaseUnit, Margin, Spacing, BtnW, BtnH: Integer;
 begin
   BaseUnit := Canvas.TextHeight('0'); { 1 BaseUnit = 8 DBU определениям }
   Width := (212 * BaseUnit) div 8;
   Height := (188 * BaseUnit) div 8;
   Margin := (7 * BaseUnit) div 8 - GetSystemMetrics(SM_CXFIXEDFRAME);
   Spacing := (4 * BaseUnit) div 8;
   BtnW := (40 * BaseUnit) div 8;
   BtnH := (14 * BaseUnit) div 8;
   Memo1.SetBounds(Margin, Margin, ClientWidth - 2 * Margin, ClientHeight -
     2 * Margin - Spacing - BtnH);
   OkButton.SetBounds(ClientWidth - Margin - Spacing - 2 * BtnW, ClientHeight -
     Margin - BtnH, BtnW, BtnH);
   CancelButton.SetBounds(ClientWidth - Margin - BtnW, ClientHeight - Margin -
     BtnH, BtnW, BtnH);
 end;
 

Данный код позволяет создать диалоговое окно с правильными размерами и пропорциями, независимо от разрешения экрана и шрифтов.




Что нужно предусмотреть для работы при различном разрешении дисплея

Два мужика разговаривают:
- Почему твой сын так быстро растёт, за уши тянешь что-ли?
- Не, я просто монитор каждый месяц на 5 см поднимаю!

  • а ранней стадии создания приложения решите для себя хотите ли вы позволить форме масштабироваться. Преимущество немасштабируемой формы в том, что ничего не меняется во время выполнения. В этом же заключается и недостаток (ваша форма может быть слишком маленькой или слишком большой в некоторых случаях).
  • Если вы Е собираетесь делать форму масштабируемой, установите св-во Scaled=False и дальше не читайте.
  • В противном случае Scaled=True.
  • Установите AutoScroll=False. AutoScroll = True означает не менять размер окна формы при выполнении что не очень хорошо выглядит, когда содержимое формы размер меняет.
  • Установите фонты в форме на TrueType фонты, например Arial. !!!!: Если такого фонта не окажется на пользовательском компьютере, то Windows выберет альтернативный фонт из того же семейства. Этот фонт может не совпадать по размеру, что вызовет проблемы.
  • Установите св-во Position в любое значение, отличное от poDesigned. poDesigned оставляет форму там, где она была во время дизайна, и, например, при разрешении 1280x1024 форма окажется в левом верхнем углу и совершенно за экраном при 640x480.
  • Оставляйте по-крайней мере 4 точки между компонентами, чтобы при смене положения границы на одну позицию компоненты не " наезжали" друг на друга.
  • Для однострочных меток (TLabel) с выравниванием alLeft или alRight установите AutoSize=True. Иначе AutoSize=False.
  • Убедитесь, что достаточно пустого места у TLabel для изменения ширины фонта - 25% пустого места многовато, зато безопасно. При AutoSize=False Убедитесь, что ширина метки правильная, при AutoSize=True убедитесь, что есть ссвободное место для роста метки.
  • Для многострочных меток (word-wrapped labels), оставьте хотя бы одну пустую строку снизу.
  • Будьте осторожны при открытии проекта в среде Delphi при разных разрешениях. Свойство PixelsPerInch меняется при открытии формы. Лучше тестировать приложения при разных разрешениях, запуская готовый скомпилированный проект, а редактировать его при одном разрешении. Иначе это вызовет проблемы с размерами.
  • Не изменяйте свойство PixelsPerInch !
  • В общем, нет необходимости тестировать приложение для каждого разрешения в отдельности, но стоит проверить его на 640x480 с маленькими и большими фонтами и на более высоком разрешении перед продажей.
  • Уделите пристальное внимание принципиально однострочным компонентам типа TDBLookupCombo. Многострочные компоненты всегда показывают только целые строки, а TEdit покажет урезанную снизу строку. Каждый компонент лучше сделать на несколько точек больше.



Сделать сложный фон окна

Фон окна может представлять собой повторяющиеся картинки произвольного размера.


 procedure TForm1.FormCreate(Sender: TObject);
 begin
   bm := TBitMap.Create;
   bm.LoadFromFile('Example.bmp');
 end;
 
 procedure TForm1.FormPaint(Sender: TObject);
 var
   x, y: integer;
 begin
   for x := 0 to Form1.ClientWidth div bm.Width do
     for y := 0 to Form1.ClientHeight div bm.Height do
       Form1.Canvas.Draw(x * bm.Width, y * bm.Height, bm);
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   bm.Destroy;
 end;
 

Вы можете использовать для "подложки" формы любой стиль кисти. Таким образом, можно получить окно "в полосочку", "в сеточку" и т.д.


 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Form1.Brush.Style := bsDiagCross;
 end;
 

Ту же задачу можно решить, используя свойство кисти Bitmap, позволяющее создавать свои стили. Размер картинки при этом всегда равен 8X8.


 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Form1.Brush.Bitmap := TBitMap.Create;
   Form1.Brush.Bitmap.LoadFromFile('Phone.bmp');
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   Form1.Brush.Bitmap.Destroy;
 end;
 




У меня константы могут иметь значение, отличное от заданного

Автор: Nomadic

Const из другого unit'а дает неверное значение.

Похоже, это действительно bug, пpичем ОСОБО ОПАСHЫЙ, т.к. может исказить pезультаты pасчетов, не вызвав заметных наpушений pаботы пpогpаммы.

В общем так. Экспеpимент показал, что любая вещественная константа, опpеделенная в интеpфейсе модуля, может быть невеpно (и не обязательно очень невеpно - напpимеp, вместо 0.7 может появиться 0.115) пpочитана в дpугом модуле. Баг особенно опасен тем, что он неустойчив и может пpопадать и возникать без видимых пpичин (напpимеp, возникнуть, если пpедыдущая компиляция была неудачной и исчезнуть после использования константы в модуле, где она опpеделена).

Лечится (вpоде бы) указанием типа


 const Wko: double = 0.9;
 

пpавда, тепеpь это уже не совсем константа...




Как сделать чтобы орган управления хватался только за некий контур

Автор: Nomadic

Надо обpабатывать сообщение CM_HITTEST (Это сообщение получают даже потомки от TGraphicsControl, не имеющего своего HWND).

Hапpимеp, так:


 procedure TLine.CMHitTest(var Message: TWMNCHitTest);
 begin
   if PointInLineReg(Message.XPos, Message.YPos) then
   begin
     Message.Result := 1;
   end
   else
   begin
     Message.Result := 0;
   end;
 end;
 

Для органов управления Windows, если Вы не используете VCL, требуется обрабатывать сообщение WM_NCHITTEST.




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS