???? Слишком большой сегмент данных ???? II

Как найти необъяснимые незаполненные области в сегментах данных:

Я знаю, что это нелегкий способ, но я знаю что он будет работать, поскольку я делал это сам. Используйте DCC.EXE, компилируйте ваш полный проект (DPR) и добавляйте к командной строке опцию /GD, это позволит создать .MAP-файл. MAP-файл создан по правилам форматирования текстового файла, поэтому вы можете затем загрузить его в Delphi и там изучать.

Первая секция каждого MAP-файла включает в себя все модули, добавленные линковщиком в EXE-файл и размер этих модулей в HEX-байтах. Имя последнего модуля в списке - всегда DATA для сегментов данных. Здесь необходимо запомнить одну вещь - начальный адрес сегмента данных.

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

Самый минимально-возможный проект Delphi создаст вам список из нескольких сотен записей.

Для нашего примера я использовал пустой проект, который Delphi создает вам автоматически: сохраните проект и модуль под любым именем каким вы хотите, закройте проект и выйдите из Delphi. Я использую имена DATAP.DPR и DATAU.PAS.

В DOS-строке введите следующую команду: DCC DATAP.DPR /GD Теперь у вас будет скомпилированный проект и созданный файл DATAP.MAP. Снова загрузите Delphi и откройте в нем MAP-файл. Смотрим адрес сегмента DATA. 0008:0000 0E34H DATA DATA В нашем примере, как вы можете увидеть, VCL требует минимум $0E34 (3636) байт для сегмента данных (Data Segment). Теперь перейдем ко второй секции (ниже по тексту) и увидим начальные адреса вашего сегмента DATA. 0008:055A CreationControl 0008:055E VBXHook ....... .......... В любом проекте, который я когда-либо создавал, первые $0040 байт в MAP-файле всегда резервируются чем-то неопределенным. Вставляемая по умолчанию часть листинга всегда начинается с "CreationControl".

В проектах, где я имею хотя бы одно объявление TYPED CONST DATA, всегда указывается первый начальный адрес с отступом xxxx:0040 и перед "CreationControl", который, оказывается, сам занимает около 1300 байт.

Используя шестнадцатиричный адрес в качестве указателя, вы запросто можете вычислить разницу между распределенной памятью и памятью, реально занимаемую каждым элементом. Для этого понадобиться научный калькулятор, для этой цели подойдет калькулятор, поставляемый с Windows 3.0, только не забудьте переключить его в режим scientific (научный). Продолжаем: "встроенные" данные обычно начинаются с "CreationControl"/"HaltVector", который тут же сопровождается переменным указателем на вашу главную форму (4 байта). 0008:09DC HaltVector 0008:0A32 Form1 0008:0B60 NewStyleControls ....... .......... 0008:0D84 LongDayNames Все переменные для каждой формы приведены здесь в том же порядке, как они объявлены в модуле. Строка с "NewStyleControls" обычно знаменует конец секции с вашими переменными и начало остальных "встроенных" данных, которые, обычно, заканчиваются строкой "LongDayNames".

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

- Dennis Passmore [000832]

StrAlloc и GetMem

StrAlloc непосредственно использует GetMem, поэтому обе функции живут за счет Кучи. StrAlloc имеет преимущество: он распределяет на два байта больше, чем вы просите и там хранит размер размещенного блока. Поэтому StrDispose знает сколько памяти освободить и вы можете этого не помнить (в отличие от GetMem/FreeMem). Не смешивайте при работе эти две функциональные пары, иначе вы будете потрясены количеством возникающих ошибок! [000491]

Управление размером сегмента данных

Тема: Управление размером сегмента данных

Ошибка "Data Segment too large" (сегмент данных слишком велик) возникает в Delphi 16-битных приложениях в случае, когда размер статических данных, стека и локальной кучи превышает предел приложений Windows, установленный в 64К. В данном совете обсуждается тема идентификации и изменения части вашего кода, которая поглощает память в сегменте данных, и как, собственно, управлять этим ограниченным ресурсом.

Из чего состоит сегмент данных? Task header: 16 байт различной системной информации Windows (заголовок задачи) Static data: Содержит глобальные переменные и типовые (статические константы данные) Stack: Хранит локальные переменые, распределенные (стек) процедурами и функциями. Размер стека по по умолчанию 16К и может быть изменен на странице Options|Project|Linker. Local heap: Используется Windows для временного хранения и (локальная по умолчанию имеет размер 8К. Не устанавливайте куча) разнер локальной кучи, равным 0. Windows при необходимости может увеличить данную область. Как мне узнать полный размер сегмента данных?

Для того, чтобы получить размер статических данных 16-битного приложения Delphi, стека и локальной кучи для проекта, скомпилируйте проект и выберите в меню Delphi пункт Compile|Information. Для нового проекта с одной формой диалог покажет следующую информацию: Source compile: 12 lines (скомпилировано 12 строк исходного кода) Code size: 128981 bytes (размер кода 128981 байт) Data size: 3636 bytes (размер данных 3636 байт) Stack size: 16384 bytes (размер стека 16384 байт) Local Heap size: 8192 bytes (размер локальной кучи 8192 байт) Приложение Delphi начинается с объявления в модуле статических данных, тем самым обеспечивая функциональную инициализацию. Если единственная глобальная переменная является именем формы, то приложение занимает уже, по крайней мере, 3,636 байт. Добавляя вторую форму, размер увеличивается только до 3640 -- добавляется только размер глобальной переменной, необходимой для объявления второй формы.

var Form2: TForm2; { 4-х байтный указатель }

Общий размер сегмента данных (сумма статических данных, стека и локальной кучи) составляет 28,212 байт: Data size: 3,636 Stack size: 16,384 Local Heap size: 8,192 ----------------------- 28,212 Какие части моего проекта увеличивают размер данных? Переменные, объявленные в секции interface и implementation. Типизированные константы, объявленные в любом месте приложения. Пример объявления типизированной константы:

const MyConst: integer = 100;

Модули, объявленные в списке Uses, и компоненты могут содержать код с объявлениями глобальных переменных или типизированных констант. Например, TBitBtn добавляет к проекту 180 байт, и, по крайней мере, 132 байт резервируются для типизированных констант и глобальных переменных, объявленных в модуле Buttons.Pas. При добавлении дополнительных 10 компонентов TBitBtn, размер проекта после первых 180 байт не увеличится.

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

unit Test; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; { Используемые в модуле функции могут иметь глобальные переменные и типизированные константы, которые увеличивают размер сегмента данных. } type { Объекты класса хранятся в глобальной куче, не в сегменте данных} TForm1 = class(TForm) Label1: TLabel; Button1: TButton; procedure Button1Click(Sender: TObject); public { MyInteger и MyString хранятся в глобальной куче. } MyInteger: Integer; MyString: String; end; const { MyConst - типизированная константа и сохраняется в области статических данных сегмента. Минимизируйте количество типизированных констант. } MyConst: integer = 23; var { Form1 - глобальная переменная и хранится в области статических данных сегмента. Вы должны минимизировать число и размер глобальных переменных. Form1 является указателем и занимает только четыре байта. } Form1: TForm1; { MyGlobalString занимает 256 байт, даже если строка состояла бы всего из нескольких символов. } MyGlobalString: string; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var { MyLocal - локальная переменная и не хранится в сегменте данных. } MyLocal: String; begin MyLocal := 'Тестовое приложение'; Label1.Caption := MyLocal end; end.

Как влияют компоненты на размер данных?

