nyuuzyou/wikis huggingface dataset:
Посылать и считывать данные с COM порта, а также менять параметры (биты данных, четность)

=== Посылать и считывать данные с COM порта, а также менять параметры (биты данных, четность) ===
Ниже представлен класс для работы с COM-портом. Протестирован в Windows 95. Класс выдернут из контекста, так что не ручаюсь в компиляции с первого раза, однако все функции работы с COM очевидны. 
unit Unit1;
interface
uses
 Windows;
type
 TComPort = class
 private
 hFile: THandle;
 public
 constructor Create;
 destructor Destroy; override;
 function InitCom(BaudRate, PortNo: Integer; Parity: Char;
 CommTimeOuts: TCommTimeouts): Boolean;
 procedure CloseCom;
 function ReceiveCom(var Buffer; Size: DWORD): Integer;
 function SendCom(var Buffer; Size: DWORD): Integer;
 function ClearInputCom: Boolean;
 end;
implementation
uses
 SysUtils;
constructor TComPort.Create;
begin
 inherited;
 CloseCom;
end;
destructor TComPort.Destroy;
begin
 CloseCom;
 inherited;
end;
function TComPort.InitCom(BaudRate, PortNo: Integer; Parity: Char;
 CommTimeOuts: TCommTimeouts): Boolean;
var
 FileName: string;
 DCB: TDCB;
 PortParam: string;
