nyuuzyou/wikis huggingface dataset:
Справочник по функциям работы с PChar

=== Справочник по функциям работы с PChar ===
function StrLIComp(Strl, Str2: PChar; MaxLen: Cardinal): Integer; // Работает как StrLComp, но без учета регистра символов. 
function StrScan(const Str: PChar; Chr: Char): PChar; // Отыскивает первое вхождение символа Chr в строку Str и возвращает указатель на него или nil в случае отсутствия. 
function StrRScan(const Str: PChar; Chr: Char): PChar; // Работает как StrScan, но отыскивается последнее вхождение Chr. 
function StrPos(Strl, Str2: PChar): PChar; // Отыскивает первое вхождение строки Str2 в строку Strl и возвращает указатель на нее или nil в случае отсутствия.
function StrUpper(Str: PChar): PChar; // Преобразует строку к верхнему регистру.
function StrLower(Str: PChar): PChar; // Преобразует строку к нижнему регистру. 
function StrPas(const Str: PChar): String; // Преобразует строку Str в строку типа string. 
function StrAlloc(Size: Cardinal): PChar; // Размещает в куче памяти новую строку размером Size и возвращает указатель на нее. 
function StrBufSize(Str: PChar): Cardinal; // Возвращает размер блока памяти, выделенного для строки при помощи функции StrAlloc. 
function StrNew(const Str: PChar): PChar; // Размещает в куче памяти копию строки Str и возвращает указатель на нее. 
procedure StrDispose(Str: PChar); // Уничтожает строку, размещенную при помощи StrAlloc или StrNew. 
function StrLen(const Str: PChar): // Возвращает число символов в строке Str (без учета завершающего нулевого). 
function StrEnd(const Str: PChar): PChar; // Возвращает указатель на завершающий нулевой символ строки Str. 
function StrMove(Dest, Source: PChar; Count: Cardinal): PChar; // Копирует из строки Source в строку Dest ровно Count символов, причем строки могут перекрываться.
function StrCopy(Dest, Source: PChar): PChar; // Копирует Source в Dest и возвращает указатель на Dest.
function StrECopy(Dest, Source: PChar): PChar; // Копирует Source в Dest и возвращает указатель на завершающий символ Dest.
function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar; // Работает как StrCopy, но копирует не более MaxLen символов.
function StrPCopy(Dest: PChar; const Source: String): PChar; // Копирует строку Source (типа string) в Dest и возвращает указатель на Dest.
function StrPLCopy(Dest: PChar; const Source: string; MaxLen: Cardinal): PChar; // Работает как StrPCopy, но копирует не более MaxLen символов.
function StrCat(Dest, Source: PChar): PChar; // Дописывает Source к концу Dest и возвращает указатель на Dest. 
function StrLCat(Dest PChar; const Source: PChar; MaxLen: Cardinal): PChar; // Работает как StrCat, но копирует не более MaxLen-StrLen(Dest) символов.
function StrComp(Strl, Str2: PChar): Integer; // Сравнивает две строки (посимвольно). Возвращает значение: <0 - при Strl<Str2, 0 - при Strl=Str2, >0 - при Strl>Str2. 
function StrIComp(Strl, Str2: PChar): Integer; // Работает как StrComp, но без учета регистра символов.
function StrLComp(Strl, Str2: PChar; MaxLen: Cardinal): Integer; // Работает как StrComp, но сравнение происходит на протяжении не более чем MaxLen символов. 
ID: 00133
Category:Справочники
Справочник по функциям работы со строками

