nyuuzyou/wikis huggingface dataset:
Кнопки в панели задач

=== Кнопки в панели задач ===
// Это необходимо объявить в секции public в верхней части вашего pas-файла
procedure TForm1.IconCallBackMessage(var Mess: TMessage); message WM_USER + 100;
procedure TForm1.FormCreate(Sender: TObject);
var
 nid: TNotifyIconData;
begin
 with nid do
 begin
 cbSize := SizeOf(TNotifyIconData);
 Wnd := Form1.Handle;
 uID := 1;
 uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
 uCallbackMessage := WM_USER + 100;
 hIcon := Application.Icon.Handle;
 szTip := 'Текст всплывающей подсказки';
 end;
 Shell_NotifyIcon(NIM_ADD, @nid);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
 nid: TNotifyIconData;
begin
 with nid do
 begin
 cbSize := SizeOf(TNotifyIconData);
 Wnd := Form1.Handle;
 uID := 1;
 uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
 uCallbackMessage := WM_USER + 100;
 hIcon := Application.Icon.Handle;
 szTip := 'Текст всплывающей подсказки';
 // Все, что указано выше, не является обязательным
 end;
 Shell_NotifyIcon(NIM_DELETE, @nid);
end;
procedure TForm1.IconCallBackMessage(var Mess: TMessage);
var
 sEventLog: string;
begin
 case Mess.lParam of
 // Сделайте здесь все что вы хотите. Например,
 // вызов контекстного меню при нажатии правой кнопки мыши.
 WM_LBUTTONDBLCLK: sEventLog := 'Двойной щелчок левой кнопкой';
 WM_LBUTTONDOWN: sEventLog := 'Нажатие левой кнопки мыши';
 WM_LBUTTONUP: sEventLog := 'Отжатие левой кнопки мыши';
 WM_MBUTTONDBLCLK: sEventLog := 'Двойной щелчок мышью';
 WM_MBUTTONDOWN: sEventLog := 'Нажатие кнопки мыши';
 WM_MBUTTONUP: sEventLog := 'Отжатие кнопки мыши';
 WM_MOUSEMOVE: sEventLog := 'перемещение мыши';
 WM_MOUSEWHEEL: sEventLog := 'Вращение колесика мыши';
 WM_RBUTTONDBLCLK: sEventLog := 'Двойной щелчок правой кнопкой';
 WM_RBUTTONDOWN: sEventLog := 'Нажатие правой кнопки мыши';
 WM_RBUTTONUP: sEventLog := 'Отжатие правой кнопки мыши';
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01790
Кобинации клавиш Ctrl-C, Ctrl-O, и т.д. не срабатывают. В чём проблема?

Перевод материала с сайта members.home.com/hfournier/webbrowser.htm
Это не ошибка. Информацию по данному вопросу можно найти на сайте
 Microsoft KnowledgeBase статья Q168777.
Приведённый ниже код, устраняет данную проблему:
var
 Form1: TForm1;
 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
 SaveMessageHandler: TMessageEvent;
implementation
procedure TForm1.FormActivate(Sender: TObject);
begin
 SaveMessageHandler := Application.OnMessage;
 Application.OnMessage := MyMessageHandler;
end;
procedure TForm1.FormDeactivate(Sender: TObject);
begin
 Application.OnMessage := SaveMessageHandler;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Application.OnMessage := SaveMessageHandler;
 FOleInPlaceActiveObject := nil;
end;
procedure TForm1.MyMessageHandler(var Msg: TMsg; var Handled: Boolean);
var
 iOIPAO: IOleInPlaceActiveObject;
 Dispatch: IDispatch;
begin
 { exit if we don't get back a webbrowser object }
 if WebBrowser = nil then
 begin
 Handled := False;
 Exit;
 end;
 Handled := (IsDialogMessage(WebBrowser.Handle, Msg) = True);
 if (Handled) and (not WebBrowser.Busy) then
 begin
 if FOleInPlaceActiveObject = nil then
 begin
 Dispatch := WebBrowser.Application;
 if Dispatch < > nil then
 begin
 Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
 if iOIPAO <> nil then
 FOleInPlaceActiveObject := iOIPAO;
 end;
 end;
 if FOleInPlaceActiveObject <> nil then
 if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP))
 and ((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam = VK_RIGHT)) then
 // nothing - do not pass on Backspace, Left or Right arrows
 else
 FOleInPlaceActiveObject.TranslateAccelerator(Msg);
 end;