Вот список компонентов со страниц Standard, Additional, Data Access и Data Control (часть списка) палитры компонентов. В списке приведен размер компилиции после добавления к новому проекту единственного экземпляра компонента. Список отсортирован согласно количеству расходуемой памяти: Компонент Прил. Байтов в свыше байт. 3,636 table 4272 636 batchmove 4272 636 storedproc 4258 622 query 4250 614 database 4036 400 datasource 3886 250 outline 3838 202 bitbtn 3816 180 stringgrid 3794 158 drawgrid 3790 154 maskedit 3762 126 memo 3750 114 report 3722 86 listbox 3704 68 edit 3694 58 tabset 3692 56 combobox 3674 38 scrollbar 3654 18 button 3652 16 checkbox 3652 16 radiobutton 3652 16 radiogroup 3652 16 panel 3650 14 label 3648 12 speedbutton 3646 10 header 3644 8 scrollbox 3644 8 notebook 3638 2 menu 3636 0 groupbox 3636 0 tabbednotebook 3636 0 image 3636 0 shape 3636 0 Как управлять размером сегмента данных? Избегайте объявления глобальных переменных и типизированных констант, особенно больших массивов. Вместо этого объявляйте тип и указель на него. Затем пользуйтесь функциями для работы с памятью, например, Getmem, которая распределит вам память в глобальной куче. Это уменьшит использование ресурсов в сегменте данных до 4 байт, необходимых для переменной указательного типа. Смотрите ниже пример кода. Отдавайте себе отчет о влиянии компонентов. Смотри выше. Если у вас имеется множество строк, или массив строк, распределяйте это динамически. Примечание: по умолчанию длина строки равна 255 символам -- объявляйте, где это возможно, специфический размер строки: (например, MyShortString: string[20]). При необходимости работать с большим количеством строк рекомендуется использовать объект TStringList. Тип Pchar, "указатель на строку", может быть использован для динамического создания и управления символьными строками, используя при этом небольшое размер сегмента данных. Смотри раздел электронной справки "String-handling routines (Null-terminated)" (подпрограммы обработки строк (с терминирующим нулем)). Информация, необходимая для работы с памятью, доступна в Object Pascal Language Guide (руководство по языку Object Pascal), OBJLANG.ZIP и может быть загружена из Compuserve, форум DELPHI, или из Интернета по адресу www.borland.com/TechInfo/delphi/whatsnew/dwnloads.html. Альтернатива для глобального объявления большой структуры

Первый пример расходует 32 байта сегмента данных, второй всего-лишь 4 байта, но выполняет ту же задачу.

{ Объявление TMyStructure не вызовет никаких изменений в размере сегмента данных. } TMyStructure = record Name: String[10]; Data: array[0..9] of Integer; end; var Form1: TForm1; { Объявление MyStructure вызовет увеличение размера сегмента памяти на 32 байта: указатель Mystructure = 1 байт Name = 11 байт (10 символов + байт длины) Data = 20 байт (10 * 2 байт на целое) } MyStructure: TMyStructure;

{ Объявление TMyStructure не вызовет никаких изменений в размере сегмента данных. } PMyStructure = ^TMyStructure; TMyStructure = record Name: String[10]; Data: array[0..9] of Integer; end; var Form1: TForm1; { MyDataPtr вызывает увеличение на 4 байта для размещения указательной переменной. } MyDataPtr: PMyStructure; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin { Здесь ресурсы берутся из кучи. } New(MyDataPtr); MyDataPtr.Name := 'Fred'; MyDataPtr.array[0] := 560; Dispose(MyDataPtr); end;

Вы также можете разместить объявление переменной в пределах класса:

type TMyBigArray = array[1..100] of string TForm1 = class(TForm) public { Это объявление не повлияет на размер сегмента данных. } MyBigArray: TMyBigArray; end; var { Это объявление увеличивает сегмент данных на 25,600 байт. } MyOtherBigArray: TMyBigArray;

[000944]

DLL и управление памятью

...я сомневаюсь в том, что GPF вызвана нехваткой памяти. Если это была нехватка кучи, вы должны были получить ошибку Error 202. В отношение кучи памяти: Windows поддерживает виртуальную глобальную память, поэтому нормальный признак нехватки реальной памяти - сильное замедление работы системы, а никак не GPF.

Из раздела "Writing DLLs" электронной справки:

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

DLLs и сегменты стека: DLL не имеет собственного сегмента стека, поэтому она использует сегменты кучи приложения, которое вызвало DLL.

Также обратитесь к совету "Run-time errors in DLLs" (ошибки DLL времени выполнения)

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

Чтобы найти проблему в коде DLL, нужно собрать стандартное EXE-приложение, и посмотреть его в отладчике на предмет возможных ошибок (напомню, что речь идет о Delphi 1).

Если вы когда-либо разрабатывали серьезную DLL, то вы должны знать, что при получении GPF перезагрузка каждый раз Windows является уж слишком непрактичным делом. Можно попытаться убрать DLL из памяти, перекомпилировать, и работать дальше. И я делал это нескончаемое число раз. Также, для того чтобы найти ошибку, я перемещал код библиотеки в 'нормальный' модуль, компилировал обычный EXE, и отлаживал его. Например, в Turbo Debugger for Windows, входящий в поставку RAD. Для отладки в нем DLL, необходимо просто установить точку 'жесткую' разрыва, добавляя в место необходимой остановки, или в точку входа в DLL строку 'inline($cc);'. Это "разбудит" отладчик, и вы сможете поработать с вашим кодом. [001978]

Общий доступ к памяти, распределенной DLL

Общий доступ к области отображения файлов (Sharing Memory Mapped Files)... Проверьте нижеследующий код:

var HMapping: THandle; PMapData: Pointer; const MAPFILESIZE = 1000; procedure OpenMap; var llInit: Boolean; lInt: Integer; begin HMapping := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, MAPFILESIZE, pchar('ИМЯ ОБЛАСТИ ОТОБРАЖЕНИЯ')); // Проверка наличия llInit := (GetLastError() <> ERROR_ALREADY_EXISTS); if (hMapping = 0) then begin ShowMessage('Невозможно создать объект отображения файла'); Application.Terminate; exit; end; PMapData := MapViewOfFile(HMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0); if PMapData = nil then begin CloseHandle(HMapping); ShowMessage('Невозможно отобразить блок памяти'); Application.Terminate; exit; end; if (llInit) then begin // Если объект отображения создан, инициализируем блок символами #0 memset(PMapData, #0, MAPFILESIZE); end; end; procedure CloseMap; begin if PMapData <> nil then begin UnMapViewOfFile(PMapData); end; if HMapping <> 0 then begin CloseHandle(HMapping); end; end;

Таким образом любые два или более приложения или DLL могут получить указатели к одному и тому же блоку памяти. В данном примере PMapData указывает на 1000-байтный буфер, инициализированный вначале символами #0. Однако существует одна потенциальная проблема - синхронизация доступа к памяти. Решить эту проблему можно с помощью мьютексов. Вот пример их использования:

{ Вызовите LockMap перед записью (и чтением?) объекта отображения файла. Не забывайте после каждого обновления немедленно вызывать UnlockMap. } var HMapMutex: THandle; const REQUEST_TIMEOUT = 1000; function LockMap:Boolean; begin Result := true; HMapMutex := CreateMutex(nil, false, pchar('ИМЯ ВАШЕГО МЬЮТЕКСА')); if HMixMutex = 0 then begin ShowMessage('Не могу создать мьютекс'); Result := false; end else begin if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) = WAIT_FAILED then begin // время ожидания ShowMessage('Невозможно заблокировать объект отображения файла'); Result := false; end; end; end; procedure UnlockMap; begin ReleaseMutex(HMixMutex); CloseHandle(HMixMutex); end;

[000272]

Сегменты данных DLL

Я надеюсь что у вас имеются эти две небольшие строки в главных модулях ваших DLL (если он не содержит обработку прерываний):

(* делаем фиксированные сегменты данных DLL перемещаемыми *) GlobalPageUnlock( DSeg ); GlobalReAlloc(DSeg, 0, GMEM_MODIFY or GMEM_MOVEABLE);

Если вы не будете размещать сегменты данных DLL в нижней части памяти DOS, то вы сможете сэкономить весьма скудные (и важные!) ресурсы...

- Peter Below [000808]

Как избавиться от торможения модальных окон?

Igor Nikolaev aKa The Sprite советует:

Hемодальные диалоговые окна, находящиеся на экране во время выполнения длительных операций,могут реагировать на действия пользователя очень медленно. Это ограничение Windows, и обойти его можно так:

while Flag do begin PerformOperation; Application.ProcessMessages; Flag:=ContinueOperation; end;

[001414]

Как определить номер текущей строки в любом edit-компоненте?

Своим опытом делится Олег Кулабухов:

Посыл сообщения WM_COPY компоненту активного окна заставит его выполнить требуемые действия.