=== Справочник по функциям работы со строками ===
function NewStr(const S: String): PString; // Создает копию строки S и возвращает указатель на нее. 
procedure DisposeStr(P: PString); // Уничтожает строку, на которую указывает Р. 
procedure AssignStr(var P: PString; const S: strings); // Уничтожает строку, на которую указывает Р и затем присваивает ему адрес созданной копии строки S. 
procedure AppendStr(var Dest: string; const S: string); // Добавляет строку S в конец строки Dest. 
function UpperCase(const S: string): string; // Преобразует символы 'a'..'z' в строке S к верхнему регистру.
function LowerCase(const S: string): string; // Преобразует символы 'A'..'Z' в строке S к нижнему регистру.
function CompareStr(const SI, S2: string): Integer; // Сравнивает две строки S1 и S2 с учетом регистра символов. Возвращаемое значение равно 0 в случае равенства строк или разности кодов пары первых несовпадающих символов.
function CompareText(const SI, S2: string): Integer; // Сравнивает две строки без учета регистра символов. 
function AnsiUpperCase(const S: string): string; // Преобразует символы в строке к верхнему регистру с учетом языкового драйвера.
function AnsiLowerCase(const S: string): string; // Преобразует символы в строке к нижнему регистру с учетом языкового драйвера.
function AnsiCompareStr(const SI, S2: string): Integer; // Сравнивает две строки с использованием языкового драйвера и с учетом регистра символов. 
function AnsiCompareText(const SI, S2: string): Integer; // Сравнивает две строки с использованием языкового драйвера и без учета регистра символов. 
function IsValidldent(const Ident: string): Boolean; // Возвращает True, если строка Ident может служить идентификатором в программе на Object Pascal (т. е. содержит только буквы и цифры, причем первый символ - буква). 
function IntToStr(Value: Longint): string; // Преобразует целое число в строку.
function IntToHex(Value: Longint; Digits: Integer): string; // Преобразует целое число в строку с его шестнадцатиричным представлением. 
function StrToInt(const S: string): Longint; // Преобразует строку в целое число. При ошибке возникает исключительная ситуация EConvertError. 
function StrToIntDef(const S: string; Default; Longint): Longint; // Работает как StrToInt, но при ошибке возвращает значение Default.
function LoadStr(Ident: Word): string; // Загружает строку с индексом Ident из ресурсов приложения. 
function FmtLoadStr(Ident: Word; const Args: array of const): string; // Загружает строку с индексом Ident из ресурсов приложения с форматированием (см. описание функции Format). 
ID: 00132
Category:Справочники
Спрятать горизонтальную или вертикальную полосу прокрутки в TListView

=== Спрятать горизонтальную или вертикальную полосу прокрутки в TListView ===
type
 TForm1 = class(TForm)
 ListView1: TListView;
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 FListViewWndProc: TWndMethod;
 procedure ListViewWndProc(var Msg: TMessage);
 public
 { Private declarations }
 FShowHoriz: Boolean;
 FShowVert: Boolean;
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ListViewWndProc(var Msg: TMessage);
begin
 ShowScrollBar(ListView1.Handle, SB_HORZ, FShowHoriz);
 ShowScrollBar(ListView1.Handle, SB_VERT, FShowVert);
 FListViewWndProc(Msg); // process message 
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 FShowHoriz := True; // show the horiz scrollbar 
 FShowVert := False; // hide vert scrollbar 
 FListViewWndProc := ListView1.WindowProc; // save old window proc 
 ListView1.WindowProc := ListViewWndProc; // subclass 
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 ListView1.WindowProc := FListViewWndProc; // restore window proc 
 FListViewWndProc := nil;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01150
Сравнение картинок

procedure TForm1.Button1Click(Sender: TObject);
var
 b1, b2: TBitmap;
 c1, c2: PByte;
 x, y, i,
 different: Integer; // Counter for different pixels
begin
 b1 := Image1.Picture.Bitmap;
 b2 := Image2.Picture.Bitmap;
 Assert(b1.PixelFormat = b2.PixelFormat); // they have to be equal
 different := 0;
 for y := 0 to b1.Height - 1 do
 begin
 c1 := b1.Scanline[y];
 c2 := b2.Scanline[y];
 for x := 0 to b1.Width - 1 do
 for i := 0 to BytesPerPixel - 1 do // 1, to 4, dep. on pixelformat
 begin
 Inc(different, Integer(c1^ <> c2^));
 Inc(c1);
 Inc(c2);
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch
ID: 03786
Category:Графика
Category:Bitmap
Сравнить быстродействие алгоритмов

=== Сравнить быстродействие алгоритмов ===
Если вас сколько-нибудь интересует скорость работы вашей программы, то нужно смерить скорость алгоритмов и сравнивать их. Здесь я привожу пример, сравнивающий четыре способа возведения 2 в степень 30. 
uses Math;
procedure TForm1.Button1Click(Sender: TObject);
var
 Res, Exponent: integer;
 Res1: real;
 t, i: integer;