end;
Source: http://blackman.km.ru/myfaq/cont4.phtml
ID: 03447
Category:Связь
Category:WebBrowser
Когда приходит несколько пакетов в одном

{ **** UBPFD *********** by kladovka.net.ru ****
>> Разбиение полученных данных через ClientSocket и ServerSocket, когда приходит несколько пакетов в одном.
При получении нескольких данных по socket иногда приходят два и более пакета в одном.
Здесь пример, как разбить при получении полученную строку на несколько отправленных.
Зависимости: System, ScktComp
Автор: cyborg, cyborg1979@newmail.ru, ICQ:114205759, Бузулук
Copyright: Собственное написание (Осипов Евгений Анатольевич)
Дата: 23 мая 2002 г.
********************************************** }
{ Разделитель строк, добавляется в конец отсылаемых данных,
можно написать любой, какой нравится/какой вам подойдёт }
const Delitel: string = #13#10;
{ Процедура обработки строк, S-передаваемая строка,
Socket - Передаваемый сокет откуда пришли данные }
procedure Process_Message(var S: AnsiString; var Socket: TCustomWinSocket);
begin
 { Обрабатываем здесь полученные данные S из сокета Socket }
end;
{ Обработка события по получению данных из ClientSocket,
а так же действенно и для ServerSocket }
procedure TMyForm.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
 S1, S2: AnsiString;
 I: Integer;
begin
 S1 := Socket.ReceiveText; { Присваиваем S1 полученную строку из Socket }
 I := 0;
 repeat { Разделяем строку, если одновременно пришло несколько }
 I := Pos(Delitel, S1); { Ищем разделитель Delitel в строке S1 }
 if I <> 0 then { Если найден делитель, тогда ...
 Если не найден, то вы не добавили в конце отсылаемой строки Delitel! }
 begin
 S2 := Copy(S1, 1, I-1); { Копируем одну пришедшую строку в S2 }
 Delete(S1, 1, I+Length(Delitel)-1); { Удаляем уже скопированную строку }
 Process_Message(S2, Socket);
 { Вызываем процедуру обработки полученных строк,
 где S2 наша выделенная строка }
 end;
 until I = 0; { Повторять, пока будет не найден разделитель Delitel }
end;
Author: cyborg
ID: 03565
Category:Связь
Category:Сокеты
Код определения свойств

=== Код определения свойств ===
Итак вам опять нужно "немного" кода. Вот небольшой примерчик компонента лично для вас и остальных моих читателей. Установите этот компонент в палитру Delphi, бросьте экземпляр на форму, закройте ее и модуль и откройте форму как файл формы, используя в диалоге открытия тип *.dfm. Вы увидите дополнительные свойства 'StringThing' и 'Thing'. Первое - свойство строки, второе - бинарное свойство, фактически запись. Если вы имеете HexEdit (шестнадцатиричный редактор) или что-то аналогичное, взгляните на ваш dfm-файл и вы увидите тэги ваших новых свойств вместе с их именами.
Если TReader/TWriter имеет специфические методы для чтения/записи свойств и вы хотите добавить, например, строку, целое, символ или что-то еще (проверьте описание соответствующих методов TReader в файлах помощи), то в этом случае используйте DefineProperty. В случае сложного объекта используйте DefineBinaryProperty и ваши методы чтения и записи получат TStream вместо TReader/TWriter.
unit PropDemo;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs;
type
 TDemoProps = class(TComponent)
 private
{ Private declarations }
 FStringThing: string;
 FThing: record
 i, j, k: integer;
 x, y: real;
 ch: char;
 end;
 procedure ReadStringThing(Reader: TReader);
 procedure WriteStringThing(Writer: TWriter);
 procedure ReadThing(Stream: TStream);
 procedure WriteThing(Stream: TStream);
 protected
{ Protected declarations }
 procedure DefineProperties(Filer: TFiler); override;
 public
{ Public declarations }
 constructor Create(AOwner: TComponent); override;
 published
{ Published declarations }
 end;