begin
 result := FALSE;
 FileName := 'Com' + IntToStr(PortNo); {имя файла}
 hFile := CreateFile(PChar(FileName),
 GENERIC_READ or GENERIC_WRITE, 0, nil,
 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 if hFile = INVALID_HANDLE_VALUE then
 exit;
 //установка требуемых параметров
 GetCommState(hFile, DCB); //чтение текущих параметров порта
 PortParam := 'baud=' + IntToStr(BaudRate) + ' parity=' + Parity +
 ' data=8 stop=1 ' +
 'octs=off';
 if BuildCommDCB(PChar(PortParam), DCB) then
 begin
 result := SetCommState(hFile, DCB) and
 SetCommTimeouts(hFile, CommTimeOuts);
 end;
 if not result then
 CloseCom;
end;
procedure TComPort.CloseCom;
begin
 if hFile < > INVALID_HANDLE_VALUE then
 CloseHandle(hFile);
 hFile := INVALID_HANDLE_VALUE;
end;
function TComPort.ReceiveCom(var Buffer; Size: DWORD): Integer;
var
 Received: DWORD;
begin
 if hFile = INVALID_HANDLE_VALUE then
 raise Exception.Create('Не открыта запись в Com порт');
 if ReadFile(hFile, Buffer, Size, Received, nil) then
 begin
 Result := Received;
 end
 else
 raise Exception.Create('Ошибка приема данных: ' + IntToStr(GetLastError));
end;
function TComPort.SendCom(var Buffer; Size: DWORD): Integer;
var
 Sended: DWORD;
begin
 if hFile = INVALID_HANDLE_VALUE then
 raise Exception.Create('Не открыта запись в Com порт');
 if WriteFile(hFile, Buffer, Size, Sended, nil) then
 begin
 Result := Sended;
 end
 else
 raise Exception.Create('Ошибка передачи данных: ' + IntToStr(GetLastError));
end;
function TComPort.ClearInputCom: Boolean;
begin
 if hFile = INVALID_HANDLE_VALUE then
 raise Exception.Create('Не открыта запись в Com порт');
 Result := PurgeComm(hFile, PURGE_RXCLEAR);
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 01349
Потеря памяти

=== Потеря памяти ===
Если Ваша программа после завершения "съест" некоторое количество памяти, Windows тактично об этом умолчит, и ошибка останется не найденной. Поэтому я рекомендую на этапе разработки, в файл проекта вставлять модуль checkMem, который отследит некорректную работу с памятью. Вставлять его нужно первым, для обеспечения чистоты эксперимента. Текст модуля: 
unit checkMem; 
interface
implementation
uses sysUtils, dialogs;
var HPs: THeapStatus;
var HPe: THeapStatus;
var lost: integer;
initialization
 HPs := getHeapStatus;
finalization
 HPe := getHeapStatus;
 Lost:= HPe.TotalAllocated - HPs.TotalAllocated;
 if lost > 0 then
 begin
 beep;
 ShowMessage( format('lostMem: %d',[ lost ]) );
 end;
end.
Author: http://sunsb.dax.ru 
Source: http://delphiworld.narod.ru
ID: 00827
Поток с доступом к глобальной переменной основной программы

=== Поток с доступом к глобальной переменной основной программы ===
unit Main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TMainForm = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 MainForm: TMainForm;
implementation
{$R *.DFM}
{ NOTE: Change GlobalStr from var to threadvar to see difference }
var
 //threadvar
 GlobalStr: string;
type
 TTLSThread = class(TThread)
 private
 FNewStr: string;
 protected
 procedure Execute; override;
 public
 constructor Create(const ANewStr: string);
 end;
procedure SetShowStr(const S: string);
begin
 if S = then
 MessageBox(0, PChar(GlobalStr), 'The string is...', MB_OK)
 else
 GlobalStr := S;
end;
constructor TTLSThread.Create(const ANewStr: string);
begin
 FNewStr := ANewStr;
 inherited Create(False);
end;
procedure TTLSThread.Execute;
begin
 FreeOnTerminate := True;
 SetShowStr(FNewStr);
 SetShowStr();
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
 SetShowStr('Hello world');
 SetShowStr();
 TTLSThread.Create('Dilbert');
 Sleep(100);
 SetShowStr();
end;
end.
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00307
Поточность TreeView

=== Поточность TreeView ===
На пустой форме у меня располагается TTreeView. Затем я сохраняю это в файле, используя WriteComponent. Это работает как положено; я могу из DOS c помощью команды "type" посмотреть двоичный файл и увидеть его содержимое, типа строк TTreeView и имя объекта. По крайней мере файл записывается и создается впечатление его "наполненности". 
Затем я освобождаю компонент TTreeView, открываю поток, делаю ReadComponent и, затем, InsertControl. И получаю исключение "TreeView1 has no parent window" (TreeView1 не имеет родительского окна). 
Это происходит из-за того, что при установке определенных свойств TreeView требуется дескриптор окна элемента управления, а для этого необходимо иметь родителя. Решение заключается в создании пустого TreeView и передаче его в качестве параметра ReadComponent - вы наверняка меня спросите, почему ReadComponent необходим параметр, правильно? Смотрите дальше. 
Попробуйте этот код:
procedure TForm1.Button1Click(Sender: TObject);
var 
 TreeView: TTreeView;
begin
 with TFileStream.Create('JUNK.STR', fmCreate) do 
 try
 WriteComponent(TreeView1) ;
 TreeView1.Name := 'TreeView';
 Position := 0 ;
 TreeView := TTreeView.Create(Self);
 TreeView.Visible := false;
 TreeView.Parent := Self;
 ReadComponent(TreeView);
 TreeView.Top := TreeView1.Top + TreeView1.Height + 10;
 TreeView.Visible := true;
 finally
 Free;
 end;
end;
Два небольших замечания: 
Убедитесь в отсутствии конфликта имен. Данный код делает форму владельцем второго TreeView и при ее освобождении разрушает компонент. Я просто переименовываю существующий TreeView перед загрузкой 'клона'. 
Я установил свойство visible в false перед установкой свойства parent, этим я предотвратил показ только что созданного TreeView до момента загрузки его из потока.
Source: http://delphiworld.narod.ru/
ID: 01122
Почему DB2 ругается на Create Trigger

=== Почему DB2 ругается на Create Trigger ===
Я тут писал по поводу того, что у меня не работали триггеры. Все дело оказалось в правиле написания команды "create trigger". Если все остальные команды корректно воспринимаются на любом регистре, то эта - только набранная одними большими буквами.
Source: Взято с http://delphiworld.narod.ru
ID: 02976
Category:Базы данных
Category:DB2
Почему IB работает неустойчиво на NetWare 4.x?

=== Почему IB работает неустойчиво на NetWare 4.x? ===
Для NetWare 4.x нужно использовать IB 4.2.2. Предыдущие версии IB for Netware сертифицированы только для NetWare 3.11/3.12.
Для NetWare 5.x выпущена версия IB 5.6. Также нужно знать, что ни Interbase 6 ни Firebird не выпускаются и не будут выпускаться для Netware.
Author: Дмитрий Кузьменко (http://www.ibase.ru)
ID: 02900
Category:Базы данных
Category:Interbase
Почему MDI Child форма при закрывании просто минимизируется?

=== Почему MDI Child форма при закрывании просто минимизируется? ===
Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть
Source: Взято с http://delphiworld.narod.ru
ID: 00491
Почему в операторе SELECT для VIEW нельзя использовать ORDER BY?

=== Почему в операторе SELECT для VIEW нельзя использовать ORDER BY? ===
Вообще независимо от наличия индексов записи в таблице располагаются в том порядке, в котором они добавлялись. Поскольку view представляет из себя "виртуальную" таблицу, то записи также должны быть представлены в произвольном порядке.
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02886
Category:Базы данных
Category:Interbase
Почему возникает deadlock?

=== Почему возникает deadlock? ===
Перекрестная блокировка (deadlock) двух транзакций возникает при изменении одних и тех же записей в разном порядке.
Последовательность действий, приводящая к перекрестной блокировке:
# Транзакция A изменяет запись X. Заблокирована X.
# Транзакция B изменяет запись Y. Заблокирована Y.
# Транзакция A пытается изменить запись Y. Остановлена A.
# Транзакция B пытается изменить запись X. Остановлена B.
Сервер определяет перекрестную блокировку и откатывает одну из транзакций, возвращая ошибку соответствующему соединению.
Аминь.
Чтобы не выводить ошибку пользователю, обломанное соединение должно молча повторить транзакцию.
Source: http://delphiworld.narod.ru/
ID: 02430
Почему возникает ошибка Access Violation?

=== Почему возникает ошибка Access Violation? ===
Ошибка "Access Violation" возникает, когда идёт обращение к памяти к которой обращение запрещено. Это возможно во многих случаях, но наиболее типичные ситуации я попытаюсь перечислить:
==== Обращение к не созданному объекту ====
var 
 e: TEdit;
begin
 e.text := 'Hello world!';
end;
В данном случае объект e ещё не создан и идёт обращение к памяти, которая ещё не выделена. 
==== Обращение к уже разрушенному объекту ====
var
 e: TEdit;
begin
 ...
 e.free();
 ...
 e.text := 'Hello world';
end;
Тут есть хитрость, допустим вы хотите проверить есть ли объект и модернизируете код:
if e <> nil then
 e.text := 'Hello world!';
или 
if Assigned(e) then
 e.text := 'Hello world!';
Особенно часто приходится такое делать когда надо уничтожить объект:
if e <> nil then
 e.free();
Так вот - такой код может быть источником ошибки, так как метод Free автоматически не устанавливает указатель в Nil. Обязательно после каждого Free используйте установление указателя в nil:
e.free();
e := nil;
==== При выходе за границы динамического массива ====
При выходе за границы динамического массива обычно генерится ошибка "Index out of bound", но возможно и возникновение Access Violation, особенно когда не стоят опции компиляции для проверки границ массивов. Эта ошибка может быть очень сложна в отлаживании - дело в том что допустим у вас есть массив а длиной в 10 элементов, в пишете:
a[20] := something;
И эта строка может пройти как и надо, без всяких проблем, но её выполнение повредит какой-то другой код, причём каждый раз другой! Теперь самая безобидная операция типа i := 10 может вдруг внезапно дать Access Violation.
==== OnCreate и OnDestroy ====
* На форме на onCreate вызывается что-то с других форм - эти другие формы на этот момент еще не созданы
* На форме на onDestroy вызывается что-то с других форм - эти другие формы на этот момент уже разрушены
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: http://forum.vingrad.ru
ID: 00020
Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

Так работает большинство графических систем, включая Windows. Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите нарисовать линию с последним пикселом включительно просто добавьте единицу к координатам.
ID: 03740
Category:Графика
Category:Рисование
Почему не всегда верно обновляются IndexDefs по Update

=== Почему не всегда верно обновляются IndexDefs по Update ===
Ошибка в VCL.
А помогает добавление
 FUpdated := False;
в теле процедуры TIndexDefs.Update 
Или убиением владельца через Free, и пересозданием.
Author: Nomadic
Source: http://delphiworld.narod.ru/
ID: 02438
ID: 02631
Почему таблица или select показывается в Grid быстро, а перемещение в конец таблицы происходит долго?

=== Почему таблица или select показывается в Grid быстро, а перемещение в конец таблицы происходит долго? ===
Когда вы открываете набор данных при помощи TTable, BDE производит fetch только такого количества записей, которые помещаются в Grid. Если вы захотели переместиться в конец таблицы, то для большинства SQL-серверов возможно перемещение по записям только вперед - т.е. если вам потребуется поместить указатель в середину таблицы то BDE пришлось-бы заново перечитывать записи с ее начала. Причина такой работы в том, что SQL-серверы в большинстве возвращают результаты запросов в виде последовательных наборов записей. В навигационных БД напротив, возможно физическое позиционирование на любую запись таблицы.
Если SQL-сервер поддерживает двунаправленные скроллируемые курсоры, то полное кэширование записей запроса выполняться BDE не будет.
Кроме этого, TTable и TQuery работают по разному. TQuery при перемещении в конец таблицы действительно сделает выборку всех записей, т.к. он и не может иначе - для выполнения задано конкретное SQL-выражение.
TTable-же напротив, показывает всю таблицу, и запросы для получения содержимого таблицы формируются автоматически. Поэтому TTable при нажатии вами в TDBGrid клавиш Ctrl-End сформирует запрос типа
SELECT * FROM TABLE ORDER BY INDEXFIELD DESC
и покажет только видимые в DBGrid записи "с конца". При этом, если нет DESC индекса по полю INDEXFIELD, сортировка данных (ORDER BY) будет производиться на диске. И чем больше записей в таблице, тем дольше. Для того, чтобы перемещение по Ctrl-End для TTable происходило быстро, нужно создать DESC индекс по полю сортировки. В этом случае операцию перехода в конец таблицы TTable выполнит практически мгновенно. Пользователи Delphi C/S могут посмотреть операторы, выдаваемые TTable SQL-серверу при помощи SQL Monitor.
Более подробно на эту тему см. документ http://www.ibase.ru/devinfo/bde.htm
 Borland Interbase / Firebird FAQ
 Borland Interbase / Firebird Q&A, версия 2.02 от 31 мая 1999
 последняя редакция от 17 ноября 1999 года.
 Часто задаваемые вопросы и ответы по Borland Interbase / Firebird
 Материал подготовлен в Демо-центре клиент-серверных технологий. (Epsylon Technologies)
 Материал не является официальной информацией компании Borland.
 E-mail mailto:delphi@demo.ru
 www: http://www.ibase.ru/
 Телефоны: 953-13-34
 источники: Borland International, Борланд АО, релиз Interbase 4.0, 4.1, 4.2, 5.0, 5.1, 5.5, 5.6, различные источники на WWW-серверах, текущая переписка, московский семинар по Delphi и конференции, листсервер ESUNIX1, листсервер mers.com.
 Cоставитель: Дмитрий Кузьменко
ID: 02556
Category:Базы данных
Category:Interbase
Почему такие большие программы сделанные в Дельфи?

Это плата за визуальность и объектность. Простая форма, это не так просто как кажется. Код простой формы включает в себя:
:1) Обработчик событий от Windows
:2) Базовые классы оконного приложения: TApplication, TMouse, TScreen и т.д.
:3) Весь класс TForm + все его предки + все используемые им классы.
и многое другое.
Зачем это нужно? Ну например ты не используешь метод формы "Close", зачем его реализацию совать в код? Да затем что логика в том, что чужое приложение может послать сообщение твоему окну и инициализировать работу этого метода. Или допустим ты не пользуешь какое-нибудь свойство или метод - но его можно передать в твое приложение как строку и инициализировать их использование. Т.е. на этапе компиляции компилятор совершенно не имеет понятия какие из методов объектов ты будешь использовать. Ты даже можешь использовать методы родительских классов формы и компилятор не будет знать об этом - логика программы может "решить" их использовать по ходу дела, при определенных обстоятельствах. Так например работают многие русификаторы - в файле национальных установок прописаны свойства компонентов, и эти свойства при выполнении программы используются. При написании программы программист "разрешает" изменять любые свойства любых объектов и это реализовано. Таким образом компилятор вынужден загружать всю библиотеку, вместе с реализацией методов которые вообще никогда не будут реализованы.
Кстати если вы поставите на форму несколько контролов и откомпилируете, затем добавите еще сотню контролов, то код вырастет не на много - на пару килобайт. Т.е. раз будучи прикомпилированной библиотека теперь будет использоваться и размер программы расти будет медленно.
Можно писать на чистом WinAPI тогда программы на Дельфи будут компактными, но тогда прощай визуальная обработка - все руками.
PS. Многие среды создают видимость компактного кода - например VB - дает небольшие программы за счет того что использует огромную библиотеку VBRunxx.DLL. А MS VC++ зачастую требует библиотеку MFC. На Дельфи можно сделать тоже - в опциях проекта есть возможность компилировать с пакетами - тогда библиотеки будут поставляться в виде отдельных файлов BPL - а сама программа будет маленькой. Если вы например поставляете 10 программ - то так и надо сделать - тогда все библиотеки будут храниться только в одном экземпляре, и программы будут очень небольшими. Если программа одна, то понятное дело что этим вы ничего не сэкономите.
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04525
Category:Разработка приложений
Category:Оптимизация и отладка
Права доступа NTFS

