Blitting, Спрайты и Анимация

Для тех, кто интересуется, что это за слово такое "JEDI"? выберите в Delphi 5 пункт меню Help->About и наберите слово JEDI, удерживая нажатой клавишу Alt. Вы узнаете, что JEDI ? это аббревиатура, расшифровывающаяся как Join Endeavor of Delphi Innovators. (на русский это можно перевести приблизительно ? Совместные Усилия Дельфийских Новаторов или еще лучше - все для Delphi, все для победы) :-).

Звучит красиво, но нам-то что до этого? На самом деле нам до этого есть дело ? в рамках проекта JEDI (кстати, некоммерческого и держащегося на энтузиазме, пусть и с официальным одобрением Borland), в рамках именно этого проекта были созданы заголовочные файлы DirectX для Delphi. Так скачаем же их! (http://www.delphi-jedi.org/DelphiGraphics/)

Итак, заголовочные фалы у нас есть. Более того ? мы умеем инициализировать Direct Draw, создавать Surface'ы и загружать на них картинки. (Если Вы забыли как это делается ? перечитайте первые две главы).

Наконец то мы приблизились к самому интересному. Спрайты. Анимация. Blitting.

Blitting -непереводимое на русский язык слово. Тоже кстати аббревиатура - bit block transfer ? пересылка блоков бит. Благодаря этой пересылке, мы можем скопировать прямоугольную область из одной части Surface'а в другую или из одного Surface'а в другой. Такое копирование происходит пересылкой байт в видеопамяти, отсюда и название - bit block transfer. Да конечно, ничего удивительного в копировании прямоугольных участков Вы не видите ? это можно и без DirectDraw сделать кучей способов… Стоп! Прежде чем Вы начнете перечислять эти способы ? Blitting с использованием DirectDraw самый быстрый. Тем паче, что большинство современных видеоадаптеров поддерживают его на аппаратном уровне. Чувствуете, к чему я клоню? Стоит разобраться с Blitting'ом внимательнее.

Итак, для копирования прямоугольных участков интерфейс IDirectDrawSurface имеет два метода: IDirectDrawSurface4::Blt и IDirectDrawSurface4::BltFast. Как видно из названия второй быстрее ? с него и начнем.





functionBltFast(dwX: DWORD;
  dwY: DWORD;
  lpDDSrcSurface: IDirectDrawSurface4;
  lpSrcRect: PRect;
  dwTrans: DWORD): HResult;




Копирует прямоугольный участок из Surface'а-источника, задаваемого параметром lpDDSrcSurface. Первые два параметра метода ? dwX и dwY ? координаты верхнего левого угла прямоугольника на принимающем Surface'е - в эту точку будет скопирован прямоугольный участок, размеры которого задаются структурой типа TRect (параметр lpSrcRect типа PRect ? указатель на TRect). (для тех, кто не знаком с типом TRect ? познакомьтесь с ним в справке Delphi) Параметр dwTrans ? набор флагов, о них чуть позже. Использовать BltFast можно, например, так:



// копируем прямоугольник, размер которого задается переменной
// Kvadratik из Surface'а AnotherSurface в PrimarySurface.
PrimarySurface.BltFast(10, 10, AnotherSurface, Kvadratik,
  DDBLTFAST_NOCOLORKEY or DDBLTFAST_WAIT);




Если вызвать этот метод, передав в качестве параметров dwX и dwY нулевые значения, а вместо указателя на ограничивающий прямоугольник lpSrcRect ? nil, то будет скопирован весь Surface-источник.

Вторая функция



function Blt(lpDestRect: PRect;
  lpDDSrcSurface: IDirectDrawSurface4;
  lpSrcRect: PRect;
  dwFlags: DWORD;
  lpDDBltFx: PDDBltFX): HResult;




Здесь координаты принимающего (lpDestRect) и передающего (lpSrcRect) Surface'ов задаются с помощью структур TRect. Размеры передающего и принимающего прямоугольников могут быть не равны! Функция Blt выполнит масштабирование автоматически. Но возможности Blt этим не ограничиваются: можно использовать его для закрашивания областей экрана определенным цветом (dwFlags:=DDBLT_COLORFILL, lpDDBltFx.dwFillColor:= цвет), можно зеркально переворачивать копируемый прямоугольник по горизонтали или по вертикали (dwFlags:=DDBLT_DDFX, lpDDBltFx.dwDDFX:=DDBLTFX_MIRRORUPDOWN или DDBLTFX_MIRRORLEFTRIGHT), поворачивать его на 90, 180, 270 градусов (dwFlags:=DDBLT_DDFX, lpDDBltFx.dwDDFX:= DDBLTFX_ROTATE90 или DDBLTFX_ROTATE180 или DDBLTFX_ROTATE270), поворачивать на любой заданный угол (угол задается в 1/100-х градуса) (dwFlags:= DDBLT_ROTATIONANGLE, lpDDBltFx.dwRotationAngle:=угол поворота)…. и делать еще многое другое. За все эти удовольствия приходится расплачиваться быстродействием ? Blt обладает многими возможностями, которых нет в BltFast, но работает чуть медленнее.

Кстати о скорости. Несмотря на потрясающую скорость Blitting-операций, использующих всю мощь аппаратного ускорения, может возникнуть ситуация, когда видеоадаптер еще не успел закончить пересылку одного блока байт, а наша программа уже просит его сделать другую. Что будет в таком случае? Катастрофа? Нет. Просто функция Blt или BltFast вернет код ошибки DDERR_WASSTILLDRAWING. Чтобы такого не происходило, можно указать Blitting-функциям, что им следует ждать, не возвращая управления до тех пор, пока видеоадаптер не выполнит операцию. Для этого при вызове функции Blt параметру dwFlags нужно присвоить значение DDBLT_WAIT, а при вызове BltFast - значение DDBLTFAST_WAIT параметру dwTrans.

Самое время рассказать, наконец, поподробнее о параметре dwTrans функции BltFast. Кроме флага, используемого для приостановки программы на время неготовности видеоадаптера, этот параметр используется для указания цветового ключа (Color Key).

Цветовой ключ ? очень полезная штука, из разряда тех, которые следовало бы изобрести, если бы их не было. Цветовой ключ ? это один или, несколько цветов, предназначенных для изображения "прозрачного" цвета. Пикселы окрашенные этим цветом не копируются при Blitting'е. Это позволяет создавать иллюзию непрямоугольного изображения, хотя при Blitting'е копируются только прямоугольные области. Делается это вот как: рисуем (или просим нарисовать кого-нибудь у кого это хорошо получается) какую-нибудь картинку, ограниченную прямоугольной областью. Все пикселы этой прямоугольной области, которые не относятся к картинке, закрашиваем каким-то особым цветом, который не использовался в самой картинке. Этот особый цвет назначаем в качестве цветового ключа ? при Blitting'е он не будет копироваться, и вместо пикселов, окрашенных этим цветом, останутся пикселы фона ? возникнет иллюзия прозрачности. Такая картинка, в прямоугольной области, заполненной цветовым ключом называется "спрайт".

Итак, параметр dwTrans функции BltFast может принимать следующие, кроме уже знакомого нам DDBLTFAST_WAIT, значения:

DDBLTFAST_NOCOLORKEY ? цветовой ключ не используется;
DDBLTFAST_SRCCOLORKEY - используется цветовой ключ Surface'а ?источника;
DDBLTFAST_DESTCOLORKEY - используется цветовой ключ Surface'а ?приемника;
Аналогично, при использовании цвтового ключа с функцией Blt, ее параметру dwFlags присваивают значение DDBLT_KEYSRC (цветовой ключ источника) или DDBLT_KEYDEST (цветовой ключ приемника).
Для задания цветового ключа предназначена специальная структура TDDColorKey. Вот ее описание



TDDColorKey = packed record
  dwColorSpaceLowValue: DWORD;
  dwColorSpaceHighValue: DWORD;
end;




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

Пример задания цветового ключа:



{для 8 - битового палитрового режима}
dwColorSpaceLowValue := 26;
dwColorSpaceHighValue := 26;
// 26 - ой элемент палитры будет использоваться как цветовой ключ.

{для 24 - битового безпалитрового режима}
dwColorSpaceLowValue = RGB(255, 128, 128);
dwColorSpaceHighValue = RGB(255, 128, 128);
// Цвет RGB(255, 128, 128) ? будет считаться прозрачным.

 


Естественно, для Blitting'а спрайт должен находится на каком-то Surface. А у Surface'а для указания цветового ключа есть специальный метод: IDirectDrawSurface4.SetColorKey, который принимает в качестве параметра указатель на структуру типа TDDColorKey, описывающую цветовой ключ.

Итак, с помощью Blitting'а можно вывести на экран спрайт. Можно перемещать его по экрану, каждый раз восстанавливая фон, который был под спрайтом и выводя спрайт в соседнее место. А что если не просто перемещать спрайт, а сделать так, чтобы при перемещении сама картинка спрайта менялась? Так можно получить анимацию, бегущую лошадь, например. Для этого при каждом Blitting'е нужно выводить не одну и ту же картинку спрайта, а картинку следующей фазы движения, заставляя, например, ту же лошадь перебирать ногами. Естественно для этого нужно заранее нарисовать картинку со всеми фазами движения и загрузить ее на какой-то Surface, выводя с этого Surface'а при каждой итерации только определенную часть картинки, соответствующую текущей фазе анимации. А если анимированных спрайтов не один, а много? Алгоритм работы программы в этом случаем может быть таков:

Алгоритм 1.

Подготовить два Surface'а ? Primary (видимый на экране) и BackBuffer ? они будут учавствовать во flip-цепочке (см. первую главу). Кроме того, понадобятся Surface'ы для хранения фонового изображения и для хранения всех изображений всех спрайтов. Загрузить на Surface'ы соответствующие изображения (см. вторую главу).
Занести в BackBuffer-Surface изображение фоновой картинки, выполнив BltFast с соответствующего Surface'а (тем самым удалив на нем спрайты если они там были).
Занести в BackBuffer-Surface изображения всех спрайтов, поверх картинки фона, используя цветовые ключи, каждый в соответствующие координаты, и каждый в соответствующей фазе движения. Это можно сделать либо функцией BltFast либо функцией Blt.
Выполнить Flip. Очередной кадр анимации появится на экране. Подождать некоторое время (если необходимо) и повторить с шага 2.
Этот примерный алгоритм можно усовершенствовать, ведь на шаге 2 перерисовывается вся картинка фона, можно, зная координаты всех спрайтов, перерисовывать только ту часть фоновой картинки, на которой находятся спрайты, требующие перемещения.

Пожалуй, пришло время попробовать все это на практике. Посмотрите на мой пример (DDrawPrimer3.zip 80K ). Программа-пример инициализирует DirectDraw, создает три Surface'а, два размером 640Х480 (т.е. на весь экран) (FPrimarySurface и FPictureSurface), и один маленький (FSpriteSurface), для хранения изображения спрайта, и загружает на них соответствующие картинки, на FPrimarySurface и FPictureSurface ? изображение фона, а на FSpriteSurface ? изображения спрайта. В этом нет ничего нового, с этим Вы уже познакомились в первых двух главах. Вы можете открыть изображение из файла Sprite.bmp, которое загружается на FSpriteSurface и убедится, что там находятся изображения для всех фаз анимации спрайта (я пытался нарисовать что-то вроде жучка, перебирающего ногами, но похоже получилось нечто, больше смахивающее на муравья). В моем примере для простоты, я несколько отошел от Алгоритма 1 ? вместо рисования на BackBuffer'e c последующим вызовом функции Flip я рисую непосредственно на главном, видимом Surface. Это может привести к небольшому миганию спрайта при перерисовке, но я думаю, в нашем примере это не так уж и существенно ? мне не хотелось его слишком усложнять.

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

Если Вы хорошо знакомы с объектно-ориентированным подходом в программировании, Вы, безусловно, подвергнете Алгоритм 1 беспощадной (и справедливой) критике. В самом деле, почему бы не создать специальный класс спрайта, который сам бы перерисовывал себя при каждой итерации, зная свои старые и новые координаты. Можно было бы снабдить этот класс методами, автоматически меняющими картинку спрайта при анимации, регулирующими скорость анимации и т.п. Что ж, это очень неплохая идея. Я надеюсь рассказанная мной информация послужит Вам подспорьем для создания чего-то подобного. Впрочем можно воспользоваться и каким-либо готовым спрайтовым "движком", например тем, что входит в состав набора компонент DelphiX. Спрайтовый Engine от Hiroyuki Hori очень неплох. Примеры его использования входят в поставку DelphiX ? они находятся в каталогах \Samples\Sprite\Basic и \Samples\Sprite\Shoot.

На этом я пока заканчиваю рассказ о DirectDraw ? присылайте свои предложения и замечания: aziz@telebot.com или error@softhome.net.

Автор: Азиз (JINX)

Взято из

BLOB has been modified., Index is out of date

BLOB has been modified., Index is out of date

Объяснение от Борланд:
Index out Date ($2F02) is an error that occurs while using Paradox tables when the data in a table and a corresponding index is not consistent. In most cases (see below for the one exception), short of malicious behavior such as renaming an index, adding some data to the table, then renaming the index back, there is no programmatic way to cause this error to occur. There is no way to determine which index is out of date. All indexes must be recreated.

Blob has been modified ($3302) is an error that occurs when the Blob portion of the record contained in the .DB file has become inconsistent with the Blob portion in the .MB file. This could occur when the write to the .DB file was successful but the .MB file did not get updated, or visa-versa.

There are a few mechanisms to fix a table where these errors have occurred.
1. First try re-starting the application. It is possible that the BDE has become unstable and is reporting incorrect errors. Also try opening the table with a different application.
2. Use Paradox 7 or 8 to run the Table Repair utility. Please see original documentation for more information.
3. Run TUtility and rebuild the table. TUtility is an unsupported utility available for download from the Borland web site in the {Utilities, programs and updates section}.
4. Delete all indexes and recreate them (Index out Date ($2F02) error only). To do this you'll need to know the structure of all your indexes (including primary) before recreating them, which means you need to know the structure of all indexes before the error occurs.
There are 8 known possible causes for this error.
1. Incorrectly setting the LOCAL SHARE property.

Most commonly this occurs via Peer-to-Peer networking. In this case the two different database engines are on two CPUs, even though they may be the same version. See { BDE setup for Peer-To-Peer(Non-Dedicated) Networks} for additional information on Peer-to-Peer setup.

Another condition is when two different database engines execute on the same CPU concurrently and access data locally. This would be true when any combination of following are used concurrently: The Paradox Engine, BDE 16 bit, BDE 32 bit, Paradox for DOS. In this case each engine must set LOCAL SHARE to TRUE. Note that if use two applications which both use the same database engine (for example: Delphi 3 and C++ Builder 3) concurrently are run LOCAL SHARE does not need to be set to TRUE. In this case, all locking and cached data is in a central memory pool which all BDE applications have access to. Also, if two different database engines use data remotely, LOCAL SHARE must be set to TRUE.

Code should be used at startup to check the setting of local share. Look at the {DbiOpenCfgInfoList } BDE API function call for more information.

2. Error transmitting data from the workstation to the server.

Most commonly, this occurs with bad network hardware (cable, card, hub, etc.). This has been determined to be a problem even though there were no other errors are detected in data transmission. To determine if this is the cause for your error, try eliminating one CPU at a time from using the data and see if the problem continues.

3. Bad VREDIR.VXD on any client accessing tables Windows 95 ONLY:

Several versions (notably 4.00.1113 and 4.00.1114) of the file VREDIR.VXD may need to be updated.

Reports have shown that using the original release of VREDIR.VXD (4.00.950) and a new release (4.00.1116) do not result in the errors "Blob has been modified" and/or "Index is out of date." If any one of the clients has a "bad" version of this device driver, the error can occur on any machine, not just the machine with the bad driver.

This error most likely occurs in 16Bit versions of the Borland Database Engine, although it still can occur in 32Bit versions.

For further information on the update of VREDIR.VXD, Please check the following Microsoft Articles: {Q174371} and {Q165403}

4. For Windows 95 clients only, when using data on Windows NT: Add the following key in your registry: HKEY_LOCAL_MACHINESystemCurrentControlSetServicesVxDVredir

Then create the string or Binary Value (either one works) with a name of DiscardCacheonOpen and make it equal to 1.

Note that this an undocumented registry entry obtained from Microsoft. Questions on its functionality should be directed to Microsoft.

5. Problem with opportunistic locking Windows NT ONLY: Try turning off opportunistic locking in the Windows NT registry: See Microsoft Article {Q129202}

Note: Borland internal testing has not indicated this setting to be significant. However, some Borland customers have indicated this to solve the problem.

6. Improperly closing files such as due to loss of power or restarting a workstation or the server without closing files first may cause this problem. Paradox tables are not designed to withstand such behavior. If this is a possibility in your environment, we recommend you use a Client Server database that can recover from such conditions.

7. Extremely large numbers of indexes, especially involving Referential Integrity can cause this problem and especially when using Windows NT as the server. Borland recommends using a Client Server database under this condition. However, if you are using Windows NT as your server, switching to Novell Netware or Windows 95 as the server may resolve the problem as well.

8. The one programmatic way you can make this error occur is if you attempt to post a duplicate value to a unique, non-primary index at the same time you attempt to open the same table. This problem only occurs if local share is set to False and only occurs on local drives.
Unverified solutions
1. Windows 95 Only: Bring up the network properties screen on all Workstations and enter the netBEUI properties screen. On the advanced tab, make sure that "Set this protocol to be the default protocol" is checked.

2. Windows 95 Only: If the previous suggestion did not work, try removing the following protocols in order. Remove one at a time and then re-test your problem:
1. NETBIOS support for IPX/SPX-compatible Protocol
2. TCP/IP
3. IPX/SPX-compatible Protocol If the problem disappears, attempt to add back in all protocols except for the last one that was taken out. Again, make sure netBEUI's default protocol check box is checked.

3. Windows NT Only used as a Workstation: On the Network Bindings page of the Network Properties, set the NetBEUI Protocol to be at the top of all services. The TCP/IP stack is known for having a lot of overhead that might cause timing problems. Since NT will send requests back in the same protocol as it is sent, changing the bindings on a NT machine used as a server will have no effect.
Other resources
1. {The Delphi Magazine} has a number of interesting articles on this subject as well. See { www.itecuk.com/Delmag/Paradox.htm} for details.

Примечание от Vit:
Обычно такие ошибки возникают из-за проблем с кэшированием измений в базе данных, особенно при использовании BLOB/Memo полей и особенно при многопользовательском доступе. В простейшем случае снизить частоту возникновения этой ошибки на несколько порядков помогает вызов метода FlushBuffers после каждого изменения таблицы:

Table1.post;
Table1.FlushBuffers;

BLOBFIELD как BITMAP

BLOBFIELD как BITMAP

Сохраняем Bitmap в поле dbase с именем Icon. Icon представляет собой двоичное Blob-поле.

procedure....
var IconStream : TMemoryStream;
..
..
begin

.
.
IconStream := TMemoryStream.Create;
Image1.picture.icon.savetostream(IconStream);
(Table1.fieldbyname('Icon') as TBlobField).LoadFromStream(IconStream);
Table1.post;
IconStream.Free;
.
.
end;


** Читаем Bitmap в Timage из поля dbase с именем Icon.

procedure .....
var IconStream : TMemoryStream;
..
..
begin
.  
.  
IconStream := TMemoryStream.Create;  
(Table1.fieldbyname('Icon') as TBlobField).SaveToStream(IconStream);  
{что бы что-нибудь записать, необходимо установить позицию потока в ноль!}  
IconStream.Position := 0;  
appointment.iconimage.picture.icon.loadfromstream(iconstream);  
IconStream.Free;  
end;

Надеюсь это поможет, поскольку найти информацию в справочной системе по этой теме практически невозможно. Чтобы сделать это, я перепробовал множество способов. Я пробовал использовать TBlobField и TBlobStream, но они не смогли мне помочь (может быть из-за убогой документации borland?).

Взято из

Блокировка/Разблокировка CD-ROM

Блокировка/Разблокировка CD-ROM

Вы уж простите, что на сях... сподручней было :\
Исходный код

//заблокировать
void CMFcDlg::OnBnClickedButton1()
{
HANDLE hDevice = CreateFile ("\\\\.\\E:", 
 GENERIC_READ,
 FILE_SHARE_READ | FILE_SHARE_WRITE,
 NULL,
 OPEN_EXISTING,
 NULL,
 NULL);
DWORD dwBytesReturned = 0;
PREVENT_MEDIA_REMOVAL pmr = {TRUE};
if(!DeviceIoControl (hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, &pmr, sizeof(pmr), NULL, 0, &dwBytesReturned, NULL)) AfxMessageBox ("Door can\'t be locked");
CloseHandle (hDevice);
}

//разблокировать
void CMFcDlg::OnBnClickedButton2()
{
HANDLE hDevice = CreateFile ("\\\\.\\E:", 
 GENERIC_READ,
 FILE_SHARE_READ | FILE_SHARE_WRITE,
 NULL,
 OPEN_EXISTING,
 NULL,
 NULL);
DWORD dwBytesReturned = 0;
PREVENT_MEDIA_REMOVAL pmr = {FALSE};
if(!DeviceIoControl (hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, &pmr, sizeof(pmr), NULL, 0, &dwBytesReturned, NULL)) AfxMessageBox ("Door can\'t be unlocked");
CloseHandle (hDevice);

}

Автор ответа: Baa
Взято с Vingrad.ru

Блокируется таблица в MS SQL Server

Блокируется таблица в MS SQL Server

По умолчанию, оператор UPDATE в MS SQL Server пытается поставить эксклюзивную табличную блокировку. Вы можете обойти это, используя ключевое слово FROM в сочетании с опцией PAGLOCK для использования MS SQL Server страничных блокировок вместо эксклюзивной табличной блокировки:

UPDATEorders SET customer_id=NULL FROM orders(PAGLOCK) WHERE customer_id=32;

Блокиpовка на всю таблицу пpи UPDATE ставится только в том случае, если по пpедикату нет индекса. Так, можно пpосто пpоиндексиpовать таблицу orders по полю customer_id, и не забывать делать UPDATE STATISTIC, хотя будет работать и с PAGLOCK. Просто не факт, что UPDATE всегда делает табличную блокировку.

Взято из

BMP ---> AVI (для TAnimate)

BMP ---> AVI (для TAnimate)

TAnimate is a rather nice component. However if you don't want to use the built in AVI files and want to create your own AVI files from BMP files, then you may have a problem as there is no tool in Delphi to do this.

While browsing the web for information on AVI file formats I came upon a site www.shrinkwrapvb.com/avihelp/avihelp.htm that is maintained by Ray Mercer. In this tutorial he explains how to manipulate,read and write AVI files. I was particularly interested in "Step 5" in which he shows a utility that takes a list of BMP files that creates an AVI file which can be used by the TAnimate component. The only problem was that the examples are in Visual Basic, thus a conversion to Delphi was required.

I have posted this procedure
CreateAVI(const FileName : string; BMPFileList : TStrings; FramesPerSec : integer = 10);

To keep the text of the example simple and readable I have left out most to the error checking (try except etc.). You can also play with the AVISaveOptions dialog box, but I can only seem to get it to work with "Full Frames Uncompressed" with BMP files. Can anyone shed some light on this ?

Errors you should check for are ..
All files are valid BMP files and are of the same size.
All Blockreads are valid with no read errors.

Ray has a downloadable EXE that works quite nicely, however I am about to write my own utility that incorporates the following ...

Multiline file selection.
Listbox line reordering (drag/drop).
Sort File list
Layout Save and Load .
AVI Preview.

(I have beta version 1.0.0.0 ready, if anyone wants a copy of exe or source code, drop me a mail at mheydon@pgbison.co.za)

For further info on AVI files I recommend you vist Ray's site at http://www.shrinkwrapvb.com/avihelp/avihelp.htm it really is a well written tutorial (even if it is in Visual Basic)

const
// AVISaveOptions Dialog box flags

  ICMF_CHOOSE_KEYFRAME = 1; // show KeyFrame Every box
  ICMF_CHOOSE_DATARATE = 2; // show DataRate box
  ICMF_CHOOSE_PREVIEW = 4; // allow expanded preview dialog
  ICMF_CHOOSE_ALLCOMPRESSORS = 8; // don't only show those that
  // can handle the input format
  // or input data
  AVIIF_KEYFRAME = 10;

type

  AVI_COMPRESS_OPTIONS = packed record
    fccType: DWORD; // stream type, for consistency
    fccHandler: DWORD; // compressor
    dwKeyFrameEvery: DWORD; // keyframe rate
    dwQuality: DWORD; // compress quality 0-10,000
    dwBytesPerSecond: DWORD; // bytes per second
    dwFlags: DWORD; // flags... see below
    lpFormat: DWORD; // save format
    cbFormat: DWORD;
    lpParms: DWORD; // compressor options
    cbParms: DWORD;
    dwInterleaveEvery: DWORD; // for non-video streams only
  end;

  AVI_STREAM_INFO = packed record
    fccType: DWORD;
    fccHandler: DWORD;
    dwFlags: DWORD;
    dwCaps: DWORD;
    wPriority: word;
    wLanguage: word;
    dwScale: DWORD;
    dwRate: DWORD;
    dwStart: DWORD;
    dwLength: DWORD;
    dwInitialFrames: DWORD;
    dwSuggestedBufferSize: DWORD;
    dwQuality: DWORD;
    dwSampleSize: DWORD;
    rcFrame: TRect;
    dwEditCount: DWORD;
    dwFormatChangeCount: DWORD;
    szName: array[0..63] of char;
  end;

  BITMAPINFOHEADER = packed record
    biSize: DWORD;
    biWidth: DWORD;
    biHeight: DWORD;
    biPlanes: word;
    biBitCount: word;
    biCompression: DWORD;
    biSizeImage: DWORD;
    biXPelsPerMeter: DWORD;
    biYPelsPerMeter: DWORD;
    biClrUsed: DWORD;
    biClrImportant: DWORD;
  end;

  BITMAPFILEHEADER = packed record
    bfType: word; //"magic cookie" - must be "BM"
    bfSize: integer;
    bfReserved1: word;
    bfReserved2: word;
    bfOffBits: integer;
  end;

  // DLL External declarations

function AVISaveOptions(Hwnd: DWORD; uiFlags: DWORD; nStreams: DWORD;
  pPavi: Pointer; plpOptions: Pointer): boolean;
  stdcall; external 'avifil32.dll';

function AVIFileCreateStream(pFile: DWORD; pPavi: Pointer; pSi: Pointer): integer;
  stdcall; external 'avifil32.dll';

function AVIFileOpen(pPfile: Pointer; szFile: PChar; uMode: DWORD;
  clSid: DWORD): integer;
  stdcall; external 'avifil32.dll';

function AVIMakeCompressedStream(psCompressed: Pointer; psSource: DWORD;
  lpOptions: Pointer; pclsidHandler: DWORD): integer;
  stdcall; external 'avifil32.dll';

function AVIStreamSetFormat(pAvi: DWORD; lPos: DWORD; lpGormat: Pointer;
  cbFormat: DWORD): integer;
  stdcall; external 'avifil32.dll';

function AVIStreamWrite(pAvi: DWORD; lStart: DWORD; lSamples: DWORD;
  lBuffer: Pointer; cBuffer: DWORD; dwFlags: DWORD;
  plSampWritten: DWORD; plBytesWritten: DWORD): integer;
  stdcall; external 'avifil32.dll';

function AVISaveOptionsFree(nStreams: DWORD; ppOptions: Pointer): integer;
  stdcall; external 'avifil32.dll';

function AVIFileRelease(pFile: DWORD): integer; stdcall; external 'avifil32.dll';

procedure AVIFileInit; stdcall; external 'avifil32.dll';

procedure AVIFileExit; stdcall; external 'avifil32.dll';

function AVIStreamRelease(pAvi: DWORD): integer; stdcall; external 'avifil32.dll';

function mmioStringToFOURCCA(sz: PChar; uFlags: DWORD): integer;
  stdcall; external 'winmm.dll';

// ============================================================================
// Main Function to Create AVI file from BMP file listing
// ============================================================================

procedure CreateAVI(const FileName: string; IList: TStrings;
  FramesPerSec: integer = 10);
var
  Opts: AVI_COMPRESS_OPTIONS;
  pOpts: Pointer;
  pFile, ps, psCompressed: DWORD;
  strhdr: AVI_STREAM_INFO;
  i: integer;
  BFile: file;
  m_Bih: BITMAPINFOHEADER;
  m_Bfh: BITMAPFILEHEADER;
  m_MemBits: packed array of byte;
  m_MemBitMapInfo: packed array of byte;
begin
  DeleteFile(FileName);
  Fillchar(Opts, SizeOf(Opts), 0);
  FillChar(strhdr, SizeOf(strhdr), 0);
  Opts.fccHandler := 541215044; // Full frames Uncompressed
  AVIFileInit;
  pfile := 0;
  pOpts := @Opts;

  if AVIFileOpen(@pFile, PChar(FileName), OF_WRITE or OF_CREATE, 0) = 0 then
  begin
    // Determine Bitmap Properties from file item[0] in list
    AssignFile(BFile, IList[0]);
    Reset(BFile, 1);
    BlockRead(BFile, m_Bfh, SizeOf(m_Bfh));
    BlockRead(BFile, m_Bih, SizeOf(m_Bih));
    SetLength(m_MemBitMapInfo, m_bfh.bfOffBits - 14);
    SetLength(m_MemBits, m_Bih.biSizeImage);
    Seek(BFile, SizeOf(m_Bfh));
    BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo));
    CloseFile(BFile);

    strhdr.fccType := mmioStringToFOURCCA('vids', 0); // stream type video
    strhdr.fccHandler := 0; // def AVI handler
    strhdr.dwScale := 1;
    strhdr.dwRate := FramesPerSec; // fps 1 to 30
    strhdr.dwSuggestedBufferSize := m_Bih.biSizeImage; // size of 1 frame
    SetRect(strhdr.rcFrame, 0, 0, m_Bih.biWidth, m_Bih.biHeight);

    if AVIFileCreateStream(pFile, @ps, @strhdr) = 0 then
    begin
      // if you want user selection options then call following line
      // (but seems to only like "Full frames Uncompressed option)

      // AVISaveOptions(Application.Handle,
      //                ICMF_CHOOSE_KEYFRAME or ICMF_CHOOSE_DATARATE,
      //                1,@ps,@pOpts);
      // AVISaveOptionsFree(1,@pOpts);

      if AVIMakeCompressedStream(@psCompressed, ps, @opts, 0) = 0 then
      begin
        if AVIStreamSetFormat(psCompressed, 0, @m_memBitmapInfo[0],
          length(m_MemBitMapInfo)) = 0 then
        begin

          for i := 0 to IList.Count - 1 do
          begin
            AssignFile(BFile, IList[i]);
            Reset(BFile, 1);
            Seek(BFile, m_bfh.bfOffBits);
            BlockRead(BFile, m_MemBits[0], m_Bih.biSizeImage);
            Seek(BFile, SizeOf(m_Bfh));
            BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo));
            CloseFile(BFile);
            if AVIStreamWrite(psCompressed, i, 1, @m_MemBits[0],
              m_Bih.biSizeImage, AVIIF_KEYFRAME, 0, 0) <> 0 then
            begin
              ShowMessage('Error during Write AVI File');
              break;
            end;
          end;
        end;
      end;
    end;

    AVIStreamRelease(ps);
    AVIStreamRelease(psCompressed);
    AVIFileRelease(pFile);
  end;

  AVIFileExit;
  m_MemBitMapInfo := nil;
  m_memBits := nil;