procedure Register;
implementation
constructor TDemoProps.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
{ создайте любые данные, чтобы было что передать в поток}
 FStringThing := 'Всем привет!';
 with FThing do
 begin
 i := 1;
 j := 2;
 k := 3;
 x := PI;
 y := 180 / PI;
 ch := '?';
 end;
end;
procedure TDemoProps.ReadStringThing(Reader: TReader);
begin
 FStringThing := Reader.ReadString;
end;
procedure TDemoProps.WriteStringThing(Writer: TWriter);
begin
 Writer.WriteString(FStringThing);
end;
procedure TDemoProps.ReadThing(Stream: TStream);
begin
 Stream.ReadBuffer(FThing, sizeof(FThing));
end;
procedure TDemoProps.WriteThing(Stream: TStream);
begin
 Stream.WriteBuffer(FThing, sizeof(FThing));
end;
procedure TDemoProps.DefineProperties(Filer: TFiler);
begin
 inherited DefineProperties(Filer);
 Filer.DefineProperty('StringThing', ReadStringThing, WriteStringThing,
 FStringThing <> );
 Filer.DefineBinaryProperty('Thing', ReadThing, WriteThing, true);
end;
procedure Register;
begin
 RegisterComponents('Samples', [TDemoProps]);
end;
end.
Mike Scott
Mobius Ltd. 
Сборник Kuliba
Source: Валентина Озерова
ID: 00036
Кодирование русского текста методом сдвига

unit uMain;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls, ComCtrls, Spin;
type
 TForm1 = class(TForm)
 Panel1: TPanel;
 mmText: TMemo;
 Label1: TLabel;
 seN: TSpinEdit;
 Label2: TLabel;
 btEncode: TButton;
 btDecode: TButton;
 procedure btEncodeClick(Sender: TObject);
 private
 { Private declarations }
 procedure Encode(bCode: Boolean; n: Integer); // Encode - ПРОЦЕДУРА
 // bCode - зашифровать/расшифровать
 // n - шаг смещения
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
// ПРОЦЕДУРА КОДИРОВАНИЯ
procedure TForm1.Encode(bCode: Boolean; n: Integer);
const
 sMsgRangeErr = 'Значение шага должно быть от %d до %d!';
 // Крайние символы для кодирования
 chBigFirstLetter: char = 'А';
 chBigLastLetter: char = 'Я';
 chFirstLetter: char = 'а';
 chLastLetter: char = 'я';
var
 iMinOrd: Integer; // Код символа с наименьшим кодом
 iMaxOrd: Integer; // Код символа с наибольшим кодом
 i: Integer; // Для фикла
 iTempOrd: Integer; // Код подставляемого символа
 ch: char; // Каждый символ текста
 s: string; // Преобразуемый текст
begin
 // Проверка шага на диапазон допустимых значений
 if (n > Ord(chBigLastLetter) - Ord(chBigFirstLetter)) or (n < 1) then
 begin
 MessageDlg(Format(sMsgRangeErr, [1, Ord(chBigLastLetter) - Ord(chBigFirstLetter)]),
 mtError, [mbOK], 0);
 Exit;
 end;
 s := Trim(mmText.Text);
 if s <> then // Если есть текст
 for i := 1 to Length(s) do // Проходит каждый символ
 begin
 ch := s[i];
 // Если очередной символ нужно кодировать
 if ch in [chBigFirstLetter .. chBigLastLetter] then
 // Заглавные буквы
 begin
 iMinOrd := Ord(chBigFirstLetter);
 iMaxOrd := Ord(chBigLastLetter);
 end
 else
 if ch in [chFirstLetter .. chLastLetter] then // Строчные буквы
 begin
 iMinOrd := Ord(chFirstLetter);
 iMaxOrd := Ord(chLastLetter);
 end
 else // Символ кодировать не нужно
 continue;
 if bCode then // Закодировать
 begin
 iTempOrd := Ord(ch) + n;
 // Получаем потенциальную позицию
 if iMaxOrd - iTempOrd < 0 then
 // Если символ зашел за границу предельного
 ch := Chr(iMinOrd + abs(iMaxOrd - iTempOrd) - 1)
 // Возьмем символ с другого конца круга
 else // Если нет..
 ch := chr(iTempOrd); //..все нормально
 end
 else // Раскодировать
 begin
 iTempOrd := Ord(ch) - n;
 // Получаем потенциальную позицию
 if iMinOrd - iTempOrd > 0 then
 // Если символ зашел за границу предельного
 ch := Chr(iMaxOrd - (iMinOrd - iTempOrd - 1))
 // Возьмем символ с другого конца круга
 else // Если нет..
 ch := chr(iTempOrd); //..все нормально
 end;
 s[i] := ch;
 end;
 mmText.Text := s;