procedure TForm1.Button1Click(Sender: TObject); var LineNumber : integer; begin LineNumber := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, word(-1), 0); ShowMessage(IntToStr(LineNumber)); end;

[001884]

Как отловить сообщения от неклиентской части моей формы, такой, например, как заголовок?

Своим опытом делится Олег Кулабухов:

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

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) private procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage); var s : string; begin case Message.wParam of HTERROR : s := 'HTERROR'; HTTRANSPARENT : s := 'HTTRANSPARENT'; HTNOWHERE : s := 'HTNOWHERE'; HTCLIENT : s := 'HTCLIENT'; HTCAPTION : s := 'HTCAPTION'; HTSYSMENU : s := 'HTSYSMENU'; HTSIZE : s := 'HTSIZE'; HTMENU : s := 'HTMENU'; HTHSCROLL : s := 'HTHSCROLL'; HTVSCROLL : s := 'HTVSCROLL'; HTMINBUTTON : s := 'HTMINBUTTON'; HTMAXBUTTON : s := 'HTMAXBUTTON'; HTLEFT : s := 'HTLEFT'; HTRIGHT : s := 'HTRIGHT'; HTTOP : s := 'HTTOP'; HTTOPLEFT : s := 'HTTOPLEFT'; HTTOPRIGHT : s := 'HTTOPRIGHT'; HTBOTTOM : s := 'HTBOTTOM'; HTBOTTOMLEFT : s := 'HTBOTTOMLEFT'; HTBOTTOMRIGHT : s := 'HTBOTTOMRIGHT'; HTBORDER : s := 'HTBORDER'; HTOBJECT : s := 'HTOBJECT'; HTCLOSE : s := 'HTCLOSE'; HTHELP : s := 'HTHELP'; else s := ''; end; Form1.Caption := s; Message.Result := 0; end; end.

[001915]

Как послать некое сообщение всем формам?

Nomadic предлагает следующий код:

var I: Integer; M: TMessage; ... with M do begin Message := ... ... end; for I := 0 to Pred(Screen.FormCount) do begin PostMessage( Forms[I].Handle, ... ); // Если надо и всем чилдам Forms[I].Broadcast( M ); end;

[001687]

Как послать самостийное сообщение всем главным окнам в Windows?

Nomadic советует:

Пример:

Var FM_FINDPHOTO: Integer; // Для того, чтобы использовать hwnd_Broadcast нужно сперва зарегистрировать уникальное // сообщение. Initialization FM_FindPhoto:=RegisterWindowMessage('MyMessageToAll'); // Чтобы поймать это сообщение в другом приложении (приёмнике) нужно перекрыть DefaultHandler procedure TForm1.DefaultHandler(var Message); begin with TMessage(Message) do begin if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM)  else Inherited DefaultHandler(Message); end; end; // А теперь можно в приложении-передатчике SendMessage(HWND_BROADCAST,FM_FINDPHOTO,0,0);

Кстати, для посылки сообщения дочерним контролам некоего контрола можно использовать метод Broadcast. [001133]

Как сказать компоненту другого окна скопировать свое содержимое в буффер обмена Windows?

Своим опытом делится Олег Кулабухов:

Посыл сообщения WM_COPY компоненту активного окна заставит его выполнить требуемые действия.

SendMessage(Edit1.handle, WM_COPY, 0, 0);

[001881]

Как сообщить какую-то глобальную переменную все (в т.ч. скрытым) окнам программы?

Своим опытом делится Олег Кулабухов:

Решением для такой задачи является рассылка пользовательского сообщения всем окнам массива Screen.Forms

{Code for Unit1} const UM_MyGlobalMessage = WM_USER + 1; type TForm1 = class(TForm) Label1: TLabel; Button1: TButton; procedure FormShow(Sender: TObject); procedure Button1Click(Sender: TObject); { Private declarations } private procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses Unit2; procedure TForm1.FormShow(Sender: TObject); begin Form2.Show; end; procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage); begin Label1.Left := AMessage.WParam; Label1.Top := AMessage.LParam; Form1.Caption := 'Got It!'; end; procedure TForm1.Button1Click(Sender: TObject); var f: integer; begin for f := 0 to Screen.FormCount - 1 do Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42); end; {Code for Unit2} const UM_MyGlobalMessage = WM_USER + 1; type TForm2 = class(TForm) Label1: TLabel; private { Private declarations } procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage; public { Public declarations } end; var Form2: TForm2; implementation {$R *.DFM} procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage); begin Label1.Left := AMessage.WParam; Label1.Top := AMessage.LParam; Form2.Caption := 'Got It!'; end;

[001847]

Моя программа довольно долго делает

Nomadic отвечает:

A: Application.ProcessMessages.

(AA): Если вы хотите отдавать timeslices в нитях, пользуйтесь Sleep(0); это отдаст остаток слайса системе.

(Win16) Если вы хотите разрешить отработку сообщений другим программам, но не вашей, то лучше пользоваться Yield(). [001516]

Рисование на минимизированной иконке

Есть ли у кого пример рисования на иконке минимизированного приложения с помощью Delphi?

Когда Delphi-приложение минимизировано, иконка, которая вы видите - реальное главное окно, объект TApplication, поэтому вам необходимо использовать переменную Application. Таким образом, чтобы удостовериться что приложение минимизировано, вызовите IsIconic(Application.Handle). Если функция возвратит True, значит так оно и есть. Для рисования на иконке создайте обработчик события Application.OnMessage. Здесь вы можете проверять наличие сообщения WM_Paint и при его нахождении отрисовывать иконку. Это должно выглядеть приблизительно так:

... { private declarations } procedure AppOnMessage(VAR Msg : TMsg; VAR Handled : Boolean); ... procedure TForm1.AppOnMessage(VAR Msg : TMsg; VAR Handled : Boolean); VAR DC : hDC; PS : TPaintStuff; begin IF (Msg.Message = WM_PAINT) AND IsIconic(Application.Handle) THEN BEGIN DC := BeginPaint(Application.Handle, PS); ... осуществляем отрисовку с помощью вызовов Windows GDI ... EndPaint(Application.Handle, PS); Handled := True; END; end; procedure TForm1.OnCreate(Sender : TObject); begin Application.OnMessage := AppOnMessage; end;

Код создан на основе алгоритма Neil Rubenking.

Nick Hodges
Monterey, CA [000605]

Сохранение приложения в виде иконки

Как мне после запуска сохранять все время приложение в виде иконки? В свойствах формы вы должны установить WindowState на wsMinimized. В секции класса формы private поместите следующее объявление:

... { private declarations } PROCEDURE WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;

В секции implementation поместите следующую реализацию метода:

PROCEDURE TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen); begin Msg.Result := 0; end;

Это все! Форма всегда будет иконкой. [000625]

Сообщения Windows - введение

Кто-нибудь может со мной поделиться информацией о работе в Delphi с Windows Messages (системные сообщения)? Все эти сообщения типа WM_*** вызывают у меня нервный тик, поскольку это я не могу понять как это работает.

Список всех системных сообщений Windows доступен в файлах электронной справки Delphi. (Я использую D5, но думаю в будущих версиях все останется на своих местах).

Сообщения WM_ (и другие) играют существенную роль в работе Windows. Все вы хорошо знаете, что Delphi первоначально строится на принципе *управления событиями*; наверняка не один раз вы создавали обработчики событий OnKeyPress, OnThis, OnThat и других. Если у вас есть исходный код VCL, вы легко обнаружите, что механизм работы событий в Delphi основан на обработке конкретных системных соощенияй, посылаемых вашему элементу управления (как раз здесь и заложено главное достоинство объектно-ориентированного программирования, когда вы можете создать новый компонент на основе существующего и "научить" его обрабатывать другие необходимые вам системные сообщения). Windows постоянно посылает сообщения в ответ на действия пользователя и ждет соответствующей реакции от приложений Delphi (и всех остальных приложений Windows), заключающейся в их "приеме" и соответствующей обработке. Delphi имеет оболочки для большинства системных сообщений, создав "механизм оповещения элемента управления о приеме сообщения на его адрес" - события для компонентов, как было описано выше.