end;

Взято с

Delphi Knowledge Base

BMP ---> DIB

BMP ---> DIB

Если файл хранится в формате BMP, как мне преобразовать его в DIB и как затем отобразить?

Это не тривиально, но помочь нам смогут функции GetDIBSizes и GetDIB из модуля GRAPHICS.PAS. Приведу две процедуры: одну для создания DIB из TBitmap и вторую для его освобождения:



{Преобразование TBitmap в DIB }

procedure BitmapToDIB(Bitmap: TBitmap;
  var BitmapInfo: PBitmapInfo;
  var InfoSize: integer;
  var Bits: pointer;
  var BitsSize: longint);
begin
  BitmapInfo := nil;
  InfoSize := 0;
  Bits := nil;
  BitsSize := 0;
  if not Bitmap.Empty then
  try
    GetDIBSizes(Bitmap.Handle, InfoSize, BitsSize);
    GetMem(BitmapInfo, InfoSize);
    Bits := GlobalAllocPtr(GMEM_MOVEABLE, BitsSize);
    if Bits = nil then
      raise
        EOutOfMemory.Create('Не хватает памяти для пикселей изображения');
    if not GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^) then
      raise Exception.Create('Не могу создать DIB');
  except
    if BitmapInfo <> nil then
      FreeMem(BitmapInfo, InfoSize);
    if Bits <> nil then
      GlobalFreePtr(Bits);
    BitmapInfo := nil;
    Bits := nil;
    raise;
  end;
end;

{ используйте FreeDIB для освобождения информации об изображении и битовых указателей }

procedure FreeDIB(BitmapInfo: PBitmapInfo;
  InfoSize: integer;
  Bits: pointer;
  BitsSize: longint);
begin
  if BitmapInfo <> nil then
    FreeMem(BitmapInfo, InfoSize);
  if Bits <> nil then
    GlobalFreePtr(Bits);
end;




Создаем форму с TImage Image1 и загружаем в него 256-цветное изображение, затем рядом размещаем TPaintBox. Добавляем следующие строчки к private-объявлениям вашей формы:



{ Private declarations }
BitmapInfo : PBitmapInfo ;
InfoSize   : integer ;
Bits       : pointer ;
BitsSize   : longint ;




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



procedure TForm1.FormCreate(Sender: TObject);
begin
  BitmapToDIB(Image1.Picture.Bitmap, BitmapInfo, InfoSize,
    Bits, BitsSize);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeDIB(BitmapInfo, InfoSize, Bits, BitsSize);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  OldPalette: HPalette;
begin
  if Assigned(BitmapInfo) and Assigned(Bits) then
    with BitmapInfo^.bmiHeader, PaintBox1.Canvas do
    begin
      OldPalette := SelectPalette(Handle,
        Image1.Picture.Bitmap.Palette,
        false);
      try
        RealizePalette(Handle);
        StretchDIBits(Handle, 0, 0, PaintBox1.Width, PaintBox1.Height,
          0, 0, biWidth, biHeight, Bits,
          BitmapInfo^, DIB_RGB_COLORS,
          SRCCOPY);
      finally
        SelectPalette(Handle, OldPalette, true);
      end;
    end;
end;




Это поможет вам сделать первый шаг. Единственное, что вы можете захотеть, это создание собственного HPalette на основе DIB, вместо использования TBitmap и своей палитры. Функция с именем PaletteFromW3DIB из GRAPHICS.PAS как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в ваш модуль.

Взято с

BMP ---> EMF

BMP ---> EMF

function bmp2emf(const SourceFileName: TFileName): Boolean; 
// Converts a Bitmap to a Enhanced Metafile (*.emf) 
var 
  Metafile: TMetafile; 
  MetaCanvas: TMetafileCanvas; 
  Bitmap: TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  try 
    Bitmap := TBitmap.Create; 
    try 
      Bitmap.LoadFromFile(SourceFileName); 
      Metafile.Height := Bitmap.Height; 
      Metafile.Width  := Bitmap.Width; 
      MetaCanvas := TMetafileCanvas.Create(Metafile, 0); 
      try 
        MetaCanvas.Draw(0, 0, Bitmap); 
      finally 
        MetaCanvas.Free; 
      end; 
    finally 
      Bitmap.Free; 
    end; 
    Metafile.SaveToFile(ChangeFileExt(SourceFileName, '.emf')); 
  finally 
    Metafile.Free; 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  bmp2emf('C:\TestBitmap.bmp'); 
end; 

Взято с сайта

BMP ---> ICO

BMP ---> ICO

Автор: Bernhard Angerer

Вам необходимо создать два битмапа, битмап маски (назовём его "AND" bitmap) и битмап изображения (назовём его XOR bitmap). Вы можете пропустить обработчики для "AND" и "XOR" битмапов в Windows API функции CreateIconIndirect() и использовать обработчик возвращённой иконки в Вашем приложении.

procedureTForm1.Button1Click(Sender: TObject); 
var 
  IconSizeX : integer; 
  IconSizeY : integer; 
  AndMask : TBitmap; 
  XOrMask : TBitmap; 
  IconInfo : TIconInfo; 
  Icon : TIcon; 
begin 
{Получаем размер иконки} 
  IconSizeX := GetSystemMetrics(SM_CXICON); 
  IconSizeY := GetSystemMetrics(SM_CYICON); 

{Создаём маску "And"} 
  AndMask := TBitmap.Create; 
  AndMask.Monochrome := true; 
  AndMask.Width := IconSizeX; 
  AndMask.Height := IconSizeY; 

{Рисуем на маске "And"} 
  AndMask.Canvas.Brush.Color := clWhite; 
  AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY)); 
  AndMask.Canvas.Brush.Color := clBlack; 
  AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4); 

{Рисуем для теста} 
  Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask); 

{Создаём маску "XOr"} 
  XOrMask := TBitmap.Create; 
  XOrMask.Width := IconSizeX; 
  XOrMask.Height := IconSizeY; 

{Рисуем на маске "XOr"} 
  XOrMask.Canvas.Brush.Color := ClBlack; 
  XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY)); 
  XOrMask.Canvas.Pen.Color := clRed; 
  XOrMask.Canvas.Brush.Color := clRed; 
  XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4); 

{Рисуем в качестве теста} 
  Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask); 

{Создаём иконку} 
  Icon := TIcon.Create; 
  IconInfo.fIcon := true; 
  IconInfo.xHotspot := 0; 
  IconInfo.yHotspot := 0; 
  IconInfo.hbmMask := AndMask.Handle; 
  IconInfo.hbmColor := XOrMask.Handle; 
  Icon.Handle := CreateIconIndirect(IconInfo); 

{Уничтожаем временные битмапы} 
  AndMask.Free; 
  XOrMask.Free; 

{Рисуем в качестве теста} 
  Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon); 

{Объявляем иконку в качестве иконки приложения} 
  Application.Icon := Icon; 

{генерируем перерисовку} 
  InvalidateRect(Application.Handle, nil, true); 

{Освобождаем иконку} 
  Icon.Free; 
end; 

Взято с Исходников.ru


Способ преобразования изображения размером 32x32 в иконку.



unit main;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls;

type

  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  winDC, srcdc, destdc: HDC;

  oldBitmap: HBitmap;
  iinfo: TICONINFO;
begin

  GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

  WinDC := getDC(handle);
  srcDC := CreateCompatibleDC(WinDC);
  destDC := CreateCompatibleDC(WinDC);
  oldBitmap := SelectObject(destDC, iinfo.hbmColor);
  oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

  BitBlt(destdc, 0, 0, Image1.picture.icon.width,
    Image1.picture.icon.height,
    srcdc, 0, 0, SRCPAINT);
  Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
  DeleteDC(destDC);
  DeleteDC(srcDC);
  DeleteDC(WinDC);

  image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
    + 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.

Взято из

BMP ---> JPG

BMP ---> JPG

uses 
  Jpeg, ClipBrd; 

procedure TfrmMain.ConvertBMP2JPEG; 
  // converts a bitmap, the graphic of a TChart for example, to a jpeg 
var  
  jpgImg: TJPEGImage; 
begin 
  // copy bitmap to clipboard 
  chrtOutputSingle.CopyToClipboardBitmap; 
  // get clipboard and load it to Image1 
  Image1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap, 
    ClipBoard.GetAsHandle(cf_Bitmap), 0); 
  // create the jpeg-graphic 
  jpgImg := TJPEGImage.Create; 
  // assign the bitmap to the jpeg, this converts the bitmap 
  jpgImg.Assign(Image1.Picture.Bitmap); 
  // and save it to file 
  jpgImg.SaveToFile('TChartExample.jpg'); 
end; 

Взято с сайта

BMP ---> RTF

BMP ---> RTF

function BitmapToRTF(pict: TBitmap): string; 
var 
  bi, bb, rtf: string; 
  bis, bbs: Cardinal; 
  achar: ShortString; 
  hexpict: string; 
  I: Integer; 
begin 
  GetDIBSizes(pict.Handle, bis, bbs); 
  SetLength(bi, bis); 
  SetLength(bb, bbs); 
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^); 
  rtf := '{\rtf1 {\pict\dibitmap0 '; 
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2); 
  I := 2; 
  for bis := 1 to Length(bi) do 
  begin 
    achar := IntToHex(Integer(bi[bis]), 2); 
    hexpict[I - 1] := achar[1]; 
    hexpict[I] := achar[2]; 
    Inc(I, 2); 
  end; 
  for bbs := 1 to Length(bb) do 
  begin 
    achar := IntToHex(Integer(bb[bbs]), 2); 
    hexpict[I - 1] := achar[1]; 
    hexpict[I] := achar[2]; 
    Inc(I, 2); 
  end; 
  rtf := rtf + hexpict + ' }}'; 
  Result := rtf; 
end; 

Взято с сайта

BMP ---> WMF

BMP ---> WMF

procedure ConvertBMP2WMF
(const BMPFileName, WMFFileName: TFileName); 
var 
  MetaFile : TMetafile; 
  Bitmap : TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  Bitmap := TBitmap.Create; 
  try 
    Bitmap.LoadFromFile(BMPFileName); 
    with MetaFile do 
    begin 
      Height := Bitmap.Height; 
      Width  := Bitmap.Width; 
      Canvas.Draw(0, 0, Bitmap); 
      SaveToFile(WMFFileName); 
    end; 
  finally
      Bitmap.Free; 
    MetaFile.Free; 
  end; 
end;

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

ConvertBMP2WMF('c:\mypic.bmp','c:\mypic.wmf')

Взято с Исходников.ru

Более быстрый способ добавлять пункты меню

Более быстрый способ добавлять пункты меню

Обычно, когда Вы создаёте меню в приложении, то код выглядит примерно так:

    PopupMenu1 := TPopupMenu.Create(Self); 
    Item := TMenuItem.Create(PopupMenu1); 
    Item.Caption := 'First Menu'; 
    Item.OnClick := MenuItem1Click; 
    PopupMenu1.Items.Add(Item); 
    Item := TMenuItem.Create(PopupMenu1); 
    Item.Caption := 'Second Menu'; 
    Item.OnClick := MenuItem2Click; 
    PopupMenu1.Items.Add(Item); 
    Item := TMenuItem.Create(PopupMenu1); 
    Item.Caption := 'Third Menu'; 
    Item.OnClick := MenuItem3Click; 
    PopupMenu1.Items.Add(Item); 

    Item := TMenuItem.Create(PopupMenu1); 
    Item.Caption := '-'; 
    PopupMenu1.Items.Add(Item); 
    Item := TMenuItem.Create(PopupMenu1); 
    Item.Caption := 'Fourth Menu'; 
    Item.OnClick := MenuItem4Click; 
    PopupMenu1.Items.Add(Item); 


Однако есть более быстрый способ! Воспользуйтесь функциями NewItem и NewLine:

    PopupMenu1 := TPopupMenu.Create(Self); 
    with PopUpMenu1.Items do 
      begin 
        Add(NewItem('First Menu',0,False,True,MenuItem1Click,0,'MenuItem1')); 
        Add(NewItem('Second Menu',0,False,True,MenuItem2Click,0,'MenuItem2')); 
        Add(NewItem('Third Menu',0,False,True,MenuItem3Click,0,'MenuItem3')); 
        Add(NewLine);                        // Добавляем разделитель
        Add(NewItem('Fourth Menu',0,False,True,MenuItem4Click,0,'MenuItem4')); 

      end;

Взято с Исходников.ru

Borland Delphi 7 - миграция в сторону .Net

Borland Delphi 7 - миграция в сторону .Net

Borland Delphi 7 - миграция в сторону .Net

Автор: Виталий Чужа
Qui non proficit, deficit. Теряет тот, кто не идет вперед

Delphi 7 Studio позиционируется как первый независимый инструмент для облегчения миграции к платформе .Net
Итак, перед нами очередная версия знаменитого продукта фирмы Borland - Delphi 7 Studio, о выходе которого было сообщено в пресс-релизе компании от 6 августа 2002 года. Новая версия Delphi позиционируется как первый независимый инструмент для облегчения миграции к платформе .Net и, будучи доступна с лета 2002 года, поставляется в четырех редакциях: Architect, Enterprise, Professional и Personal. В шестой версии, как вы помните, отсутствовала редакция Architect, да и само понятие (студии). Также нужно заметить, что, хотя Delphi несколько <потяжелела> и изменился перечень поддерживаемых операционных систем, системные требования Delphi 6 и Delphi 7 версий Enterprise, в основном, остались прежними.
Для версии Architect, которая является самой полной и дорогой (99) редакцией, требования к ПК выше - для полной установки ей требуется 540 Мб пространства на жестком диске. Цены на <стандартные> версии, по сравнению с Delphi 6, не изменились: Enterprise стоит 99, Professional - 9 .
Какие же новые возможности были включены в Delphi 7 Studio? Рассмотрим их по порядку.
Среда разработки
Изменения, затронувшие IDE, коснулись палитры компонент, достройщика кода, отладчика и настроек редактора кода. В палитре компонент появились следующие закладки: новая версия закладки System только для CLX-приложений, закладки Indy Intercepts и Indy I/O Handlers, содержащие компоненты с поддержкой протоколов интернет с открытым исходным кодом (редакции Professional и Enterprise). Для разработки веб-приложений - новые закладки IW Standard, IW Data, IW Client Side, и IW Control с компонентами IntraWeb, а также новая закладка Rave с компонентами генерации отчетов. Кроме того, если закладка содержит компоненты, для доступа к которым необходима горизонтальная прокрутка, то теперь добраться до них можно и с помощью ниспадающего меню.
Достройщик кода (code completion) теперь работает быстрее и позволяет перейти к объявлениям элементов через их список путем нажатия клавиши <Ctrl> и клика мышью на любом идентификаторе в списке. Появился новый достройщик HTML-кода, который автоматически отображает нужные HTML-элементы и атрибуты в редакторе кода (для редакций Professional и Enterprise). Для удобства работы через меню Tools р Editor Options р Code Insight можно настроить цвета, используемые достройщиком кода. Также необходимо отметить возможность написания собственных менеджеров завершения кода.
Окно просмотра сообщений отладчика (Watch List) обзавелось множеством закладок для облегчения процесса отлова ошибок. Каждую закладку можно настроить - отображать ее или спрятать. Диалоговое окно Run Parameters теперь имеет новую настройку: рабочий каталог (Working Directory), указав который, можно настроить каталог, используемый для отладки.
Из Project Manager можно компилировать лишь часть проектов в группе, щелкнув правой кнопкой по проекту и выбрав пункты меню Make All from Here или Build All from Here, а в окне просмотра сообщений (Message view) появилось множество закладок для отображения разных типов сообщений (Build, Search, и т. д.) В окне, доступном через меню View р Component List, можно выбирать несколько компонент с помощью клавиши <Ctrl>. Окно настроек редактора кода, доступное через меню Tools р Editor Options р Source Options, позволяет устанавливать различные настройки для языков Pascal, C++, C#, HTML, XML, контролировать отображение знаков пробела и табуляции, редактировать шаблоны кода. Окно, доступное через меню Tools р Editor Options р Color, имеет две новые настройки: цвет символа (Foreground Color) и цвет фона (Background Color) - вместо цветовой сетки для настройки цвета в редакторе кода.
Веб-технологии
В седьмую версию Delphi вошел набор компонент IntraWeb от AtoZed Software, который может быть использован для написания приложений веб-сервера с использованием стандартного инструментария разработки форм. IntraWeb также годится для разработки страниц Web Broker и WebSnap приложений. Полная версия IntraWeb входит в состав редакции Delphi Enterprise. Delphi также поддерживает Apache 2 - как целевой тип для Web Broker, WebSnap и SOAP. В то же время Borland не рекомендует использовать Win-CGI для приложений веб-сервера или веб-сервисов. Вместо этого рекомендуется использовать CGI, ISAPI/NSAPI, или Apache.
Веб-сервисы
Появился новый UDDI (Universal Description, Discovery, and Integration) браузер у волшебника импорта WSDL, который позволяет сканировать реестр UDDI для поиска веб-сервиса и импорта адреса WSDL документа. Сам реестр UDDI является базой данных, в которой регистрируются компании, поставляющие веб-сервисы. Новые классы и интерфейсы позволяют читать или вставлять заголовки в SOAP-конверты, пересылающие сообщения между клиентом и сервером. Приложения веб-сервисов (как клиентов, так и серверов) теперь в состоянии обрабатывать вложения. Вложения (наследники класса TSOAPAttachment) отсылаются вместе с закодированными сообщениями SOAP как часть составной формы. Когда приложение получает сообщение с вложением, оно сохраняет вложение во временном файле, доступном вашей программе.
Новые события, обрабатываемые компонентом THTTPReqResp, позволят вам перехватывать сообщения HTTP до их отсылки и отслеживать ход получения или отсылки длинных сообщений. В классе THTTPSoapPascalInvoker доступны сообщения, которые позволят написать код, исполняемый до или после того, как объект класса осуществит вызов запрашиваемого метода. Интерфейс IOPConvert получил новое свойство Encoding, что позволяет указать набор символов для использования в сообщениях, передаваемых между клиентом поставщиком веб-сервиса.
Базы данных
Обновлены драйвера dbExpress для Informix SE, Oracle 9i, DB2 7.2, InterBase 6.5 и MySQL 3.23.49. Новый драйвер поставляется и для MS SQL Server 2000. А вот SQL Links Borland не рекомендует использовать, более того - работа над усовершенствованием SQL Links прекращается. Сообщается также, что эта технология не будет поставляться вместе с Delphi после 2002 года. В виде замены рекомендовано использовать dbExpress для доступа к базам данных SQL серверов.
Прекращена также поддержка CORBA-соединений компонентами DataSnap.
Библиотека компонент
Приложения, написанные с использованием VCL, теперь включают компоненты, поддерживающие библиотеку элементов управления Windows шестой версии. Поэтому приложение будет автоматически использовать новые элементы управления Windows в ОС Windows XP, если найдет подходящий файл-манифест.
Новый модуль DBClientActns включает три новых компонента для работы с клиентскими наборами данных: TClientDataSetApply, TclientDataSetUndo и TClientDataSetRevert.
Закладка dbExpress включает новый компонент TSimpleDataSet для использования с простыми, двухуровневыми приложениями баз данных (TSimpleDataSet заменил собой TSQLClientDataSet). Обновлена закладка Dialogs на палитре компонент - добавлен TPageSetupDialog для представления стандартного диалогового окна Windows настройки параметров страницы. На закладку Additional добавлены компоненты TXPColorMap, TstandardColorMap и TtwilightColorMap для окраски меню и панелей инструментов.
У VCL-версии компонента TCustomForm добавились два новых свойства: ScreenSnap и SnapBuffer, контролирующие <прилипание> окна к краям экрана. Компонент TCustomComboBoxEx получил новое свойство AutoCompleteOptions, которое позволяет откликаться на ввод пользователя.
Библиотека времени выполнения
Модуль Classes содержит новый класс-исключение EFileStreamError. Классы EFCreateError и EFOpenError являются наследниками этого класса. Поскольку конструктор этого класса принимает имя файла как параметр, то в сообщении об исключительной ситуации можно видеть имя файла, в котором она произошла.
Класс TStrings также обладет теперь двумя новыми свойствами: ValueFromIndex и NameValueSeparator.
В модуле StrUtils также произошли определенные изменения, касающиеся работы с многобайтными наборами символов. Ранее функции LeftStr, RightStr и MidStr принимали параметр типа AnsiString и возвращали значение того же типа, не поддерживая многобайтные наборы символов. Теперь каждая из этих функций заменена парой перегруженных функций, одна из которых работает с типом AnsiString, а другая - с типом WideString. Также в модуль добавлена новая функция для поиска в строке, именуемая PosEx.
В модуле SysUtils функции, работающие над форматированием и разбором чисел, валют и значений типа дата и время, заменены на безопасные при работе с нитями.
Модуль VarCmplx содержит новые функции VarComplexLog2, VarComplexLog10, VarComplexLogN, VarComplexTimesImaginary и VarComplexTimesReal.
В модуль Variants добавлены функции VarIsError и VarAsError. Исключение EVariantError теперь является родительским классом для более тщательно разработанных классов-исключений, которые используются в коде с использованием переменных типа variant.
Компилятор
Компилятор Delphi поддерживает три дополнительных предупреждения: Unsafe_Type, Unsafe_Code и Unsafe_Cast. Эти предупреждения по умолчанию отключены, однако их можно задействовать с помощью директив компилятора {$WARN UNSAFE_CODE ON}, команды компилятора командной строки (dcc32 -W+UNSAFE_CODE), или посредством среды разработки, воспользовавшись меню Project р Options р Compiler Messages. Эта особенность должна помочь вам портировать код в окружение управляемого выполнения платформы Microsoft .NET. В этом окружении значит, что действия, выполняемые программой, не могут быть проверены во время анализа, осуществляемого Just In Time (JIT) компилятором. Такой код представляется небезопасным. Примером такого кода могут послужить операции с указателями.
Поддержка Rave Reports (для редакции Professional и Enterprise)
Вместе с Delphi теперь поставляется набор компонент для генерации отчетов Rave Reports фирмы Nevrona. Полное его название - Rave 4.0 Borland Edition (BE). Включает 19 компонентов, содержащих более 500 методов, свойств и событий. Компоненты компилируются в ехе-файл приложения и не требуют для работы никаких дополнительных файлов. В генератор отчетов включена поддержка графики, выравнивания и переноса текста, точное позиционирование страницы, конфигурирование принтера, управление шрифтами, полнофункциональный предпросмотр. Rave 4.0 BE справляется и с отчетами вида master-detail, письмами, счетами и т. д. (рис. 1)
Поддержка ModelMaker (для редакции Professional и Enterprise)
ModelMaker призван помочь упростить дизайн, разработку и поддержку классов и интерфейсов. ModelMaker также включает инструменты для создания диаграмм в стиле UML (Unified Modeling Language), которые могут быть использованы для создания и модификации исходного кода проекта.
Отмечу, что версия Delphi Enterprise включает полноценную версию ModelMaker, а Delphi Professional - лишь 30-дневную пробную версию, хотя функциональность обоих версий одинакова.
Заключение
Несмотря на множество нововведений в этой версии Borland Delphi, можно отметить, как минимум, три важные тенденции.
Первая - сворачивание собственных технологий, таких как Borland Database Engine (BDE) и SQL Links. Кажется вероятным отказ от набора компонент Quick Reports, успешно поставлявшихся с несколькими последними версиями Delphi.
Вторая - ставшая уже традиционной поддержка написания приложений для Linux.
Третья - на мой взгляд, более важная - постепенный отход ведущих средств разработки от платформы Win32 и их миграция в сторону платформы .Net. И хотя, как сказано в пресс-релизе Borland, за одну ночь новая платформа не изменит технологию разработки и распространения приложений, однако платформа .Net - следующая, эволюционная ступень Windows, приход которой неизбежен. Принимая во внимание тот факт, что разработчики в основной своей массе люди инертные, а также то, что на изучение новых технологий необходимо довольно много времени и средств, Borland сделала ставку на необходимость эволюционного развития Delphi и, на мой взгляд, не ошиблась. Включение в эту версию подсказок и предупреждений компилятора, касающихся совместимости с Microsoft .Net, возможности импорта узлов (assembly) .Net в Delphi и экспорта COM объектов в приложения .Net, подтверждает сказанное выше. Полноценная же поддержка этой многообещающей платформы наверняка будет реализована в следующей версии Delphi - Delphi .Net, которую и будем с нетерпением ждать.

Взято с сайта

Буфер обмена (Clipboard) и TMemoryStream

Буфер обмена (Clipboard) и TMemoryStream

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

CF_MYFORMAT := RegisterClipboardFormat('My Format Description'); 