end;
procedure TForm1.btEncodeClick(Sender: TObject);
begin
 Encode(boolean((Sender as TButton).Tag), seN.Value);
end;
end.
Author: ___Nikolay
Source: http://delphiworld.narod.ru/
ID: 04011
Category:Алгоритмы
Category:Шифрование
Кодировка полиалфавитным шифром Вигeнера

{ **** UBPFD *********** by kladovka.net.ru ****
>> Кодировка полиалфавитным шифром Вигенера - xor кодировка
Кодировка полиалфавитным шифром Вигенера - xor кодировка
одна функция для кодирования и декодирования
Input - входная строка. При кодировании это незакодированная строка, при декодировнии это закодированная строка.
Key - слово ключ один и тот же в обоих случаях.
При совпадении символов во входной строке и строке ключе на выходе получается символ '#0'.
Зависимости: Стандартные модули
Автор: Ru, DiVo_Ru@rambler.ru, Одесса
Copyright: DiVo 2002 creator Ru
Дата: 18 ноября 2002 г.
********************************************** }
function VigenerCoDec(Input, Key: PChar): PChar
var
 i, j: Integer;
 tmps, text: string;
begin
 text := Input;
 for i := 1 to Length(text) do
 begin
 if i > Length(key) then
 j := i mod Length(key)
 else
 j := i;
 tmps := tmps + Chr((Ord(text[i])) xor (Ord(key[j])));
 end;
 Result := PChar(tmps);
end;
Пример использования:
Text := Edit1.Text;
K := Edit2.Text;
Edit3.Text := VigenerCoDec(Text, K);
// Закодировать:
Input := 'Привет я РУ';
Key := 'hello';
Result := 'ГуднйзHвH++';
// Восстановить:
Input := 'ГуднйзHвH++';
Key := 'hello';
Result := 'Привет я РУ';
Author: Ru
ID: 03989
Category:Алгоритмы
Category:Шифрование
Коды виртуальных клавиш