Кроме приема сообщений, у вас также существует возможность их отправления. Это возможно двумя способами: SendMessage и PostMessage (обе являются Win API функциями), а также метод Delphi Perform. Первые два требуют в качестве параметра Handle указывать дескриптор компонента, которому вы шлете сообщение, тогда как Perform является методом, принадлежащим самому компоненту. Сообщения передаются в стандартную очередь системных сообщений и обрабатываются подобно другим сообщениям.

Вот тривиальный пример: я хочу (по некоторой причудливой причине) вставлять в TMemo символ 'y' каждый раз после набора цифры '4'. (Обдумайте способ автоматической вставки блока begin-end или заключительной скобки.) Я, конечно, мог бы поработать с Memo-свойством Lines, но это было бы не так красиво и достаточно громоздко. Вот как выглядит наш пример с использованием сообщений:

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char); begin if Key = '4' then SendMessage(Memo1.Handle, WM_CHAR, Word('y'), 0); end;

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

procedure TFormEffortRates.ComboBoxMaterialKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var iShowing : integer; { какой-то код, затем... } begin { С помощью сообщения узнаем состояние ("раскрытость") ComboBox'а } iShowing := SendMessage((Sender as TComboBox).Handle, CB_GETDROPPEDSTATE, 0, 0); if iShowing = 0 then { раскрываем ComboBox } SendMessage((Sender as TComboBox).Handle, CB_SHOWDROPDOWN, 1,0); end;

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

function TMDIChild.GetMemoColumn(const TheMemo : TMemo) : integer; begin Result := TheMemo.SelStart - (SendMessage(TheMemo.Handle, EM_LINEINDEX, GetMemoLine(TheMemo), 0)); end; function TMDIChild.GetMemoLine(const TheMemo : TMemo) : integer; begin Result := SendMessage(TheMemo.Handle, EM_LINEFROMCHAR, TheMemo.SelStart, 0); end;

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

Короче говоря, сообщения API позволяют тонко управлять вашими приложениями, выполняя именно те задачи, которые вам необходимо решить (метод "точечной наводки"). Вам необходимо лишь выбрать цель и передать свою просьбу понравившемуся элементу управления (или самому ловить такие сообщения). [000288]

Возможно ли определение изменения времени другим приложением?

Своим опытом делится Олег Кулабухов:

Нижеприведенный код демонстрирует это. Учтите, что приложение, меняющее время должно передать сообщение WM_TIMECHANGE всем другим приложениям.

type TForm1 = class(TForm) private { Private declarations } procedure WMTIMECHANGE(var Message: TWMTIMECHANGE); message WM_TIMECHANGE; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE); begin Form1.Caption := 'Time Changed'; end;

[001902]

Динамические и виртуальные методы

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

type   t = class function a : integer; {статический} function b : integer; virtual; function c : integer; dynamic; property i : integer read a; { ok } property j : integer read b; { ok } property k : integer read c; { ОШИБКА: type mismatch (несовпадение типа) } end;

[000339]

Функции обратного вызова

{function FindWindowHandle (HuntFor: string): HWnd;} {----------------------------------------------------------------} { Ищем родительское окно с заголовком, содержащим строку HuntFor.} { Возвращаем дескриптор окна, или 0, если ничего не найдено.     } {----------------------------------------------------------------} { Приведенный ниже код является логической частью     } { FindWindowHandle, но расположен здесь, поскольку    } { реальная функция FindWindowHandle, реализованная    } { Borland, не допускает вложенных функций возврата.   } {-----------------------------------------------------} type PHuntRec = ^THuntRec; THuntRec = record HuntingFor: string; WindowFound: HWnd; end; function EnumWindowsFunc (WindowHandle: HWnd; lParam: Longint): WordBool; export; {-----------------------------------------------------} { Callback-функция, используемая FindWindowHandle.    } {-----------------------------------------------------} var ATitle: array[0..255] of Char; begin GetWindowText(WindowHandle, PChar(@ATitle), 255); if StrContains(StrPas(PChar(@ATitle)), PHuntRec(lParam)^.HuntingFor, CaseInsensitive) then begin PHuntRec(lParam)^.WindowFound := WindowHandle; EnumWindowsFunc := false;     {останавливаем просмотр} end else EnumWindowsFunc := true   {продолжаем просмотр} end; {EnumWindowsFunc} function FindWindowHandle (HuntFor: string): HWnd; var Proc: TFarProc; HuntRec: PHuntRec; begin GetMem(HuntRec, SizeOf(THuntRec)); HuntRec^.HuntingFor := HuntFor; HuntRec^.WindowFound := 0; Proc := MakeProcInstance(@EnumWindowsFunc, HInstance); EnumWindows(Proc, Longint(HuntRec)); FreeProcInstance(Proc); FindWindowHandle := HuntRec^.WindowFound; FreeMem(HuntRec, SizeOf(THuntRec)); end; {FindWindowHandle}

[001993]

Использование SetBounds

Вы можете не задавать отдельно параметры Left, Top, Height и Width при использовании

SetBounds(l,t,w,h);

Например

Abc.Left = 25;

генерит

SetBounds(25,Abc.Top,Abc.Width,Abc.Height);

[000452]

Макро-процедуры

Каким образом мне можно использовать переменную типа String в качестве имени процедуры?

Если все процедуры, которые вы собираетесь вызывать имеют список с одними и теми же параметрами, (или все без параметров), то это не трудно. Для этого необходимо:

процедурный тип, соответствующий вашей процедуре, например:

Type TMacroProc = Procedure( param: Integer );

массив, "подключающий" имена процедур к их адресам во время выполнения приложения:

Type TMacroName  = String[32]; TMacroLink = Record name: TMacroName; proc: TMacroProc; End; TMacroList = Array [1..MaxMacroIndex] Of TMacroLink; Const Macros: TMacroList=( (name: 'Proc1'; proc: Proc1 ), (name: 'Proc2'; proc: Proc2 ), .....);

интерпретатор функций, типа:

Procedure CallMacro( name: String; param: Integer ); Var i: Integer; Begin For i := 1 To MaxMacroIndex Do If CompareText( name, Macros[i].name ) = 0 Then Begin Macros[i].proc( param ); Break; End; End;

Макро-процедуры необходимо объявить в секции Interface модуля или с ключевым словом Far, например:

Procedure Proc1( n: Integer ); far; Begin .... End; Procedure Proc2( n: Integer ); far; Begin .... End;

Peter Below [000691]

Override/Vitual/Dynamic - методы

Если метод в классе предка объявлен как виртуальный (virtual) или динамический (dynamic), вам необходимо перекрыть его во всех классах-наследниках. Если вы объявляете наследованный метод виртуальным или динамическим, вы начинаете строить его новое виртуальное/динамическое дерево наследования. Допустим, у нас есть следующая иерархия: A (родитель) - B - C - D. Если вы объявляете метод как виртуальный (или динамический) в A, перекрываете в B, создаете виртуальным в C и перекрываете в D, вот что получается: фактический класс, используемый класс, использующий класс для доступа к методу метод -----------+---------------------+-------------------- D D D D C D D B B D A B C C C C B B C A B B B B B A B Вывод: работа виртуального/динамического наследования прекращается в момент создания одноименного виртуального/динамического метода наследниками класса.

Mark [000643]

Перекрытие виртуальных методов

Кто-нибудь знает, в чем разница между перекрытием (OVERRIDING) виртуального метода и заменой (REPLACING) его? Я немного запутался.

Допустим у вас есть класс:

TMyObject = class (TObject)

и его наследник:

TOverrideObject = class (TMyObject)

К примеру, TMyObject имеет метод Wiggle:

procedure Wiggle; virtual;

а TOverrideObject перекрывает Wiggle:

procedure Wiggle; override;

и, естественно, вы реализовали оба метода.

Теперь вы создаете TList, содержащий целую кучу MyObjects и OverrideObjects в свойстве TList.Items[n]. Свойство Items является указателем, поэтому для вызова метода Wiggle вам достаточно вызвать необходимый элемент списка. Например так:

if TObject(Items[1]) is TMyObject then TMyObject(Items[1]).Wiggle else if TObject(Items[1]) is TOverrideObject then TOverrideObject(Items[1]).Wiggle;

но возможности полиморфизма и директива override позволяют вам сделать так:

TMyObject(Items[1]).Wiggle;