Затем необходимо проделать следующие шаги:
1. Создать поток (stream) и записать в него данные.
2. Создать в памяти глобальный буфер и скопировать в него поток (stream).
3. При помощи Clipboard.SetAsHandle() поместить глобальный буфер в буфер обмена.

Пример:

var
  hbuf    : THandle;
  bufptr  : Pointer;
  mstream : TMemoryStream;
begin
  mstream := TMemoryStream.Create;
  try
    {-- Записываем данные в mstream. --}
    hbuf := GlobalAlloc(GMEM_MOVEABLE, mstream.size);
    try
      bufptr := GlobalLock(hbuf);
      try
        Move(mstream.Memory^, bufptr^, mstream.size);
        Clipboard.SetAsHandle(CF_MYFORMAT, hbuf);
      finally
        GlobalUnlock(hbuf);
      end;
    except
      GlobalFree(hbuf);
      raise;
    end;
  finally
    mstream.Free;
  end;
end;

ВАЖНО: Не удаляйте буфер после GlobalAlloc(). Как только Вы поместите его в буфер обмена, то буфер обмена будет пользоваться им.

Для получения данных из потока, можно воспользоваться следующим кодом:

var
  hbuf    : THandle;
  bufptr  : Pointer;
  mstream : TMemoryStream;
begin
  hbuf := Clipboard.GetAsHandle(CF_MYFORMAT);
  if hbuf <> 0 then begin
    bufptr := GlobalLock(hbuf);
    if bufptr <> nil then begin
      try
        mstream := TMemoryStream.Create;
        try
          mstream.WriteBuffer(bufptr^, GlobalSize(hbuf));
          mstream.Position := 0;
          {-- Читаем данные из mstream. --}
        finally
          mstream.Free;
        end;
      finally
        GlobalUnlock(hbuf);
      end;
    end;
  end;
end;

Взято с Исходников.ru

Буффер обмена

Буффер обмена

Cодержание раздела:

















См. также статьи в других разделах:

Button, SpeedButton, BitBtn

Button, SpeedButton, BitBtn

Cодержание раздела:

Быстрая обработка CSV файла

Быстрая обработка CSV файла

Классы Tstrings/TStringlist имеют свойство commatext, которое автоматически разделяет строки, содержащие разделители, на отдельные части. Пример показывает как считать CSV файл. В Конечном итоге, автоматически разделённые строки содержатся в TStringlist.

var
ts: tstringlist;
  S: string;
  Tf: Textfile;
begin
  Ts := Tstringlist.create;
  Assignfile(tf, 'filename');
  Reset(tf);
  while not eof(tf) do
  begin
    Readln(tf,S);
    Ts.CommaText := S;
    //ProcessLine;
  end;
  closefile(tf);
  ts.free;
end;

Так же операцию можно производить в обратном порядке.

Свойство Commatext поддерживает разделители как в виде запятых, так и двойных кавычек: 1,2,3,4 и "1","2","3","4"

Например, строка вида "1","2,3","4" будет разделена на три элемента, которые заключены в кавычки (средняя запятая будет проигнорирована). Чтобы включить кавычку в конечный результ, нужно поставить две кавычки подряд: "1",""2" (результат будет 1 и "2 ).

Взято из

Быстрое копирование таблиц

Быстрое копирование таблиц

Из книги Стива Тейксейра и Пачеко 'Delphi 4. Руководство разработчика'
я взял функцию для быстрого копирования
таблиц вместе со всеми дополнительными файлами:
Вот она:

procedure QuickCopyTable(T: TTable;DestTblName:string;Overwrite: boolean);
// только для не SQL-ых, т.е не промышленных  БД (dBase, Paradox ..)
var DBType: DBIName;
   WasOpen:boolean;
   NumCopied:word;
begin
 WasOpen:=T.Active;
 if not WasOpen then T.Open;
 Check(DbiGetProp(hDBIObj(T.Handle),drvDRIVERTYPE,@DBType,SizeOf(DBINAME),
    NumCopied));
 Check(DbiCopyTable(T.DBHandle, Overwrite, PChar(T.TableName),DBType, PChar(DestTblName)));
 T.Active:=WasOpen;
end;

Взято с сайта

Быстрое сравнение памяти

Быстрое сравнение памяти

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

functionKeys_are_Equal(var OldRec, NewRec; KeyLn: word): boolean; assembler;
asm
PUSH    DS  
MOV     AL,01  
CLD  
LES     DI,NewRec  
LDS     SI,OldRec  
MOV     CX,KeyLn  
CLI  
REPE    CMPSB  
STI  
JZ      @1  
XOR     AL,AL  
@1:  
POP     DS  
end;

function First_Key_is_Less(var NewRec, OldRec; Keyln : word): boolean; assembler;
asm
PUSH    DS  
MOV     AL,01  
CLD  
LES     DI,NewRec  
LDS     SI,OldRec  
MOV     CX,KeyLn  
CLI  
REPE    CMPSB  
STI  
JZ      @5  
JGE     @6  
@5: XOR     AL,AL  
@6: POP     DS  
end; 

- Dennis Passmore

Взято из

Советов по Delphi от

Сборник Kuliba

Быстрый доступ к ADO

Быстрый доступ к ADO

unitADO;
{This unit provides a quick access into ADO
      It handles all it's own exceptions
      It assumes it is working with SQL Server, on a PLC Database
         If an exception is thrown with a [PLCErr] suffix:
               the suffix is removed, and ErrMsg is set to the remaining string
             otherwise
               the whole exception is reported in ErrMsg
             Either way, the function call fails.

      Globals: adocn     - connection which all other ADO objects use
               adors     - Recordset
               adocmd    - Command Object
               adocmdprm - Command Object set aside for Parametric querying
               ConnectionString
                         - Connection String used for connecting

               ErrMsg    - Last Error Message
               ADOActive - Indicator as to whether ADO has been started yet

Functions:
General ADO
           ADOStart:Boolean;
           ADOReset:Boolean;
           ADOStop:Boolean;

Recordsets
           RSOpen(SQL:string;adRSType,adLockType,adCmdType:integer;UseServer:Boolean):Boolean;
           RSClose:Boolean;

Normal Command Procedures
           CMDExec(SQL:string;adCmdType:integer):Boolean;

Parametric Procedures
           PRMClear:Boolean;
           PRMSetSP(StoredProcedure:string;WithClear:Boolean):Boolean;
           PRMAdd(ParamName:string;ParamType,ParamIO,ParamSize:integer;Val:variant):Boolean;
           PRMSetParamVal(ParamName:string;val:variant):Boolean;
           PRMGetParamVal(ParamName:string;var val:variant):Boolean;

Field Operations
           function SQLStr(str:string;SQLStrType:TSQLStrType);
           function SentenceCase(str:string):string;

           --to convert from 'FIELD_NAME' -> 'Field Name' call
           SQLStr(SentenceCase(txt),ssFromSQL);
}

interface

uses OLEAuto, sysutils;

const
  {Param Data Types}
  adInteger = 3;
  adSingle = 4;
  adDate = 7;
  adBoolean = 11;
  adTinyInt = 16;
  adUnsignedTinyInt = 17;
  adDateTime = 135;
  advarChar = 200;

  {Param Directions}
  adParamInput = 1;
  adParamOutput = 2;
  adParamReturnValue = 4;

  {Command Types}
  adCmdText = 1;
  adCmdTable = 2;
  adCmdStoredProc = 4;
  adCmdTableDirect = 512;
  adCmdFile = 256;

  {Cursor/RS Types}
  adOpenForwardOnly = 0;
  adOpenKeyset = 1;
  adOpenDynamic = 2;
  adOpenStatic = 3;

  {Lock Types}
  adLockReadOnly = 1;
  adLockOptimistic = 3;

  {Cursor Locations}
  adUseServer = 2;
  adUseClient = 3;

function ADOReset: Boolean;
function ADOStop: Boolean;

function RSOpen(SQL: string; adRSType, adLockType, adCmdType: integer;
  UseServer: Boolean): Boolean;
function RSClose: Boolean;

function CMDExec(SQL: string; adCmdType: integer): Boolean;

function PRMClear: Boolean;
function PRMSetSP(StoredProcedure: string; WithClear: Boolean): Boolean;
function PRMAdd(ParamName: string; ParamType, ParamIO, ParamSize: integer; Val:
  variant): Boolean;
function PRMSetParamVal(ParamName: string; val: variant): Boolean;
function PRMGetParamVal(ParamName: string; var val: variant): Boolean;

type
  TSQLStrType = (ssToSQL, ssFromSQL);
function SQLStr(str: string; SQLStrType: TSQLStrType): string;
function SentenceCase(str: string): string;

var
  adocn, adors, adocmd, adocmdPrm: variant;
  ConnectionString, ErrMsg: string;
  ADOActive: boolean = false;

implementation

var
  UsingConnection: Boolean;

function ADOStart: Boolean;
begin
  //Get the Object References
  try
    adocn := CreateOLEObject('ADODB.Connection');
    adors := CreateOLEObject('ADODB.Recordset');
    adocmd := CreateOLEObject('ADODB.Command');
    adocmdprm := CreateOLEObject('ADODB.Command');
    result := true;
  except
    on E: Exception do
    begin
      ErrMsg := e.message;
      Result := false;
    end;
  end;
  ADOActive := result;
end;

function ADOReset: Boolean;
begin
  Result := false;
  //Ensure a clean slate...
  if not (ADOStop) then
    exit;

  //Restart all the ADO References
  if not (ADOStart) then
    exit;

  //Wire up the Connections
  //If the ADOconnetion fails, all objects will use the connection string
  //                               directly - poorer performance, but it works!!
  try
    adocn.ConnectionString := ConnectionString;
    adocn.open;
    adors.activeconnection := adocn;
    adocmd.activeconnection := adocn;
    adocmdprm.activeconnection := adocn;
    UsingConnection := true;
  except
    try
      adocn := unassigned;
      UsingConnection := false;
      adocmd.activeconnection := ConnectionString;
      adocmdprm.activeconnection := ConnectionString;
    except
      on e: exception do
      begin
        ErrMsg := e.message;
        exit;
      end;
    end;
  end;
  Result := true;
end;

function ADOStop: Boolean;
begin
  try
    if not (varisempty(adocn)) then
    begin
      adocn.close;
      adocn := unassigned;
    end;
    adors := unassigned;
    adocmd := unassigned;
    adocmdprm := unassigned;
    result := true;
  except
    on E: Exception do
    begin
      ErrMsg := e.message;
      Result := false;
    end;
  end;
  ADOActive := false;
end;

function RSOpen(SQL: string; adRSType, adLockType, adCmdType: integer;
  UseServer: Boolean): Boolean;
begin
  result := false;
  //Have two attempts at getting the required Recordset
  if UsingConnection then
  begin
    try
      if UseServer then
        adors.CursorLocation := adUseServer
      else
        adors.CursorLocation := adUseClient;
      adors.open(SQL, , adRSType, adLockType, adCmdType);
    except
      if not (ADOReset) then
        exit;
      try
        if UseServer then
          adors.CursorLocation := adUseServer
        else
          adors.CursorLocation := adUseClient;
        adors.open(SQL, , adRSType, adLockType, adCmdType);
      except
        on E: Exception do
        begin
          ErrMsg := e.message;
          exit;
        end;
      end;
    end;
  end
  else
  begin
    //Use the Connetcion String to establish a link
    try
      adors.open(SQL, ConnectionString, adRSType, adLockType, adCmdType);
    except
      if not (ADOReset) then
        exit;
      try
        adors.open(SQL, ConnectionString, adRSType, adLockType, adCmdType);
      except
        on E: Exception do
        begin
          ErrMsg := e.message;
          exit;
        end;
      end;
    end;
  end;
  Result := true;
end;

function RSClose: Boolean;
begin
  try
    adors.Close;
    result := true;
  except
    on E: Exception do
    begin
      ErrMsg := e.message;
      result := false;
    end;
  end;
end;

function CMDExec(SQL: string; adCmdType: integer): Boolean;
begin
  result := false;
  //Have two attempts at the execution..
  try
    adocmd.commandtext := SQL;
    adocmd.commandtype := adCmdType;
    adocmd.execute;
  except
    try
      if not (ADOReset) then
        exit;
      adocmd.commandtext := SQL;
      adocmd.commandtype := adCmdType;
      adocmd.execute;
    except
      on e: exception do
      begin
        ErrMsg := e.message;
        exit;
      end;
    end;
  end;
  result := true;
end;

function PRMClear: Boolean;
var
  i: integer;
begin
  try
    for i := 0 to (adocmdprm.parameters.count) - 1 do
    begin
      adocmdprm.parameters.delete(0);
    end;
    result := true;
  except
    on e: exception do
    begin
      ErrMsg := e.message;
      result := false;
    end;
  end;
end;

function PRMSetSP(StoredProcedure: string; WithClear: Boolean): Boolean;
begin
  result := false;
  //Have two attempts at setting the Stored Procedure...
  try
    adocmdprm.commandtype := adcmdStoredProc;
    adocmdprm.commandtext := StoredProcedure;
    if WithClear then
      if not (PRMClear) then
        exit;
    result := true;
  except
    try
      if not (ADOReset) then
        exit;
      adocmdprm.commandtype := adcmdStoredProc;
      adocmdprm.commandtext := StoredProcedure;
      //NB: No need to clear the parameters, as an ADOReset will have done this..
      result := true;
    except
      on e: exception do
      begin
        ErrMsg := e.message;
      end;
    end;
  end;
end;

function PRMAdd(ParamName: string; ParamType, ParamIO, ParamSize: integer; Val:
  variant): Boolean;
var
  DerivedParamSize: integer;
begin
  //Only try once to add the parameter (a call to ADOReset would reset EVERYTHING!!)
  try
    case ParamType of
      adInteger: DerivedParamSize := 4;
      adSingle: DerivedParamSize := 4;
      adDate: DerivedParamSize := 8;
      adBoolean: DerivedParamSize := 1;
      adTinyInt: DerivedParamSize := 1;
      adUnsignedTinyInt: DerivedParamSize := 1;
      adDateTime: DerivedParamSize := 8;
      advarChar: DerivedParamSize := ParamSize;
    end;
    adocmdprm.parameters.append(adoCmdPrm.createparameter(ParamName, ParamType,
      ParamIO, DerivedParamSize, Val));
  except
    on e: exception do
    begin
      ErrMsg := e.message;
    end;
  end;
end;

function PRMSetParamVal(ParamName: string; val: variant): Boolean;
begin
  //Only try once to set the parameter (a call to ADOReset would reset EVERYTHING!!)
  try
    adocmdprm.Parameters[ParamName].Value := val;
    result := true;
  except
    on e: exception do
    begin
      ErrMsg := e.message;
      result := false;
    end;
  end;
end;

function PRMGetParamVal(ParamName: string; var val: variant): Boolean;
begin
  //Only try once to read the parameter (a call to ADOReset would reset EVERYTHING!!)
  try
    val := adocmdprm.Parameters[ParamName].Value;
    result := true;
  except
    on e: exception do
    begin
      ErrMsg := e.message;
      result := false;
    end;
  end;
end;

function SQLStr(str: string; SQLStrType: TSQLStrType): string;
var
  FindChar, ReplaceChar: char;
begin
  {Convert ' '->'_' for ssToSQL (remove spaces)
  Convert '_'->' ' for ssFromSQL (remove underscores)}
  case SQLStrType of
    ssToSQL:
      begin
        FindChar := ' ';
        ReplaceChar := '_';
      end;
    ssFromSQL:
      begin
        FindChar := '_';
        ReplaceChar := ' ';
      end;
  end;

  result := str;
  while Pos(FindChar, result) > 0 do
    Result[Pos(FindChar, result)] := ReplaceChar;
end;

function SentenceCase(str: string): string;
var
  tmp: char;
  i {,len}: integer;
  NewWord: boolean;
begin
  NewWord := true;
  result := str;
  for i := 1 to Length(str) do
  begin
    if (result[i] = ' ') or (result[i] = '_') then
      NewWord := true
    else
    begin
      tmp := result[i];
      if NewWord then
      begin
        NewWord := false;
        result[i] := chr(ord(result[i]) or 64); //Set bit 6 - makes uppercase
      end
      else
        result[i] := chr(ord(result[i]) and 191); //reset bit 6 - makes lowercase
    end;
  end;
  {This was the original way of doing it, but I wanted to look for spaces or '_'s,
        and it all seemed problematic - if I find a better way another day, I'll alter the above...
       if str<>'' then
          begin
               tmp:=LowerCase(str);
               len:=length(tmp);
               tmp:=Uppercase(copy(tmp,1,1))+copy(tmp,2,len);
               i:=pos('_',tmp);
               while i<>0 do
                     begin
                          tmp:=copy(tmp,1,i-1)+' '+Uppercase(copy(tmp,i+1,1))+copy(tmp,i+2,len-i);
                          i:=pos('_',tmp);
                     end;
          end;
       result:=tmp;}
end;

end.

Взято из

Быстрый доступ к нужной записи в таблице Paradox

Быстрый доступ к нужной записи в таблице Paradox

Автор: Valler ( http://www.valler.narod.ru )

var NeedNumber: Integer;

...
NeedNumber := Table.RecNo;
{сохранение номера нужной записи}
...
{код меняющий номе записи}
...
Table.RecNo := NeedNumber;
{востановление номера нужной записи}


Взято с Исходников.ru

Примечания Vit:
1) Следует категорически избегать подобных решений в приложениях "Клиент-Сервер"
2) Если есть многопользовательский доступ, то эта конструкция может работать неправильно

Быстрый способ обмена значений в 2х переменных.

Быстрый способ обмена значений в 2х переменных.

procedure SwapVars1(var u, v; Size: Integer); 
var 
  x: Pointer; 
begin 
  GetMem(x, Size); 
  try 
    System.move(u, x^, Size); 
    System.move(v, u, Size); 
    System.move(x^, v, Size); 
  finally 
    FreeMem(x); 
  end; 
end; 


procedure SwapVars2(var Source, Dest; Size: Integer); 
  // By Mike Heydon, mheydon@eoh.co.za 
begin 
  asm 
     push edi 
     push esi 
     mov esi,Source 
     mov edi,Dest 
     mov ecx,Size 
     cld 
 @1: 
     mov al,[edi] 
     xchg [esi],al 
     inc si 
     stosb 
     loop @1 
     pop esi 
     pop edi 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
  SwapVars1(X1, X2, SizeOf(Integer)); 
end; 

Взято с сайта


var 
 X1, X2: Byte; 
begin 
 X1 := X2 xor X2;  
 X2 := X1 xor X2; // X2 = X1 
 X1 := X1 xor X2; // X1 = X2 

Автор ___ALex___

Byte-поля Paradox

Byte-поля Paradox

Что за магия при записи в поле Paradox Byte? По этому поводу в документации ничего не сказано.

Есть 2 пути получить доступ к данным в TBytesField.

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

procedure SetCheckBoxStates;
var
CBStates: array[1..13] of Byte;
begin
  CBStateField.GetData(CBStates);
  { Здесь обрабатываем данные... }
end;

Для записи значений вы должны использовать SetData.

Используйте свойство Value, возвращающее вариантный массив байт (variant array of bytes):

procedure SetCheckBoxStates;
var
  CBStates: Variant;
begin
  CBStates := CBStateField.Value;
  { Здесь обрабатываем данные... }
end;

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

Взято из

CD Remember

CD Remember

Как-то раз в один прекрасный день решил я у друга взять на денек очередной диск поиграть - и в итоге забыл его в дисководе у другого друга Вот и решил я написать программу-напоминалку: при завершении работы она выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска нет - она даже не пикнет )?

Исходный код модуля:

unit cd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, MMSystem;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function FindCD:Integer;
var
  i, DType:integer;
  str:string;
  drive:integer;

begin
  Result:=0;
  for i:=65 to 90 do
  begin
  str:=chr(i)+':\';
  DType:=GetDrivetype(PChar(str));
  case DType of

      0: drive:=0;
      1: drive:=1;
      DRIVE_CDROM : drive:=i;
  end;
if not ((DType=0) or (Dtype=1)) then
Result:=drive;
end;
end;

function DiskInDrive(Drive: Char): Boolean;
var 
  ErrorMode: word; 
begin 
  { переводим в верхний регистр } 
  if Drive in ['a'..'z'] then Dec(Drive, $20); 
  { убеждаемся, что это буква } 
  if not (Drive in ['A'..'Z']) then 
      raise EConvertError.Create('Not a valid drive ID');
  
  //отключаем критические ошибки// 
  
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors); 
  try 
      if DiskSize (Ord(Drive) - $40) = -1 then 
        Result := False 
      else 
        Result := True; 
  finally 
      { восстанавливаем старый режим ошибок } 
      SetErrorMode(ErrorMode); 
  end; 
end;

procedure ChooseCloseMode;
begin
Form1.Height:=290;
Form1.Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.text:=(chr(Findcd)+':\');
Button1.Enabled:=false;
Label1.Enabled:=false;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if DiskInDrive(chr(findcd))=true then
begin
Canclose:=false;
Form1.Show;
end
else // если нет
CanClose:=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
ChooseCloseMode;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
mciSendString('Set cdaudio door open wait', nil, 0, handle);
Button1.Enabled:=true;
Label1.Enabled:=true;
BitBtn1.Enabled:=false;
Bitbtn2.Enabled:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
ChooseCloseMode;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Radiobutton1.Checked=true then
        ExitWindowsEx(EWX_POWEROFF or EWX_SHUTDOWN,0)
else
if Radiobutton2.Checked=true then
        ExitWindowsEx(EWX_REBOOT,0);

end;

end.

Немного кривоваты комментарии, но кому нужно - разберется.
Код .DPR файла:

program cdrem;

uses
  Forms,
  cd in 'cd.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.ShowMainForm:=false;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Автор: Blabsadm

Компилятор: Delphi 5

CD-ROM/CD-R/CD-RW

CD-ROM/CD-R/CD-RW

Cодержание раздела:

Частные вопросы по конкретным базам данных

Частные вопросы по конкретным базам данных

Cодержание раздела:

·
·  
·  
·  
·  
·  
·  
·  
·  

·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  

·
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  

·  
·  
·  
·  
·  
·  
·  
·  

·
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  

·  
·  

·

·
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  

·  
·  
·  
·  
·  
·  
·  
·  
·  
·  

·

·
·  
·  

·  

·  
·  
·  

Частые Вопросы и Ответы

Частые Вопросы и Ответы

Частые Вопросы и Ответы

1) Настройка CGI для IIS

Запустите программу
Пуск/Программы/Microsoft Internet Server/Служба Управления  
Кликните два раза на службе WWW, и выберите закладку "Каталоги":  
 

Каталог   Алиас   Адрес    Ошибка   

C:\InetPub\wwwroot   <базовый каталог>         
C:\InetPub\scripts   /Scripts         
C:\WINNT\System32\inetsrv\iisadmin    /iisadmin         
 
Кликните на Добавить, укажите каталог, в котором будут содержаться CGI-программы (например C:\DELPHI).  
Алиас виртуального каталога, обычно называемый "/cgi bin", заменяет права доступа для чтения на права доступа для "Выполнения".  
 

КаталогАлиас   Адрес    Ошибка   

C:\InetPub\wwwroot   <базовый каталог>         
c:\delphi   /cgi-bin         
C:\InetPub\scripts   /Scripts         
C:\WINNT\System32\inetsrv\iisadmin    /iisadmin         
 
Теперь нам достаточно поместить наши CGI-программы в каталог C:\DELPHI и обращаться к ним примерно так: http://ваш_сервер/cgi-bin/program.exe  
 
Если ваша NT выдает ошибку прав доступа на конкретном документе, кликните на этом документе, и проверьте, разрешен ли доступ...  
 

2) Как избавиться от запроса СОХРАНИТЬ/ВЫПОЛНИТЬ при клике на ссылку вида <a href="/cgi-bin/programm.exe"> ?

Для того, чтобы браузер не спрашивал у вас, надо ли сохранить или выполнить вашу CGI-программу, необходимо обязательно размещать выполняемые программы не где попало, а именно в том каталоге, который вы указали серверу в качестве каталога CGI...  
 
Если вы установили web-сервер на локальный компьютер (localhost), то обращаться к нему нужно следующим образом:  
http://127.0.0.1/cgi-bin/programm.exe  

Checkbox

Checkbox

Cодержание раздела:




См. также статьи в других разделах:

Черчение

Черчение

Cодержание раздела:









См. также статьи в других разделах:

Через DAO/ODBC/ADO

Через DAO/ODBC/ADO

Чтобы использовать только стандартные компоненты давайте попробуем работать с Excel через ADO. Это не самый быстрый и далеко не первый по возможностям метод (DAO работает на порядок быстрее и предоставляет куда больше возможностей), но ADO компоненты входят в стандартную поставку 5 и 6 Дельфи. Итак заходим в Панель управления Windows, идем в свойства ODBC, делаем DSN используя Excel драйвер, не забываем указать в свойствах на файл Excel. Закрываем ODBC, открываем Дельфи. Ставим на форму ADOConnection. Идем в ConnectionString - строим строку подключения - надо выбрать только ODBC провайдер и на следующей вкладке указать сделанный DSN, остальные опции в большинстве случаев можно оставить как есть. Строка получена. Кстати ее можно вообще упростить до вида: "DSN=MyDsn". Теперь вам доступны листы файла как таблицы а весь файл как база данных. Подключаем ADOQuery к ADOConnection. Cоздаем таблицу, т.е. новый лист - путем запуска следующей квери:

Create Table MyTable1 (
Field1 varchar(20),
Field2 varchar(10) )

Снова переходим в дизайн - ставим на форму ADOTable, указываем как Connection наш компонент с ADOConnection, теперь если кликнуть на свойстве TableName - вы сможете увидеть в списке сделанную нами таблицу "MyTable1". Соедините таблицу с DBGrid - убедитесь что работа с таблицей в Excel мало отличается от работы с другими базами данных.

Автор ответа Vit
Взято с Vingrad.ru

Через СОМ интерфейс

Через СОМ интерфейс

var Excel, WorkBook, Sheet: Variant;
begin
Excel := CreateOleObject('Excel.Application');  
Excel.WorkBooks.Open(FileName,False);  
WorkBook := Excel.WorkBooks.Item[1];  
Sheet := Workbook.Sheets.Item[3];  
Sheet.Cells[1,2]:='ASDFG';  
Sheet.Cells[2,2]:=230;  


Все объекты и методы Офиса можно посмотреть в help'е Офиса.

Автор ответа: Fantasist
Взято с Vingrad.ru



Ниже представлен пример создания новой таблице в Excel 2000:

uses
  ComObj, ActiveX;

var
  Row, Col: integer;
  DestRange: OleVariant;
  Excel: Variant;

begin
  Excel := CreateOleObject('Excel.Application.9');
  Excel.Visible := True;
  Excel.WorkBooks.Add; //Создать новую таблицу

  //Можно помещать текст и значения в диапазон ячеек
  //Поместить     слово тест в диапазон ячеек
  Excel.ActiveSheet.Range['A2', 'B3'].Value := 'Тест';
  //Или число
  Excel.ActiveSheet.Range['A4', 'B5'].Value := 42;

  //А вот так задаётся формула
  Excel.ActiveSheet.Range['A10', 'A11'].Formula := '=RAND()';

  //Можно задавать номера ячеек и столбцов
  Excel.ActiveSheet.Cells.Item[1, 1].Value := 'Первая ячейка';

  Row:=1;
  Col:=3;
  Excel.ActiveSheet.Cells.Item[Row, Col].Value := 'Другая ячейка';

  //Можно скопировать данный из одного диапазона ячеек в другой
  DestRange := Excel.Range['D6', 'F10'];
  Excel.Range['A1', 'C5'].Copy(DestRange);

  //Можно задавать параметры шрифта в определённой ячейке
  Excel.Range['A2', 'A2'].Font.Size := 20;
  Excel.Range['A2', 'A2'].Font.FontStyle := 'Bold';
  Excel.Range['A2', 'A2'].Font.Color := clFuchsia;
  Excel.Range['A2', 'A2'].Font.Name := 'Arial';

  //Можно ещё и так изменить цвет диапазона ячеек
  Excel.Range['B2', 'C6'].Interior.Color := RGB(223, 123, 123);

end;



