nyuuzyou/wikis huggingface dataset:
Write/read a string to/from the serial port

=== Write/read a string to/from the serial port ===
function OpenCOMPort: Boolean;
var
 DeviceName: array[0..80] of Char;
 ComFile: THandle;
begin
 { First step is to open the communications device for read/write.
 This is achieved using the Win32 'CreateFile' function.
 If it fails, the function returns false. }
 StrPCopy(DeviceName, 'COM1:');
 ComFile := CreateFile(DeviceName,
 GENERIC_READ or GENERIC_WRITE,
 0,
 nil,
 OPEN_EXISTING,
 FILE_ATTRIBUTE_NORMAL,
 0);
 if ComFile = INVALID_HANDLE_VALUE then
 Result := False
 else
 Result := True;
end;
function SetupCOMPort: Boolean;
const
 RxBufferSize = 256;
 TxBufferSize = 256;
var
 DCB: TDCB;
 Config: string;
 CommTimeouts: TCommTimeouts;
begin
 { We assume that the setup to configure the setup works fine.
 Otherwise the function returns false. }
 Result := True;
 if not SetupComm(ComFile, RxBufferSize, TxBufferSize) then
 Result := False;
 if not GetCommState(ComFile, DCB) then
 Result := False;
 Config := 'baud=9600 parity=n data=8 stop=1';
 if not BuildCommDCB(@Config[1], DCB) then
 Result := False;
 if not SetCommState(ComFile, DCB) then
 Result := False;
 with CommTimeouts do
 begin
 ReadIntervalTimeout := 0;
 ReadTotalTimeoutMultiplier := 0;
 ReadTotalTimeoutConstant := 1000;
 WriteTotalTimeoutMultiplier := 0;
 WriteTotalTimeoutConstant := 1000;
 end;
 if not SetCommTimeouts(ComFile, CommTimeouts) then
 Result := False;
end;
{ The following is an example of using the 'WriteFile' function
 to write data to the serial port. }
procedure SendText(s: string);
var
 BytesWritten: DWORD;
begin
 { Add a word-wrap (#13 + #10) to the string }
 s := s + #13 + #10;
 WriteFile(ComFile, s[1], Length(s), BytesWritten, nil);
end;
{ The following is an example of using the 'ReadFile' function to read
 data from the serial port. }
procedure ReadText: string;
var
 d: array[1..80] of Char;
 s: string;
 BytesRead, i: Integer;
begin
 Result := ;
 if not ReadFile(ComFile, d, SizeOf(d), BytesRead, nil) then
 begin
 { Raise an exception }
 end;
 s := ;
 for i := 1 to BytesRead do s := s + d[I];
 Result := s;
end;
procedure CloseCOMPort;
begin
 // finally close the COM Port!
 CloseHandle(ComFile);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01353
XLS в TStringGrid

=== XLS ---> TStringGrid ===
function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
 xlCellTypeLastCell = $0000000B;
var
 XLApp, Sheet: OLEVariant;
 RangeMatrix: Variant;
 x, y, k, r: Integer;
begin
 Result := False;
 XLApp := CreateOleObject('Excel.Application');
 try
 Screen.Cursor := crAppStart;
 XLApp.Visible := False;
 XLApp.Workbooks.Open(AXLSFile);
 Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
 Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
 x := XLApp.ActiveCell.Row;
 y := XLApp.ActiveCell.Column;
 AGrid.RowCount := x;
 AGrid.ColCount := y; 
 RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
 k := 1;
 repeat
 for r := 1 to y do
 AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
 Inc(k, 1);
 AGrid.RowCount := k + 1; 
 until k > x; 
 RangeMatrix := Unassigned;
 finally
 if not VarIsEmpty(XLApp) then
 begin 
 XLApp.Quit; 
 XLAPP := Unassigned; 
 Sheet := Unassigned; 
 Result := True; 
 end; 
 Screen.Cursor := crDefault;
 end;
end;
Author: Kostas
Source: Взято из http://forum.sources.ru
ID: 00617
Автозаполнение формы для нового письма

А вот пример автозаполнения формы для нового письма в почтовой программе установленной по умолчанию:
uses shellapi;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShellExecute(handle,
 'Open',
 'mailto:someone@somewhere.ru?subject=Regarding your advice&Body=First%20Line%0D%0ASecond%20line&CC=somebodyelse@somewhere.ru',
 nil, nil, SW_RESTORE);
end;
Немного пояснений:
:1) Пробелы в тексте желательно заполнять сочетанием %20
:2) Конец строки обозначать как %0D%0A
:3) Поля отделять друг от друга символом &
Author: Vit
Source: Vingrad.ru http://forum.vingrad.ru
ID: 03401
Category:Связь
Category:Электронная почта
Автоматический logon к локальной InterBase