=== Права доступа NTFS ===
uses ..., Aclapi, AccCtrl;
function SetFileAccessRights(AFile, AUser: String; AMask: DWORD): Boolean;
var
 psd : PSECURITY_DESCRIPTOR;
 dwSize, dwError : DWord;
 bDaclPresent : Bool;
 bDaclDefaulted : Bool;
 OldAcl : PACL;
 NewAcl : PACL;
 sd : SECURITY_DESCRIPTOR;
 ea : EXPLICIT_ACCESS;
begin
 Result := False;
 if WIN32Platform <> VER_PLATFORM_WIN32_NT then Exit;
 psd := nil;
 NewAcl := nil;
 bDaclDefaulted := True;
 if not GetFileSecurity(PChar(AFile), DACL_SECURITY_INFORMATION, Pointer(1),
 0, dwSize) and (GetLastError = ERROR_INSUFFICIENT_BUFFER)
 then
 try
 psd := HeapAlloc(GetProcessHeap, 8, dwSize);
 if psd <> nil then
 begin
 BuildExplicitAccessWithName(@ea, PChar(AUser), AMask,
 SET_ACCESS, SUB_CONTAINERS_AND_OBJECTS_INHERIT{NO_INHERITANCE});
 Result := GetFileSecurity(PChar(AFile), DACL_SECURITY_INFORMATION, psd, dwSize, dwSize) and
 GetSecurityDescriptorDacl(psd, bDaclPresent, OldAcl, bDaclDefaulted) and
 (SetEntriesInAcl(1, @ea, OldAcl, NewAcl) = ERROR_SUCCESS) and
 InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION) and
 SetSecurityDescriptorDacl(@sd, True, NewAcl, False) and
 SetFileSecurity(PChar(AFile), DACL_SECURITY_INFORMATION, @sd);
 end;
 finally
 if NewAcl <> nil then LocalFree(HLocal(NewAcl));
 if psd <> nil then HeapFree(GetProcessHeap, 0, psd);
 end;