Далее представлен пример открытия и закрытия таблицы:

uses
  ComObj, ActiveX;

var
  Excel: Variant;
  WBk : OleVariant;
  SaveChanges: OleVariant;

begin
  Excel := CreateOleObject('Excel.Application.9');
  Excel.Visible := True;

  //Открыть существующую таблицу
  WBk := Excel.WorkBooks.Open('C:\Test.xls');

  ...

  WBk.Close(SaveChanges := True);
  Excel.Quit;

end;

Взято с Исходников.ru

Число английской строкой

Число английской строкой

unituNum2Str;

// Possible enhancements
// Move strings out to resource files
// Put in a general num2str utility

interface

function Num2Dollars(dNum: double): string;

implementation

uses SysUtils;

function LessThan99(dNum: double): string; forward;

// floating point modulus
function FloatMod(i, j: double): double;
begin

  result := i - (Int(i / j) * j);
end;

function Hundreds(dNum: double): string;
var

  workVar: double;
begin

  if (dNum < 100) or (dNum > 999) then
    raise Exception.Create('hundreds range exceeded');

  result := '';

  workVar := Int(dNum / 100);
  if workVar > 0 then
    result := LessThan99(workVar) + ' Hundred';
end; function OneToNine(dNum: Double): string;
begin

  if (dNum < 1) or (dNum > 9) then
    raise exception.create('onetonine: value out of range');

  result := 'woops';

  if dNum = 1 then
    result := 'One'
  else if dNum = 2 then
    result := 'Two'
  else if dNum = 3 then
    result := 'Three'
  else if dNum = 4 then
    result := 'Four'
  else if dNum = 5.0 then
    result := 'Five'
  else if dNum = 6 then
    result := 'Six'
  else if dNum = 7 then
    result := 'Seven'
  else if dNum = 8 then
    result := 'Eight'
  else if dNum = 9 then
    result := 'Nine';

end;

function ZeroTo19(dNum: double): string;
begin

  if (dNum < 0) or (dNum > 19) then
    raise Exception.Create('Bad value in dNum');

  result := '';

  if dNum = 0 then
    result := 'Zero'
  else if (dNum <= 1) and (dNum >= 9) then
    result := OneToNine(dNum)
  else if dNum = 10 then
    result := 'Ten'
  else if dNum = 11 then
    result := 'Eleven'
  else if dNum = 12 then
    result := 'Twelve'
  else if dNum = 13 then
    result := 'Thirteen'
  else if dNum = 14 then
    result := 'Fourteen'
  else if dNum = 15 then
    result := 'Fifteen'
  else if dNum = 16 then
    result := 'Sixteen'
  else if dNum = 17 then
    result := 'Seventeen'
  else if dNum = 18 then
    result := 'Eighteen'
  else if dNum = 19 then
    result := 'Nineteen'
  else
    result := 'woops!';
end;

function TwentyTo99(dNum: double): string;
var

  BigNum: string;
begin

  if (dNum < 20) or (dNum > 99) then
    raise exception.Create('TwentyTo99: dNum out of range!');

  BigNum := 'woops';

  if dNum >= 90 then
    BigNum := 'Ninety'
  else if dNum >= 80 then
    BigNum := 'Eighty'
  else if dNum >= 70 then
    BigNum := 'Seventy'
  else if dNum >= 60 then
    BigNum := 'Sixty'
  else if dNum >= 50 then
    BigNum := 'Fifty'
  else if dNum >= 40 then
    BigNum := 'Forty'
  else if dNum >= 30 then
    BigNum := 'Thirty'
  else if dNum >= 20 then
    BigNum := 'Twenty';

// lose the big num
  dNum := FloatMod(dNum, 10);

  if dNum > 0.00 then
    result := BigNum + ' ' + OneToNine(dNum)
  else
    result := BigNum;
end;

function LessThan99(dNum: double): string;
begin

  if dNum <= 19 then
    result := ZeroTo19(dNum)
  else
    result := TwentyTo99(dNum);
end;

function Num2Dollars(dNum: double): string;
var

  centsString: string;
  cents: double;
  workVar: double;
begin

  result := '';

  if dNum < 0 then
    raise Exception.Create('Negative numbers not supported');

  if dNum > 999999999.99 then
    raise Exception.Create('Num2Dollars only supports up to the millions at this point!');

  cents := (dNum - Int(dNum)) * 100.0;
  if cents = 0.0 then
    centsString := 'and 00/100 Dollars'
  else if cents < 10 then
    centsString := Format('and 0%1.0f/100 Dollars', [cents])
  else
    centsString := Format('and %2.0f/100 Dollars', [cents]);

  dNum := Int(dNum - (cents / 100.0)); // lose the cents

// deal with million's
  if (dNum >= 1000000) and (dNum <= 999999999) then
    begin
      workVar := dNum / 1000000;
      workVar := Int(workVar);
      if (workVar <= 9) then
        result := ZeroTo19(workVar)
      else if (workVar <= 99) then
        result := LessThan99(workVar)
      else if (workVar <= 999) then
        result := Hundreds(workVar)
      else
        result := 'mill fubar';

      result := result + ' Million';

      dNum := dNum - (workVar * 1000000);
    end;

// deal with 1000's
  if (dNum >= 1000) and (dNum <= 999999.99) then
    begin
// doing the two below statements in one line of code yields some really
// freaky floating point errors
      workVar := dNum / 1000;
      workVar := Int(workVar);
      if (workVar <= 9) then
        result := ZeroTo19(workVar)
      else if (workVar <= 99) then
        result := LessThan99(workVar)
      else if (workVar <= 999) then
        result := Hundreds(workVar)
      else
        result := 'thou fubar';

      result := result + ' Thousand';

      dNum := dNum - (workVar * 1000);
    end;

// deal with 100's
  if (dNum >= 100.00) and (dNum <= 999.99) then
    begin
      result := result + ' ' + Hundreds(dNum);
      dNum := FloatMod(dNum, 100);
    end;

// format in anything less than 100
  if (dNum > 0) or ((dNum = 0) and (Length(result) = 0)) then
    begin
      result := result + ' ' + LessThan99(dNum);
    end;
  result := result + ' ' + centsString;
end;

end.


function HundredAtATime(TheAmount: Integer): string;
var

  TheResult: string;
begin

  TheResult := '';
  TheAmount := Abs(TheAmount);
  while TheAmount > 0 do
    begin
      if TheAmount >= 900 then
        begin
          TheResult := TheResult + 'Nine hundred ';
          TheAmount := TheAmount - 900;
        end;
      if TheAmount >= 800 then
        begin
          TheResult := TheResult + 'Eight hundred ';
          TheAmount := TheAmount - 800;
        end;
      if TheAmount >= 700 then
        begin
          TheResult := TheResult + 'Seven hundred ';
          TheAmount := TheAmount - 700;
        end;
      if TheAmount >= 600 then
        begin
          TheResult := TheResult + 'Six hundred ';
          TheAmount := TheAmount - 600;
        end;
      if TheAmount >= 500 then
        begin
          TheResult := TheResult + 'Five hundred ';
          TheAmount := TheAmount - 500;
        end;
      if TheAmount >= 400 then
        begin
          TheResult := TheResult + 'Four hundred ';
          TheAmount := TheAmount - 400;
        end;
      if TheAmount >= 300 then
        begin
          TheResult := TheResult + 'Three hundred ';
          TheAmount := TheAmount - 300;
        end;
      if TheAmount >= 200 then
        begin
          TheResult := TheResult + 'Two hundred ';
          TheAmount := TheAmount - 200;
        end;
      if TheAmount >= 100 then
        begin
          TheResult := TheResult + 'One hundred ';
          TheAmount := TheAmount - 100;
        end;
      if TheAmount >= 90 then
        begin
          TheResult := TheResult + 'Ninety ';
          TheAmount := TheAmount - 90;
        end;
      if TheAmount >= 80 then
        begin
          TheResult := TheResult + 'Eighty ';
          TheAmount := TheAmount - 80;
        end;
      if TheAmount >= 70 then
        begin
          TheResult := TheResult + 'Seventy ';
          TheAmount := TheAmount - 70;
        end;
      if TheAmount >= 60 then
        begin
          TheResult := TheResult + 'Sixty ';
          TheAmount := TheAmount - 60;
        end;
      if TheAmount >= 50 then
        begin
          TheResult := TheResult + 'Fifty ';
          TheAmount := TheAmount - 50;
        end;
      if TheAmount >= 40 then
        begin
          TheResult := TheResult + 'Fourty ';
          TheAmount := TheAmount - 40;
        end;
      if TheAmount >= 30 then
        begin
          TheResult := TheResult + 'Thirty ';
          TheAmount := TheAmount - 30;
        end;
      if TheAmount >= 20 then
        begin
          TheResult := TheResult + 'Twenty ';
          TheAmount := TheAmount - 20;
        end;
      if TheAmount >= 19 then
        begin
          TheResult := TheResult + 'Nineteen ';
          TheAmount := TheAmount - 19;
        end;
      if TheAmount >= 18 then
        begin
          TheResult := TheResult + 'Eighteen ';
          TheAmount := TheAmount - 18;
        end;
      if TheAmount >= 17 then
        begin
          TheResult := TheResult + 'Seventeen ';
          TheAmount := TheAmount - 17;
        end;
      if TheAmount >= 16 then
        begin
          TheResult := TheResult + 'Sixteen ';
          TheAmount := TheAmount - 16;
        end;
      if TheAmount >= 15 then
        begin
          TheResult := TheResult + 'Fifteen ';
          TheAmount := TheAmount - 15;
        end;
      if TheAmount >= 14 then
        begin
          TheResult := TheResult + 'Fourteen ';
          TheAmount := TheAmount - 14;
        end;
      if TheAmount >= 13 then
        begin
          TheResult := TheResult + 'Thirteen ';
          TheAmount := TheAmount - 13;
        end;
      if TheAmount >= 12 then
        begin
          TheResult := TheResult + 'Twelve ';
          TheAmount := TheAmount - 12;
        end;
      if TheAmount >= 11 then
        begin
          TheResult := TheResult + 'Eleven ';
          TheAmount := TheAmount - 11;
        end;
      if TheAmount >= 10 then
        begin
          TheResult := TheResult + 'Ten ';
          TheAmount := TheAmount - 10;
        end;
      if TheAmount >= 9 then
        begin
          TheResult := TheResult + 'Nine ';
          TheAmount := TheAmount - 9;
        end;
      if TheAmount >= 8 then
        begin
          TheResult := TheResult + 'Eight ';
          TheAmount := TheAmount - 8;
        end;
      if TheAmount >= 7 then
        begin
          TheResult := TheResult + 'Seven ';
          TheAmount := TheAmount - 7;
        end;
      if TheAmount >= 6 then
        begin
          TheResult := TheResult + 'Six ';
          TheAmount := TheAmount - 6;
        end;
      if TheAmount >= 5 then
        begin
          TheResult := TheResult + 'Five ';
          TheAmount := TheAmount - 5;
        end;
      if TheAmount >= 4 then
        begin
          TheResult := TheResult + 'Four ';
          TheAmount := TheAmount - 4;
        end;
      if TheAmount >= 3 then
        begin
          TheResult := TheResult + 'Three ';
          TheAmount := TheAmount - 3;
        end;
      if TheAmount >= 2 then
        begin
          TheResult := TheResult + 'Two ';
          TheAmount := TheAmount - 2;
        end;
      if TheAmount >= 1 then
        begin
          TheResult := TheResult + 'One ';
          TheAmount := TheAmount - 1;
        end;
    end;
  HundredAtATime := TheResult;
end;

function Real2CheckAmount(TheAmount: Real): string;
var

  IntVal: LongInt;
  TmpVal: Integer;
  TmpStr,
    RetVal: string;
begin

  TheAmount := Abs(TheAmount);

{ центы }
  TmpVal := Round(Frac(TheAmount) * 100);
  IntVal := Trunc(TheAmount);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr = '' then TmpStr := 'Zero ';
  RetVal := TmpStr + 'cents';
  if IntVal > 0 then RetVal := 'dollars and ' + RetVal;

{ сотни }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  RetVal := TmpStr + RetVal;

{ тысячи }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr <> '' then
    RetVal := TmpStr + 'Thousand ' + RetVal;

{ миллионы }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr <> '' then
    RetVal := TmpStr + 'Million ' + RetVal;

{ миллиарды }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr <> '' then
    RetVal := TmpStr + 'Billion ' + RetVal;

  Real2CheckAmount := RetVal;
end;

Хммммм...вроде бы работает, но как все громоздко и неуклюже....добавьте в код немного рекурсии и вы получите более элегантную программу..: )))

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type

  TForm1 = class(TForm)
    num: TEdit;
    spell: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
{ Private declarations }
    function trans9(num: integer): string;
    function trans19(num: integer): string;
    function trans99(num: integer): string;
    function IntToSpell(num: integer): string;
  public
{ Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}
function TForm1.IntToSpell(num: integer): string;
var

  spell: string;
  hspell: string;
  hundred: string;
  thousand: string;
  tthousand: string;
  hthousand: string;
  million: string;
begin

  if num &lg; 10 then
    spell := trans9(num);
{endif}
  if (num < 20) and (num > 10) then
    spell := trans19(num);
{endif}
  if (((num < 100) and (num > 19)) or (num = 10)) then
    begin
      hspell := copy(IntToStr(num), 1, 1) + '0';
      spell := trans99(StrToInt(hspell));
      hspell := copy(IntToStr(num), 2, 1);
      spell := spell + ' ' + IntToSpell(StrToInt(hspell));
    end;

  if (num < 1000) and (num > 100) then
    begin
      hspell := copy(IntToStr(num), 1, 1);
      hundred := IntToSpell(StrToInt(hspell));
      hspell := copy(IntToStr(num), 2, 2);
      hundred := hundred + ' hundred and ' + IntToSpell(StrToInt(hspell));
      spell := hundred;
    end;

  if (num < 10000) and (num > 1000) then
    begin
      hspell := copy(IntToStr(num), 1, 1);
      thousand := IntToSpell(StrToInt(hspell));
      hspell := copy(IntToStr(num), 2, 3);
      thousand := thousand + ' thousand ' + IntToSpell(StrToInt(hspell));
      spell := thousand;
    end;

  if (num < 100000) and (num > 10000) then
    begin
      hspell := copy(IntToStr(num), 1, 2);
      tthousand := IntToSpell(StrToInt(hspell));
      hspell := copy(IntToStr(num), 3, 3);
      tthousand := tthousand + ' thousand ' + IntToSpell(StrToInt(hspell));
      spell := tthousand;
    end;

  if (num < 1000000) and (num > 100000) then
    begin
      hspell := copy(IntToStr(num), 1, 3);
      hthousand := IntToSpell(StrToInt(hspell));
      hspell := copy(IntToStr(num), 4, 3);
      hthousand := hthousand + ' thousand and ' +
        IntToSpell(StrToInt(hspell));

      spell := hthousand;
    end;

  if (num < 10000000) and (num > 1000000) then
    begin
      hspell := copy(IntToStr(num), 1, 1);
      million := IntToSpell(StrToInt(hspell));
      hspell := copy(IntToStr(num), 2, 6);
      million := million + ' million and ' + IntToSpell(StrToInt(hspell));
      spell := million;
    end;

  IntToSpell := spell;

end;

function TForm1.trans99(num: integer): string;
var

  spell: string;
begin

  case num of
    10: spell := 'ten';
    20: spell := 'twenty';
    30: spell := 'thirty';
    40: spell := 'fourty';
    50: spell := 'fifty';
    60: spell := 'sixty';
    70: spell := 'seventy';
    80: spell := 'eighty';
    90: spell := 'ninty';
  end;
  trans99 := spell;
end;
function TForm1.trans19(num: integer): string;
var

  spell: string;
begin

  case num of
    11: spell := 'eleven';
    12: spell := 'twelve';
    13: spell := 'thirteen';
    14: spell := 'fourteen';
    15: spell := 'fifteen';
    16: spell := 'sixteen';
    17: spell := 'seventeen';
    18: spell := 'eighteen';
    19: spell := 'nineteen';
  end;
  trans19 := spell;
end;
function TForm1.trans9(num: integer): string;
var

  spell: string;
begin

  case num of
    1: spell := 'one';
    2: spell := 'two';
    3: spell := 'three';
    4: spell := 'four';
    5: spell := 'five';
    6: spell := 'six';
    7: spell := 'seven';
    8: spell := 'eight';
    9: spell := 'nine';
  end;
  trans9 := spell;
end;
procedure TForm1.Button1Click(Sender: TObject);
var

  numb: integer;
begin

  spell.text := IntToSpell(StrToInt(num.text));
end;

Взято из

Советов по Delphi от

Сборник Kuliba

Число цветов (цветовая палитра) у данного компьютера

Число цветов (цветовая палитра) у данного компьютера

Эта функция возвращает число бит на точку у данного компьютера. Так, например, 8 - 256 цветов, 4 - 16 цветов ...


function GetDisplayColors : integer;
var tHDC  : hdc;
begin
 tHDC:=GetDC(0);
 result:=GetDeviceCaps(tHDC, 12)* GetDeviceCaps(tHDC, 14);
 ReleaseDC(0, tHDC);
end;

Зайцев О.В.
Владимиров А.М.
Взято с Исходников.ru

Число русской строкой

Число русской строкой

Автор Александр

{------------------------Деньги прописью ---------------------}
function TextSum(S: double): string;

  function Conv999(M: longint; fm: integer): string;
  const

    c1to9m: array[1..9] of string[6] =
    ('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять');
    c1to9f: array[1..9] of string[6] =
    ('одна', 'две', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять');
    c11to19: array[1..9] of string[12] =
    ('одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать',
      'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать');
    c10to90: array[1..9] of string[11] =
    ('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят',
      'семьдесят', 'восемьдесят', 'девяносто');
    c100to900: array[1..9] of string[9] =
    ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот',
      'восемьсот', 'девятьсот');
  var

    s: string;
    i: longint;
  begin

    s := '';
    i := M div 100;
    if i <> 0 then s := c100to900[i] + ' ';
    M := M mod 100;
    i := M div 10;
    if (M > 10) and (M < 20) then
      s := s + c11to19[M - 10] + ' '
    else
      begin
        if i <> 0 then s := s + c10to90[i] + ' ';
        M := M mod 10;
        if M <> 0 then
          if fm = 0 then
            s := s + c1to9f[M] + ' '
          else
            s := s + c1to9m[M] + ' ';
      end;
    Conv999 := s;
  end;

{--------------------------------------------------------------}
var

  i: longint;
  j: longint;
  r: real;
  t: string;

begin

  t := '';

  j := Trunc(S / 1000000000.0);
  r := j;
  r := S - r * 1000000000.0;
  i := Trunc(r);
  if j <> 0 then
    begin
      t := t + Conv999(j, 1) + 'миллиард';
      j := j mod 100;
      if (j > 10) and (j < 20) then
        t := t + 'ов '
      else
        case j mod 10 of
          0: t := t + 'ов ';
          1: t := t + ' ';
          2..4: t := t + 'а ';
          5..9: t := t + 'ов ';
        end;
    end;

  j := i div 1000000;
  if j <> 0 then
    begin
      t := t + Conv999(j, 1) + 'миллион';
      j := j mod 100;
      if (j > 10) and (j < 20) then
        t := t + 'ов '
      else
        case j mod 10 of
          0: t := t + 'ов ';
          1: t := t + ' ';
          2..4: t := t + 'а ';
          5..9: t := t + 'ов ';
        end;
    end;

  i := i mod 1000000;
  j := i div 1000;
  if j <> 0 then
    begin
      t := t + Conv999(j, 0) + 'тысяч';
      j := j mod 100;
      if (j > 10) and (j < 20) then
        t := t + ' '
      else
        case j mod 10 of
          0: t := t + ' ';
          1: t := t + 'а ';
          2..4: t := t + 'и ';
          5..9: t := t + ' ';
        end;
    end;

  i := i mod 1000;
  j := i;
  if j <> 0 then t := t + Conv999(j, 1);
  t := t + 'руб. ';

  i := Round(Frac(S) * 100.0);
  t := t + Long2Str(i) + ' коп.';
  TextSum := t;
end;

unit RoubleUnit;
{$D Пропись © Близнец Антон '99 http:\\anton-bl.chat.ru\delphi\1001.htm }
{ 1000011.01->'Один миллион одинадцать рублей 01 копейка'               }
interface
function RealToRouble(c: Extended): string;
implementation
uses SysUtils, math;
const Max000 = 6; {Кол-во триплетов - 000}
  MaxPosition = Max000 * 3; {Кол-во знаков в числе }
//Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости
function IIF(i: Boolean; s1, s2: Char): Char; overload; begin if i then
    result := s1
  else
    result := s2 end;
function IIF(i: Boolean; s1, s2: string): string; overload; begin if i then
    result := s1
  else
    result := s2 end;

function NumToStr(s: string): string; {Возвращает число прописью}
const c1000: array[0..Max000] of string = ('', 'тысяч', 'миллион', 'миллиард', 'триллион', 'квадраллион', 'квинтиллион');

  c1000w: array[0..Max000] of Boolean = (False, True, False, False, False, False, False);
  w: array[False..True, '0'..'9'] of string[3] = (('ов ', ' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов '),
    (' ', 'а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' '));
  function Num000toStr(S: string; woman: Boolean): string; {Num000toStr возвращает число для триплета}
  const c100: array['0'..'9'] of string = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
    c10: array['0'..'9'] of string = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');
    c11: array['0'..'9'] of string = ('', 'один', 'две', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят');
    c1: array[False..True, '0'..'9'] of string = (('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '),
      ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '));
  begin {Num000toStr}
    Result := c100[s[1]] + iif((s[2] = '1') and (s[3] > '0'), c11[s[3]] + 'надцать ', c10[s[2]] + c1[woman, s[3]]);
  end; {Num000toStr}

var s000: string[3];

  isw, isMinus: Boolean;
  i: integer; //Счётчик триплетов
begin

  Result := ''; i := 0;
  isMinus := (s <> '') and (s[1] = '-');
  if isMinus then s := Copy(s, 2, Length(s) - 1);
  while not ((i >= Ceil(Length(s) / 3)) or (i >= Max000)) do
    begin
      s000 := Copy('00' + s, Length(s) - i * 3, 3);
      isw := c1000w[i];
      if (i > 0) and (s000 <> '000') then //тысячи и т.д.
        Result := c1000[i] + w[Isw, iif(s000[2] = '1', '0', s000[3])] + Result;
      Result := Num000toStr(s000, isw) + Result;
      Inc(i)
    end;
  if Result = '' then Result := 'ноль';
  if isMinus then Result := 'минус ' + Result;
end; {NumToStr}

function RealToRouble(c: Extended): string;

const ruble: array['0'..'9'] of string[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей');
  Kopeek: array['0'..'9'] of string[3] = ('ек', 'йка', 'йки', 'йки', 'йки', 'ек', 'ек', 'ек', 'ек', 'ек');

  function ending(const s: string): Char;
  var l: Integer; //С l на 8 байт коротче $50->$48->$3F
  begin //Возвращает индекс окончания
    l := Length(s);
    Result := iif((l > 1) and (s[l - 1] = '1'), '0', s[l]);
  end;

var rub: string[MaxPosition + 3]; kop: string[2];
begin {Возвращает число прописью с рублями и копейками}

  Str(c: MaxPosition + 3: 2, Result);
  if Pos('E', Result) = 0 then //Если число можно представить в строке <>1E+99
    begin
      rub := TrimLeft(Copy(Result, 1, Length(Result) - 3));
      kop := Copy(Result, Length(Result) - 1, 2);
      Result := NumToStr(rub) + ' рубл' + ruble[ending(rub)]
        + ' ' + kop + ' копе' + Kopeek[ending(kop)];
      Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);
    end;
end;
end.


Редянов Денис


function CifrToStr(Cifr: string; Pr: Integer; Padeg: Integer): string;
{Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19

Padeg - 1-нормально 2- одна, две }
var i: Integer;
begin

  i := StrToInt(Cifr);
  if Pr = 1 then
    case i of
      1: CifrToStr := 'сто';
      2: CifrToStr := 'двести';
      3: CifrToStr := 'триста';
      4: CifrToStr := 'четыреста';
      5: CifrToStr := 'пятьсот';
      6: CifrToStr := 'шестьсот';
      7: CifrToStr := 'семьсот';
      8: CifrToStr := 'восемьсот';
      9: CifrToStr := 'девятьсот';
      0: CifrToStr := '';
    end
  else if Pr = 2 then
    case i of
      1: CifrToStr := '';
      2: CifrToStr := 'двадцать';
      3: CifrToStr := 'тридцать';
      4: CifrToStr := 'сорок';
      5: CifrToStr := 'пятьдесят';
      6: CifrToStr := 'шестьдесят';
      7: CifrToStr := 'семьдесят';
      8: CifrToStr := 'восемьдесят';
      9: CifrToStr := 'девяносто';
      0: CifrToStr := '';
    end
  else if Pr = 3 then
    case i of
      1: if Padeg = 1 then
          CifrToStr := 'один'
        else
          CifrToStr := 'одна';
      2: if Padeg = 1 then
          CifrToStr := 'два'
        else
          CifrToStr := 'две';
      3: CifrToStr := 'три';
      4: CifrToStr := 'четыре';
      5: CifrToStr := 'пять';
      6: CifrToStr := 'шесть';
      7: CifrToStr := 'семь';
      8: CifrToStr := 'восемь';
      9: CifrToStr := 'девять';
      0: CifrToStr := '';
    end
  else if Pr = 4 then
    case i of
      1: CifrToStr := 'одиннадцать';
      2: CifrToStr := 'двенадцать';
      3: CifrToStr := 'тринадцать';
      4: CifrToStr := 'четырнадцать';
      5: CifrToStr := 'пятнадцать';
      6: CifrToStr := 'шестнадцать';
      7: CifrToStr := 'семнадцать';
      8: CifrToStr := 'восемнадцать';
      9: CifrToStr := 'девятнадцать';
      0: CifrToStr := 'десять';

    end;
end;

function Rasryad(K: Integer; V: string): string;
{Функция возвращает наименование разряда в зависимости от последних 2 цифр его}
var j: Integer;
begin

  j := StrToInt(Copy(v, Length(v), 1));
  if (StrToInt(Copy(v, Length(v) - 1, 2)) > 9) and (StrToInt(Copy(v, Length(v) - 1, 2)) < 20) then
    case K of
      0: Rasryad := '';
      1: Rasryad := 'тысяч';
      2: Rasryad := 'миллионов';
      3: Rasryad := 'миллиардов';
      4: Rasryad := 'триллионов';
    end
  else
    case K of
      0: Rasryad := '';
      1: case j of
          1: Rasryad := 'тысяча';
          2..4: Rasryad := 'тысячи';
        else
          Rasryad := 'тысяч';
        end;
      2: case j of
          1: Rasryad := 'миллион';
          2..4: Rasryad := 'миллионa';
        else
          Rasryad := 'миллионов';
        end;
      3: case j of
          1: Rasryad := 'миллиард';
          2..4: Rasryad := 'миллиарда';
        else
          Rasryad := 'миллиардов';
        end;
      4: case j of
          1: Rasryad := 'триллион';
          2..4: Rasryad := 'триллиона';
        else
          Rasryad := 'триллионов';
        end;
    end;
end;

function GroupToStr(Group: string; Padeg: Integer): string;
{Функция возвращает прописью 3 цифры}
var i: Integer;

  S: string;
begin

  S := '';
  if (StrToInt(Copy(Group, Length(Group) - 1, 2)) > 9) and (StrToInt(Copy(Group, Length(Group) - 1, 2)) < 20) then
    begin
      if Length(Group) = 3 then
        S := S + ' ' + CifrToStr(Copy(Group, 1, 1), 1, Padeg);
      S := S + ' ' + CifrToStr(Copy(Group, Length(Group), 1), 4, Padeg);
    end
  else
    for i := 1 to Length(Group) do
      S := S + ' ' + CifrToStr(Copy(Group, i, 1), i - Length(Group) + 3, Padeg);
  GroupToStr := S;
end;

{Функция возвращает сумму прописью}
function RubToStr(Rubs: Currency; Rub, Kop: string): string;
var i, j: Integer;

  R, K, S: string;
begin

  S := CurrToStr(Rubs);
  S := Trim(S);
  if Pos(',', S) = 0 then
    begin
      R := S;
      K := '00';
    end
  else
    begin
      R := Copy(S, 0, (Pos(',', S) - 1));
      K := Copy(S, (Pos(',', S) + 1), Length(S));
    end;

  S := '';
  i := 0;
  j := 1;
  while Length(R) > 3 do
    begin
      if i = 1 then
        j := 2
      else
        j := 1;
      S := GroupToStr(Copy(R, Length(R) - 2, 3), j) + ' ' + Rasryad(i, Copy(R, Length(R) - 2, 3)) + ' ' + S;
      R := Copy(R, 1, Length(R) - 3);
      i := i + 1;
    end;
  if i = 1 then
    j := 2
  else
    j := 1;
  S := Trim(GroupToStr(R, j) + ' ' + Rasryad(i, R) + ' ' + S + ' ' + Rub + ' ' + K + ' ' + Kop);
  S := ANSIUpperCase(Copy(S, 1, 1)) + Copy(S, 2, Length(S) - 1);
  RubToStr := S;
end;


Вот еще одно решение, присланное Олегом Клюкач.


unit Numinwrd;

interface
function sMoneyInWords(Nin: currency): string; export;
function szMoneyInWords(Nin: currency): PChar; export;
{ Денежная сумма Nin в рублях и копейках прописью

1997, в.2.1, by О.В.Болдырев}

implementation
uses SysUtils, Dialogs, Math;

type

  tri = string[4];
  mood = 1..2;
  gender = (m, f);
  uns = array[0..9] of string[7];
  tns = array[0..9] of string[13];
  decs = array[0..9] of string[12];
  huns = array[0..9] of string[10];
  nums = array[0..4] of string[8];
  money = array[1..2] of string[5];
  endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег}

const

  units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ',
    'шесть ', 'семь ', 'восемь ', 'девять ');
  unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ',
    'шесть ', 'семь ', 'восемь ', 'девять ');
  teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',
    'четырнадцать ', 'пятнадцать ', 'шестнадцать ',
    'семнадцать ', 'восемнадцать ', 'девятнадцать ');
  decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ',
    'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ',
    'девяносто ');
  hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ',
    'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ',
    'девятьсот ');
  numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион');
  RusMon: money = ('рубл', 'копе');
  ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')),
    (('а', 'и', ''), ('йка', 'йки', 'ек')));