Ваше приложение посмотрит на экземпляр специфического объекта, ссылка на который содержится в Items[1] и скажет: "Да, это - TMyObject, но, точнее говоря, это TOverrideObject; но поскольку метод Wiggle является виртуальным методом и TOverrideObject переопределил метод Wiggle, я собираюсь выполнить метод TOverrideObject.Wiggle, а не метод TMyObject.Wiggle."

Теперь представьте себе, что при декларации метода вы пропустили директиву override, попробуйте это выполнить теперь:

TMyObject(Items[1]).Wiggle;

Приложение и в этом случае должно "видеть" данный метод, даже если Items[1] - TOverrideObject; но у него отсутствует перекрытая версия метода Wiggle, поэтому приложение выполнит TMyObject.Wiggle, а не TOverrideObject.Wiggle (поведение, которое вы можете как хотеть, так и избегать).

Так, перекрытый метод функционально может отличаться от декларированного метода, содержащего директиву virtual (или dynamic) в базовом классе, и объявленный с директивой override в классе-наследнике. Для замены метода необходимо объявить его в классе-наследнике без директивы override. Перекрытые методы могут выполняться даже тогда, когда специфический экземпляр класса-предка является точной копией базового класса. "Замененные" методы могут выполняться только тогда, когда специфический экземпляр является "слепком" только этого класса.

[000297]

Подключение процедур к созданным компонентам

...я могу порекомендовать перекрыть события по-умолчанию KeyPress, Click, DblClick и прочие. Вот пример того, как можно перекрыть процедуру Click:

(Объявление в секции класса protected)

procedure Click ; override ;

(Следующий код должен располагаться в секции implementation)

procedure GOKButton.Click ; begin inherited Click ; (Owner as TForm).Close ; end ;

[001991]

Выполнение процедуры по адресу

var F:procedure(x,y:double); @F := GetProcAddress( hDLL, 'SOMEPROC'); F(3,4);

Ключом здесь является использование оператора @, располагаемого с левой части процедурной переменной. Он говорит компилятору: "Не волнуйтесь здесь о совместимости типов, просто присвойте полученный в правой части выражения адрес переменной в левой части выражения (и процедурные переменные являются переменными-указателями).

- Peter Below [000811]

Вызов процедуры, имя которой содержится в переменной I

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

unit ProcDict; interface type MyProc = procedure (s : String); procedure RegisterProc(procName : String; proc : MyProc); procedure ExecuteProc(procName : String; arg : String); implementation uses Classes; var ProcDict : TStringList; procedure RegisterProc(procName : String; proc : MyProc); begin ProcDict.AddObject(procName, TObject(@proc)); end; procedure ExecuteProc(procName : String; arg : String); var index : Integer; begin index := ProcDict.IndexOf(ProcName); if index >= 0 then MyProc(ProcDict.objects[index])(arg); // Можно вставить обработку исключительной ситуации - сообщение об ошибке end; initialization ProcDict := TStringList.Create; ProcDict.Sorted := true; finalization ProcDict.Free; end.

[000307]

Как мне использовать переменную типа string в качестве имени процедуры?

Никак. Тем не менее, вы могли бы создать StringList как показано ниже:

StringList.Create; StringList.AddObject('Proc1',@Proc1); StringList.AddObject('Proc2',@Proc2);

и затем реализовать это в вашей программе:

var myFunc : procedure; begin if Stringlist.indexof(S) = -1 then MessageDlg('Не понял процедуру '+S,mtError,[mbOk],0) else begin @myFunc := Stringlist.Objects[Stringlist.indexof(S)]; myFunc; end;

RAM [000697]

AT-команды модема

AT-команды модема
Команда	Описание
A	Команда ответа (Answer Command)
Bn	Настройка связи (Communications Options)
D	Команда набора (Dial Command)
En	Команда выбора символа эха (Select Command Character Echo Option)
Hn	Управление Switchhook - эмуляция нажатия телефонного рычага (Control The Switchhook)
I0	Идентификация кода продукта (Identify The Product Code)
I2	Выполнение теста контрольной суммы ROM ( Perform ROM Checksum Test)
I7	Номер версии (Version Number)
Ln	Выбор уровня громкости динамика (Select Speaker Volume Level)
Mn	Функция выбора опций динамика (Select Speaker Function Option)
Nn	Выбор опций для установления связи (Select Negotiate Handshake Option)
On	Переход к онлайновым командам (Go Online Command)
P	Выбор метода пульсового набора (Select Pulse Dialing Method)
Qn	Выбор опции результирующего кода (Select Result Code Option)
Sn=	Запись в S-регистр (Write To An S-Register)
Sn?	Чтение S-регистра (Read An S-Register)
T	Выбор метода тонового набора (Select Tone Dialing Method)
Vn	Выбор опции формата ответа (Select Response Format Option)
Wn	Выбор расширенного результирующего кода (Select Extended Result Code)
Xn	Выбор опции модемного вызова (Select Call Progress Option)
Yn	Выбор опции бездействия для разъединения (Select Long Space Disconnect Option)
Zn	Выполнение мягкого сброса (Perform Soft Reset)
&An	Выбор роли автоответчика (Select Originate/Answer Role For Autoanswer)
&Cn	Выбор опции определения передаваемых данных (Select Data Carrier Detect Option)
&Dn	Выбор опции готовности терминала данных (Select Data Terminal Ready Option)
&F	Загрузка заводских установок (Load Factory Default Profile)
&Gn	Выбор опции защиты тонового набора (Select Guard Tone Option)
&Kn	Выбор опций потока ConTDol (Select Flow ConTDol Option)
&Pn	Выбор параметров пульсового набора (Select Pulse Dialing Parameters)
&Qn	Выбор опций режима связи (Select Communications Mode Option)
&Rn	Выбор опций RTS/CTS (Select RTS/CTS Option)
&Sn	Выбор опций готовности передачи данных (Select Data Set Ready Option)
&T0	Тест завершения в процессе (Terminate Test In Process)
&T1	Инициирование локального аналога сетевой петли (Initiate Local Analog Loopback)
&T3	Выполнение локальной цифровой сетевой петли (Perform Local Digital Loopback)
&T4	Включение предоставления RDL-запросов (Enable Granting Of RDL Requests)
&T5	Запрет предоставления RDL-запросов (Deny Granting Of RDL Requests)
&T6	Инициирование удаленной цифровой сетевой петли (Initiate Remote Digital Loopback)
&T7	Иниицирование внутреннего теста RDL (Initiate RDL With Self Test)
&T8	Внутренний тест локальной сетевой петли (Local Loopback With Self Test)
&T19	Выполнение теста RTS/CTS кабеля (Perform RTS/CTS Cable Test)
&Un	Отмена TDellis кодирования (Disable TDellis Coding)
&V	Просмотр профилей конфигурации (View Configuration Profiles)
&Wn	Сохранение активного профиля (Store Active Profile)
&Xn	Выбор источника синхронизации времени TDansmit (Store Active Profile)
&Yn	Выбор сохранения профиля для аппаратного перезапуска (Select Stored Profile For Hard Reset)
&Zn=	Сохранение телефонного номера (Store Telephone Number)
,	Пауза (Perform Pause)
=	Запись в S-регистр (Write To An S-Register)
?	Чтение S-регистра (Read An S-Register)
P	Выбор пульсового набора (Select Pulse Dialing)
Т	Тоновый набор (Tone)

[000179]

Как использовать TAPI для набора телефона, чтобы поговорить голосом?

Олег Кулабухов приводит следующий код:

{tapi Errors} const TAPIERR_CONNECTED = 0; const TAPIERR_DROPPED = -1; const TAPIERR_NOREQUESTRECIPIENT = -2; const TAPIERR_REQUESTQUEUEFULL = -3; const TAPIERR_INVALDESTADDRESS = -4; const TAPIERR_INVALWINDOWHANDLE = -5; const TAPIERR_INVALDEVICECLASS = -6; const TAPIERR_INVALDEVICEID = -7; const TAPIERR_DEVICECLASSUNAVAIL = -8; const TAPIERR_DEVICEIDUNAVAIL = -9; const TAPIERR_DEVICEINUSE = -10; const TAPIERR_DESTBUSY = -11; const TAPIERR_DESTNOANSWER = -12; const TAPIERR_DESTUNAVAIL = -13; const TAPIERR_UNKNOWNWINHANDLE = -14; const TAPIERR_UNKNOWNREQUESTID = -15; const TAPIERR_REQUESTFAILED = -16; const TAPIERR_REQUESTCANCELLED = -17; const TAPIERR_INVALPOINTER = -18; {tapi size constants} const TAPIMAXDESTADDRESSSIZE = 80; const TAPIMAXAPPNAMESIZE = 40; const TAPIMAXCALLEDPARTYSIZE = 40; const TAPIMAXCOMMENTSIZE = 80; const TAPIMAXDEVICECLASSSIZE = 40; const TAPIMAXDEVICEIDSIZE = 40; function tapiRequestMakeCallA(DestAddress : PAnsiChar; AppName : PAnsiChar; CalledParty : PAnsiChar; Comment : PAnsiChar) : LongInt; stdcall; external 'TAPI32.DLL'; function tapiRequestMakeCallW(DestAddress : PWideChar; AppName : PWideChar; CalledParty : PWideChar; Comment : PWideChar) : LongInt; stdcall; external 'TAPI32.DLL'; function tapiRequestMakeCall(DestAddress : PChar; AppName : PChar; CalledParty : PChar; Comment : PChar) : LongInt; stdcall; external 'TAPI32.DLL'; procedure TForm1.Button1Click(Sender: TObject); var DestAddress : string; CalledParty : string; Comment : string; begin DestAddress := '1-555-555-1212'; CalledParty := 'Frank Borland'; Comment := 'Calling Frank'; tapiRequestMakeCall(pChar(DestAddress), PChar(Application.Title), pChar(CalledParty), PChar(Comment)); end; end.

[001839]

Как набрать номер модемом?

Олег Кулабухов приводит следующий код:

var hCommFile : THandle; procedure TForm1.Button1Click(Sender: TObject); var PhoneNumber : string; CommPort : string; NumberWritten : LongInt; begin PhoneNumber := 'ATDT 1-555-555-1212' + #13 + #10; CommPort := 'COM2'; {Open the comm port} hCommFile := CreateFile(PChar(CommPort), GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hCommFile=INVALID_HANDLE_VALUE then begin ShowMessage('Unable to open '+ CommPort); exit; end; {Dial the phone} NumberWritten:=0; if WriteFile(hCommFile, PChar(PhoneNumber)^, Length(PhoneNumber), NumberWritten, nil) = false then begin ShowMessage('Unable to write to ' + CommPort); end; end; procedure TForm1.Button2Click(Sender: TObject); begin {Close the port} CloseHandle(hCommFile); end;

[001838]

Nomadic советует:

unit PortInfo; interface uses Windows, SysUtils, Classes, Registry; function EnumModems : TStrings; implementation function EnumModems : TStrings; var R : TRegistry; s : ShortString; N : TStringList; i : integer; j : integer; begin Result:= TStringList.Create; R:= TRegistry.Create; try with R do begin RootKey:= HKEY_LOCAL_MACHINE; if OpenKey('\System\CurrentControlSet\Services\Class\Modem', False) then if HasSubKeys then begin N:= TStringList.Create; try GetKeyNames(N); for i:=0 to N.Count - 1 do begin closekey; { + } openkey('\System\CurrentControlSet\Services\Class\Modem',false); { + } OpenKey(N[i], False); s:= ReadString('AttachedTo'); for j:=1 to 4 do if Pos(Chr(j+Ord('0')), s) > 0 then Break; Result.AddObject(ReadString('DriverDesc'),TObject(j)); CloseKey; end; finally N.Free; end; end; end; finally R.Free; end; end; end.

[001102]

Олег Кулабухов приводит следующий код:

procedure TForm1.Button1Click(Sender: TObject); var CommPort : string; hCommFile : THandle; ModemStat : DWord; begin CommPort := 'COM2'; {Open the comm port} hCommFile := CreateFile(PChar(CommPort), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hCommFile = INVALID_HANDLE_VALUE then begin ShowMessage('Unable to open '+ CommPort); exit; end; {Get the Modem Status} if GetCommModemStatus(hCommFile, ModemStat) <> false then begin if ModemStat and MS_CTS_ON <> 0 then ShowMessage('The CTS (clear-to-send) is on.'); if ModemStat and MS_DSR_ON <> 0 then ShowMessage('The DSR (data-set-ready) is on.'); if ModemStat and MS_RING_ON <> 0then ShowMessage('The ring indicator is on.'); if ModemStat and MS_RLSD_ON <> 0 then ShowMessage('The RLSD (receive-line-signal-detect) is on.'); end; {Close the comm port} CloseHandle(hCommFile); end;

[001920]

S-регистры модема

S-регистры модема
Регистр	Описание
S0	Звонок, на который необходимо ответить (Ring After Which To Answer)
S1	Количество звонков (Ring Count)
S2	Символ отмены (Hayes Escape Character)
S3	Символ перевода строки (Carriage Return Character)
S4	Символ пропуска строки (Line Feed Character)
S5	Символ пробела (Backspace Character)
S6	Ожидание перед вызывом (Wait Before Blind Dialing)
S7	Ожидание ответа (Wait For Carrier)
S8	Время паузы для запятой (Pause Time For Comma)
S9	Время восстановления (Carrier Recovery Time)
S10	Время задержки для поднятия трубки после потери соединения (Lost Carrier Hang Up Delay)
S11	Время DTMF соединения (DTMF Dialing Speed)
S12	Время защиты отмены (Hayes Escape Guard Time)
S16	Выполнение теста (Test in Progress)
S18	Тест таймера модема (Modem Test Timer)
S19	Настройки автосинхронизации (AutoSync Options)
S25	Обнаружено изменение DTD (Detect DTD Change)
S26	Интервал задержки RTS для CTS (RTS To CTS Delay Interval)
S30	Неактивное время ожидания (Inactivity Timeout)
S31	Символ XON (XON Character)
S32	Символ XOFF (XON Character)
S36	Ошибка согласования TDeatment (Negotiation Failure TDeatment)
S37	Ускорение DCE линии (Desired DCE Line Speed)
S38	Время ожидания снятия трубки (Hang-up Timeout)
S43	Текущая скорость линии (Current Line Speed)
S44	Техническая конструкция (Framing Technique)
S46	Выбор протокола/компрессии (Protocol/Compression Selection)
S48	Действие характеристики согласования (Feature Negotiation Action)
S49	Низкий предел буфера (Buffer Low Limit)
S50	Высокий предел буфера (Buffer High Limit)
S70	Максимальное число ReTDansmissions (Maximum Number of ReTDansmissions)
S73	Неактивное время ожидания (No Activity Timeout)
S82	Выбор прерывания (Break Selection)
S86	Код причины неудачной связи (Connection Failure Cause Code)
S91	Выбор уровня TDansmit коммутируемой линии (Select Dial-up Line TDansmit Level)
S95	Расширенный результат кода битовой карты (Extended Result Code Bit Map)
S97	Позднее время соединения - снятия трубки (V.32 Late Connecting Handshake Timing)
S105	Размер кадра (Frame Size)
S108	Селектор качества сигнала (Signal Quality Selector)
S109	Селектор скорости соединения (Carrier Speed Selector)
S110	Селектор V.32/V.32 bis (V.32/V.32 bis Selector)
S113	Тональный вызов ConTDol (Calling Tone ConTDol)
S121	Использование DTD (Use of DTD)
S141	Таймер фазы обнаружения (Detection Phase Timer)
S142	Онлайновый формат символов (Online Character Format)
S144	Выбор скорости автобода (Autobaud Speed Group Selection)

[000180]

Добавление события OnMouseLeave

Все потомки TComponent могут посылать сообщения CM_MOUSEENTER и CM_MOUSELEAVE во время вхождения и покидания курсора мыши области компонента. Если вам необходимо, чтобы ваши компоненты обладали реакцией на эти события, необходио написать для них соответствующие обработчики.

procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE; .. .. .. procedure MyComponent.CMMouseEnter(var msg:TMessage); begin inherited; {действия на вход мыши в область компонента} end; procedure MyComponent.CMMouseLeave(var msg: TMessage); begin inherited; {действия на покидание мыши области компонента} end;

Дополнение

Часто приходится сталкиваться с ситуацией, когда необходимо обработать два важных события для визуальных компонентов: MouseEnter - когда событие мыши входит в пределы визуального компонента; MouseLeave - когда событие мыши оставляет его пределы. Известно, что все Delphi объявляет эти сообщения в виде: Cm_MouseEnter; Cm_MouseLeave. Т.е. все визуальные компоненты, которые порождены от TControl, могут отлавливать эти события. Следующий пример показывает как создать наследника от TLabel и добавить два необходимых события OnMouseLeave и OnMouseEnter.

(*///////////////////////////////////////////////////////*) (*// Author: Briculski Serge (*// E-Mail: bserge@airport.md (*// Date: 26 Apr 2000 (*// (*////////////////////////////////////////////////////////*) unit BS_Label; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TBS_Label = class(TLabel) private { Private declarations } FOnMouseLeave: TNotifyEvent; FOnMouseEnter: TNotifyEvent; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; protected { Protected declarations } public { Public declarations } published { Published declarations } property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; end; procedure Register; implementation procedure Register; begin RegisterComponents('Custom', [TBS_Label]); end; { TBS_Label } procedure TBS_Label.CMMouseEnter(var Message: TMessage); begin if Assigned(FOnMouseEnter) then FOnMouseEnter(Self); end; procedure TBS_Label.CMMouseLeave(var Message: TMessage); begin if Assigned(FOnMouseLeave) then FOnMouseLeave(Self); end; end.

Best regards,
Briculski, bserge@airport.md [000181]

Использование анимированных курсоров

Привет.

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

Вот пример:

(mycursor.ani - файл, содержащий анимированный курсор. Вы можете создать его с помощью программы Microsoft aniedit.exe)

const crMyCursor = 1; procedure TForm1.FormCreate(Sender: TObject); begin // Загружаем курсор. Единственный способ для этого Screen.Cursors[crMyCursor] := LoadCursorFromFile('c:\mystuff\mycursor.ani'); // Используем курсор на форме Cursor := crMyCursor; end;

Я надеюсь, что помог вам этой информацией.

[000182]

Изменение положения курсора мыши

Nomadic советует:

Установка курсора мыши в определенное место

Чтобы установить курсор мыши в какое-либо место экрана необходимо воспользоваться функцией SetCursorPos(x,y); Например: Чтобы установить курсор в верхний левый угол монитора нужно написать следующий код: SetCursorPos(0,0);

Получение координат курсора

Для начала необходимо определить переменную pos типа TPoint.

Сначала:

//Вне процедуры! Type Tpoint = record x:integer; y:integer; end;

Потом объявляете саму переменную :

Var Pos: TPoint;

И собcтвенно получение координат:

begin; GetCursorPos(pos); x:=pos.x; y:=pos.y; end;

[001768]

Как определить, что мышь находится над моей формой?

Олег Кулабухов приводит следующий код:

Используйте функцию GetCapture.

procedure TForm1.FormDeactivate(Sender: TObject); begin ReleaseCapture; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,B Y: Integer); begin If GetCapture = 0 then SetCapture(Form1.Handle); if PtInRect(Rect(Form1.Left, Form1.Top, Form1.Left + Form1.Width, Form1.Top + Form1.Height), ClientToScreen(Point(x, y))) then Form1.Caption := 'Mouse is over form' else Form1.Caption := 'Mouse is outside of form'; end;

[001899]

Определение и использование курсора

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

implementation {$R MyApp01.Res}

Вы не можете назначить курсор свойству компонента Cursor или DragCursor из .RES-файла напрямую, необходимо выполнить несколько промежуточных шагов. В каждом проекте Delphi определяет глобальный объект с именем Screen (тип TScreen), который, между прочим, определяет массив курсоров, называемый, как ни странно, Cursors. Когда вы щелкаете на свойстве Cursor/DragCursor в Инспекторе объектов, выпадающий список и есть список элементов указанного массива.

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

Для начала определите константу, допустим так:

Const MyCursor = 1;

Далее необходимо загрузить курсор. Сделать это можно в обработчике события формы OnCreate:

Screen.Cursors[MyCursor] := LoadCursor(HInstance, 'MYCURSOR');

Затем просто установите в свойстве DragCursor любого элемента управления:

MyListbox.DragCursor := MyCursor;

Примечание: имя вашего курсора всегда должно писаться в ВЕРХНЕМ регистре, как при вызове LoadCursor, так и в его названии в .RES-файле. [000473]

Подсветка компонента во время перемещения над ним мыши

Я хочу создать компонент, реагирующий на перемещение мыши над его областью, но не знаю как.

Вы должны обрабатывать сообщения CM_MOUSEENTER и CM_MOUSELEAVE примерно таким образом:

TYourObject = class(TAnyControl) ... private FMouseInPos : Boolean; procedure CMMouseEnter(var AMsg: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var AMsg: TMessage); message CM_MOUSELEAVE; ... end; implementation procedure TYourObject.CMMouseEnter(var AMsg: TMessage); begin FMouseInPos := True; Refresh; end; procedure TYourObject.CMMouseLeave(var AMsg: TMessage); begin FMouseInPos := False; Refresh; end;

...затем читать параметр FMouseInPos при прорисовке области компонента или использовать иное решение. [000185]

Покидание мыши области компонента

Кто-нибудь знает как мне определить момент покидания мыши области компонента?

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (X = 0) or (X = Panel1.Width) or (Y = 0) or (Y = Panel1.Width) then Screen.Cursor := crHSplit else Screen.Cursor := crDefault; end;

Техника, которую я применяю, подразумевает использование события OnMouseMove ВСЕМИ моими компонентами, (включая панель, на которой они расположены). В момент покидания мыши области кнопки возникает событие Panel.OnMouseMove у панели, на которой она расположена. Это может показаться непрактичным, но для решения моей задачи вполне подходит. BTW, было бы неплохо соорудить компонент, который имел бы опубликованными все события, начинающиемя с префикса CM_xxx, в этом случае ни одна из манипуляций мыши в области компонента не осталась бы незамеченной. Для справки привожу порядок возникновения всех возможных событий мыши: попадание мыши в область клиента OnEnter, MouseMove - перемещение мыши, следом идет щелчок OnClick, затем двойной щелчок и, наконец, уход мыши с области клиента (OnExit). [000186]

Поменять кнопки мышки местами

Nomadic советует:

Begin //--------- SwapMouseButton(true);  // Поменять обратно - SwapMouseButton(false); //--------- end;

[001764]

Создание мышиного перехватчика

library Hookdemo; uses Beeper in '\DELDEMOS\HOOKDEMO\BEEPER.PAS'; exports SetHook index 1, UnHookHook index 2, HookProc index 3; begin HookedAlready:=False; end.

, где beeper.pas содержит следующий код:

unit Beeper; interface uses Wintypes,Winprocs,Messages; function SetHook:Boolean;export; function UnHookHook:Boolean;export; function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export; var HookedAlready:Boolean; implementation var ourHook:HHook; function SetHook:Boolean; begin if HookedAlready then exit; ourHook:=SetWindowsHookEx(WH_MOUSE,HookProc,HInstance,0); HookedAlready:=True; end; function UnHookHook:Boolean; begin UnHookWindowsHookEx(ourHook); HookedAlready:=False; end; function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint; begin if (wParam=WM_LBUTTONDOWN) then MessageBeep(0); result:=CallNextHookEx(ourHook,Code,wParam,lParam); end; end.

Теперь, при вызове из приложения функции SetHook, при каждом нажатии левой кнопки мыши будет раздаваться сигнал - до тех пор, пока вы не вызовете функцию UnHookHook. В действующем приложении возвращаемое функцией CallNextHookEx значение < 0 сведетельствует об отсутствии манипуляций с мышью.

[000183]

Управление MouseOver через Hint

Cуществует ли какой-либо способ отловить момент попадания курсора в область компонента? А его уход оттуда? Мне необходимо убедиться в видимости элемента управления под курсором мыши и совершить над ним некоторые действия.

Вы можете приспособить для этих целей метод OnHint класса TApplication. Данный метод вызывается при перемещении мыши над компонентом и, обычно в ответ на это, становится видимой всплывающая подсказка, а заголовок компонента присваивается величине Application.Hint. Тем не менее вы НЕ должны пользоваться этим решением. Зато при наступлении события вы можете проверять величину Hint для определения того, над каким компонентом в данный момент находится курсор мыши. Стоящая попытка, во всяком случае!

Вот некоторые детали для усвоения идеи. Я расположил на форме компоненты button, edit и label, установил их свойство Hint соответственно в 'Button', 'Edit' и 'Label', и создал несколько их дубликатов. Далее я добавил компонент TRadioGroup, содержащий три элемента, Button, Edit и Label. И, наконец, я реализовал метод приложения OnHint следующим образом:

procedure TForm1.AppOnHint(Sender: TObject); begin WITH Application DO IF Hint='Button' THEN RadioGroup1.ItemIndex := 0 ELSE IF Hint='Edit' THEN RadioGroup1.ItemIndex := 1 ELSE IF Hint='Label' THEN RadioGroup1.ItemIndex := 2 ELSE RadioGroup1.ItemIndex := -1; end;

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

- Neil

Событие OnShowHint в данном контексте, по-моему мнению, должно подойти больше, поскольку HintControl уже доступен в записи THintInfo объекта TShowHintEvent. К тому же, с помощью него гораздо удобнее производить проверку типа и др.... и вы все еще можете при желании использовать всплывающие подсказки по назначению.

-= Gary =- (TurboPower Software)

О да! Эта идея еще интереснее. И как я ее пропустил! Хотя, с другой стороны, получение информации теперь будет связано с задержкой, обозначенной величиной HintPause. Конечно можно установить HintPause в 0... Главное, что это работает. Классная идея!

- Neil [000588]

Nomadic советует:

procedure TForm1.Timer1Timer(Sender: TObject); begin mouse_event(MOUSEEVENTF_MOVE, Random(21) - 10, Random(21) - 10, 0, 0); end;

[001745]

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;

[000198]

Excel

Подскажите мне основные функции OLE Automation для работы с Excel из Delphi.

Есть множество статей по этому вопросу. Смотри также материал по адресу http://vzone.virgin.net/graham.marshall/excel.htm#excel.htm.

Я не могу привести полный код моего проекта, здесь я поместил лишь его небольшую часть, создающую и форматирующую таблицу Excel на основе содержимого DBGrid, сгенеренного с помощью SQL запроса. Код содержит некоторое форматирование ячеек. Код проверен в работе с Delphi 3 и Excel 97:

procedure TfrmBlank.btnExcelClick(Sender: TObject); var XL, XArr: Variant; i : Integer; j : Integer; begin {не забудьте включить ComObj в список используемых модулей} // Создаем массив элементов, полученных в результате запроса XArr:=VarArrayCreate([1,EmailQuery.FieldCount],varVariant); XL:=CreateOLEObject('Excel.Application');     // Создание OLE объекта XL.WorkBooks.add; XL.visible:=true; j := 1; EmailQuery.First; while not EmailQuery.Eof do begin i:=1; while i<=EmailQuery.FieldCount do begin XArr[i] := EmailQuery.Fields[i-1].Value; i := i+1; end; XL.Range['A'+IntToStr(j), CHR(64+EmailQuery.FieldCount)+IntToStr(j)].Value := XArr; EmailQuery.Next; j := j + 1; end; XL.Range['A1',CHR(64+EmailQuery.FieldCount)+IntToStr(j)].select; // XL.cells.select;                     // Выбираем все XL.Selection.Font.Name:='Garamond'; XL.Selection.Font.Size:=10; XL.selection.Columns.AutoFit; XL.Range['A1','A1'].select; end;

Дополнение

При однопроходной передачи полной страницы гораздо удобнее использовать двумерный Variant Array, чем запихивать данные туда построчно. Функция VarArrayCreate позволяет создать многомерные массивы при определении 2N (где N - кол-во измерений) границ массива в аргументе Bounds.

Konstantin Khripkov [000196]

Не работает передача данных по OLE в русский Excel

Nomadic отвечает:

A: (SM): Дело в том что в VCL твои команды OLE2 передаются Excel'у в русском контексте (не знаю, как это правильно назвать). Для исправления необходимо найти в файле OLEAUTO.pas в функции GetIDsOfNames строчку

if Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, NameCount, LOCALE_SYSTEM_DEFAULT, DispIDs) <> 0 then