begin
 Exponent := 30;
 Application.ProcessMessages;
 t := GetTickCount;
 for i := 1 to 1000000 do
 Res := 1 shl Exponent;
 Form1.Caption := Form1.Caption + ' ' +
 IntToStr(GetTickCount - t);
 Application.ProcessMessages;
 t := GetTickCount;
 for i := 1 to 1000000 do
 Res1 := LdExp(1, Exponent);
 Form1.Caption := Form1.Caption + ' ' +
 IntToStr(GetTickCount - t);
 Application.ProcessMessages;
 t := GetTickCount;
 for i := 1 to 1000000 do
 Res1 := IntPower(2, Exponent);
 Form1.Caption := Form1.Caption + ' ' +
 IntToStr(GetTickCount - t);
 Application.ProcessMessages;
 t := GetTickCount;
 for i := 1 to 1000000 do
 Res1 := Power(2, Exponent);
 Form1.Caption := Form1.Caption + ' ' +
 IntToStr(GetTickCount - t);
end; 
Source: http://delphiworld.narod.ru
ID: 00772
Ссылки на сайты по Дельфи

== Ссылки на сайты по Дельфи ==
* http://www.forum.vingrad.ru/ - программистский портал с большим разделом Дельфи
* http://www.sources.ru - программистский портал с большим разделом Дельфи
* http://www.borland.com.ru/delphi/index.htm - Borland Russia 
На сервере новости для разработчиков ПО на Delphi. Полное описание свойств Delphi 4. Полезные ссылки на ресурсы Delphi в Интернет. "Лидер на рынке RAD-инструментов" и "Delphi снова побеждает!" - это лозунги с этого сайта.
* http://www.torry.net - Torry's Delphi Pages
Сайт для программистов на Delphi. На сайте документация, компоненты, приложения, разработанные на Delphi, примеры программных кодов, файлы для загрузки, новости и ссылки на ресурсы Delphi в Интернет. Самая большая коллекция компонентов
* http://www.delphikingdom.com - 'Королевство Дельфи' - Виртуальный клуб программистов. Сайт для программистов пишущих на Delphi, организация взаимопомощи и общение программистов на тему задач на Delphi
* http://www.delphimaster.ru/ - Мастера Дельфи. Большое количество статей и материалов.
* http://www.freepascal.ru/article/ - Статьи на FreePascal.ru
* Программирование Delphi
* http://delphibaza.ru/article/section_main.html - Статьи, примеры кода и готовых приложений
* https://www.gunsmoker.ru - блог опытного разработчика, много хороших статей
* http://compgraph.tpu.ru - много статей по компьютерной графике, ссылки на дополнительные материалы
* http://beluch.ru/progr/100comp.htm - Книга "100 компонентов Delphi" и другие материалы
* http://msk.edu.ua/ivk/Informatika/Uch_posobiya/Programmirovanie/ - набор документации по Delphi и Lazarus
== Руководства для начинающих ==
* Краткое введение в современный Object Pascal для программистов
* Онлайн учебник по Delphi 7
* Многопоточное программирование в Delphi для начинающих
* Графика в DirectX, Графика для Windows средствами DirectDraw
* Заповеди молодого разработчика Delphi 
== Хорошие статьи ==
* Многопоточность - как это делается в Дельфи. Не используйте потоки, не прочитав это 
* Многопоточность - как это делается в Дельфи. вариант с картинками
* Конвертация VCL-приложения в Lazarus много нюансов портирования на Linux
== Сайты на английском языке ==
* http://www.sulaco.co.za - много обучающих примеров по OpenGL для Delphi и Lazarus
Статическая и динамическая загрузка DLL

=== Статическая и динамическая загрузка DLL ===
DLL возможно загружать двумя способами:
* статически
* динамически
Давайте создадим простую библиотеку DLL:
Project file name: c:\example\exdouble\exdouble.dpr 
library ExDouble; 
// my simple dll 
function calc_double(r: Real): Real; stdcall; 
begin 
 Result := r * 2; 
end; 
exports 
 calc_double index 1; 