threadvar

  str: string;

function EndingIndex(Arg: integer): integer;
begin

  if ((Arg div 10) mod 10) <> 1 then
    case (Arg mod 10) of
      1: Result := 1;
      2..4: Result := 2;
    else
      Result := 3;
    end
  else
    Result := 3;
end;

function sMoneyInWords(Nin: currency): string; { Число Nin прописью, как функция }
var
//  str: string;

  g: gender; //род
  Nr: comp; {целая часть числа}
  Fr: integer; {дробная часть числа}
  i, iTri, Order: longint; {триада}

  procedure Triad;
  var
    iTri2: integer;
    un, de, ce: byte; //единицы, десятки, сотни

    function GetDigit: byte;
    begin
      Result := iTri2 mod 10;
      iTri2 := iTri2 div 10;
    end;

  begin
    iTri := trunc(Nr / IntPower(1000, i));
    Nr := Nr - int(iTri * IntPower(1000, i));
    iTri2 := iTri;
    if iTri > 0 then
      begin
        un := GetDigit;
        de := GetDigit;
        ce := GetDigit;
        if i = 1 then
          g := f
        else
          g := m; {женского рода только тысяча}

        str := TrimRight(str) + ' ' + Hundreds[ce];
        if de = 1 then
          str := TrimRight(str) + ' ' + Teens[un]
        else
          begin
            str := TrimRight(str) + ' ' + Decades[de];
            case g of
              m: str := TrimRight(str) + ' ' + Units[un];
              f: str := TrimRight(str) + ' ' + UnitsF[un];
            end;
          end;

        if length(numericals[i]) > 1 then
          begin
            str := TrimRight(str) + ' ' + numericals[i];
            str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)];
          end;
      end; //triad is 0 ?

    if i = 0 then Exit;
    Dec(i);
    Triad;
  end;

begin

  str := '';
  Nr := int(Nin);
  Fr := round(Nin * 100 + 0.00000001) mod 100;
  if Nr > 0 then
    Order := trunc(Log10(Nr) / 3)
  else
    begin
      str := 'ноль';
      Order := 0
    end;
  if Order > High(numericals) then
    raise Exception.Create('Слишком большое число для суммы прописью');
  i := Order;
  Triad;
  str :=
    Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2, EndingIndex(iTri)],
    Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]);
  str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1];
  str[Length(str) + 1] := #0;
  Result := str;
end;

function szMoneyInWords(Nin: currency): PChar;
begin

  sMoneyInWords(Nin);
  Result := @(str[1]);
end;

end.

Взято из

Советов по Delphi от

Сборник Kuliba

Число украинской строкой

Число украинской строкой

unitUkrRecog;
{копирайт непомню чей. Был для русских циферок, а я переделал под
украинские}
{если кто что найдет пришлите

}
{by Andrew Tkachenko, proektwo@netcity.ru, Ukraine,

}
interface

const

  UkrMonthString: array[1..12] of string[9] = (
    'січня', 'лютого', 'березня', 'квiтня', 'травня',
    'червня', 'липня', 'серпня', 'вересня', 'жовтня',
    'листопада', 'грудня');

function UkrRecognizeAmount(Amount: real;
  CurrName, CurrSubname: string): string;

implementation
uses Sysutils;

function UkrRecognizeAmount(Amount: real;
  CurrName, CurrSubname: string): string;
{* CurrName in [грн.]

CurrSubName in [коп.]
Распознается число <= 999 999 999 999.99*}
const suffBL: string = ' ';

  suffDCT: string = 'дцять';
  suffNA: string = 'надцять ';
  suffDCM: string = 'десят';
  suffMZ: string = 'ь';
  sot: string = 'сот';
  st: string = 'ст';
  aa: string = 'а';
  ee: string = 'и'; {e}
  ii: string = 'і'; {и}
  oo: string = 'о';
  ov: string = 'ів'; {ов}
  C2: string = 'дв';
  C3: string = 'тpи';
  C4: string = 'чотир';
  C5: string = 'п''ят';
  C6: string = 'шіст';
  C7: string = 'сім';
  C8: string = 'вісім';
  C9: string = 'дев''ят';
var

  i: byte;
  sAmount, sdInt, sdDec: string;
  IsMln, IsTha {,IsDcm}, IsRange1019: boolean;
  currNum, endMlx, sResult: string;
begin

  if (amount <= 0) or (amount > 999999999999.99) then
    begin
      Result := '<<<< Ошибка в диапазоне >>>>';
      Exit;
    end;
  STR(Amount: 16: 2, sAmount);
  sdInt := Copy(sAmount, 1, 13);
  sdDec := Copy(sAmount, 15, 2);
  IsMln := false;
//IsDcm:=false;
  IsTha := false;
  IsRange1019 := false;
  sResult := '';

  for i := 1 to 13 do
    begin
      currNum := Copy(sdInt, i, 1);

      if currNum <> suffBL then
        begin
          case i of
            5, 6, 7: if currNum <> '0' then IsMln := true;
            8, 9, 10: if currNum <> '0' then IsTha := true;
          end;

          if i in [2, 5, 8, 11] then {сотни}
            begin
              if currNum = '1' then sResult := sResult + st + oo + suffBL;
              if currNum = '2' then sResult := sResult + C2 + ii + st + ii + suffBL;
              if currNum = '3' then sResult := sResult + C3 + st + aa + suffBL;
              if currNum = '4' then sResult := sResult + C4 + ee + st + aa + suffBL;
              if currNum = '5' then sResult := sResult + C5 + sot + suffBL;
              if currNum = '6' then sResult := sResult + C6 + sot + suffBL;
              if currNum = '7' then sResult := sResult + C7 + sot + suffBL;
              if currNum = '8' then sResult := sResult + C8 + sot + suffBL;
              if currNum = '9' then sResult := sResult + C9 + sot + suffBL;
            end;
          if i in [3, 6, 9, 12] then {десятки}
            begin
              if currNum = '1' then IsRange1019 := true;
              if currNum = '2' then sResult := sResult + C2 + aa + suffDCT + suffBL;
              if currNum = '3' then sResult := sResult + C3 + suffDCT + suffBL;
              if currNum = '4' then sResult := sResult + 'соpок ';
              if currNum = '5' then
                sResult := sResult + C5 + suffMZ + suffDCM + suffBL;

              if currNum = '6' then
                sResult := sResult + C6 + suffMZ + suffDCM + suffBL;

              if currNum = '7' then
                sResult := sResult + C7 + suffMZ + suffDCM + suffBL;

              if currNum = '8' then
                sResult := sResult + C8 + suffMZ + suffDCM + suffBL;

              if currNum = '9' then
                sResult := sResult + 'дев''ян' + oo + st + oo + suffBL;

            end;
          if i in [4, 7, 10, 13] then {единицы}
            begin
              if (currNum = '0') then
                if IsRange1019 then sResult := sResult + suffDCM + suffMZ + suffBL;
              if (currNum = '1') then
                begin
                  if (i = 13) and (not IsRange1019) then
                    sResult := sResult + 'одна '
                  else
                    begin
                      if (i = 10) and (IsRange1019) then
                        sResult := sResult + 'оди'
                      else if (i = 10) and (not IsRange1019) then
                        sResult := sResult + 'одна '
                      else
                        sResult := sResult + 'один' {ин};

                      if IsRange1019 and (i = 13) then
                        sResult := sResult + 'адцять' + suffBL

                      else if IsRange1019 then
                        sResult := sResult + suffNA
                      else
                        sResult := sResult + suffBL;
                    end;
                end;
              if (currNum = '2') then
                begin
                  sResult := sResult + C2;
                  if (i = 10) and (IsRange1019 = False) then
                    sResult := sResult + ii
                  else if (i = 10) or (IsRange1019) then
                    sResult := sResult + aa
                  else
                    sResult := sResult + {aa} ii;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '3') then
                begin
                  sResult := sResult + C3;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '4') then
                begin
                  sResult := sResult + C4;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + ee + suffBL;
                end;
              if (currNum = '5') then
                begin
                  sResult := sResult + C5;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffMZ + suffBL;
                end;
              if (currNum = '6') then
                begin
                  sResult := sResult + C6;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffMZ + suffBL;
                end;
              if (currNum = '7') then
                begin
                  sResult := sResult + C7;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '8') then
                begin
                  sResult := sResult + C8;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '9') then
                begin
                  sResult := sResult + C9;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffMZ + suffBL;
                end;
            end;

          endMlx := '';
          case i of
            4:
              begin
                if IsRange1019 then
                  endMlx := ov + suffBL
                else if currNum = '1' then
                  endMlx := suffBL
                else if (currNum = '2') or (currNum = '3') or (currNum = '4') then
                  endMlx := aa + suffBL
                else
                  endMlx := ov + suffBL;
                sResult := sResult + 'мiльярд' + endMlx;
              end;
            7: if IsMln then
                begin
                  if IsRange1019 then
                    endMlx := ov + suffBL
                  else if currNum = '1' then
                    endMlx := suffBL
                  else if (currNum = '2') or (currNum = '3') or (currNum = '4') then
                    endMlx := aa + suffBL
                  else
                    endMlx := ov + suffBL;
                  sResult := sResult + 'мiльйон' + endMlx;
                end;
            10: if IsTha then
                begin
                  if IsRange1019 then
                    endMlx := suffBL
                  else if currNum = '1' then
                    endMlx := aa + suffBL
                  else if (currNum = '2') or (currNum = '3') or (currNum = '4') then
                    endMlx := ii + suffBL
                  else
                    endMlx := suffBL;
                  sResult := sResult + 'тисяч' + endMlx;
                end;
          end; {case}
          if i in [4, 7, 10, 13] then IsRange1019 := false;
        end; {IF}
    end; {FOR}

  sResult := sResult + CurrName + ',' + suffBL + sdDec + suffBL + CurrSubname;
  sResult := AnsiUpperCase(sResult[1]) + Copy(sResult, 2, length(sResult) - 1);
  Result := sResult;
end;

end.

С уважением,

Andrew Tkachenko

ООО "Проект ВО"
Украина, г.Харьков

Взято из

Советов по Delphi от

Сборник Kuliba

Читаем CSV текстовый файл в StringGrid

Читаем CSV текстовый файл в StringGrid

procedureReadTabFile(FN: TFileName; FieldSeparator:
Char; SG: TStringGrid);
var 
  i: Integer; 
  S: string; 
  T: string; 
  Colonne, ligne: Integer; 
  Les_Strings: TStringList; 
  CountCols: Integer; 
  CountLines: Integer; 
  TabPos: Integer; 
  StartPos: Integer; 
  InitialCol: Integer; 