и заменить ее на

if Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, NameCount, ((LANG_ENGLISH+SUBLANG_DEFAULT*1024)+SORT_DEFAULT* 65536 ), DispIDs) <> 0 then

После этого у меня Excel стал понимать нормальные английские команды :)). Необходимая комбинация для установки английского языка взята из C-шных хедеров. [001498]

Пересылка данных в ячейки Excel

Mikhail Andronov советует:

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

Привожу полностью все файлы проекта:

Main.dfm

object Form1: TForm1 Left = 267 Top = 137 AutoScroll = False Caption = 'Экспорт результатов SELECT в Excel' ClientHeight = 277 ClientWidth = 519 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 8 Top = 4 Width = 114 Height = 13 Caption = 'Предложение SELECT' end object Label2: TLabel Left = 8 Top = 224 Width = 91 Height = 13 Caption = 'Имя базы данных' end object btnExport: TButton Left = 436 Top = 20 Width = 75 Height = 25 Caption = 'Экспорт' TabOrder = 0 OnClick = btnExportClick end object memSelect: TMemo Left = 8 Top = 20 Width = 417 Height = 197 TabOrder = 1 end object edtDatabaseName: TEdit Left = 8 Top = 240 Width = 413 Height = 21 TabOrder = 2 end object queSelect: TQuery Left = 24 Top = 20 end end

Main.pas

unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Db, DBTables; type TForm1 = class(TForm) queSelect: TQuery; btnExport: TButton; memSelect: TMemo; edtDatabaseName: TEdit; Label1: TLabel; Label2: TLabel; procedure btnExportClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses ComObj; {$R *.DFM} procedure TForm1.btnExportClick(Sender: TObject); var XL, // Приложение Excel TableVals : Variant;  // Врем. массив для переноса значений в Excel i, LineCounter,       // Счетчик строк для переноса записей в Excel queSelectRecCount, queSelectFieldsCount : Integer; begin inherited; try Application.ProcessMessages; Screen.Cursor := crSQLWait; with queSelect do begin SQL.Assign(memSelect.Lines); DatabaseName := edtDatabaseName.Text; Open; {AMA: Экспорт в Excel} queSelectRecCount := RecordCount; queSelectFieldsCount := FieldCount; TableVals := VarArrayCreate([0, queSelectRecCount-1,//кол-во строк 0, queSelectFieldsCount-1], // кол-во столбцов varOleStr); First; LineCounter := 0; while not EOF do begin for i := 0 to queSelectFieldsCount-1 do if not Fields[i].IsNull then TableVals[LineCounter, i] := Fields[i].AsString else TableVals[LineCounter, i] := ''; LineCounter := LineCounter + 1; Next; end; Close; end; try try XL := GetActiveOleObject('Excel.Application'); except XL := CreateOleObject('Excel.Application'); end; except raise Exception.Create('Не могу запустить Excel'); end; XL.Visible := True; XL.Workbooks.Add; XL.Range[XL.Cells[1,1], XL.Cells[queSelectRecCount, queSelectFieldsCount]].Value := TableVals; XL.Range[XL.Cells[1,1], XL.Cells[queSelectRecCount, queSelectFieldsCount ]].Borders.Weight := 2; finally Screen.Cursor := crDefault; end; end; end.

SelectToExcel.dpr

program SelectToExcel; uses Forms, Main in 'Main.pas' {Form1}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

[000845]

MAPI и MS Exchange

Используйте для регистрации:

MapiLogon(application.handle,nil,nil,mapi_use_default,0,@mapihandle)

Чтобы послать сообщение:

MapiSendMail(mapihandle, 0,MapiMessage,0, 0);

Убедитесь, что поля SUBJECT, RECIP и NOTTEXT в структуре MapiMessage заполнены, в противном случае сообщение отправлено не будет.

Также, с помощью API функции GetWindowHandle, необходимо убедиться в том, что Exchange запущен, в противном случае для запуска клиента используйте ShellExecute. [000311]

---

---