=== Коды виртуальных клавиш ===
vk_LButton = $01;
vk_RButton = $02;
vk_Cancel = $03;
vk_MButton = $04; { генерятся только системой вместе с L & RBUTTON }
vk_Back = $08;
vk_Tab = $09;
vk_Clear = $0C;
vk_Return = $0D;
vk_Shift = $10;
vk_Control = $11;
vk_Menu = $12;
vk_Pause = $13;
vk_Capital = $14;
vk_Escape = $1B;
vk_Space = $20;
vk_Prior = $21;
vk_Next = $22;
vk_End = $23;
vk_Home = $24;
vk_Left = $25;
vk_Up = $26;
vk_Right = $27;
vk_Down = $28;
vk_Select = $29;
vk_Print = $2A;
vk_Execute = $2B;
vk_SnapShot = $2C;
{ vk_Copy = $2C не используется клавиатурой }
vk_Insert = $2D;
vk_Delete = $2E;
vk_Help = $2F;
{ vk_A - vk_Z такие же, как и их ASCII-эквиваленты: 'A' - 'Z' }
{ vk_0 - vk_9 такие же, как и их ASCII-эквиваленты: '0' - '9' }
vk_NumPad0 = $60;
vk_NumPad1 = $61;
vk_NumPad2 = $62;
vk_NumPad3 = $63;
vk_NumPad4 = $64;
vk_NumPad5 = $65;
vk_NumPad6 = $66;
vk_NumPad7 = $67;
vk_NumPad8 = $68;
vk_NumPad9 = $69;
vk_Multiply = $6A;
vk_Add = $6B;
vk_Separator = $6C;
vk_Subtract = $6D;
vk_Decimal = $6E;
vk_Divide = $6F;
vk_F1 = $70;
vk_F2 = $71;
vk_F3 = $72;
vk_F4 = $73;
vk_F5 = $74;
vk_F6 = $75;
vk_F7 = $76;
vk_F8 = $77;
vk_F9 = $78;
vk_F10 = $79;
vk_F11 = $7A;
vk_F12 = $7B;
vk_F13 = $7C;
vk_F14 = $7D;
vk_F15 = $7E;
vk_F16 = $7F;
vk_F17 = $80;
vk_F18 = $81;
vk_F19 = $82;
vk_F20 = $83;
vk_F21 = $84;
vk_F22 = $85;
vk_F23 = $86;
vk_F24 = $87;
vk_NumLock = $90;
vk_Scroll = $91;
Source: http://delphiworld.narod.ru/
ID: 01560
Коды ответов HTTP сервера

Успешные
 200 OK 
 201 Created 
 202 Accepted 
 203 Non-Authoriative Information 
 204 No Content 
 205 Reset Content 
 206 Partial Content 
 Перенаправляющие
 300 Multiple Choices 
 301 Moved Permanently 
 302 Moved Temporarily 
 303 See Other 
 304 Not Modified 
 305 Use Proxy (proxy redirect) 
 Клиентские ошибки
 400 Bad Request 
 401 Unauthorized 
 402 Payment Required 
 403 Forbidden 
 404 Not Found 
 405 Method Not Allowed 
 406 Not Acceptable 
 407 Proxy Authentication Required 
 408 Request Timeout 
 409 Confict 
 410 Gone 
 411 Length Required 
 412 Precondition Failed 
 413 Request Entity To Large 
 414 Request-URI Too Long 
 415 Unsupported Media Type 
 Ошибки сервера
 500 Internal Server Error 
 501 Not Implemented 
 502 Bad Gateway 
 503 Service Unavailable 
 504 Gateway Timeout 
 505 HTTP Version Not Supported 
Дополнительная информация здесь: Hypertext Transfer Protocol -- HTTP/1.0
Author: Rouse_
Source: http://forum.sources.ru
ID: 03371
Category:Связь
Количество вхождений подстроки в строку

=== Количество вхождений подстроки в строку ===
function CountPos(const subtext: string; Text: string): Integer;
begin
 if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then
 Result := 0
 else
 Result := (Length(Text) - Length(StringReplace(Text, subtext, , [rfReplaceAll]))) div
 Length(subtext);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00156
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Подсчёт количества вхождений символа в строке
Функцийка считает количество повторений
символа заданного InputSubStr в строке InputStr.
Зависимости: Стандартные модули
Автор: Ru, DiVo_Ru@rambler.ru, Одесса (Украина)
Copyright: DiVo 2003 creator Ru
Дата: 18 ноября 2003 г.
***************************************************** }
function CntChRepet(InputStr: string; InputSubStr: char): integer;
var
 i: integer;
begin
 result := 0;
 for i := 1 to length(InputStr) do
 if InputStr[i] = InputSubStr then
 inc(result);
end;
Source: http://delphibase.endimus.com
ID: 00866
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Подсчитать количество вхождений подстроки в строке
Понадобилось подсчитать количество вхождений подстроки в строку,
вот и появилась эта функция. Возможно в ней и нет изюминки,
но может кому и пригодится.
Зависимости: System
Автор: Дмитрий, bestonix@mail.ru, ICQ:155133146, Тольятти
Copyright: Дмитрий
Дата: 17 октября 2002 г.
***************************************************** }
function CntRecurrences(substr, str: string): integer;
var
 cnt, p: integer;