end;
Параметры: путь к объекту, имя пользователя, маска доступа, ее расчитываешь вот так: http://msdn.microsoft.com/library/default....access_mask.asp
Author: Александр (Rouse_) Багель
Source: Взято из http://forum.sources.ru
ID: 03119
Category:Файловая система
Правила для SetRange

=== Правила для SetRange ===
Я, похоже, обнаружил неплохое решение ранжирования данных - вам необходимо только установить различные начальный и конечный диапазоны последнего поля, определенного вашим индексом, после чего введенное в любое поле индекса значение будет проигнорировано. Также вы не сможете покинуть ранжируемое поле, если редактируемая запись пуста.
Попытаюсь изложить все попроще... Скажем, у меня есть индекс Field1; Field2; Field3, затем;
SetRangeStart;
Table1Field1.Value := x1;
Table1Field2.Value := y1;
Table1Field3.Value := z1;
SetRangeEnd;
Table1Field1.Value := x2;
Table1Field2.Value := y2;
Table1Field3.Value := z2;
ApplyRange;
Правила...
* x1 должен равняться x2, если y или z определен
* y1 должен равняться y2, если z определен
* x должен быть определен, если y или z определены
* y должен быть определен, если x определен
* если x1 = x2 и никаких других критериев не определено, тогда y1 и y2 должны быть соответственно min/max значениями y
* если x1 = x2 и y1 = y2 и никаких других критериев не определено, тогда z1 и z2 должны быть соответственно min/max значениями z
Я не знаю, поняли вы это или нет, но надеюсь это поможет...
Source: Взято с http://delphiworld.narod.ru
ID: 02638
Правильные диалоги от Борланда