end;
Теперь посмотрим, как её можно загружать:
==== СТАТИЧЕСКАЯ ЗАГРУЗКА DLL ====
При таком способе загрузки достаточно поместить файл DLL в директорию приложения или в директорию Windows, или в Windows\System, Windows\Command. Однако, если система не найдёт этого файла в этих директория, то высветится сообщение об ошибке (DLL не найдена, или что-то в этом духе).
unit untMain; 
interface 
uses 
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 StdCtrls; 
type 
 TForm1 = class(TForm) 
 Button1: TButton; 
 procedure Button1Click(Sender: TObject); 
 private 
 { Private declarations } 
 public 
 { Public declarations } 
 end; 
var 
 Form1: TForm1; 
implementation 
function calc_double(r: Real): Real; stdcall; external 'ExDouble.dll'; 
{$R *.DFM} 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 // в окошке сообщения будет цифра 21
 ShowMessage(FloatToStr(calc_double(10.5))); 
end; 
end. 
==== ДИНАМИЧЕСКАЯ ЗАГРУЗКА DLL ====
При динамической загрузке требуется написать немного больше кода.
А вот как это выглядит:
unit untMain; 
interface 
uses 
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 StdCtrls; 
type 
 Tcalc_double = function(r: Real): Real; 
 TForm1 = class(TForm) 
 Button1: TButton; 
 procedure Button1Click(Sender: TObject); 
 private 
 { Private declarations } 
 public 
 { Public declarations } 
 end; 
var 
 Form1: TForm1; 
implementation 
{$R *.DFM} 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 hndDLLHandle: THandle; 
 calc_double: Tcalc_double; 
begin 
 try 
 // загружаем dll динамически
 hndDLLHandle := LoadLibrary('ExDouble.dll'); 
 if hndDLLHandle <> 0 then
 begin 
 // получаем адрес функции
 @calc_double := GetProcAddress(hndDLLHandle, 'calc_double'); 
 // если адрес функции найден
 if Addr(calc_double) <> nil then
 begin 
 // показываем результат ( 21...) 
 ShowMessage(FloatToStr(calc_double(10.5))); 
 end
 else 
 // Функция 'calc_double' в DLL не найдена 
 ShowMessage('Function not exists...'); 
 end;
 end
 else 
 // DLL не найдена
 ShowMessage('DLL not found...'); 
 finally 
 // liberar 
 FreeLibrary(hndDLLHandle); 
 end; 
end; 
end. 
Source: Взято из http://forum.sources.ru
ID: 01990
Статическая реализация стека на основе массива