begin
 cnt := 0;
 while str <> do
 begin
 p := Pos(substr, str);
 if p > 0 then
 inc(cnt)
 else
 p := 1;
 Delete(str, 1, (p + Length(substr) - 1));
 end;
 Result := cnt;
end;
Source: http://delphibase.endimus.com
ID: 00868
----
// Кол-во вхождений символа в строку
function SymbolEntersCount(s: string; ch: char): integer;
var
 i: integer;
begin
 Result := 0;
 if Trim(s) <> then
 for i := 1 to Length(s) do
 if s[i] = ch then
 inc(Result);
end;
Source: http://delphiworld.narod.ru
ID: 00873
Количество уникальных цветов Bitmap

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Функция возвращает количество уникальных цветов Bitmap
Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай Федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
function HowManyColors(Bitmap: TBitmap): Integer;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 i: Byte;
 x, y: Integer;
 Dest: pRGB;
 RGBArray: array[0..255, 0..255] of array of Byte;
begin
 Bitmap.PixelFormat := pf24Bit;
 Result := 0;
 for y := 0 to Bitmap.Height - 1 do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to Bitmap.Width - 1 do
 begin
 with Dest^ do
 if RGBArray[r, g] <> nil then
 for i := 0 to High(RGBArray[r, g]) do
 begin
 // если такой цвет уже есть, то выходим из цикла
 if RGBArray[r, g][i] = b then
 Break;
 // если это последний круг цикла, то такого цвета нет
 if i = High(RGBArray[r, g]) then
 begin
 Inc(Result); // прибавляем один цвет
 SetLength(RGBArray[r, g], Length(RGBArray[r, g]) + 1);
 RGBArray[r, g][High(RGBArray[r, g])] := b;
 end;
 end
 else
 begin
 Inc(Result);
 SetLength(RGBArray[r, g], 1);
 RGBArray[r, g][0] := b;
 end;
 Inc(Dest);
 end;
 end;
end;
Пример использования:
procedure TForm1.MMHowManyColorsClick(Sender: TObject);
var
 str: string;
begin
 Screen.Cursor := crHourGlass;
 try
 str := Format('Изображение содержит %d цветов.', [HowManyColors(FBitmap)]);
 finally
 Screen.Cursor := crDefault;
 end;
 Application.MessageBox(PChar(str), PChar(Application.Title), MB_OK);
end;
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03777
Category:Графика
Category:Bitmap
Компактный код для сортировки массива

{ **** UBPFD *********** by kladovka.net.ru ****
>> Компактный код для сортировки массива.
Очень небольшой код для сортировки массива. Состоит из двух циклов for.
Сортирует от большего к меньшему.
Зависимости: нет
Автор: Михон
Copyright: (<Михон>) (с)
Дата: 14 января 2007 г.
********************************************** }
 for i := 1 to 5 do // отвечает за место старта проверки
 begin
 for j := i to 5 do // сам цикл поверки
 begin
 if (x[j]) > (x[i]) then // если следующее число больше i, то
 begin
 a := x[j];
 x[j] := x[i]; // меняем местами
 x[i] := a;
 end;
 end;
 end;
Пример использования:
var
 x: array [1..5] of Integer;
 a, k, i, j: Integer;
begin
 WriteLn('Vvedite massiv!!!');
 for k := 1 to 4 do
 begin
 // вводим массив
 Read(x[k]);
 end;
 ReadLn(x[5]);
 for i := 1 to 5 do // отвечает за место старта проверки
 begin
 for j := i to 5 do // сам цикл поверки
 begin
 if (x[j]) > (x[i]) then // если следующее число больше i, то
 begin
 a := x[j];
 x[j] := x[i]; // меняем местами
 x[i] := a;
 end;
 end;
 end;
 for k := 1 to 4 do
 begin
 Write(x[k], ' ');
 end; // выводим массив
 WriteLn(x[5]);
 ReadLn;
end.
Author: Михон
ID: 04169
Category:Алгоритмы
Category:Сортировка
Компиляция ресурсов