begin 
  Les_Strings := TStringList.Create; 
  try 
    Les_Strings.LoadFromFile(FN); 
    CountLines := Les_Strings.Count + SG.FixedRows; 
    T := Les_Strings[0]; 
    for i := 0 to Length(T) - 1 do Inc(CountCols,
    Ord(IsDelimiter(FieldSeparator, T, i)));
    Inc(CountCols, 1 + SG.FixedCols); 
    if CountLines > SG.RowCount then SG.RowCount := CountLines; 
    if CountCols > SG.ColCount then SG.ColCount := CountCols; 
    InitialCol := SG.FixedCols - 1;
    Ligne := SG.FixedRows - 1; 
    for i := 0 to Les_Strings.Count - 1 do 
    begin 
      Colonne := InitialCol; 
      Inc(Ligne); 
      StartPos := 1; 
      S := Les_Strings[i]; 
      TabPos := Pos(FieldSeparator, S); 
      repeat 
        Inc(Colonne); 
        SG.Cells[Colonne, Ligne] := Copy(S, StartPos, TabPos - 1); 
        S := Copy(S, TabPos + 1, 999); 
        TabPos := Pos(FieldSeparator, S); 
      until TabPos = 0; 
    end; 
  finally 
    Les_Strings.Free; 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Screen.Cursor := crHourGlass; 
  ReadTabFile('C:\TEST.TXT', #9, StringGrid1); 
  Screen.Cursor := crDefault; 
end;

Взято из

Читаем заголовок exe файла

Читаем заголовок exe файла

{ You'll need a OpenDialog to open a Exe-File and a Memo to show the file informations } 



procedure DumpDOSHeader(const h: IMAGE_DOS_HEADER; Lines: TStrings); 
begin 
  Lines.Add('Dump of DOS file header'); 
  Lines.Add(Format('Magic number: %d', [h.e_magic])); 
  Lines.Add(Format('Bytes on last page of file: %d', [h.e_cblp])); 
  Lines.Add(Format('Pages in file: %d', [h.e_cp])); 
  Lines.Add(Format('Relocations: %d', [h.e_crlc])); 
  Lines.Add(Format('Size of header in paragraphs: %d', [h.e_cparhdr])); 
  Lines.Add(Format('Minimum extra paragraphs needed: %d', [h.e_minalloc])); 
  Lines.Add(Format('Maximum extra paragraphs needed: %d', [h.e_maxalloc])); 
  Lines.Add(Format('Initial (relative) SS value: %d', [h.e_ss])); 
  Lines.Add(Format('Initial SP value: %d', [h.e_sp])); 
  Lines.Add(Format('Checksum: %d', [h.e_csum])); 
  Lines.Add(Format('Initial IP value: %d', [h.e_ip])); 
  Lines.Add(Format('Initial (relative) CS value: %d', [h.e_cs])); 
  Lines.Add(Format('File address of relocation table: %d', [h.e_lfarlc])); 
  Lines.Add(Format('Overlay number: %d', [h.e_ovno])); 
  Lines.Add(Format('OEM identifier (for e_oeminfo): %d', [h.e_oemid])); 
  Lines.Add(Format('OEM information; e_oemid specific: %d', [h.e_oeminfo])); 
  Lines.Add(Format('File address of new exe header: %d', [h._lfanew])); 
  Lines.Add(''); 
end; 

procedure DumpPEHeader(const h: IMAGE_FILE_HEADER; Lines: TStrings); 
var 
  dt: TDateTime; 
begin 
  Lines.Add('Dump of PE file header'); 
  Lines.Add(Format('Machine: %4x', [h.Machine])); 
  case h.Machine of 
    IMAGE_FILE_MACHINE_UNKNOWN : Lines.Add(' MACHINE_UNKNOWN '); 
    IMAGE_FILE_MACHINE_I386: Lines.Add(' Intel 386. '); 
    IMAGE_FILE_MACHINE_R3000: Lines.Add(' MIPS little-endian, 0x160 big-endian '); 
    IMAGE_FILE_MACHINE_R4000: Lines.Add(' MIPS little-endian '); 
    IMAGE_FILE_MACHINE_R10000: Lines.Add(' MIPS little-endian '); 
    IMAGE_FILE_MACHINE_ALPHA: Lines.Add(' Alpha_AXP '); 
    IMAGE_FILE_MACHINE_POWERPC: Lines.Add(' IBM PowerPC Little-Endian '); 
    // some values no longer defined in winnt.h 
    $14D: Lines.Add(' Intel i860'); 
    $268: Lines.Add(' Motorola 68000'); 
    $290: Lines.Add(' PA RISC'); 
    else 
      Lines.Add(' unknown machine type'); 
  end; { Case } 
  Lines.Add(Format('NumberOfSections: %d', [h.NumberOfSections])); 
  Lines.Add(Format('TimeDateStamp: %d', [h.TimeDateStamp])); 
  dt := EncodeDate(1970, 1, 1) + h.Timedatestamp / SecsPerDay; 
  Lines.Add(FormatDateTime(' c', dt)); 

  Lines.Add(Format('PointerToSymbolTable: %d', [h.PointerToSymbolTable])); 
  Lines.Add(Format('NumberOfSymbols: %d', [h.NumberOfSymbols])); 
  Lines.Add(Format('SizeOfOptionalHeader: %d', [h.SizeOfOptionalHeader])); 
  Lines.Add(Format('Characteristics: %d', [h.Characteristics])); 
  if (IMAGE_FILE_DLL and h.Characteristics) <> 0 then 
    Lines.Add(' file is a DLL') 
  else if (IMAGE_FILE_EXECUTABLE_IMAGE and h.Characteristics) <> 0 then 
    Lines.Add(' file is a program'); 
  Lines.Add(''); 
end; 

procedure DumpOptionalHeader(const h: IMAGE_OPTIONAL_HEADER; Lines: TStrings); 
begin 
  Lines.Add('Dump of PE optional file header'); 
  Lines.Add(Format('Magic: %d', [h.Magic])); 
  case h.Magic of 
    $107: Lines.Add(' ROM image'); 
    $10b: Lines.Add(' executable image'); 
    else 
      Lines.Add(' unknown image type'); 
  end; { If } 
  Lines.Add(Format('MajorLinkerVersion: %d', [h.MajorLinkerVersion])); 
  Lines.Add(Format('MinorLinkerVersion: %d', [h.MinorLinkerVersion])); 
  Lines.Add(Format('SizeOfCode: %d', [h.SizeOfCode])); 
  Lines.Add(Format('SizeOfInitializedData: %d', [h.SizeOfInitializedData])); 
  Lines.Add(Format('SizeOfUninitializedData: %d', [h.SizeOfUninitializedData])); 
  Lines.Add(Format('AddressOfEntryPoint: %d', [h.AddressOfEntryPoint])); 
  Lines.Add(Format('BaseOfCode: %d', [h.BaseOfCode])); 
  Lines.Add(Format('BaseOfData: %d', [h.BaseOfData])); 
  Lines.Add(Format('ImageBase: %d', [h.ImageBase])); 
  Lines.Add(Format('SectionAlignment: %d', [h.SectionAlignment])); 
  Lines.Add(Format('FileAlignment: %d', [h.FileAlignment])); 
  Lines.Add(Format('MajorOperatingSystemVersion: %d', [h.MajorOperatingSystemVersion])); 
  Lines.Add(Format('MinorOperatingSystemVersion: %d', [h.MinorOperatingSystemVersion])); 
  Lines.Add(Format('MajorImageVersion: %d', [h.MajorImageVersion])); 
  Lines.Add(Format('MinorImageVersion: %d', [h.MinorImageVersion])); 
  Lines.Add(Format('MajorSubsystemVersion: %d', [h.MajorSubsystemVersion])); 
  Lines.Add(Format('MinorSubsystemVersion: %d', [h.MinorSubsystemVersion])); 
  Lines.Add(Format('Win32VersionValue: %d', [h.Win32VersionValue])); 
  Lines.Add(Format('SizeOfImage: %d', [h.SizeOfImage])); 
  Lines.Add(Format('SizeOfHeaders: %d', [h.SizeOfHeaders])); 
  Lines.Add(Format('CheckSum: %d', [h.CheckSum])); 
  Lines.Add(Format('Subsystem: %d', [h.Subsystem])); 
  case h.Subsystem of 
    IMAGE_SUBSYSTEM_NATIVE: 
      Lines.Add(' Image doesnot require a subsystem. '); 
    IMAGE_SUBSYSTEM_WINDOWS_GUI: 
      Lines.Add(' Image runs in the Windows GUI subsystem. '); 
    IMAGE_SUBSYSTEM_WINDOWS_CUI: 
      Lines.Add(' Image runs in the Windows character subsystem. '); 
    IMAGE_SUBSYSTEM_OS2_CUI: 
      Lines.Add(' image runs in the OS/2 character subsystem. '); 
    IMAGE_SUBSYSTEM_POSIX_CUI: 
      Lines.Add(' image run in the Posix character subsystem. '); 
    else 
      Lines.Add(' unknown subsystem') 
  end; { Case } 
  Lines.Add(Format('DllCharacteristics: %d', [h.DllCharacteristics])); 
  Lines.Add(Format('SizeOfStackReserve: %d', [h.SizeOfStackReserve])); 
  Lines.Add(Format('SizeOfStackCommit: %d', [h.SizeOfStackCommit])); 
  Lines.Add(Format('SizeOfHeapReserve: %d', [h.SizeOfHeapReserve])); 
  Lines.Add(Format('SizeOfHeapCommit: %d', [h.SizeOfHeapCommit])); 
  Lines.Add(Format('LoaderFlags: %d', [h.LoaderFlags])); 
  Lines.Add(Format('NumberOfRvaAndSizes: %d', [h.NumberOfRvaAndSizes])); 
end; 

// Example Call, Beispielaufruf: 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  fs: TFilestream; 
  signature: DWORD; 
  dos_header: IMAGE_DOS_HEADER; 
  pe_header: IMAGE_FILE_HEADER; 
  opt_header: IMAGE_OPTIONAL_HEADER; 
begin 
  memo1.Clear; 
  with Opendialog1 do 
  begin 
    Filter := 'Executables (*.EXE)|*.EXE'; 
    if Execute then 
    begin 
      fs := TFilestream.Create(FileName, fmOpenread or fmShareDenyNone); 
      try 
        fs.read(dos_header, SizeOf(dos_header)); 
        if dos_header.e_magic <> IMAGE_DOS_SIGNATURE then 
        begin 
          memo1.Lines.Add('Invalid DOS file header'); 
          Exit; 
        end; 
        DumpDOSHeader(dos_header, memo1.Lines); 

        fs.seek(dos_header._lfanew, soFromBeginning); 
        fs.read(signature, SizeOf(signature)); 
        if signature <> IMAGE_NT_SIGNATURE then 
        begin 
          memo1.Lines.Add('Invalid PE header'); 
          Exit; 
        end; 

        fs.read(pe_header, SizeOf(pe_header)); 
        DumpPEHeader(pe_header, memo1.Lines); 

        if pe_header.SizeOfOptionalHeader > 0 then 
        begin 
          fs.read(opt_header, SizeOf(opt_header)); 
          DumpOptionalHeader(opt_header, memo1.Lines); 
        end; 
      finally 
        fs.Free; 
      end; { finally } 
    end; 
  end; 
end; 

Взято с сайта

Чтение из открытого файла

Чтение из открытого файла

Даже если файл открыт с низкими привелегиями (используя ReadOnly, ShareReadWrite) , иногда открытие уже открытого файла может приводить к ошибкам, особенно, если это файл интенсивно используется другим приложением. Самый простой способ решить эту проблемму - это использовать MemoryStream вместо непосредственного доступа к файлу:

var Memory: TMemoryStream;

begin
  Memory := TMemoryStream.Create;
  try
    Memory.LoadFromFile('busyfile.dat'); // это он!!
    ..
      Memory.Read(...); // Вы можете использовать методы чтения как у файлов
      Memory.Seek(...);
      FileSize := Memory.Size;
      ..
  finally
    Memory.Free;
  end;
end;

Данный способ никогда не открывает файл, а заместо этого создаёт копию его в памяти. Конечно Вы можете и записать в поток (Stream) в Памяти(Memory), но изменения не будут записаны на диск до тех пор, пока Вы не запишете их в файл (командой SaveToFile).

Автор ответа: neutrino

Комментарий от Vit

Решение хорошее, но накладно если файл большой...
Взято с Vingrad.ru



var b:string[15];
begin
with TFileStream.create('c:\MyFile.doc', fmShareDenyNone) do
try
read(b,14);
showmessage(b);
finally
Free;
end;

Автор ответа: Vit
Взято с Vingrad.ru


procedure TForm1.Button1Click(Sender: TObject);
type
AnyType = byte; // ??? ???? ?????
var
F: file of AnyType;
const
FName = 'D:/Exp.exe'; //?????????? ????
begin
begin
AssignFile(F, FName); { File selected in dialog }
FileMode:=fmOpenRead;
Reset(F);
// ...
// ...
CloseFile(F);
FileMode:=fmOpenReadWrite;
end;
end;

Автор ответа: PILOTIK
Взято с Vingrad.ru

Чтение OLE из Blob поля Paradox

Чтение OLE из Blob поля Paradox

Автор: Eryk

...после моих дискуссий с людьми из службы технической поддержки Borland вывод один -- это невозможно!

Попробуйте так:

procedureTForm1.SpeedButton1Click(Sender: TObject);
var
  b: TBlobStream;
begin
  try
    b := TBlobStream.Create((Table1.FieldByName('OLE') as TBlobField),bmRead);
    OLEContainer1.LoadFromStream(b);
  finally
    b.free;
  end;
end;

...и:

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  b: TBlobStream;
begin
  try
    Table1.Insert;
    b := TBlobstream.Create((Table1.FieldByName('OLE') as TBlobField),bmReadWrite);
    OLEContainer1.SaveToStream(b);
    Table1.Post;
  finally
    b.free;
  end;
end;

Я, кажется, припоминаю несколько ошибок GPFs с этим кодом, но это, вероятно, связано с тем, что я использую WinNT с другим распределением памяти... тем не менее, основные функции работали как положено (т.е. данные сохранялись и загружались). Основная специфика проявилась в том, что PdoxWIN не смог прочесть данные TOLEContainer. Но это результаты моих экспериментов и предположений, исходя из которых PdoxWIN ожидает 8-байтовый заголовок BLOB-поля, который ему просто не дает TOLEContainer... если это так, то это легко обойти.

Взято из

Что делает inf-файл?

Что делает inf-файл?

Он позволяет осуществить:

Создание элементов реестра
Определение инициализационных параметров (INI-settings)
Копирование файлов с дистрибутива и размещение их в системе
Инсталляция устройств
Управление другими INF-фаилами
Конфигурирование опций устройств

INF-файлы представляют собой инициализационные файлы, которые конфигурируют
устройство или приложение в вашей системе и задают его элементы в реестре.
INF-файлы обычно поставляются производителем продукта вместе с устройством
или приложением. Кроме того, можно их найти на электронных досках объявле-
ний и других on-line сервисах. INF-файлы понадобятся вам для многих обычных
(не РпР) устройств, которые вам нужно будет конфигурировать для работы с
Windows 95. Как правило, INF-файлы включают список допустимых логических
конфигураций, имена файлов драйверов устройств и г. д. В ряде случаев вам
потребуется самим писать INF-файлы для устройств или программного обеспече-
ния. Формат lNF-файлов аналогичен формату INIфайлов, которые использовались
в Windows З.х, включая квадратные скобки, ключи и разделы, используемые то-
лько Windows 95.

Структура INF-файла
Когда вы инсталлируете новое устройство. Windows ищет INF-фаилы для этого
устройства, используя при этом идентификатор устройства (device ID). Собрав
из INF-фаила всю необходимую информацию, система создает в реестре элемент
для этого устройства под ключом HKEY_LOCAL_MACHINE. Значения из INF-файла
копируются в элемент реестра, соответствующий драйверу устройства. Такие
значения, как DevLoader= и Driverdesc= включаются в элемент аппаратного
драйвера Driver=. Элемент Еnum содержит значения Driver= и ConfigFlags=.
INF-фаилы представляют собой файлы в формате ASCII, состоящие из нескольких
разделов. Каждый раздел предназначен для выполнения определенной задачи.
Имена разделов обычно заключаются в квадратные скобки. Типичные элементы
представляют собой ключ и значение, соединенные знаком равенства. В раздел
можно включить одно или несколько значений. Кроме того, в состав элемента
можно включать комментарии, отделяя их символом точки с запятой, например:

[section] 
keyname=value ;эта часть строки является комментарием 

Поскольку INF-файлы являются файлами формата ASCII, должен существовать
способ, с помощью которого они будут предоставлять реестру информацию в
двоичном формате. Структура INF определяет двоичный файл, который преобра-
зует ASCII-текст в двоичный формат при чтении его реестром.

Типы информационных файлов:
Layout (Формат). Определяет информацию о диске и номере версии, а также
содержит список всех файлов с указанием диска, на котором они располагают-
ся.
Selective Install (Избирательная инсталляция). Определяет части инстал-
ляции, являющиеся необязательными компонентами, а также те ее части, кото-
рые зависят от инсталляции других компонентов. Например, Microsoft Fax тре-
бует предварительной загрузки Microsoft Exchange. Вы имеете возможность уп-
равлять инсталляцией компонент этих типов.
Application/Installation, APPS.INF (Приложения/Инсталляция). Обнаружива-
ет используемые вами приложения MS-DOS и устанавливает для них параметры
окружения. Эти lNF-файлы содержат настройки и параметры для многих приложе-
ний DOS. Как правило, это самый большой информационный файл в вашей систе-
ме. В его состав входят многие виды настройки памяти, настройки расширенной
памяти (XMS), а также другие параметры, которые в Windows З.х содержались в
настройках PIF
Device Installation and Configuration (Инсталляция и конфигуриро вание
устройств). Это наиболее общий из всех информационных файлов на котором мы
до сих пор концентрировали все внимание. Эти файлы описывают параметры на-
стройки для конкретных физических устройств. Если вы имеете драйвер устрой-
ства ранних версий, в INF-файле будет содержаться информация об этом уст-
ройстве. Устройства Plug and Play, с другой стороны, помещают информацию о
себе прямо в реестр.

Общая организация lNF-файла
Раздел каждого устройства в INF-файлс состоит из следующих разделов:

Раздел [Version].
Идентифицирует INF и класс поддерживаемого устройства.
Ниже перечислен список некоторых устройств, которые вы можете включить:

adapter                 keyboard        NetService 
 
CDROM                   MCADevices      NetTrans (сетевые транспорты) 
diskdrive               media           nodriver 
dispaly                 modem           PCMCIA 
EISADevices             monitor         ports 
Fdc                     mouse           printer 
Hdc                     MTD             SCSIAdapter 

Раздел [Manufacturer].
Идентифицирует производителя устройства (например, Link, Micro, и т.п.) и
соответствующих продуктов. Каждый INF-файл должен иметь по крайней мере
один раздел [ Manufacturer].

Раздел [Install].
Содержит информацию о физических атрибутах устройства и его драйверах.

Раздел [Classlnstall].
Этот раздел необязателен. Он идентифицирует новый класс для указанного уст-
ройства в INF-фаиле

Раздел [String].
Идентифицирует локализованные строки в INF-фаиле

Раздел [Miscellaneous].
Содержит информацию о том, как устройства управляются пользовательским ин-
терфейсом W95.

Элементы APPS.INF
В разделе [appname] файла APPS.INF вы найдете элементы, перечисленные в
табл. Используя эти элементы вы сможете быстрее перенести в W95 настройки
PIF из ваших старых инсталляций Windows.
Многие из приложений, перечисленных в файле APPS.INF, представляют собой
старые игры для MS-DOS. Если вы сталкиваетесь с тем, что игра не работает в
среде W95, просмотрите этот файл. Возможно, вам удастся модифицировать ка-
кой-либо из его элементов таким образом, чтобы игра запустилась или стала
работать лучше. Если вы вносите изменения в файл APPS.INF, вам потребуется
перезагрузить W95, чтобы внесенные изменения попали в реестр. Помимо редак-
тирования файла APPS.INF, некоторые из параметров вы можете изменить, от-
крыв страницу свойств конкретного приложения.
Ниже приведен пример раздела [аррname]:

[PRODIGY.EXE] 
LowMem=440 
EMSMen=None 
XMSMem=None 
Enable=lml 
Disable=win,hma 

В этой части файла APPS.INF раздел [appname] замещается именем исполняемого
модуля, например, PRODIGY.EXE, PARADOX.EXE и т.п.

Имя элемента реестра           Описание ключа                       Значение 
 
ALLOWSSAVER              Позволяет появляться заставке              sav 
(работает в REALMODE)    при работающих программах DOS. 
                         Настройка по умолчанию 
 
ALTENTER                 Позволяет использовать клавиатурную        аеn 
                         комбинацию + для переклю- 
                         чения между полноэкранным и оконным 
                         режимами. Настройка по умолчанию. 
 
ALTESC                   Позволяет использовать выход с помощью     Aes 
                         клавиатурной комбинации -. 
                         Настройка по умолчанию. 
 
ALTPRTSCRN               Позволяет выполнять моментальный снимок    Psc 
                         экрана с помощью клавиатурной комбинации 
                         +. Настройка по умолчанию. 
 
ALTSPACE                 Позволяет использовать клавиатурную        aps 
                         комбинацию + для отображения 
                         системного меню. Настройка по умолчанию. 
 
ALTTAB                   Позволяет использовать клавиатурную ком-   Ata 
                         бинацию для переключения между приложе- 
                         ниями. Настройка по умолчанию. 
 
BACKGROUND               Дает приложению указание работать в        win 
                         фоновом режиме. Настройка по умолчанию. 
 
CDROM                    Позволяет использовать драйвер MSCDEX.     cdr 
(работает в REALMODE)    Настройка по умолчанию. 
 
CLOSEONEXIT              Закрывает при выходе окно DOS. He явля-    cwe 
                         ется настройкой по умолчанию. 
 
CRTLESC                  Позволяет закрывать приложение нажатием    ces 
                         клавиатурной комбинации +. 
                         Настройка по умолчанию. 
 
DETECTIDLE              Задает чувствительность в неактивном сос-   dit 
                        тоянии. Настройка по умолчанию. 
 
DISKLOCK                Позволяет осуществлять прямой доступ к      dsk 
(работает в REALMODE)   диску. 
 
EMS                     Активизирует EMS386 для программ DOS.       ems 
(работает в REALMODE)   Настройка по умолчанию. 
 
EMSLOCKED               Указывает на блокировку памяти EMS          eml 
 
EMULATEROM              Указывает на необходимость использо-        emt 
                        вания быстрой эмуляции ROM. Настройка 
                        по умолчанию. 
 
EXCLUSIVE               Работает в эксклюзивном режиме. Этот        exc 
                        параметр игнорируется. 
 
FASTPASTE               Активизирует быструю вставку из прило-      aft 
                        жения. Настройка по умолчанию. 
 
GLOBALMEM               Активизирует глобальную защиту памяти       gmp 
 
LOWLOCKED               Указывает на то, что нижняя память          lml 
                        (до 640 Кб) заблокирована. Этот параметр 
                        игнорируется. 
 
MOUSE                   Активизирует функции мыши. Настройка по     mse 
(работает в REALMODE)   умолчанию. 
 
NETWORK                 Разрешает программе DOS получать доступ     net 
(работает в REALMODE)   к сетевым дискам и принтерам. Настройка 
                        по умолчанию. 
 
PRIVATECFG              Позволяет программе DOS использовать пер-   cfg 
(работает в REALMODE)   сональный файл CONFIG.SYS. He является 
                        настройкой по умолчанию. 
 
REALMODE                Запускает программу в реальном режиме DOS.  dos 
                        He является настройкой по умолчанию. 
 
RETAINVRAM              Дает указание сохранить видеопамять.        rvm 
                        Этот параметр игнорируется. 
 
UNIQUESETTINGS          Запускает программы DOS в отдельных DOS-    uus 
                        сеансах. Не является настройкой по 
                        умолчаний. 
 
USEHMA                  Дает указание использовать НМА (верхние     hma 
                        адреса памяти). Значение по умолчанию. 
 
VESA                    Дает программам DOS получать доступ к       vsa 
(работает в REALMODE)   продвинутым графическим возможностям. 
 
WINDOWED                Запускает приложение в окне, а не в         win 
                        полноэкранном режиме. Настройка по 
                        умолчанию. 
 
WINLIE                  Не позволяет программам DOS обнаруживать    lie 
                        W95. Не яаляется параметром по умолчанию. 
 
XMSLOCKED               Дает указание блокировать память XMS.       Xml 

В файле APPS.INF доступны, но не реализованы следующие параметры:

DISPLAYTBAR (dtb) Отображает панель инструментов.
EXCLMOUSE (exm) Разрешает режим монопольного использования мыши
QUICKEDIT (qme) Активизирует для мыши режим быстрого редактирования
WARNIFACTIVE (wia). Позволяет подавать предупреждения, если приложение
DOS еще активно

Справочник по разделам
В нижеприведенных таблицах описаны все ключевые слова и значения, ассоци-
ированные с конкретными разделами. Синтаксис раздела [Version] приведен ни-
же. Квадратные скобки используются для обозначения начала нового раздела.
Для того чтобы настройки INF были понятны W95 и реестру, квадратные скобки
обязательно должны присутствовать.

[Version] 
Signature=$CHICAGO$ 
Class=name_of_class 
Provider=%File_creator% 
LayoutFile=filename.inf 

Ключевое слово Значение       Описание 
 
Signature      $Chicago$    Задает операционную систему для INF-файла. 
                            На момент написания большинства INF-файлов 
                            кодовое название Windows 95 было следующим: 
                            Chicago. 
 
Class         name_of_class Указывает класс, который будет определен в ре- 
                            естре. Список общих классов устройств, которые 
                            вы можете ввести сюда, приведен в данном при- 
                            ложении ранее. 
 
LayoutFile     filename.inf Эта строка определяет имя INF-файла, содержа- 
                            щего имена исходного диска и файлов, которые 
                            должны быть включены для инсталляции этого 
                            устройства. Если его не определить, то по умол- 
                            чанию файл имеет имя LAYOUT.INF. Если вы не 
                            включите эти данные в раздел Version, то должны 
                            будете включить в файл APPS.INF разделы 
                            SourceDiskName и SourceDiskFiles. 

Синтаксис раздела [Manufacturer] приведен ниже.

[Manufacturer] 
"manufacturer" %string_value%=manufacturer_section 

Информация раздела [Manufacturer]

Ключевое слово          Описание 
 
"manufacturer"          Имя производителя этого устройства, заключенное в 
                        кавычки. Сюда можно включить любую строку. Это клю- 
                        чевое слозо является необязательным. 
 
%string_value%          Указывает имя строки, включенной в раздел Stings 
                        INF-файла. Строки должны быть заключены в символы 
                        процента (%). 
 
manufacturer_section    Указывает на раздел Manufacturer Name в INF-файле. 

Раздел [Manufacturer Name] включает описания устройства для указанного уст-
ройства Ключевые слова, используемые в этом разделе, описаны в таблице.
Синтаксис этого раздела выглядит следующим образом:

[name_of_manufacturer] 
description of deviсe=install_section,ID_of_device[compatible_device_IDs,...] 

Информация раздела [Manufacturer Name] 
 
Ключевое слово           Описание 
 
description_of_device      Описание инсталлируемого устройства. 
install_section            Указывает имя раздела Install для этого устройства. 
ID_of_device               Идентификатор (ID) инсталлируемого устройства. 
[compatible_device_IDs,...] Содержит Ссылки на устройства, совместимые с 
                            данным. В этот список можно включить несколько 
                            устройств, разделив их запятыми. 

Раздел [File List] можно использовать для указания файлов, которые вы хоти-
те скопировать, переименовать или удалить. В зависимости от элемента разде-
ла [Install] вы можете использовать три следующих синтаксических параметра:

[file_list section] 
new_filename, old_filename 

Эта конструкция используется для элементов RenFiles. Допускается вклююние
любого количества элементов new_filename, old_filename.

Для элементов DelFiles используется следующий синтаксис:

[file_list section] 
filename 

Параметр filename обозначает имя файла, который вы хотите удалить.

Для элемента CopyFiles используется следующий синтаксис. Параметры
source_filename и temporary_filename в этой конструкции являются необязате-
льными.

[file_list section] 
destination_filename,source_filename,temporary_filename 

Ниже приведен образец синтаксиса раздела [Install]. Этот раздел включает
дополнительные разделы INF-файла, которые содержат описания устройства. В
правой части выражения, после знака равенства, можно указать несколько зна-
чений, разделенных запятыми.

[name_of_install_section] 
LogConfig=section_name 
Copyfiles=file_list_section 
Renfiles=file_list_section 
DelFiles=file_list_section 
UpdateInis=UpdateIni_section_name 
UpdateIniFields=UpdateIniFields_section_name 
AddReg=AddRegitry_section 
DelReg=DelRegitry_section 
Ini2Reg=IniToRegistry_section 
UpdateCfgSys=UpdateConfig_section 
UpdateAutoBat=UpdateAutoexec_section 
Reboot или Restart 

Информация раздела [Install]

Ключевое слово             Значение         Описание 
 
[name_of_install_section]                    Содержит имя устройства, соответ- 
                                             ствующего информации, приведен- 
                                             ной в этом разделе. В разделе 
                                             ManufacturerName INF-файла дол- 
                                             жна присутствовать ссылка на 
                                             этот раздел 
 
LogСonfig                section_name        Содержит информацию о разделах 
                                             логической конфигурации уст- 
                                             ройства. Значения section_name 
                                             указывают на разделы INF-файла 
                                             в которых содержится информа- 
                                             ция о данном устройстве. 
 
CopyFiles             file_list_section      Содержит информацию, необходимую 
                                             для копирования указанного файла 
                                             или файлов в каталог, указанный 
                                             в разделе File_List. Вы можете 
                                             дать системе указание скопировать 
                                             отдельный файл. Для этого перед 
                                             именем файла необходимо включить 
                                             символ @. При этом файл будет 
                                             скопирован в каталог 
                                             DefaultDestDir, определенный в 
                                             разделе DestinationDir INF-файла. 
 
RenFiles             fiie_list_section       Позволяет переименовать указан- 
                                             ный файл. Представляет собой 
                                             указатель на раздел File_List 
                                             INF-файла. 
 
DelFiles             file_list_section       Позволяет удалить указанный 
                                             файл. Представляет собой указа- 
                                             тель на раздел FileList INF-файла. 
 
UpdateInis          UpdateIni_section_name   Позволяет указать Значение INI- 
                                             файла, которое вы хотите изме- 
                                             нить через INF-файл. Представля- 
                                             ет собой указатель на раздел 
                                             Update INI. 
 
UpdatelniFields UpdateIniFields_section_name Позволяет изменять, замещать 
                                             или удалять отдельные элементы 
                                             значений INI-файла (в отличие от 
                                             предыдущего параметра, который 
                                             изменял все значение целиком). 
                                             Этот параметр представляет со- 
                                             бой указатель на раздел Update 
                                             IniFields. 
 
AddReg                AddRegistry_section    Позволяет указать подключ или 
                                             значение, которые требуется до- 
                                             бавить в реестр. Представляет 
                                             собой указатель на раздел Add 
                                             Registry. 
 
DelReg                Del_Registry_section   Позволяет указать подключ или 
                                             значение, которые требуется уда- 
                                             лить из реестра. Представляет 
                                             собой указатель на раздел Delete 
                                             Registry 
 
Ini2Reg            IniToRegistry_section     Перемещает в реестр строки и 
                                             разделы из INI-файла. Представ- 
                                             ляет собой указатель на раздел 
                                             Ini to Registry. 
 
UpdateCfgSys        UpdateConfig_section     Содержит указатель на раздел 
                                             Update Config. в этом разделе 
                                             находятся команды, которые 
                                             должны быть добавлены, удалены 
                                             или переименованы в файле 
                                             CONFIG.SYS. 
 
UpdateAutoBat     UpdateAutoexec_section     Содержит указатель на раздел 
                                             Update AutoExec. В этом разделе 
                                             находятся команды, которые мо- 
                                             дифицируют файл AUTOEXEC.BAT. 
 
Reboot или Restart                           Команды, вызывающие перезапуск 
                                             системы или перезагрузку ком- 
                                             пьютера после завершения про- 
                                             граммы установки. 

Ниже приведен пример синтаксиса раздела [Logical Configuration]. Раздел
[LogConfig] необходимо указать в разделе [Install]. Этот раздел содержит
информацию о конфигурации системных ресурсов, включая IRQ, порты ввода/вы-
вода, каналы DMA и т. д. Для каждого включаемого элемента программа Setup
создает запись логической конфигурации в двоичном формате и включает эту
информацию в реестр в раздел driver. INF-файлы могут содержать несколько
(или ни одного) разделов [Logical Configuration]. Ключевые слова и значения
этого раздела описаны в таблице.

[LogConfig Section name] 
ConfigPriority=value_of_priority 
MemConfig=menory_range_settings 
I/OConfig=ioport_settings 
IRQConfig=irq_sectings 
DMAConfig=dma_settings 


Ключевое слово          Значение             Описание 
 
ConfigPriority         value_of_priority     Содержит значение приоритета 
                                             конфигурации для данного устрой- 
                                             ства. 
 
MemConfig          memory_range_settings     Указывает диапазон памяти для 
                                             данного устройства. 
 
I/OConfig           ioport_settings          Позволяет указать для устройства 
                                             конфигурацию портов ввода/вывода. 
 
IRQConfig            irq_settings            Содержит СПИСОК допустимых IRQ 
                                             для данного устройства. Если 
                                             устройство не использует IRQ, 
                                             не следует включать эту 
                                             строку в INF-файл. 
 
DMAConfig             dma_settings           Указывает допустимые значения 
                                             DMA для данного устройства. 

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


Ниже приведен пример синтаксиса раздела [Update AutoExec]. Имя раздела
[UpdateAutoBat] должно быть указано в разделе [Install]. Этот раздел соде-
ржит команды, манипулирующие строками в файле AUTOEXEC.BAT. Ключевые слова
и значения этого раздела приведены в таблице.

[Update_autobat_section] 
CmdDelete=command 
CmdAdd=command 
UnSet=environmentvariablename 
PreFixPath=%ldid% 
RemOldPath=%ldid% 
TmpDir=%ldid% 

Ключевое слово        Значение              Описание 
 
CmdDelete               command         Указывает команду, которая должна 
                                        быть удалена из файла AUTOEXEC.BAT. 
                                        Эта строка обрабатывается перед 
                                        строкой CmdAdd. 
 
CmdAdd                  command         Указывает команду, которую требуется 
                                        добавить в файл AUTOEXEC.BAT. 
 
UnSet          environmentvariablename  Указывает переменную окружения, кото- 
                                        рую вы хотите удалить из файла 
                                        AUTOEXEC.BAT. 
 
PreFixPath               %ldid%         Позволяет включить предопределенную 
                                        фиксированную переменную path в форме 
                                        логического идентификатора каталога 
                                        (logical directory identificator, LDID). 
 
RemOldPath               %ldid%         Позволяет указать путь, который должен 
                                        быть удален из файла AUTOEXEC.BAT. 
 
TmpDir                   %ldid%         Позволяет указать временный каталог на 
                                        время установки. 

Ниже приведен пример синтаксиса раздела [Update Config]. Имя раздела
[Update_config_section] должно быть задано в разделе [Install]. Этот раздел
содержит команды манипуляции со строками в файле CONFIG.SYS. Ключевые слова
и значения этого раздела описаны в таблице.

[Update_config_section] 
DevRename=current_name,new_name 
DevDelete=driver_name 
DevAddDev=driver_name,configkeyword 
Stacks=dos_stack_values 
Buffers=dos_buffer_values 
Files=dos_buffer_values 
LastDrive=dos_lastdrive_value 

Ключевое слово               Значение                 Описание 
 
DevRename             current_name,new_name   Позволяет переименовать драйверы 
                                              устройств, вызываемые из файла 
                                              CONFIG.SYS. Раздел может содержать 
                                              несколько строк DevRename. 
                                              Записи DevRename обрабатываются 
                                              первыми, прежде, чем начнется 
                                              обработка каких-либо других 
                                              записей раздела. 
                                               
DevDelete               driver_name           Позволяет указать драйверы 
                                              устройств, которые должны быть 
                                              удалены из файла CONFIG.SYS. 
                                              Раздел может содержать несколько 
                                              записей DevDelete. 
 
DevAddDev          driver_name,configkeyword  Позволяет указать новый драйвер, 
                                              который должен быть добавлен в 
                                              файл CONFIG.SYS. Раздел может 
                                              содержать несколько записей 
                                              DevAddDev. 
 
Stacks            dos_stack_values            Указывает значение Stacks= в 
                                              файле CONFIG.SYS. 
                                               
Buffers           dos_buffer_values           Указывает значение Buffers= в 
                                              файле CONFIG.SYS. 
 
Files             dos_file_values             Указывает значение Files= в 
                                              файле CONFIG.SYS. 
                                               
LastDrive         dos_lastdrive_value         Указывает значение lastdrive= 
                                              в файле CONFIG.SYS. 

Ниже приведен пример синтаксиса раздела [Update INI]. Раздел [Update INI]
необходимо указать в разделе [Install] записью UpdateINIs. Этот
раздел добавляет, удаляет или замещает записи в указанном INI-фаЙле.
Ключевые слова и значения для этого раздела описаны в таблице.

[Update_ini_section] 
ini-file,ini-section,original_entry,new_entry, options 
 
Значение            Описание 
 
options             Необязательные флаги операции, которые могут принимать 
                    одно из следующих значений 
 
   0                Значение по умолчанию. Ищет ключ (имя записи) 
                    original_entry, игнорируя его значение. Если ключ при- 
                    сутствует, соответствующая запись заменяется на 
                    new_entry. Если original_entry равна NULL, new_entry 
                    добавляется безусловно. Если new_entry равна NULL, 
                    original_entry удаляется. 
 
   1                Ищет запись original_entry по ключу и значению. Обнов- 
                    ление выполняется только в том случае, когда совпадают и 
                    ключ, и значение записи original_entry. 
 
   2                Ищет запись, ключ которой совпадает с указанным в 
                    original entry. Если запись уже существует, она не за- 
                    мещается значением, указанным вами в new_entry. 
 
   3                Ищет запись, ключ и значение которой совпадают с 
                    указанными в original_entry. Если такая запись существует, 
                    она замещается new_entry. 

Ниже приведена синтаксическая конструкция раздела [Update IniFields].
Имя раздела [UpdatelniFields] должно быть указано элементом
[UpdatelniFieldsl в разделе [Install]. Утверждения этого замещают,
добавляют или удаляют поля в указанной записи INI-файла. В отличие от
раздела [Update INI], команды из данного раздела работают с фрагмента-
ми записей, а не с записями в целом.

[update_inifields_section] 
ini-file,ini-section,profile_name,old_field,new_field 

Если в строке INI-файла для указанной записи присутствовал комментарий,
он удаляется. Модификаторы old_field и new_field являются необяза-
тельными.

Раздел [Add Registry] позволяет добавлять в реестр ключи и значения.
Кроме того, существует необязательная возможность установить фактиче-
ское значение. Имя раздела [add_registry_section] должно быть задано
элементом AddReg раздела [Install]. Синтаксис раздела выглядит следую-
щим образом:

[add_registry_section] 
reg_root_string 

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

Раздел [Delete Registry] используется для удаления из реестра подклю-
чен и имен значений. Синтаксис этого раздела выглядит следующим обра-
зом:

[del_registry_section] 
reg_root_string,subkey 

Имя этого раздела должно быть указано элементом DelReg в разделе
[Install]. Каждый элемент, включенный в этот раздел, удалит из реестра
подключ или значение.

Раздел [Ini to Registry] позволяет перемещать в реестр строки и разде-
лы из INI-файла. Эта операция или создает в реестре новый элемент, или
подключ или значение.

Имя раздела [ini_to_registry section] должно быть указано элементом
lni2Reg в разделе [Install].

Раздел [DestinationDirsI позволяет определить каталог назначения для
раздела [File_List]. Ссылка на имя раздела [DestinationDirs] должна
присутствовать в одном из следующих трех элементов раздела [Install]:
DelFiles, CopyFiles или RenFiles. Синтаксис раздела приведен ниже.

Более подробную информацию можно найти в таблице.

[DestinationDirs] 
file_list=ldid,subdirectory 
DefaultDestDir=ldid,subdirectory 

Ключевое слово       Значение             Описание 
 
file_list             ldid,subdirectory    Указывает имя раздела FileList. 
 
                      subdirectory         Указывает каталог, находящийся 
                                           в каталоге ldid. Это значение 
                                           необязательно. 
                                            
                      ldid                 Указывает логический идентификатор 
                                           диска. Список допустимых значений 
                                           ldid приведен далее. 
 
DefaulDestDir                              Позволяет указать каталог-приемник 
                                           по умолчанию для всех неупомянутых 
                                           разделов File_List. Этот параметр 
                                           не является обязательным. По умол- 
                                           чанию W95 использует каталог 
                                           LDID_WIN. 

Раздел [SourceDisksFilesj используется для указания исходных файлов,
используемых в процессе инсталляции. Кроме того, с помощью этого разде-
ла можно указать исходные диски, содержащие эти файлы. Синтаксис раз-
дела очень прост:

[SourceDisksFiles] 
name_of_source_disk=disk_number 

Элемент disk_number определяется в разделе [SourceDisksNames], кото-
рый использует следующий синтаксис:

[SourceDisksNames] 
disk_ordinal=description_of_disk,label,serial_number 

Раздел [ClassInstall] устанавливает новый класс устройства в разделе
реестра [Class]. Синтаксис раздела [ClassInstall] приведен ниже.
Подробную информацию о значениях и элементах, которые используются в
этом разделе, можно найти в таблице выше.

[ClassInstall] 
CopyFiles=fils_list_section 
RenFiles=fils_list_section 
DelFiles=fils_list_section 
UpdateInis=UpdateIni_section_name 
UpdateIniFields=UpdateIniFields_section_name 
AddReg=AddRegistry_section 
DelReg=DelRegistry_section 

Наконец, последним разделом INF-фаила является раздел [Strings]. Этот
раздел определяет один или несколько строковых ключей. Синтаксис этого
раздела приведен ниже.

[Strings] 
string_key="valve" 

Ключевое слово string_key обозначает строковый ключ, формирующийся
из буквенно-цифровых символов, например, MfgName. Хотя раздел
[Strings] обычно является последним в INF-файле, строковые ключи
можно использовать везде, где допустимо употребление строк.
Программа Setup подставляет вместо строкового ключа строку, заданную
элементом "value" и в дальнейшем использует именно ее, например:
MSFT="Microsoft"
Встпетив строку MSFT. поогоамма Setup интерпретирует ее как Microsoft

Значения LDID
В таблице перечислены допустимые значения LDID (logical disk identifier),
которые вы можете использовать в INF-файлах.


  ID           Обозначает 
   
  00           Пустой LDID; используется для создания нового LDID 
  01           Исходное устройство:\путь 
  02           Временный каталог Setup; используется только в процессе 
                                                     установки W95 
  03           Каталог Uninstall 
  04           Каталог Backup 
  10           Каталог Windows 
  11           Каталог SYSTEM 
  12           Каталог lOsubsys 
  13           Каталог COMMAND 
  14           Каталог Control Panel 
  15           Каталог Printers 
  16           Каталог Workgroup 
  17           Каталог INF 
  18           Каталог Help 
  19           Каталог Administration 
  20           Каталог Fonts 
  21           Каталог Viewers 
  22           Каталог VMM32 
  23           Каталог Color 
  25           Каталог Shared 
  26           Каталог Winboot 
  27           Машинно-зависимый каталог 
  28           Каталог Winboot Host 
  30           Корневой каталог загрузочного устройства 
  31           Корневой каталог хост-диска виртуального загрузочного устройства 
  32           Каталог с прежней версией Windows (если есть) 
  33           Каталог с прежней версией MS-DOS (если есть)DB 
 

Что из себя представляет Self?

Что из себя представляет Self?

Self - это явное задание экземпляра класса в его методе.

Например для твоей формы это указание на саму форму:

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(self.classname+#13#10+self.name);
end;

Если например это MDI форма то это будет указатель именно на тот экземпляр для которого выполняется этот код. На практике Self обычно применяется при написании своих классов, когда ты пишешь класс или компонент, то у тебя нет переменной с экземпляром этого компонента, следовательно чтобы обратится к экземпляру (который появится только в коде конечного пользователя, который будет использовать компонент) класса нужна переменная - вот она и берётся за self.

Автор ответа: Vit
Взято с Vingrad.ru





Чтобы понять, что такое self надо понять что такое метод класса. Метод класса - это просто функция(процедура) который имеет дополнительный неявный параметр - указатель на экземпляр класса. То есть:

TMy=class
  x:integer;
  procedure Proc(val:integer);
end;

procedure TMy.Proc(val:integer);
begin
  x:=val;
end;

После компиляции это будет практически то же самое, что:

procedure Proc(self:TMy;val:integer);
begin
  self.x:=val;
end;

То есть на самом деле в методе Proc обращаясь к x мы на самом деле обращаемся к self.x, просто переменная self опускается. В скомпилированном коде нет такого понятия как классы - есть только код и память. Все методы классов превращаются в обыкновенные функции, в которым качестве первого параметра передается указатель на область памяти где лежит созданный пользователем экземпляр класса, который они и используют для чтения или записи(а так же для вызова) того, что мы называем членами класса.

var
  m1,m2:TMy;
begin
  .....
  m1.Proc(4); // -> Proc(m1,4)
  m2.Proc(4); // -> Proc(m2,4)
end;


Автор ответа: Fantasist
Взято с Vingrad.ru

Что из себя представляет TWebBrowser?

Что из себя представляет TWebBrowser?

Взято из FAQ:
Перевод материала с сайта members.home.com/hfournier/webbrowser.htm

Веббраузер это Microsoft's Internet Explorer в виде ActiveX контрола.
Его можно импортировать в Delphi IDE и размещать на форме на равне с другими компонентами. Поэтому, чтобы превратить Ваше приложение в браузер, достаточно воспользоваться всей мощью IE.

Что такое базы данных?

Что такое базы данных?

Итак базы данных существуют следующих видов:

1) Древовидные - простейший пример - Windows Registry, файловая система FAT и XML - здесь информация хранится в древовидной структуре и доступ осуществляется через "путь", т.е. указание всех узлов от корневого до нужного. Например: "c:\My Docs\MyPictures\Me.jpg". Недостатки этого способа хранения данных является очень медленный поиск, если не известен путь и очень плохая устойчивость к повреждениям структуры. Преимущество - возможность хранить в классифицированном виде очень разнородную информацию и очень быстрый поиск при знании ключа. Эти базы данных мы разбирать здесь не будем.

2) Сетевые базы данных - простейший пример - интернет. Т.е. существуют узлы, обособленные друг от друга, содержащие определённую информацию. Каждый узел представляет какое-то количество ссылок на другие узлы, по которым и ведётся поиск. Недостатки - очень сложный и долгий поиск, возможна неполное предоставление информации или невозможность найти нужную информацию. Преимущества - очень легко добавить любую, разнородную информацию, самая высокая стабильность из всех систем. Эти базы данных мы разбирать здесь не будем.

3) Объектные базы данных - новое веяние. Их мы разбирать здесь не будем, но интересующиеся найдут интересной дискуссию о них в нашем разделе по базам данных.

4) Реляционные базы данных - именно с ними мы и будем работать. В дальнейшем если говорится "база данных", то подразумевается "Реляционная база данных". "Реляционный" - Relation - обозначает взаимосвязанный. С этими связями мы будем разбираться потом, а пока можно для простоты считать, что реляционная база данных - это набор двумерных простых таблиц. Недостатки реляционных баз данных - хранение только однородной информации, сложности в добавлении новых структур и взаимоотношений, информация хранящаяся в такой БД должна быть в нужной степени абстрагированна. Преимущества - прежде всего очень высокая скорость поиска - по этому параметру у реляционных баз данных конкурентов нет, высокая стабильность, обилие софта для их поддержки и разработки, удобность для очень широкого круга задач.

Что такое Цвет?

Что такое Цвет?

Если Edit1.text это String то что такое Edit1.font.color?


TColor - это Integer, чтоб задать нужный цвет можно пользовать константы, а можно в числовом виде:

Edit1.font.color:=$223344

где 22 - яркость красного цвета, может быть в пределах от 00 до FF
где 33 - яркость зеленого цвета, может быть в пределах от 00 до FF
где 44 - яркость синего цвета, может быть в пределах от 00 до FF

Например:

Edit1.font.color:=$000000- черный
Edit1.font.color:=$FFFFFF - белый
Edit1.font.color:=$00FF00 - зеленый

Всего определено 256*256*256 цветов

В примерах я использовал шестнадцатиричные значения так как так проще, но можно и десятичные, если разберетесь какой это цвет

Edit1.font.color:=123456

Автор ответа: Vit
Взято с Vingrad.ru




Можно использовать константы типа clred, clblack, cllime, clgreen...
Для работы с цветом можно использовать следующие функции
RGB(r,g,b:byte):tcolor //получаешь цвет по 3 составляющим
GetRValue(color:tcolor)
GetGValue(color:tcolor)//получаешь значение интенсивности цвета.
GetBValue(color:tcolor)

Автор ответа: Mikel
Взято с Vingrad.ru


Для хранения цвета существует свой собственный тип, который называется TColor. Этот тип содержит информацию, как о самом цвете, так и том, каким образом его заменить, если, например, цветовая палитра системы не поддерживает этот цвет (скажем, установлено всего 256 цветов, а цвет, заданный в переменной, вылезает далеко за пределы этих 256 цветов).

Тип TColor состоит из четырех байт. Первый байт - указатель на замену цвета (о нем поговорим позже). Второй байт - яркость красного цвета от 0 до 255 (от 00 до FF). Третий байт - яркость зеленого цвета от 0 до 255 (от 00 до FF). И, наконец, четвертый байт - яркость синего цвета, также, от 0 до 255 (от 00 до FF).

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

Поговорим теперь о первом байте - указателе на замену цвета. Итак, этот байт может принимать три различных значения - ноль ($00), единицу ($01) или двойку ($02). Что это значит:

Ноль ($00) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из системной палитры.
Единица ($01) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из палитры, которая установлена сейчас.
Двойка ($02) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из палитры, которую поддерживает текущее устройство вывода (в нашем случае - монитор).
Видимо, всегда лучше устанавливать значение первого байта равным нулю ($00), по крайней мере, так происходит при получении типа TColor при помощи функции RGB.

И, напоследок, несколько примеров:



$00FFFFFF - белый цвет;
$00000000 - черный цвет;
$00800000 - темно-красный цвет.

Взято из

Что такое DirectShow?

Что такое DirectShow?

На этот раз речь пойдет о DirectShow. Для чего нам может понадобиться DirectShow?
DirectShow - это архитектура для воспроизведения, перехвата и обработки потоков мультимедиа. Звучит туманно? Поясняю - c помощью этого API можно:
проигрывать мультимедийные файлы различного формата, такие как MPEG (Motion Picture Experts Group), AVI (Audio-Video Interleaved), MP3 (MPEG Audio Layer-3), DVD и конечно WAV;
перехватывать видео-поток с различного рода TV-карт, видеокамер и т.п.;
создавать нестандартные обработчики мультимедиа-потоков и свои собственные форматы файлов (что, впрочем, вряд ли понадобится простым смертным);
обращаться непосредственно к видео и аудио потокам, чтобы выводить их на Surface DirectDraw (что для нас как раз интересно).
Звучит заманчиво. Но для чего это может понадобиться, спросите Вы, вспоминая родной и привычный MediaPlayer. Представьте себе, что Вы запрограммировали трехмерный мир, с анимированными спрайтами, трехмерными объектами и т.п. И в отсвете выстрелов очередной "бродилки-стрелялки", пораженный пользователь нового шедевра, видит видео клип, воспроизводимый прямо на костях очередного пораженного монстра. :-) Каково? Убедил? Тогда продолжим.
Кстати, раз уж упомянули DirectDraw - DirectShow интегрирован с DirectX так, что использует DirectDraw и DirectSound для вывода изображения и звука, и, при наличии аппаратного ускорения, автоматически им воспользуется.

Для работы с DirectShow Вам понадобятся:
иметь некоторое представление о технологии COM (Component Object Model) - хотя быть знатоком этой технологии вовсе не обязательно - просто достаточно знать, что для получения COM-интерфейса нужно вызвать QueryInterface;
скачать заголовочные файлы DirectShow API, переведенные на Delphi в рамках проекта JEDI - (http://www.delphi-jedi.org/DelphiGraphics/DirectX/DX5Media.zip) и либо поместить их в каталог Delphi\Lib либо добавить путь к каталогу, в котором они находятся в установках Delphi Library Path.
DirectShow скорее всего уже установлен на Вашем компьютере - он входит в стандартную поставку Windows 9x, Windows NT 4 (Service Pack 3 и выше), Windows 2000 (если Вы программируете для UNIX или DOS - то я вообще не понимаю зачем Вы читаете эту статью).

Основы DirectShow

В концепции DirectShow мультимедийные данные - это поток, который проходит через несколько обрабатывающих блоков. Блоки, обрабатывающие поток данных, передают данные по цепочке друг другу, таким образом можно представить себе несколько "устройств", каждое из которых выполняет какую-то обработку данных и передает их соседнему "устройству". Эти "устройства" или "блоки обработки" данных называют фильтрами. Цепочка, по которой передаются данные, содержит несколько фильтров, связанных определенным образом.
В DirectShow имеются готовые фильтры, из которых, словно из детских кубиков, программист может выстроить ту или иную цепочку обработку данных, кроме того, конечно, можно создать свои, нестандартные фильтры.
Для создания такой "цепочки обработки" (которая, кстати, официально называются Filter Graph - "граф фильтров" или, в несколько вольном переводе - "схема соединения фильтров"), так вот для создания схемы соединения фильтров, предназначен самый базовый и лежащий в основе всех основ компонет DirectShow, под названием Filter Graph Manager - Менеджер Графа Фильтров.
Например, программа показывающая видео из AVI-файла может построить такой граф фильтров:

В этом примере пять фильтров, первый (File Source) просто читает данные с диска, второй фильтр (AVI Splitter) разделяет данные на кадры и передает упакованные видео данные фильтру AVI Decompressor, который их распаковывает и передает фильтру Default DirectSound Device, выводящему звук. AVI Decompressor передает распакованные данные фильтру Video Renderer, который выводит кадры видео на экран.
Фильтры делятся на три типа:
Фильтры-источники (Source filters) - эти фильтры просто получают данные из какого-то источника, с диска (как фильтр File Source (Async) на рисунке), с CD или DVD дисковода или с TV- карты или карты, к которой подключена цифровая видеокамера.
Фильтры-преобразователи (Transform filters) - эти фильтры как видно из названия преобразуют поток данных, проходящий через них каким-либо образом, например - разделяет поток данных на кадры, производят декомпрессию и т.п. На нашем рисунке к таким фильтрам относятся AVI Splitter и AVI Decompressor.
Фильтры вывода (Renderer filters) - фильтры, которые получают полностью обработанные данные и выводят их на монитор, звуковую карту, пишут на диск или выводят на еще какое-нибудь устройство.
Итак из фильтров-кубиков можно высстраивать граф. Делается это с помощью интерфейса IGraphBuilder. Создать объект типа IGraphBuilder можно так:

CoCreateInstance(CLSID_FilterGraph,nil,CLSCTX_INPROC_SERVER,IID_IGraphBuilder,MyGraphBuilder);

Здесь переменная MyGraphBuilder имеет тип IGraphBuilder; идентификатор класса CLSID_FilterGraph и IID_IGraphBuilder обьявлены в файле DShow.pas, поэтому не забудьте добавить

usesDShow.pas 

Итак, интерфейс IGraphBuilder получен. Можно построить граф фильтров, такой, какой нам нужно. Впрочем, все не так сложно, IGraphBuilder достаточно интеллектуален, он может сам, автоматически, построить граф, в зависимости от того какие файлы мы собираемся воспроизводить. Интерфейс IGraphBuilder имеет метод RenderFile, который получает имя файла в качестве параметра и, в зависимости от типа файла (которое определяется по расширению и по специальным сигнатурам в файле), сканирует реестр, в поисках необходимой для построения графа информации, создает необходимые фильтры и строит граф, предназначенный для воспроизведения файлов этого типа (WAV, AVI, MP3, MPG и т.д.).

После построения графа DirectShow готов к воспроизведению. Для управления потоком данных через граф обработки предназначен интерфейс IMediaControl - он имеет методы Run, Pause и Stop (названия говорят сами за себя)

Давайте попробуем все это на примере:


uses
  ... DShow, ActiveX,ComObj;

var
  MyGraphBuilder : IGraphBuilder;
  MyMediaControl : IMediaControl;
begin

CoInitialize(nil);
{получаем интерфейс IGraphBuilder}
CoCreateInstance(CLSID_FilterGraph,nil,CLSCTX_INPROC_SERVER,IID_IGraphBuilder,MyGraphBuilder);

{вызываем RenderFile - граф фильтров строится автоматически}
MyGraphBuilder.RenderFile('cool.avi',nil);

{получаем интерфейс ImediaControl}
MyGraphBuilder.QueryInterface(IID_IMediaControl,MyMediaControl);

{Примечание - MyMediaControl - переменная типа IMediaControl}

{проигрываем видео}
MyMediaControl.Run;

{ждем пока пользователь не нажмет ОК (видео воспроизводится в отдельном (thread) потоке)}
ShowMessage('Нажмите OК');

CoUninitialize;

end;

Если Вы не поленитесь скопировать этот кусок кода в Delphi и запустить его то заметите, что avi-файл проигрывается в отдельном окошке, которое не принадлежит нашему приложению. Для управления окошком, в котором воспроизводится видео предназначен специальный интерфейс IVideoWindow. Получить этот интерфейс можно из экземпляра IGraphBuilder, вызвав QueryInterface и передав в качестве идентификатора интерфейса константу IID_IvideoWindow.
Интерфейс IVideoWindow содержит методы для управления заголовком, стилем, местоположением и размерами окошка в котором проигрывается видео.
Давайте попробуем переделать наш пример так, чтобы видео выводилось не в отдельном окошке, а, скажем на компоненте TPanel, расположенном в нашей форме. Добавьте на форму компонет TPanel, пусть он называется Panel1.

uses
  ... DShow, ActiveX,ComObj;


procedure TForm1.Button1Click(Sender: TObject);
var
  MyGraphBuilder : IGraphBuilder;
  MyMediaControl : IMediaControl;
  VideoWindow : IVideoWindow;

begin

CoInitialize(nil);
{получаем интерфейс IGraphBuilder}
CoCreateInstance(CLSID_FilterGraph,nil,CLSCTX_INPROC_SERVER,IID_IGraphBuilder,MyGraphBuilder);


{вызываем RenderFile - граф фильтров строится автоматически}
MyGraphBuilder.RenderFile('C:\Program Files\Borland\Delphi5\Demos\Coolstuf\cool.avi',nil);

{получаем интерфейс ImediaControl}
MyGraphBuilder.QueryInterface(IID_IMediaControl,MyMediaControl);
{Примечание - MyMediaControl - переменная типа IMediaControl}

{получаем интерфейс IVideoWindow}
MyGraphBuilder.QueryInterface(IID_IVideoWindow,VideoWindow);
{Примечание - VideoWindow - переменная типа IVideoWindow}

{располагаем окошко с видео на панель}
VideoWindow.Set_Owner(Self.Panel1.Handle);
VideoWindow.Set_WindowStyle(WS_CHILD OR WS_CLIPSIBLINGS);
VideoWindow.SetWindowPosition(0,0,Panel1.ClientRect.Right,Panel1.ClientRect.Bottom);

{проигрываем видео}
MyMediaControl.Run;

ShowMessage('Нажмите OК');

CoUninitialize;
end;

Надеюсь это проще, чем Вы ожидали?


DirectShow и DirectX

Для того, чтобы использовать DirectShow совместно с DirectShow нужно разобраться с понятием Multimedia Streaming (потоки мультимедиа).
Multimedia Streaming - это архитектура, используемая в DirectShow для облегчения жизни программиста. Эта архитектура позволяет работать с мультимедиа данными, как с абстрактным потоком, не вдаваясь в подробности форматов хранения мультимедиа-файлов или специфику устройств-источников мультимедиа. Используя эту архитектуру, программист концентрируется не на расшифровке и преобразовании данных, а на управлении потоком данных, кадрами видео или аудио семплами.
На рисунке изображена иерархия объектов Multimedia Streaming

На вершине иерархии находится базовый объект Multimedia Stream, который является контейнером для объектов Media Stream. Объект Multimedia Stream может содержать один или несколько объектов Media Stream. В то время как каждый объект типа Media Stream предназначен для работы с данными какого-то одного типа (видео, аудио и т.п.) - Multimedia Stream - просто содержит методы для обращения к содержащимся в нем объектам Media Stream и не зависит от типа данных.
Объект типа Stream Sample, доступ к которому можно получить из Media Stream - позволяет управлять непосредственно элементами мультимедийного потока (для видео каждый Sample - это кадр видеоизображения, для аудио он может содержать несколько семплов звука).
Однако хватит теории. Давайте перейдем к делу. Попробуем создать необходимые объекты, чтобы вывести видео на Surface DirectX. Для этого нам понадобится обращаться к кадрам видео изображения (т.е. к обьекту типа Stream Sample). Значит, придется пройтись по всей цепочке иерархии, чтобы добраться до обьектов StreamSample. Вообще цепочка обьектов, которую предстоит создать выглядит так:
IAMMultiMediaStream
+ IDirectDrawMediaStream
+ IDirectDrawStreamSample

Сравните это с нашим рисунком. Как видите на вершине находится объект типа MultiMediaStream, который будет содержать MediaStream конкретного, нужного нам типа (IDirectDrawMediaStream), а уж с помощью него мы получим доступ к конкретным видео кадрам через интерфейс IDirectDrawStreamSample.
Итак сейчас мы создадим объект типа IAMMultiMediaStream. Этот интерфейс унаследован от IMultimediaStream и содержит, кроме прочего, функцию OpenFile, которая автоматически строит граф фильтров для воспроизведения файла.


CoCreateInstance(CLSID_AMMultiMediaStream, nil, CLSCTX_INPROC_SERVER, IID_IAMMultiMediaStream, AMStream);

Здесь переменная AMStream имеет тип IAMMultiMediaStream.
Мы создали контейнер для мультимедийных потоков. Сверяемся с рисунком - мы на верхнем уровне иерархии. У нас есть объект типа IMultimediaStream - теперь в этот контейнер нужно проинициализировать и добавить один или несколько мультимедиа потоков, нужного нам типа. Сначала инициализация:

AMStream.Initialize(STREAMTYPE_READ,
  AMMSF_NOGRAPHTHREAD, nil);

При инициализации указываем, что будут создаваться мультимедиа потоки для чтения, передав значение STREAMTYPE_READ (другие варианты STREAMTYPE_WRITE, STREAMTYPE_TRANSFORM).

Создадим теперь мультимедиа потоки для видео и звука:

AMStream.AddMediaStream(DDraw, MSPID_PrimaryVideo, 0, NewMediaStremVideo);
    AMStream.AddMediaStream(nil, MSPID_PrimaryAudio, AMMSF_ADDDEFAULTRENDERER, NewMediaStremAudio);

Вызываем метод OpenFile - файл загружается, и автоматически строится граф фильтов:

AMStream.OpenFile('cool.avi', 0);

Осталось направить видео поток мультимедиа поток на Surface. Вот процедура, которая делает это:

procedure TForm1.RenderStreamToSurface(Surface : IDirectDrawSurface; MMStream : IMultiMediaStream);
var
PrimaryVidStream : IMediaStream;
DDStream  :  IDirectDrawMediaStream;
Sample : IDirectDrawStreamSample; 
RECT : TRect;
ddsd :  TDDSURFACEDESC;
Z : DWORD;
begin
    MMStream.GetMediaStream(MSPID_PrimaryVideo, PrimaryVidStream);
    PrimaryVidStream.QueryInterface(IID_IDirectDrawMediaStream, DDStream);
    ddsd.dwSize := sizeof(ddsd);
    DDStream.GetFormat(ddsd, Palitra, ddsd, Z);
    rect.top:=(480-ddsd.dwHeight)div 2; rect.left:=(640 - ddsd.dwWidth) div 2;
    rect.bottom := rect.top+ddsd.dwHeight;    rect.right := rect.left+ddsd.dwWidth;
    DDStream.CreateSample(Surface, Rect, 0, Sample);
    MMStream.SetState(STREAMSTATE_RUN);
end;


Как видите, в этой процедуре сначала получаем интерфейс типа IDirectDrawMediaStream (соответствующий второму уровню иерархии на нашем рисунке), потом из него получаем объект типа IDirectDrawStreamSample (переменная Sample), который соответствует третьему уровню иерархии нашего рисунка.

Теперь остается вызывать в цикле (в демо-программе это делается по таймеру - здесь для простоты опускаем):

hr:=Sample.Update(0 , 0, nil, 0);

   if hr = $40003 {MS_S_ENDOFSTREAM} then
     MMStream.Seek(0);

Метод IDirectDrawStreamSample.Update выводит очередной кадр на Surface. При достижении конца потока он вернет ошибку с кодом $40003 (MS_S_ENDOFSTREAM), я в этом случае просто перематываю поток к началу, методом Seek.

Полностью программу, фрагменты кода из которой здесь приведены можно скачать здесь <<URL>>.
В этой программе инициализируется DirectDraw, создается Surface , а затем на него выводится видео из avi-файла.

Пока все о DirectDraw - надеюсь эта информация послужит для Вас отправной точкой в написании чего-то потрясающего! :-)


Автор: JINX (Elchin Aziz Ali OglI)
EMail: aziz@telebot.com, error@softhome.net
CopyLeft 2000.

Взято с сайта

Анатолия Подгорецкого
по материалам fido7.ru.delphi.*

Что такое DOM?

Что такое DOM?

Взято из FAQ:
Перевод материала с сайта members.home.com/hfournier/webbrowser.htm  
 

Document Object Model это платформенно независимый интерфейс,
позволяющий программам и скриптам динамически обновлять и
изменять содержимое, структуру и стиль документов. Вопрос: Где можно почитать документацию по DOM? Ответ: Обзор материалов по DOM на W3C site , а так же FAQ.
Не забудьте заглянуть на Document object на сайте Microsoft.

Что такое иконка на System Tray?

Что такое иконка на System Tray?

Иконка на Tray'е это просто картинка, а не окно какой-либо программы (исследование системы с помощью Microsoft Spy++ for Windows 95 показывает, что это не окно вообще). System Tray отслеживает события мыши над иконкой и, в случае надобности, показывает ToolTip для этой иконки. Так же он отсылает сообщения о всех действиях мыши над иконкой окну, которое поместило иконку на Tray. Таким образом, нельзя поместить программу на Tray. Любая программа может добавить стоько иконок на Tray, сколько ей необходимо. При этом главное окно программы не обязано исчезать или минимизироватся - примером может служить Microsoft Internet Mail, помещающая иконку " конверт" на Tray в случае появления новых писем.

Взято из FAQ:

Что такое MIDAS (multi-tired distributed application service)?

Что такое MIDAS (multi-tired distributed application service)?

MIDAS - multi-tired distributed application service suite- это технология Borland для создания многоуровневых приложений баз данных. Применение данной архитектуры позволяет быстро разрабатывать простые в сопровождении и установке, надежные, распределенные БД. Трехуровневое приложение баз данных содержит несколько компонентов (слоев):

а) Слой БД. Хранит данные. Выполняет функции хранения информации, обеспечения целостности и непротиворечивости данных. Пример -локальные (dBase, Paradox) и серверные БД (Oracle, Sybase, MS SQL), текстовые файлы и т.д.

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