=== Автоматический logon к локальной InterBase ===
Используйте компонент TDatabase. В строках Params пропишите:
 USER NAME=sysdba
 PASSWORD=masterkey
Затем установите свойство компонента TDataBase LoginPrompt в False.
После этого, с помощью свойства DataBaseName, вы должны создать прикладной псевдоним (Alias) и связать TQuery/TTable с вашим компонентом TDataBase
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02883
Category:Базы данных
Category:Interbase
Автоматический формат даты в компоненте Edit

=== Автоматический формат даты в компоненте Edit ===
procedure TForm1.Edit1Exit(Sender: TObject);
begin
 if Edit1.Text <> then
 begin
 try
 StrToDate(Edit1.Text);
 except
 Edit1.SetFocus;
 MessageBeep(0);
 raise Exception.Create('"' + Edit1.Text
 + '" - некорректная дата');
 end;
 Edit1.Text := DateToStr(StrToDate(Edit1.Text));
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 00984
Активизация и использование в IDE окна CPU

=== Активизация и использование в IDE окна CPU ===
Предупреждение: Окно CPU еще до конца не оттестировано и может иногда приводить к ошибкам. Если у вас есть проблемы с отладчиком, или при запуске вашей программы вы не можете им воспользоваться, окно CPU может помочь решить ваши проблемы. Обычно его не требуется включать, если только у вас не "особый случай". 
В Delphi 2 эта характеристика встроена, но по умолчанию выключена, называется это окно CPU window, или DisassemblyView. Она легка в использовании, может быть полезной в отладке и сравнении кода при его оптимизации. 
Для активизации этой характеристики, запустите REGEDIT и отредактируйте регистры описанным ниже образом. Найдите ключ 
 HKEY_CURRENT_USER\Software\Borland\Delphi\2.0\Debugging. 
Создайте по этому пути строковый ключ с именем "ENABLECPU". Значение нового ключа должно быть строкой "1". Это все. Теперь в Delphi IDE появился новый пункт меню View|CPUWindow. При его активизации выводится новое окно. 
Теперь, чтобы понять какое мощное средство оказалось в ваших руках, сделаем сравнительный анализ генерируемого кода для двух примеров, имеющих одинаковую функциональность, но достигающую ее разными путями. 
Создайте 2 одинаковых обработчика события. В каждом обработчике события разместите приведенный ниже код. Установите точку прерывания на первой строчке каждого обработчика. Запустите приложение и активизируйте события. Сравните ассемблерный код обоих методов. Один короче? В этом случае он будет исполняться быстрее. 
Достойными для такого рода анализа могут быть участки кода, многократно выполняемые в процессе работы программы, или критические ко времени выполнения. 
Хорошим примером, где различный код выполняет одну и ту же работу, но делает это с разной скоростью, является использование конструкции "with object do". Исходный код с многократным использованием конструкции "with object do" будет длиннее, но ассемблерный код короче. Вспомните, сколько раз вы устанавливали свойства для динамически создаваемых объектов? Код:
with TObject.Create do
begin
 property1 := ;
 property2 := ;
 property3 := ;
end;
будет выполняться быстрее, чем
 MyObj := TObject.create;
 MyObj.Property1 := ;
 MyObj.Property2 := ;
 MyObj.Property3 := ; 