=== Правильные диалоги от Борланда ===
Если покопаться в фирменных "Дельфовых" примерах, можно найти ГОРАЗДО более удачную конструкцию (которую, кстати, я уже давно использую). 
Еще раз подчеркну - это не моя придумка, а ребят из Борланда.
Эта конструкция позволяет: 
* Возвращать ЛЮБЫЕ значения; 
* ДИНАМИЧЕСКИ создавать форму; 
* Еще куча всяких "бонусов", просто лень описывать :-)
Итак, смотрим исходники...В этом примере я привел два наиболее типичных случая. 1-й - InputString - просто ввод, без анализа отмены, второй - MrInputString - с анализом отмены ввода (ModalResult). Оба случая используют начальные значения. Без них - Еще проще... В принципе - ваша фантазия ничем не ограничивается. Я, например, храню последние вводившиеся значения в реестре и читаю их оттуда после создания формы. Удобно. Пользователь не мается вводя по 10 раз одно и то же, а у меня не болит голова с инициализацией полей (есть специальный класс, который этим занимается, но это отдельная тема...) 
ИСХОДНИКИ: 
//**************************************************************
// Основной модуль Обратите Внимание! "uses Dialog;"
implementation
{$R *.dfm}
uses
 Dialog;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
 ShowMessage('Вы ввели '+InputString('Начальное значение'));
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var
 Str: String;