При представлении стека в статической памяти для стека выделяется память, как для вектора. В дескрипторе этого вектора кроме обычных для вектора параметров должен находиться также указатель стека - адрес вершины стека. Указатель стека может указывать либо на первый свободный элемент стека, либо на последний записанный в стек элемент. (Все равно, какой из этих двух вариантов выбрать, важно в последствии строго придерживаться его при обработке стека.) В дальнейшем мы будем всегда считать, что указатель стека адресует первый свободный элемент и стек растет в сторону увеличения адресов.
При занесении элемента в стек элемент записывается на место, определяемое указателем стека, затем указатель модифицируется таким образом, чтобы он указывал на следующий свободный элемент (если указатель указывает на последний записанный элемент, то сначала модифицируется указатель, а затем производится запись элемента). Модификация указателя состоит в прибавлении к нему или в вычитании из него единицы (помните, что наш стек растет в сторону увеличения адресов.
Операция исключения элемента состоит в модификации указателя стека (в направлении, обратном модификации при включении) и выборке значения, на которое указывает указатель стека. После выборки слот, в котором размещался выбранный элемент, считается свободным.
Операция очистки стека сводится к записи в указатель стека начального значения - адреса начала выделенной области памяти.
Определение размера стека сводится к вычислению разности указателей: указателя стека и адреса начала области.
Программный модуль, представленный в примере, иллюстрирует операции над стеком, расширяющимся в сторону уменьшения адресов. Указатель стека всегда указывает на первый свободный элемент.
Предполагается, что в модуле будут уточнены определения предельного размера структуры и типа данных для элемента структуры:
{==== Программный пример ====}
{ Стек }
unit Stack;
interface
const
 SIZE = ...; { предельный размер стека }
type
 TData = ...; { элементы могут иметь любой тип }
{ инициализация - на начало }
procedure StackInit;
{ очистка = инициализация }
procedure StackClr;
{ занесение элемента в стек }
function StackPush(a: TData): Boolean;
{ выборка элемента из стека }
function StackPop(var a: TData): Boolean;
{ определение размера }
function StackSize: Integer;
implementation
var
 StA: array [1..SIZE] of TData; { Стек - данные }
 { Указатель на вершину стека, работает на префиксное вычитание }
 top: Integer;
procedure StackInit;
begin
 top := SIZE;
end;
procedure StackClr;
begin
 top := SIZE;
end;
function StackPush(a: TData): Boolean;
begin
 if top = 0 then
 Result := False
 else
 begin { занесение, затем - увеличение указателя }
 StA[top] := a;
 top := top - 1;
 StackPush := True;
 end;
end;
function StackPop(var a: TData): Boolean;
 begin
 if top = SIZE then
 StackPop := False
 else
 begin { указатель увеличивается, затем - выборка }
 top := top + 1;
 a := StA[top];
 StackPop := True;
 end;
end;
function StackSize: Integer;
begin
 StackSize := SIZE - top;
end;
end.
Source: http://algolist.manual.ru
ID: 03961
Category:Алгоритмы
Category:Списки
Стеганография (вшивание информации в рисунки)

// Do the actual encryption of the message inside the picture.
procedure TForm1.btnEncryptClick(Sender: TObject);
var
 x, y, i, j: Integer;
 PixelData: TColor;
 CharMask, CharData: Byte;
begin
 // Assign the original picture to both the target encrypted image
 // and delta image. Also make sure thier resolution is sufficient to
 // indicate the change in the LSB.
 imgTarget.Picture.Assign(imgOrig.Picture);
 imgDelta.Picture.Assign(imgOrig.Picture);
 imgTarget.Picture.Bitmap.PixelFormat := pf32bit;
 imgDelta.Picture.Bitmap.PixelFormat := pf32bit;
 x := 0;
 y := 0;
 // The letter 'c' is identified by the binary representation of '10000011'
 // for each '1' in this number change the current pixel's LSB value.
 with imgTarget.Picture.Bitmap do
 begin
 for i := 1 to Length(sourceMessage.Text) do
 begin
 CharMask := $80;
 // 8 bytes for every letter to be encrypted.
 for j := 1 to 8 do
 begin
 // See if the current byte in the character is either '1' or '0'.
 CharData := Byte(sourceMessage.Text[i]) and CharMask;
 // Data is not zero - change the LSB of the current pixel.
 if (CharData <> 0) then
 begin
 // Xor the LSB value - hence change its value.
 PixelData := Canvas.Pixels[x, y] xor $1;
 // Store the changed pixel color back in the Pixels array.
 Canvas.Pixels[x, y] := PixelData;
 end;
 // Move to the next pixel.
 x := (x + 1) mod Width;
 if (x = 0) then
 begin
 Inc(y);
 end;
 // Move the mask to be applied to the current character to the
 // right, hence will now examine the next bit in the binary
 // representation of the current letter to be encrypted.
 CharMask := CharMask shr 1;
 end;
 end;
 end;
 // Show the difference in the Delta image.
 for y := 0 to imgOrig.Picture.Bitmap.Height -1 do
 for x := 0 to imgOrig.Picture.Bitmap.Width -1 do
 // Check for difference, the difference will show in the LSB of every
 // pixel in the original and target images.
 if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
 imgTarget.Picture.Bitmap.Canvas.Pixels[x, y]) then
 imgDelta.Picture.Bitmap.Canvas.Pixels[x, y] := clYellow;
end;
// Decryption ( by Lemy )
procedure TForm1.btnDecryptClick(Sender: TObject);
var
 x, y: Integer;
 mask, ch: Byte;