Source: http://delphiworld.narod.ru
ID: 00054
Активизация или отключение автоматического проигрывания CD

=== Активизация или отключение автоматического проигрывания CD ===
uses
 Registry;
procedure CDSetAutoPlay(SioNo: Boolean);
var
 Reg: TRegistry;
begin
 try
 Reg := TRegistry.Create;
 Reg.RootKey := HKEY_LOCAL_MACHINE;
 if Reg.KeyExists('Software\Classes\AudioCD\') then
 if Reg.OpenKey('Software\Classes\AudioCD\Shell\', False) then
 if SioNo then Reg.WriteString(, 'play')
 else
 Reg.WriteString(, );
 finally
 Reg.Free;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 { Activate AutoPlay }
 CDSetAutoPlay(True);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 { Deactivate Autoplay }
 CDSetAutoPlay(False);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01412
Алгоритм обхода препятствий

Предлагаемый алгоритм обхода препятствий - это, так называемый, обобщенный алгоритм Дейкстры. В англоязычной литературе он называется алгоритмом A*.
:1. Карта разбита на квадратные части, назовем их клетками. 
:2. Каждая клетка имеет несколько показателей: 
::1) стоимость прохождения по этой клетке, 
::2) предыдущая клетка - клетка из которой пришли в эту клетку, 
::3) статус клетки (непосещенная, граничная, отброшенная), 
::4) оценка пройденного пути, 
::5) оценка оставшегося пути. 
:3. Имеется две клетки - начальная и конечная. 
:4. Сосед клетки - клетка в которую можно попасть из рассматриваемой за 1 шаг. Общий принцип: на каждой итерации из всех граничных точек выбирается та, для которой сумма уже пройденного пути и пути до конца по прямой является минимальной, и от нее осуществляется дальнейшее продвижение.
Алгоритм этот проще реализовать, чем описать:
* Start - начальная клетка
* Finish - конечная клетка.
Алгоритм итерационный
:1 шаг: Помечаем Start как граничную точку.
:2 шаг: Среди всех граничных точек находим Клетку1 - клетку с минимальной суммой оценки пройденного пути g и оценки оставшегося пути h.
:3 шаг: Для Клетки 1 рассматриваем соседей. Если сосед имеет статус непосещенного, то мы обозначаеми его как граничную клетку, и указываем Клетку1 как предыдущую для него. Оценку g1 для соседа принимаем равной g+p, где p-стоимость прохождения по клетке сосед, а g - оценка пройденного пути для Клетки1 . Оценка h для любой клетки равна длине кратчайшего пути (по прямой от рассматриваемой клетки до клетки Finish) Рассматриваемую Клетку1 помечаем как отброшенную. 
:4 шаг: Если на предыдущем шаге один из соседей оказался равен клетке Finish, то путь найден. Если ни одного нового соседа не существует, то нет и пути. 
:5 шаг: Переход на шаг 2.
Source: http://delphiworld.narod.ru/
ID: 04262
Category:Алгоритмы
Алгоритм пламени

Заведем два массива 1 и 2 - один массив будет содержать текущий кадр пламени, а во второй мы будем заносить результаты вычислений. Создадим палитру пламени от 250 до 100 это будет сплошной белый цвет - пламя в очаге. Далее белый, плавно проходя через желтый, перейдет в красный и черный. Эту палитру можете посмотреть если определен Debug.
В чем состоит основа алгоритма - для каждой точки из массива 1, мы делаем следующее : берем сумму всех окружающих ее точек и делим на их количество. Для хорошего качества точек берем 8. Что же получается? Если очаг пламени организовать внизу, т.е. внизу на каждом шаге случайно ставить точки с большим значением, усредненные суммы дадут нужное затухание. Т.к. мы ставим в очаге точки случайно, то появляются красивые языки.
Последовательность действий:
* Массив 1 содержит текущий кадр пламени. 
* Создаем в массиве 1 внизу случайные очаги (просто ставим точки) 
* Каждый элемент массива 2 получаем как усредненную сумму, соответствующих элементов окружающий данный в массиве 1 
* Массив 2 копируем на экран 
* Переносим массив 2 в массив 1 
* Переход на начало Для программы требуется модуль demovga.pas
{.$DEFINE DEBUG}
program Fire;
uses DemoVga, Crt;
type
 PFireMem = ^TFireMem;
 TFireMem = array[0..201, 0..319] of Byte;