begin
 Str := 'Начальное значение';
 If MrInputString(Str) = mrOk Then
 ShowMessage('Вы ввели ' + Str)
 Else
 ShowMessage('Вы отменили ввод');
end;
//********************************************************
//Модуль диалога
unit Dialog;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, Buttons;
type
 TOptionsDlg = class(TForm)
 Bevel1: TBevel;
 BitBtn1: TBitBtn;
 BitBtn2: TBitBtn;
 Edit1: TEdit;
 Label1: TLabel;
 Bevel2: TBevel;
 Label3: TLabel;
 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 OptionsDlg: TOptionsDlg;
function InputString(BeginVal: String): String;
function MrInputString(var Str: String): TModalResult;
implementation
{$R *.dfm}
function InputString(BeginVal: String): String;
begin
 with TOptionsDlg.Create(Application.MainForm) do
 try
 Edit1.Text := BeginVal;
 if ShowModal = mrOk then
 Result := Edit1.Text
 else
 Result := '"Отмена"';
 finally
 Free;
 end;
end;
function MrInputString(var Str: String): TModalResult;
begin
 with TOptionsDlg.Create(Application.MainForm) do
 try
 Edit1.Text := Str;
 Result := ShowModal;
 Str := Edit1.Text;
 finally
 Free;
 end;
end;
procedure TOptionsDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 case Key of
 27: ModalResult := mrCancel;
 13: ModalResult := mrOk;
 end;
end;
end.
Author: Сергей Горбань
Source: http://www.delphikingdom.com
ID: 01224