begin
 sourceMessage.Clear;
 mask := $80;
 ch := 0;
 for y := 0 to imgOrig.Picture.Bitmap.Height -1 do
 begin
 for x := 0 to imgOrig.Picture.Bitmap.Width -1 do
 begin
 // if the pixel is different then set related bit
 if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
 imgTarget.Picture.Bitmap.Canvas.Pixels[x, y]) then
 ch := ch or mask;
 // shift the bit to the rigtht
 mask := mask shr 1;
 // if the mask is 0 then the dexryption of a char is completed
 // so add to the Text and rest the highest bit
 if mask = 0 Then
 begin
 sourceMessage.Text := sourceMessage.Text + char(ch);
 mask := $80;
 ch := 0;
 end;
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch
ID: 04050
Category:Алгоритмы
Category:Шифрование
Category:Безопасность
Category:Графика
Category:Bitmap
Считать значение REG DWORD из реестра

=== Считать значение REG_DWORD из реестра ===
uses
 Registry;
// Read REG_DWORD
procedure TForm1.Button1Click(Sender: TObject);
var
 Reg: TRegistry;
 RegKey: DWORD;
 Key: string;
begin
 Reg := TRegistry.Create;
 try
 Reg.RootKey := HKEY_USERS;
 Key := '.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Internet Settings\URL History';
 if Reg.OpenKeyReadOnly(Key) then
 begin
 if Reg.ValueExists('DaysToKeep') then
 begin
 RegKey := Reg.ReadInteger('DaysToKeep');
 Reg.CloseKey;
 ShowMessage(IntToStr(RegKey));
 end;
 end;
 finally
 Reg.Free
 end;
end;
// Write REG_DWORD
procedure TForm1.Button2Click(Sender: TObject);
var
 Reg: TRegistry;
 Key: string;
begin
 Reg := TRegistry.Create;
 try
 Reg.RootKey := HKEY_USERS;
 Key := '.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Internet Settings\URL History';
 if Reg.OpenKey(Key, True) then
 begin
 Reg.WriteInteger('DaysToKeep', 20);
 Reg.CloseKey;
 end;
 finally
 Reg.Free
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02295
Сыграть звуковой файл без компонентов

=== Сыграть звуковой файл без компонентов ===
Если Вам не нужен компонент MediaPlayer, а сыграть звук, например, при нажатии на кнопку, нужно, воспользуйтесь функцией PlaySound. Одна из ее возможностей - сыграть wav-файл.
uses MMsystem;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
 PlaySound(PChar(OpenDialog1.FileName), 0, SND_FILENAME);
end;
 Автор советов: Даниил Карапетян
 e-mail: delphi4all@narod.ru
 
 Автор справки: Алексей Денисов
 e-mail: aleksey@sch103.krasnoyarsk.su
ID: 02263
Тpансляция ошибок

=== Трансляция ошибок ===
Делаем ApplyUpdates. Если при insert(update) произошла ошибка (поле null, сработал check, etc.), то BDE всегда говорит "General SQL Error" вместо нормального сообщения об ошибке :-( Без CU все нормально, разумеется. Как бороть этот баг?
Используй нормальную трансляцию ошибок в Application.OnException. Вpоде это.
procedure DBExceptionTranslate(E: EDBEngineError);
function OriginalMessage: string;
var
 I: Integer;
 DBErr: TDBError;
 S: string;
begin
 Result := ;
 for I := 0 to E.ErrorCount - 1 do
 begin
 DBErr := E.Errors[I];
 case DBErr.NativeError of
 -836: { Intebase exception }
 begin
 S := DBErr.Message;
 Result := #13#10 + Copy(S, Pos(#10, S) + 1, Length(S));
 Exit;
 end;
 end;
 S := Trim(DBErr.Message);
 if S <> then
 Result := Result + #13#10 + S;
 end;
end;
begin
 case E.Errors[0].ErrorCode of
 $2204:
 E.Message := LoadStr(SKeyDeleted);
 $271E, $2734:
 E.Message := LoadStr(SInvalidUserName);
 $2815:
 E.Message := LoadStr(SDeadlock);
 $2601:
 E.Message := LoadStr(SKeyViol);
 $2604:
 E.Message := LoadStr(SFKViolation) + OriginalMessage;
 else
 begin
 E.Message := Format(LoadStr(SErrorCodeFmt), [E.Errors[0].ErrorCode]) + OriginalMessage;
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02590