в) Презентационный слой (тонкий клиент). Задача этого слоя, используя сервисы слоя бизнес логики, предоставлять пользователям запрошенную информацию в форме удобной и приятной во всех отношениях. Может быть выполнен в виде традиционного exe файла или в качестве тонкого клиента можно использовать Web броузер.

Применение данной схемы позволяет создать клиентское приложение, которое практически не требует настройки и сопровождения, вся логика работы с БД сосредоточена в среднем слое (сервере приложений). Соответственно при доработке алгоритмов доступа к БД необходимо лишь переустановить сервер приложений. MIDAS предназначен для обеспечения связи между слоем бизнес логики и презентационным слоем. Он позволяет организовать взаимодействие тонкого клиента с сервером приложений. При этом сервер приложений взаимодействует с реляционной БД (чаще всего данные хранятся именно в этой форме) как и обычные приложения работы с БД, разработанные в Delphi. Тонкий клиент для конечного пользователя ничем не отличается от обычного (толстого) клиента БД. Разница в том, что толстый клиент через BDE, ADO, компоненты прямого доступа к серверам БД и другие библиотеки работает с БД, а тонкий клиент взаимодействует с сервером приложений, используя MIDAS. Сервер приложений скрывает от клиента детали доступа и обработки БД. На компьютере с тонким клиентом не нужно устанавливать и настраивать BDE, ADO, клиентскую часть сервера БД. Необходимо лишь иметь небольшие по объему dll, которые легко переносить вместе с exe файлом тонкого клиента. В качестве тонкого клиента может использоваться и Web браузер. Разработка пользовательского интерфейса тоже мало чем отличается от обычного клиента. Особенности - необходимость размещения и настройки одного из компонентов доступа к серверу приложений (DCOMConnection, SocketConnection, WebConnection, CorbaConnection) и вместо Table, Query, StoredProc использовать компонент TСlientDataSet. Сервер приложений, как правило, имеет весьма несложный пользовательский интерфейс (чаще одну главную форму). Да он ему и не нужен. Сердце сервера приложений - это удаленный модуль данных (Remote Data Module). В зависимости от протокола связи TRemoteDataModule, MTSDataModule, TCORBADataModule. Внутри удаленного модуля данных расположены невизуальные компоненты доступа к данным. Каждому компоненту, который должен быть доступен тонкому клиенту необходимо сопоставить компонент - TDataSetProvider. Кроме того, для автоматического запуска серверов приложений по запросу клиента и реализации стратегии безопасности доступа бывает необходимо иметь дополнительную программу SCM (service control manager).

Создание трехуровневого приложения

Итак, создадим наше первое приложение для просмотра таблицы animals.dbf БД DBDEMOS. Как указывалось выше нам необходимо разработать сервер приложений и тонкого клиента (слой БД - это dbf файл).

Создание сервера приложений

Создадим новое приложение, используя пункт меню File / New Application. Созданная при этом форма Form1 будет главной формой сервера приложений. Далее создадим удаленный модуль данных, в него будут помещаться невизуальные компоненты доступа к данным и в нем сосредотачивается вся функциональность сервера приложений. Отличие его от обычного модуля данных в том, что удаленный модуль данных обеспечивает возможность тонким клиентам получать данные с сервера приложений. Выберем пункт меню File / New и в появившемся диалоге перейдем к закладке Miltitier