var
 FireMem: PFireMem;
 I, J: Integer;
 R, G, B, dR, dG, dB: Real;
procedure PlotFireHead;
var
 i: Integer;
begin
 for i := 0 to 319 do
 if Random(2) = 1 then
 begin
 FireMem^[199][i] := 255;
 FireMem^[198][i] := 255;
 end;
end;
procedure FireLoop; assembler;
asm
 Push DS
 Les DI,DBuffer
 Lds SI,FireMem
 Add SI,320*2
 Mov CX,64000
@@F:
 Xor AX,AX
 Add AL,[SI-321]
 Adc AH,0
 Add AL,[SI-320]
 Adc AH,0
 Add AL,[SI-319]
 Adc AH,0
 Add AL,[SI-1]
 Adc AH,0
 Add AL,[SI+1]
 Adc AH,0
 Add AL,[SI+319]
 Adc AH,0
 Add AL,[SI+320]
 Adc AH,0
 Add AL,[SI+321]
 Adc AH,0
 Shr AX,3
 Or AL,AL
 Jz @@1
 Dec AL
@@1:
 Stosb
 Inc SI
 Loop @@F
 Pop DS
end;
begin
 InitDemoPart;
 GetMem(FireMem, 65000);
 R := 0; G := 0; B := 0;
 dR := 0.63; dG := 0.91; dB := 1.5;
 for I := 1 to 100 do
 begin
 SetRGBColor(I, Round(R), Round(G), Round(B));
 R := R + dR;
 if I > 30 then G := G + dG;
 if I > 60 then B := B + dB;
 end;
 for I := 100 to 250 do
 SetRGBColor(I, 60, 60, 60);
{$IFDEF DEBUG}
 for I := 1 to 100 do
 for J := 1 to 100 do
 Mem[$A000: J * 320 + I] := I;
 ReadKey;
{$ENDIF}
 FillChar(FireMem^, 65000, 0);
 repeat
 PlotFireHead;
 FireLoop;
 Move(DBuffer^, FireMem^, 64000);
 Move(DBuffer^, Ptr($A000, 0)^, 64000-320*4);
 until KeyPressed;
 ReadKey;
 FreeMem(FireMem, 65000);
 RestoreDemo;
end;
ID: 04241
Category:Алгоритмы
Category:Графика
Алгоритм поворота изображения

Вот алгоритм поворота изображения. Пусть O - это центр поворота, а M - некая точка исходного изображения.
Для каждой точки M нужно найти угол alpha между отрезком OM и горизонталью и длину r отрезка OM.
Теперь, чтобы повернуть изображение на угол beta, нужно каждой точке M присвоить цвет точки исходного изображения с координатами x,y, где
 x = xo + r * cos(alpha + beta)
 y = yo + r * sin(alpha + beta)
(xo, yo - центр поворота, r - длина отрезка OM).
Важно именно каждой точке нового изображения сопоставлять точку старого изображения, а не наоборот, так как иначе некоторые точки нового изображения останутся не закрашенными.
Эту программу можно сильно ускорить, если исходное изображение записать в массив и обращаться к реальной переменной, а не к свойству Canvas.Pixels.
uses Math;
procedure TForm1.Button1Click(Sender: TObject);
var
 bm, bm1: TBitMap;
 x, y: Integer;
 r, a: Single;
 xo, yo: Integer;
 s, c: Extended;