=== Компиляция ресурсов ===
У меня имеется приблизительно 36 маленьких растровых изображений, которые я хочу сохранить в файле и затем прилинковать его к exe. Как мне поместить их в res-файл?
Самый простой путь - создать файл с именем "BITMAPS.RC" и поместить в него список ваших .BMP-файлов:
 BMAP1 BITMAP BMAP1.BMP
 BMAP2 BITMAP BMAP2.BMP
 CLOCK BITMAP CLOCK.BMP
 DBLCK BITMAP DBLCK.BMP
 DELOK BITMAP DELOK.BMP
 LUPE BITMAP LUPE.BMP
 OK BITMAP OK.BMP
 TIMEEDIT BITMAP TIMEEDIT.BMP
Затем загрузите Resource Workshop (RW) и выберите пункт меню File|Project Open. В выпадающем списке "File Type" (тип файла) выберите RC-Resource Script и откройте файл, который вы только что создали. После того, как RW загрузит ваш файл, выберите пункт меню File|Project save as. Выберите объект RES-Resource из выпадающего списка "File Type" (тип файла). В поле редактирования "New File name" задайте имя нового файла, скажем, BITMAPS.RES. Нажмите OK. Теперь у вас есть файл ресурса. В вашем модуле Delphi добавьте после строки {$R *.RES} строку {$R BITMAPS.RES}. После компиляции вы получите exe-файл с скомпилированными ресурсами. Для получения доступа к ресурсам во время выполнения программы нужно сделать следующее:
myImage.Picture.Bitmap.Handle := LoadBitmap(HInstance, 'TIMEEDIT');
В качестве предостережения: убедитесь в том, что имена (в самой левой колонке) изображений в .RC файле написаны в верхнем регистре, при вызове также необходимо писать их имена в верхнем регистре.
Author: Ralph Friedman
Source: Взято с http://delphiworld.narod.ru
ID: 02158
Компонент PowerControl

=== Компонент PowerControl ===
Вопрос: А как реализовать в одном компоненте такие функции как выключение компьютера, перезагрузка, завершение сеанса работы пользователя, Eject CD, выключение питания монитора и т.д.?
Ответ: предлагаем посмотреть следующий пример ...
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 PowerControl1.Action := actCDEject; // Или... actLogOFF, actShutDown... 
 PowerControl1.Execute; 
end; 
Component Code: 
unit PowerControl; 
interface 
uses
 WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, 
 Forms, Graphics, MMSystem; 
type 
 TAction = (actLogOFF, actShutDown, actReBoot, actForce, actPowerOFF, 
 actForceIfHung, actMonitorOFF, actMonitorON, actCDEject, actCDUnEject); 
type 
 TPowerControl = class(TComponent) 
 private 
 FAction: TAction; 
 procedure SetAction(Value: TAction); 
 protected 
 public 
 function Execute: Boolean; 
 published 
 property Action: TAction read FAction write SetAction; 
 end; 
procedure Register; 
implementation 
procedure Register; 
begin 
 RegisterComponents('K2', [TPowerControl]); 
end; 
procedure TPowerControl.SetAction(Value: TAction); 
begin 
 FAction := Value; 
end; 
function TPowerControl.Execute: Boolean; 
begin 
 with (Owner as TForm) do 
 case FAction of 
 actLogOff: ExitWindowsEx(EWX_LOGOFF,1); 
 actShutDown: ExitWindowsEx(EWX_SHUTDOWN,1); 
 actReBoot: ExitWindowsEx(EWX_REBOOT,1); 
 actForce: ExitWindowsEx(EWX_FORCE,1); 
 actPowerOff: ExitWindowsEx(EWX_POWEROFF,1); 
 actForceIfHung: ExitWindowsEx(EWX_FORCEIFHUNG,1); 
 actMonitorOFF: SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0); 
 actMonitorON: SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1); 
 actCDEject: mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Handle); 
 actCDUnEject: mciSendstring('SET CDAUDIO DOOR CLOSED WAIT', nil, 0, Handle); 
 end; {Case} 
 Result := True; 
end; 
end.
Source: Взято из http://forum.sources.ru
ID: 01672