Выберем значок Remote Data Module и нажмем кнопку ОК (Замечание в случае использования CORBA необходимо выбирать CORBA Data Module). После этого на экране появляется диалог RemoteDataModuleWizard. Заполним поле CoClass Name базовым именем нашего удаленного модуля MyRDM. Обратите внимание, что к указанному имени будет добавлена буква T в наименовании класса и I в наименовании интерфейса для управления удаленным модулем. Остальные поля оставьте как есть (мы пишем простейшего сервера). Нажмем кнопку OK. В проект будет добавлен модуль Unit2, содержащий удаленный модуль данных. С закладки DataAccess добавим компонент TTable и свяжем его с таблицей animals.dbf алиаса DBDEMOS и активируем (свойства DatabaseName установим в DBDEMOS, TableName в animals.d, Active в true. Напомню, что порядок установки свойств важен). Теперь для того, чтобы сделать данную таблицу доступной тонкому клиенту необходим еще один компонент TDataSetProvider. Он расположен на закладке Midas. Чтобы связать DataSetProvider с TTable (как впрочем и с другими компонентами доступа к данным) установим свойство DataSet первого равным Table1. Результат наших усилий можно увидеть на рис.3. Осталось запустить сервер приложений на выполнение. Во-первых, чтобы увидеть наши труды, а во-вторых, чтобы при первом запуске сервер приложений произвел необходимые действия по своей регистрации в реестре.

Удаленный модуль данных
В принципе сервер приложений готов и работоспособен (без написания кода !!!), однако внесем последний штрих - счетчик подключений клиентов. Для этого на главную форму поместим два компонента TLabel. Свойство Caption одного установим в "Количество подключений", а второго в "0". Вид главной формы представлен на рис.4.

В обработчики события OnCreate удаленного модуля инкрементируем значение счетчика

withForm1.Label2 do
  Caption := IntToStr(StrToInt(Caption) + 1);


а в OnDestroy того же компонента декрементируем


with Form1.Label2 do
  Caption := IntToStr(StrToInt(Caption) - 1);

Создание тонкого клиента

Теперь настало время взяться за написание клиента. Создадим новое приложение, использующее в качестве протокола связи с сервером сокеты. Выбрав File / New Application в меню, на главную форму установим компонент TSocketConnection с закладки Midas. Данный компонент обеспечивает взаимодействие с сервером приложений. Далее нам необходимо запустить программу Borland Socket Server (расположена в Delphi/Bin/scktsrvr.exe). Данная программа обрабатывает запросы клиентов, передает их серверу приложений и запускает его, если раньше он не был запущен. Программы, выполняющие данные функции называют SCM (service control manager). Запуск Borland Socket Server необходим лишь в случае использования протокола сокетов. При запуске Borland Socket Server помещает свой значок в панель задач.

Настроим SocketConnection1. Значение свойства ServerName выберем из выпадающего списка и установим равным Project1.MyRDM, таким образом мы указываем к какому серверу приложений присоединяться. Затем необходимо указать на какой машине находится данный сервер. Для этого надо установить либо свойство Address в значение IP адреса или выбрать из списка значений свойства Host имя Вашего PC. Наконец, установим свойство Connected в true. О-о-пс, если все было выполнено верно, запустится сервер приложений и его счетчик клиентов будет установлен в 1. Для доступа к данным в тонком клиенте вместо TTable, TQuery используется TClientDataset. Разместим на главной форме его и мы, взяв с закладки Midas. Значение свойства RemoteServer установим в SocketConnection1, ProviderName в DataSetProvider1 (вспомним, что разместили его в удаленном модуле данных сервера приложений). Внимание, порядок установки этих свойств важен. Активизируем TClientDataSet, установив свойство Active в true. Далее порядок проектирования не отличается от разработки обычного приложения БД. Т.е. размещаем на форме DataSource, DBGrid, DBNavigator.Набор свойств, которые нужно установить приведен в таблице 1.

Таблица 1
DataSource1
DataSet ClientDataSet1
DBGrid1, DBNavigator
DataSource DataSource1

Если все выполнено правильно, то в сетке просмотра появятся данные. Вид главной формы приведен на рис.5. Ну вот, теперь можно запустить клиента. При этом на запущенном сервере приложений счетчик увеличится до2. Можно запустить еще несколько экземпляров клиентов, загнуть пальцы и сделать умное лицо. :)))

Какую из технологий (протоколов) распределенных вычислений лучше использовать с MIDAS ?
Протокол обеспечивает механизм вызова сервера приложений и соединения с ним клиента.
На данный момент Delphi поддерживает четыре протокола организации распределенных вычислений:


DCOM - технология Microsoft для создания и использования удаленных объектов автоматизации.
Достоинства:
а) Встроена в Windows 98,NT,2000. Может быть установлен в Windows 95, как дополнительная опция. Это не требует запуска дополнительных приложений на стороне сервера для управления подключением клиентов.
б) Реализован автоматический запуск сервера приложений при вызове его клиентом и автоматическое закрытие при отсутствии клиентов.
Недостатки:
а) Существуют проблемы с работой DCOM в сетях без контроллера домена NT. Поэтому использовать эту технологию в полной мере можно лишь при наличии в сети сервера с ОС Windows NT, 2000.
б) В DCOM нет встроенных средств обеспечения прозрачности положения сервера приложений (location transparency), т.е другими словами всегда нужно указывать на каком компьютере расположен сервер приложений. Данное ограничение можно сгладить применением SimpleObjectBroker.
в) Использовать DCOM можно лишь на платформе Windows.

Sockets - самый простой из протоколов организации распределенных вычислений. В его основе лежит использование сокетов TCP/IP.
Достоинства:
а) Требует минимум установленных компонентов ОС.
б) Может функционировать в любой сети Windows (c выходом Kylix надеюсь и в Linux), использующей TCP/IP.
Недостатки:
а) Требует постоянно запущенного на сервере менеджера подключений клиентов (ScktSrvr.exe).
б) Отсутствие механизмов обеспечения безопасности, другими словами все серверы приложений данной машины могут быть использованы с любого клиента, имеющего доступ по TCP/IP.

WebConnection - использует HTTP.
Достоинства:
а) Позволяет организовать вызов объекта с машины находящейся за пределами сегмента сети, защищенного файрволом.
Недостатки:
а) Требует установки на стороне клиента Wininet.dll (поставляется с IE 3 и выше).
б) Web сервер IIS 4 (и выше ) или Netscape enterprise 3.6 (и выше).

CORBA - использует соответствующую спецификацию OMG. Проще говоря CORBA - независимый от ОС стандарт взаимодействия объектов в распределенной системе.
Достоинства:
а) Независимость от ОС.
б) Наличие встроенного механизма обеспечения прозрачности положения сервера приложений. Т.е не нужно волноваться за то, где запущен сервер приложений, он будет автоматически найден.
в) Возможность выбора между автоматическим запуском сервера приложений при подключении клиента или запуска "вручную".
Недостатки:
а) Требуется установка дополнительного программного обеспечения (брокера объектных запросов - хотя бы на одной машине в сети).
б) Более сложная установка и настройка (по сравнению с DCOM) сервера приложений при автоматическом запуске.
в) Использование в Delphi COM для реализации CORBA

Таким образом можно дать следующие рекомендации по выбору протокола;
Если Вы новичок в MIDAS, то для изучения лучше всего используйте DCOM, установив сервер приложений и клиента на одной машине.
Если Ваша БД буде использоваться только с ОС Windows в сетях с контроллером домена Windows NT,2000 - используйте DCOM.
Если Вы не уверены, в том что в сети будет контроллер домена, то используйте либо CORBA, либо сокеты
В случае, если необходимо обеспечить запуск серверов приложений на любой машине в сети и конфигурация сети может меняться (или заранее неизвестны имена машин, где будут функционировать сервера приложений) лучше использовать CORBA.
Если Ваши сервера приложений должны быть доступны не только в локальной сети, но и "снаружи" - WebConnection подойдет лучше всего.
Когда Вы не хотите забивать себе голову (а надо бы) DCOM-ми, CORBA-ми, stab-ми, skeleton-ми, правами доступа итд SocketConnection поможет Вам быстро слабать многослойную БД.

Взято с

Что такое порт? Правила для работы с портами

Что такое порт? Правила для работы с портами

Взято из FAQ:http://blackman.km.ru/myfaq/cont4.phtml
Автор Дмитрий Кузан, Известно что в компьютере очень много собрано различных устройств , возникает вопрос как операционная система общается с ними. Для этого и служит порт, то есть эта «дверь» через которую программа (операционная система) может управлять данным устройством (считывать данные, заносить их).Причем я разделяю порты на две категории (это чисто мое разделение) - порты общеизвестные (COM LPT) и порты внутренние ,служащие для связи с внутренними устройствами ЭВМ. 2.Некоторые правила для работы с портами Следует иметь в виду что при разработке программ имеющих дело
работы с портами следует учитывать следующие факторы :
а) Стараться использовать функции высокого уровня для доступа к портам (в частности WinAPI) и не прибегать к низкоуровневым операциям чтения/записи портов. Если вы все-таки решили писать низкоуровневое чтение то эти процедуры нужно выносить в отдельную DLL или VXD, по следующим причинам - известно, что операционная система Windows95/98 а особенно NT являются по своей сути многозадачными системами. То есть если ваша программа обращается конкретно к порту не через динамический вызов функции DLL или VXD ( использования механизма DLL) а напрямую то это может сказаться на корректной работе системы или даже завалить ее. И даже если в Windows95/98 такой подход вполне может работать то в Windows NT вследствие его архитектуры не разрешит непосредственное чтение/запись напрямую, а использование механизма DLL или VXD позволяет обойти эту проблему.
б)Если вы работаете с каким-то нестандартным портом ввода-вывода
(например портом хранящим состояние кнопок пульта ДУ TVTunera то наверняка в комплекте поставки родного софта найдется DLL или VXD для управления этим устройством и отпадет нужда писать код, так я при работе с пультом ДУ TVTunerа использую стандартную DLL поставляемую в комплекте, это сразу решило вопросы связанные с управлением портами данного тюнера)Итак, отступление ? немного практики…
Маленький пример для работы с портами
(первый пример был уже опубликован в королевстве Дельфи
и представлял собой пример работы с весами ПетрВес)

function PortInit : boolean; //инициализация
var f: THandle;   
    ct: TCommTimeouts;  
    dcb: TDCB;  
begin
f := Windows.CreateFile(PChar('COM1'), GENERIC_READ or   
GENERIC_WRITE,  
FILE_SHARE_READ or FILE_SHARE_WRITE,  
nil, OPEN_EXISTING,  
FILE_ATTRIBUTE_NORMAL, 0);  
if (f < 0) or not Windows.SetupComm(f, 2048, 2048)or not  
Windows.GetCommState(f, dcb) then exit; //init error dcb.BaudRate := скоpость;  
dcb.StopBits := стоп-биты;  
dcb.Parity := ?етность;  
dcb.ByteSize := 8;  
if not Windows.SetCommState(f, dcb) or   
   not Windows.GetCommTimeouts(f, ct) then exit; //error  
ct.ReadTotalTimeoutConstant := 50;  
ct.ReadIntervalTimeout := 50;  
ct.ReadTotalTimeoutMultiplier := 1;  
ct.WriteTotalTimeoutMultiplier := 0;  
ct.WriteTotalTimeoutConstant := 10;  
if not Windows.SetCommTimeouts(f, ct)  
   or not Windows.SetCommMask(f, EV_RING + EV_RXCHAR + EV_RXFLAG + EV_TXEMPTY)  
  then exit; //error  
result := true;  
end;

function DoneComm: boolean; //закpыть поpт
begin
  result := Windows.CloseHandle(f);
end; 

function PostComm(var Buf; size: word): integer; //пеpеда?а в поpт
  var p: pointer; i: integer;
begin
p := @Buf;  
result := 0;  
while size > 0 do   
begin  
  if not WriteFile(f, p^, 1, i, nil) then exit;  
  inc(result, i); inc(integer(p)); dec(size);  
  Application.ProcessMessages;  
end;  
end; 

function ReadComm(var Buf; size: word): integer; //пpием из поpта
  var i: integer; ovr: TOverlapped;
begin
  fillChar(buf, size, 0);
  fillChar(ovr, sizeOf(ovr), 0); i := 0; result := -1;
  if not windows.ReadFile(f, buf, size, i, @ovr) then exit;
  result := i;
end; 

Данный пример был взят мной из многочисленный FAQ посвященных в DELPHI в сети ФИДО
Итак,для работы с портами COM и LPT нам понадобится знание функций Windows API. Вот подробное описание функций, которые нам нужны (в эквиваленте C) для работы с портами.
(извините за возможный местами неточный перевод ,если что поправьте меня если что не так перевел)

CreateFile HANDLE CreateFile( LPCTSTR lpFileName,// указатель на строку PCHAR с именем файла
DWORD dwDesiredAccess,// режим доступа
DWORD dwShareMode,// share mode
LPSECURITY_ATTRIBUTES lpSecurityAttributes,// указатель на атрибуты
DWORD dwCreationDistribution,// how to create
DWORD dwFlagsAndAttributes,// атрибуты файла
HANDLE hTemplateFile // хендл на temp файл
); Пример кода на Дельфи
< вырезано>
CommPort := 'COM2'; 
hCommFile := CreateFile(Pchar(CommPort), 
GENERIC_WRITE, 0, nil, 
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,
0);


< вырезано>
Параметры
LpFileName
Указатель на строку с нулевым символом в конце (PCHAR) ,
которая определяет название создаваемого объекта (файл,
канал, почтовый слот, ресурс связи (в данном случае порты),
дисковое устройство, приставка, или каталог)
DwDesiredAccess
Указывает тип доступа к объекту ,принимает значение
GENERIC_READ - для чтения
GENERIC_WRITE - для записи (смешивание с GENERIC_READ
операцией GENERIC_READ and GENERIC_WRITE предостовляет полный доступ )
dwShareMode
Набор разрядных флагов, которые определяют как объект может быть разделен по доступу к нему.
Если dwShareMode - 0, объект не может быть разделен.
Последовательные операции открытия объекта будут терпеть неудачу,
пока маркер(дескриптор) открытого объекта не будет закрыт.
Фактически предоставляется монопольный доступ. Чтобы разделять объект(цель), используйте комбинацию одних или большее количество следующих значений:
FILE_SHARE_DELETE (Только для Windows NT)
FILE_SHARE_READ
FILE_SHARE_WRITE
LpSecurityAttributes
Указатель на структуру SECURITY_ATTRIBUTES, которая определяет
может ли возвращенный дескриптор быть унаследован дочерними процессами.
Если lpSecurityAttributes НУЛЕВОЙ, маркер не может быть унаследован.
Используется только в windows NT.
dwCreationDistribution
Определяет поведение функции если объект уже существует и
как он будет открыт в этом случае Принимает одно из следующих значений :
CREATE_NEW
Создает новый объект (файл) Выдает ошибку если указанный объект (файл) уже существует.
CREATE_ALWAYS
Создает новый объект (файл) Функция перезаписывает существующий объект (файл)
OPEN_EXISTING
Открывает объект (файл) Выдает ошибку если указанный объект (файл) не существует.(Для более детального смотрите SDK)
OPEN_ALWAYS
Открывает объект (файл), если он существует. Если объект (файл) не существует,
функция создает его, как будто dwCreationDistribution были CREATE_NEW.
TRUNCATE_EXISTING
Открывает объект (файл). После этого объект (файл) будет
усечен до нулевого размера.Выдает ошибку если указанный объект (файл) не существует.
DwFlagsAndAttributes
Атрибуты объекта (файла) , атрибуты могут комбинироваться
FILE_ATTRIBUTE_ARCHIVE
FILE_ATTRIBUTE_COMPRESSED
FILE_ATTRIBUTE_HIDDEN
FILE_ATTRIBUTE_NORMAL
FILE_ATTRIBUTE_OFFLINE
FILE_ATTRIBUTE_READONLY
FILE_ATTRIBUTE_SYSTEM
FILE_ATTRIBUTE_TEMPORARY
HTemplateFile
Определяет дескриптор с GENERIC_READ доступом к временному объекту(файлу).
Временный объект(файл)поставляет атрибуты файла и расширенные атрибуты
для создаваемого объекта (файла)
ИСПОЛЬЗУЕТСЯ ТОЛЬКО В WINDOWS NT Windows 95: Это значение должно быть установлено в Nil.
Возвращаемые значения Если функция преуспевает, возвращаемое значение - открытый дескриптор
к указанному объекту(файлу). Если файл не существует - 0.
Если произошли функциональные сбои, возвращаемое значение - INVALID_HANDLE_VALUE.
Чтобы получить расширенные данные об ошибках, вызовите GetLastError. Обратите внимание !
Для портов, dwCreationDistribution параметр должен быть OPEN_EXISTING,
и hTemplate должен быть Nil. Доступ для чтения-записи должен быть определен явно. SECURITY_ATTRIBUTES Структура содержит описание защиты для объекта и определяет,
может ли дескриптор быть унаследован дочерними процессами.
typedef struct _SECURITY_ATTRIBUTES
{ DWORD nLength;
LPVOID lpSecurityDescriptor;
BOOL bInheritHandle;
} SECURITY_ATTRIBUTES; Параметры NLength
Определяет размер, в байтах, этой структуры.
Набор это значение к размеру структуры SECURITY_ATTRIBUTES В Windows NT
функции которые используют структуру SECURITY_ATTRIBUTES, не
LpSecurityDescriptor
Дескриптор указывающий на описатель защиты для объекта,
Если дескриптор ПУСТОЙ объект может быть назначен в наследование дочерними процессами.
BInheritHandle
Определяет, унаследован ли возвращенный дескриптор, когда новый дескриптор, создан.
Если это значение принимает ИСТИНУ новый дескриптор наследует от головного.
Замечания
Указатель на структуру SECURITY_ATTRIBUTES используется
как параметр в большинстве функций работы с окнами в Win32 API.
---------------------
Структура DCB Структура DCB определяет установку управления для последовательного порта ввода-вывода
(нам она понадобится для разбора примера с программой управления весами ПетрВес) Примечание : В местах где нельзя дать точный перевод
будет дано определение на английском из MSDK и приблизительный его перевод
Описание в эквиваленте C typedef struct _DCB { // dcb
DWORD DCBlength; // Размер DCB
DWORD BaudRate; // Скорость пересылки данных в бодах;
// текущая скорость в бодах
DWORD fBinary: 1; // binary mode, no EOF check
// двоичный режим , не проверять конец
// данных (по умолчанию значение = 1)
DWORD fParity: 1; // Включить проверку четность (по умолчанию
// значение = 1)
DWORD fOutxCtsFlow:1; // CTS управление потоком выхода
DWORD fOutxDsrFlow:1; // DSR управление потоком выхода
DWORD fDtrControl:2; // DTR Тип управления потоком скорости
// передачи данных
DWORD fDsrSensitivity:1; // DSR sensitivity (чувствительность)
DWORD fTXContinueOnXoff:1; // XOFF continues Tx (стоп-сигнал
// продалжает выполнение)
DWORD fOutX: 1; // XON/XOFF out flow control (СТАРТ-
// СИГНАЛ / СТОП-СИГНАЛ для управления
// выходящим потоком (по умолчанию
// значение = 1)
DWORD fInX: 1; // XON/XOFF in flow control (СТАРТ-
// СИГНАЛ / СТОП-СИГНАЛ для управления
// входящим потоком (по умолчанию
// значение = 1)
DWORD fErrorChar: 1; // enable error replacement (включить
// проверку погрешностей по умолчанию=1)
DWORD fNull: 1; // enable null stripping (отвергать
// пустой поток данных (по умолчанию=1))
DWORD fRtsControl:2; // RTS управление потоком данных
DWORD fAbortOnError:1; // abort reads/writes on error
// (проверять операции чтения/записи
// по умолчанию=1)
DWORD fDummy2:17; // reserved ЗАРЕЗЕРВИРОВАНО
WORD wReserved; // not currently used НЕ ДЛЯ
// ИСПОЛЬЗОВАНИЯ
WORD XonLim; // transmit XON threshold (порог
// чувствительности старт-сигнала)
WORD XoffLim; // transmit XOFF threshold (порог
// чувствительности стоп-сигнала)
BYTE ByteSize; // Бит в байте (обычно 8)
BYTE Parity; // 0-4=no,odd,even,mark,space
// (четность байта)
BYTE StopBits; // 0,1,2 = 1, 1.5, 2 (стоповые биты)
char XonChar; // Tx and Rx XON character (вид
// старт сигнал в потоке)
char XoffChar; // Tx and Rx XOFF character (вид
// стоп сигнал в потоке)
char ErrorChar; // error replacement character (какой
// сигнал погрешности,его вид)
char EofChar; // end of input character (сигнал
// окончания потока)
char EvtChar; // received event character РЕЗЕРВ
WORD wReserved1; // reserved; do not use НЕ ДЛЯ
// ИСПОЛЬЗОВАНИЯ
} DCB;

with Mode do
Begin  
BaudRate := 9600;  
ByteSize := 8;  
Parity := NOPARITY;  
StopBits := ONESTOPBIT; // одино?ный стоп-бит  
Flags := EV_RXCHAR + EV_EVENT2;  
End;   

Параметры : DCBlength
Размер DCB структуры.
BaudRate
Определяет скорость в бодах, в которых порт оперирует.
Этот параметр может принимать фактическое значение скорости в бодах,
или один из следующих стандартных индексов скорости в бодах:
CBR_110 CBR_19200
CBR_300 CBR_38400
CBR_600 CBR_56000
CBR_1200CBR_57600
CBR_2400CBR_115200
CBR_4800CBR_128000
CBR_9600CBR_256000
CBR_14400 fBinary
Определяет, допускается ли двоичный (бинарный) способ передачи данных.
Win32 API не поддерживает недвоичные (небинарные)
способы передачи данных в потоке порта, так что этот параметр
должен быть всегда ИСТИНЕН.
Попытка использовать ЛОЖЬ в этом параметре не будет работать.
Примечание : Под Windows 3.1 небинарный способ передачи допускается,
но для работы данного способа необходимо заполнит параметр
EofChar который будет восприниматься конец данных.
fParity
Определяет, допускается ли проверка четности.
Если этот параметр ИСТИНЕН, проверка четности допускается
fOutxCtsFlow
CTS (clear-to-send) управление потоком выхода
fOutxDsrFlow
DSR (data-set-ready) управление потоком выхода
fDtrControl
DTR (data-terminal-ready) управление потоком выхода
Принимает следующие значения :
DTR_CONTROL_DISABLE
Отключает линию передачи дынных
DTR_CONTROL_ENABLE
Включает линию передачи дынных
DTR_CONTROL_HANDSHAKE
Enables DTR handshaking. If handshaking is enabled,
it is an error for the application to adjust the line by using the EscapeCommFunction function.
Допускает подтверждению связи передачи данных
Если подтверждение связи допускается, это - погрешность для того чтобы регулировать(корректировать)
линию связи, используя функцию EscapeCommFunction.
fDsrSensitivity
Specifies whether the communications driver is sensitive to the state of the DSR signal.
If this member is TRUE, the driver ignores any bytes received, unless the DSR modem input line is high.
Определяет возможна ли по порту двухсторонняя передача в ту и в другую сторону сигнала.
fTXContinueOnXoff
Определяет, останавливается ли передача потока ,
когда входной буфер становится полный, и драйвер передает сигнал XoffChar.
Если этот параметр ИСТИНЕН, передача продолжается после того,
как входной буфер становится в пределах XoffLim байтов, и драйвер передает
сигнал XoffChar, чтобы прекратить прием байтов из потока .
Если этот параметр ЛОЖНЫЙ, передача не продолжается до тех пор ,
пока входной буфер не в пределах XonLim байтов,
и пока не получен сигнал XonChar, для возобновления приема .
fOutX
Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА
в течение передачи потока порту. Если этот параметр ИСТИНЕН, передача останавливается,
когда получен сигнал XoffChar и начинается снова, когда получен сигнал XonChar.
fInX
Specifies whether XON/XOFF flow control is used during reception. If this member is TRUE,
the XoffChar character is sent when the input buffer comes
within XoffLim bytes of being full, and the XonChar character is sent
when the input buffer comes within XonLim bytes of being empty.
Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА
в течение приема потока портом. Если этот параметр ИСТИНЕН,сигнал XoffChar посылается ,
когда входной буфер находится в пределах XoffLim байтов, а сигнал XonChar посылается
тогда когда входной буфер находится в пределах XonLim байтов или является пустым
fErrorChar
Определяет, заменены ли байты, полученные с ошибками четности особенностью,
указанной параметром ErrorChar Если этот параметр ИСТИНЕН, и fParity ИСТИНЕН, замена происходит.
fNull
Определяет, отвергнуты ли нулевые(пустые) байты. Если этот параметр ИСТИНЕН,
нулевые(пустые) байты, будут отвергнуты при получении их.
fRtsControl
RTS управление потоком " запрос пересылки " .
Если это значение нулевое, то по умолчанию устанавливается RTS_CONTROL_HANDSHAKE.
Принимает одно из следующих значений:
RTS_CONTROL_DISABLE
Отключает строку RTS, когда устройство открыто
RTS_CONTROL_ENABLE
Включает строку RTS
RTS_CONTROL_HANDSHAKE
Enables RTS handshaking. The driver raises the RTS line
when the " type-ahead" (input)
buffer is less than one-half full and lowers
the RTS line when the buffer is more than three-quarters full.
If handshaking is enabled, it is an error for the application
to adjust the line by using the EscapeCommFunction function.
Допускает RTS подтверждение связи. Драйвер управляет потоком пересылки.
RTS выравнивается , когда входной буфер - меньше чем половина полного и
понижается, когда буфер - больше 2/3 полного .Если подтверждение связи
допускается, это используется для регулирования передачи данных
EscapeCommFunction.
RTS_CONTROL_TOGGLE
Specifies that the RTS line will be high if bytes are available for transmission.
After all buffered bytes have been sent, the RTS line will be low.
Определяет, что буфер будет высокий при подготовке данных для передачи.
После того, как все байты отосланы, буфер RTS будет низок.
FAbortOnError
Определяет, закончена ли операции чтения/записи, если происходит погрешность.
Если этот параметр ИСТИНЕН, драйвер закрывает все операции
чтения/записи с состоянием погрешности при возникновении оной.
Драйвер не будет принимать никакие дальнейшие действия,
пока не дождется подтверждения погрешности в передоваемых
(принимаемых) данных, вызывая функцию ClearCommError.
fDummy2
ЗАРЕЗЕРВИРОВАНО Microsoft
wReserved
ЗАРЕЗЕРВИРОВАНО Microsoft
XonLim
Определяет минимальное число байтов, находящихся во в
XoffLim
Определяет максимальное число байтов, находящихся во входном буфере прежде,
чем будет генерирована подача СТОП-СИГНАЛА. Максимальное число байтов,
позволенных во входном буфере вычитается из размеров, в байтах, самого входного буфера.
ByteSize
Определяет число битов в байтах, переданных и полученных.
Parity
Определяет схему четности, которую нужно использовать.
Этот параметр может быть одним из следующих значений:
EVENPARITY
MARKPARITY
NOPARITY
ODDPARITY
StopBits
Определяет число стоповых битов, которые нужно использовать.
Этот параметр может быть одним из следующих значений:
ONESTOPBIT1 stop bit
ONE5STOPBITS1.5 stop bits
TWOSTOPBITS2 stop bits
XonChar
Определяет значение СТАРТ-СИГНАЛА для передачи и приема.
XoffChar
Определяет значение СТОП-СИГНАЛА для передачи и приема.
ErrorChar
Определяет значение СИГНАЛА ОШИБКИ (генерируемого при ошибке четности) для передачи и приема.
EofChar
Определяет значение сигнала конца данных.
EvtChar
Определяет значение сигнала события.
wReserved1
ЗАРЕЗЕРВИРОВАНО Microsoft
Дополнение : Когда структура DCB использует «ручной» выбор конфигурации ,
следующие ограничения используются для ByteSize и StopBits параметров :
Число информационных разрядов должно быть от 5 до 8 битов.
Использование 5 информационных разрядов с 2 стоповыми битами -
недопустимая комбинация, как - 6, 7, или 8 информационных разрядов с 1.5 стоповыми битами.

Взято с Vingrad.ru

---

---