begin
 bm := TBitMap.Create;
 bm.LoadFromFile('ex.bmp');
 xo := bm.Width div 2;
 yo := bm.Height div 2;
 bm1 := TBitMap.Create;
 bm1.Width := bm.Width;
 bm1.Height := bm.Height;
 a := 0;
 repeat
 for y := 0 to bm.Height - 1 do
 begin
 for x := 0 to bm.Width - 1 do
 begin
 r := sqrt(sqr(x - xo) + sqr(y - yo));
 SinCos(a + arctan2((y - yo), (x - xo)), s, c);
 bm1.Canvas.Pixels[x, y] := bm.Canvas.Pixels[Round(xo + r * c), Round(yo + r * s)];
 end;
 //Application.ProcessMessages;
 end;
 Form1.Canvas.Draw(xo, yo, bm1);
 a := a + 0.05;
 Application.ProcessMessages;
 until Form1.Tag <> 0;
 bm.Destroy;
 bm1.Destroy;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Form1.Tag := 1;
end;
Source: http://blackman.wp-club.net/
ID: 03842
Category:Графика
Category:Bitmap
Алгоритм простого перебора

Ниже приведен текст программы поиска в массиве целых чисел. Перебор элементов массива осуществляется инструкцией repeat, в теле которой инструкция if сравнивает текущий элемент массива с образцом и присваивает переменной found значение true, если текущий элемент и образец равны.
Цикл завершается, если в массиве обнаружен элемент, равный образцу (в этом случае значение переменной found равно true), или если проверены все элементы массива. По завершении цикла по значению переменной found можно определить, успешен поиск или нет.
unit s_found_;
interface
uses
 Windows, Messages, SysUtils, Classes,
 Graphics, Controls, Forms, Dialogs,
 StdCtrls, Grids;
type
 TForm1 = class(TForm)
 Label1: TLabel;
 Label2: TLabel;
 Button1: TButton;
 Edit2: TEdit;
 StringGridi: TStringGrid;
 procedure ButtonlClick(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
end;
var
Form1: TForm1 ;
implementation
{$R *.DFM}
{ поиск в массиве перебором }
procedure TForml.ButtonlClick(Sender: TObject);
const
 SIZE = 5;
var
 a: array[1..SIZE] of Integer; // массив
 obr: Integer; // образец для поиска
 found: Boolean; // TRUE — совпадение образца с элементом массива
 i: Integer; // индекс элемента массива
begin
 // ввод массива for i:=l to SIZE do
 a[i] := StrToInt(StringGridl.Cells[i - 1, 0]);
 // ввод образца для поиска
 obr := StrToInt(Edit2.Text);
 // поиск
 found := FALSE; // пусть нужного элемента в массиве нет
 i := 1;
 repeat
 if a[i] = obr then
 found := TRUE
 else
 i := i + 1;
 until (i > SIZE) or (found = TRUE);
 if found then
 ShowMessage('Совпадение с элементом номер '
 + IntToStr(i) + #13 + 'Поиск успешен.')
 else
 ShowMessage('Совпадений с образцом нет.');
end;
end.
Очевидно, что чем больше элементов в массиве и чем дальше расположен нужный элемент от начала массива, тем дольше программа будет искать необходимый элемент.
Поскольку операции сравнения применимы как к числам, так и к строкам, данный алгоритм может использоваться для поиска как в числовых, так и в строковых массивах.
Source: http://delphiworld.narod.ru/
ID: 04198
Category:Алгоритмы
Алгоритм расчета контрольного числа ИНН

{ **** UBPFD *********** by kladovka.net.ru ****
>> Алгоритм расчета контрольного числа ИНН
Зависимости: System, Sysutils
Автор: Камбалов А.Н., ACampball@mail.ru, Вологда
Copyright: Камбалов А.Н.
Дата: 3 июня 2002 г.
********************************************** }
// ===========================================
// Алгоритм расчета контрольного числа ИНН
// ===========================================
function CheckINN(const INN: string): Boolean;
const
 factor1: array[0..8] of Byte = (2, 4, 10, 3, 5, 9, 4, 6, 8);
 factor2: array[0..9] of Byte = (7, 2, 4, 10, 3, 5, 9, 4, 6, 8);
 factor3: array[0..10] of Byte = (3, 7, 2, 4, 10, 3, 5, 9, 4, 6, 8);
var
 i: Byte;
 sum: Word;
 sum2: Word;
begin
 Result := False;
 try
 if Length(INN) = 10 then
 begin
 sum := 0;
 for i := 0 to 8 do
 sum := sum + StrToInt(INN[i+1]) * factor1[i];
 sum := sum mod 11;
 sum := sum mod 10;
 Result := (StrToInt(INN[10]) = sum);
 end
 else if Length(INN) = 12 then
 begin
 sum := 0;
 for i := 0 to 9 do
 sum := sum + StrToInt(INN[i+1]) * factor2[i];
 sum := sum mod 11;
 sum := sum mod 10;
 sum2 := 0;
 for i := 0 to 10 do
 sum2 := sum2 + StrToInt(INN[i+1]) * factor3[i];
 sum2 := sum2 mod 11;
 sum2 := sum2 mod 10;
 Result := (StrToInt(INN[11]) = sum)
 and (StrToInt(INN[12]) = sum2);
 end; //
 except
 Result := False;
 end; // try
end;
Author: Камбалов А.Н.
ID: 03975
Category:Алгоритмы
Алгоритм расчета контрольного числа страхового номера ПФ

{ **** UBPFD *********** by kladovka.net.ru ****
>> Алгоритм расчета контрольного числа страхового номера ПФ
Зависимости: System, Sysutils
Автор: Камбалов А.Н., ACampball@mail.ru, Вологда
Copyright: Камбалов А.Н.
Дата: 3 июня 2002 г.
********************************************** }
// ===========================================
// Алгоритм расчета контрольного числа
// страхового номера ПФ
// ===========================================
function CheckPFCertificate(const PF: string): Boolean;
var
 sum: Word;
 i: Byte;
begin
 Result := False;
 sum := 0;
 if Length(PF) <> 11 then Exit;
 try
 for i := 1 to 9 do
 sum := sum + StrToInt(PF[i]) * (9-i+1);
 sum := sum mod 101;
 Result := (StrToInt(Copy(PF, 10, 2)) = sum);
 except
 Result := False;
 end; // try
end;
Author: Камбалов А.Н.
ID: 03976
Category:Алгоритмы
Алгоритм шифрование XOR

Вот ужасно простой пример XOR шифрования - работает без глюков.
function XorCode(AText, AKey: string): string;
var
 LongKey: string;
 i: Integer;
begin
 Result := ;
 LongKey := ; 
 for i := 0 to (Length(AText) div Length(AKey)) do
 LongKey := LongKey + AKey;
 for i := 1 to Length(AText) do
 begin
 Result := Result + Chr((Ord(AText[i]) xor Ord(LongKey[i]))); // XOR алгоритм
 end;
end;
Author: Igor N. Semenushkin
Source: http://delphiworld.narod.ru/
----
program Crypt;
{$APPTYPE CONSOLE}
uses Windows;
var
 key, text, longkey, result: string;
 i: integer;
 toto, c: char;
 F: TextFile;
begin
 WriteLn('Enter the key:');
 ReadLn(key);
 WriteLn('Enter the text:');
 ReadLn(text);
 for i := 0 to (Length(text) div Length(key)) do
 longkey := longkey + key;
 for i := 1 to Length(text) do
 begin
 // XOR алгоритм
 toto := Chr((Ord(text[i]) xor Ord(longkey[i])));
 result := result + toto;
 end;
 WriteLn('The crypted text is:');
 WriteLn(result);
 Write('Should i save it to result.txt ?');
 Read(c);
 if c in ['Y', 'y'] then
 begin
 AssignFile(F, 'result.txt');
 Rewrite(F);
 Writeln(F, result);
 CloseFile(F);
 end;
end.
Source: http://delphiworld.narod.ru/
ID: 04006
Category:Алгоритмы
Category:Шифрование
Альтернатива для Sleep(), но чтобы приложение не зависало

=== Альтернатива для Sleep(), но чтобы приложение не зависало ===
Часто требуется организовать задержку в выполнении кода, но что бы при этому приложение не зависало, могло реагировать на сообщения Windows, в частности могло перерисовываться..
procedure Delay(ATimeout: Integer);
var
 t: Cardinal;
begin
 while ATimeout > 0 do
 begin
 t := GetTickCount;
 if MsgWaitForMultipleObjects(0, nil^, False, ATimeOut, QS_ALLINPUT) = WAIT_TIMEOUT then
 Exit;
 Application.ProcessMessages; // Пришли новые сообщения Windwos , обрабатываем их..
 Dec(ATimeout, GetTickCount - t);
 end;
end;
Author: jack128
Source: Взято из http://forum.sources.ru
ID: 02033
Аналог функции С memcmp

=== Аналог функции С memcmp ===
Я создал следующие две функции, существенно повышающие произвотельность в приложениях, активно работающих с данными. Вам нужно всего-лишь обеспечить контроль типов и границ допустимого диапазона, все остальное они сделают с любым типом данных лучше нас :-) . 
function Keys_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;
Примечание от Jin X
Примеры приведены для 16-битного Pascal'я и не могут использоваться в 32-битном Delphi! Зато можно делать так:
{ Возвращает -1 при X < Y, 0 при X = Y, 1 при X > Y. }
{ Сравнение идёт по DWord'ам, будто сравнивается массив чисел Integer или Cardinal, }
{ т.е. 01 02 03 04 05 06 07 08 > 01 02 03 04 05 06 08 07, }
{ т.к. 04030201 = 04030201, но 08070605 > 07080605 (hex). }
{ Однако, если Size and 3 <> 0, то последние Size mod 4 байт сравниваются побайтно! }
function memcmp(const X, Y; Size: DWord): Integer;
asm
 mov esi,X
 mov edi,Y
 mov ecx,Size
 mov dl,cl
 and dl,3
 shr ecx,2
 xor eax,eax
 rep cmpsd
 jb @@less
 ja @@great
 mov cl,dl
 rep cmpsb
 jz @@end
 ja @@great
@@less:
 dec eax
 jmp @@end
@@great:
 inc eax
@@end:
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00295
Анимация появления текста как при вводе

Добавьте на форму 2 картинки, одну для горизонтального, другую для вертикального текста.
// Вертикальный вывод ( <Текст>, <Картинка для вывода>, <Задержка между буквами> )
procedure VerticalTypewriter(Text: string; Image: TImage; Delay: Integer);
var
 x, y, i: Integer;
begin
 Image.Canvas.Refresh();
 Application.ProcessMessages();
 y := 1;
 for i := 1 to Length(AText) do
 begin
 Application.ProcessMessages();
 y := y + Image.Canvas.TextHeight(Text[i]);
 x := Image.Width div 2 - (Image.Canvas.TextWidth(Text[i]) div 2);
 Image.Canvas.TextOut(x, y, Text[i]);
 Sleep(Delay);
 end;
end;
// Горизонтальный вывод ( <Текст>, <Картинка для вывода>, <Задержка между буквами>, <Пробел между буквами>)
procedure HorizontalTypewriter(Text: string; Image: TImage; Delay, Space: Integer);
var
 x, y, i: Integer;
begin
 Image.Canvas.Refresh();
 Application.ProcessMessages();
 x := 1;
 for i := 1 to Length(Text) do
 begin
 Application.ProcessMessages();
 y := Image.Picture.Height div 2 - (Image.Canvas.TextHeight(Text[i]) div 2);
 x := x + Image.Canvas.TextWidth(Text[i]) + Space;
 Image.Canvas.TextOut(x, y, Text[i]);
 Sleep(Delay);
 end;
end;
// Примеры вызова:
procedure TForm1.Button1Click(Sender: TObject);
begin
 // <text> <image> <delay>
 VerticalTypewriter('HELLO BIG-X', Image1, 100 );
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 // <text> <image> <delay> <space>
 HorizontalTypewriter('Hello Big-X', Image2, 100, 1 );
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03656
Category:Графика
Category:Работа с текстом