nyuuzyou/wikis huggingface dataset:
Для чего нужен WinAPI

=== Для чего нужен WinAPI ===
Иногда требуется работать с объектами WINDOWS не используя VCL. Где это может пригодиться?
Например:
* При отсутствии у приложения окна - консольный проект. 
* Если нужно работать быстро, а известно, что функции WinApi работают на порядок быстрее, чем стандартные классы Delphi. 
* Работа с устройствами ввода - вывода. Многие вещи в Дельфи можно делать через только через дескриптор, например чтение сообщений из MailSlot, работа с процессами и thread и т.д. 
==== Что это такое? ====
WINAPI - это набор фунций WINDOWS предоставляемый нам через стандартные библиотеки (kernel32.dll gdi.exe и т.д.). Раз эти библиотеки распространяются вместе с WINDOWS, следовательно их можно использовать на любых машинах (с этой платформой).
Хотя, следует оговориться, что та или иная библиотека может иметь различную версию. Но нам програмистам на Delphi по большей части это не важно.
==== Использование ====
 
Для использования нужно в разделе uses добавить модуль windows. В нем то и описано большинство функций.
Создадим проект.
На форме разместим кнопку и поле ввода TEdit
В обработчике события кнопки onClick запишем следующий код:
procedure Tform1.Button1onClick(Sender: TTobject);
var
 h: cardinal;
begin
 h := FindWindow(Edit1.Text, nil);
 ShowWindow(h, SW_MINIMIZE);
end;
Теперь откомпилируйте и запустите его. В поле ввода введите заголовок любого окна которое открыто у вас на рабочем столе (например "(Без имени) - Блокнот"). Нажмите кнопку и окно минимизируется.
Этот простой проект демонстрирует принцип работы с дескрипторами. Сначала его нужно получить у функции FindWindow, которая ищет окно по заголовку и возвращает его дескриптор. А потом следует передать его функции ShowWindow которая с параметром SW_MINIMIZE минимизирует окно.
Краткий обзор завершен. Из всего вышеперечисленного следует, что WINAPI это не монстр, а обычная техника работы с функциями, правда несколько специфическая.
Успешной работы.
ID: 02014
Category:WinAPI
Дни в месяце

=== Дни в месяце ===
// Количество дней в любом месяце любого
// года можно получить с помощью EndOfAMonth
var
 YYYY, MM, DD: Word;
 D: TDateTime;
begin
 DecodeDate(Date, YYYY, MM, DD);
 D := EndOfAMonth(YYYY, {Номер месяца});
 DecodeDate(D, YYYY, MM, DD); // DD - номер последнего дня в месяце
end;
Author: Ревенко Алексей
Source: http://delphiworld.narod.ru
ID: 00732
----
Получить число дней в месяце 
function DaysOfMonth(mm, yy: Integer): Integer; 
begin 
 if mm = 2 then 
 begin 
 Result := 28; 
 if IsLeapYear(yy) then Result := 29; 
 end 
 else 
 begin 
 if mm < 8 then 
 begin 
 if (mm mod 2) = 0 then 
 Result := 30 
 else 
 Result := 31; 
 end 
 else 
 begin 
 if (mm mod 2) = 0 then 
 Result := 31 
 else 
 Result := 30; 
 end; 
 end; 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 days: Integer; 
begin 
 days := DaysOfMonth(7, 2001); 
 ShowMessage('July 2001 has ' + IntToStr(days) + ' days'); 
end; 
Source: http://delphiworld.narod.ru
ID: 00735
----
function LastDayOfCurrentMonth: TDate;
 var
 y, m, d: Word;
 begin
 DecodeDate(now, y, m, d);
 m := m + 1;
 if m 12 then
 begin
 y := y + 1;
 m := 1;
 end;
 Result := EncodeDate(y, m, 1) - 1;
 end;
 procedure TForm1.Button1Click(Sender: TObject);
 begin
 ShowMessage(DateToStr(LastDayOfCurrentMonth));
 end;
Source: http://delphiworld.narod.ru
ID: 00736
Добавить HTML к TWebbrowser Document?

uses
 MSHTML;
procedure TForm1.Button1Click(Sender: TObject);
var
 Range: IHTMLTxtRange;
begin
 Range := ((WebBrowser1.Document as IHTMLDocument2).body as
 IHTMLBodyElement).createTextRange;
 Range.collapse(False);
 Range.pasteHTML('Hello!');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 Webbrowser1.Navigate('www.google.ch');
end;
unit Unit1;
// by Sprint
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, OleCtrls, SHDocVw, MSHTML, StdCtrls;
type
 TForm1 = class(TForm)
 WebBrowser1: TWebBrowser;
 procedure FormCreate(Sender: TObject);
 procedure WebBrowser1DocumentComplete(Sender: TObject;
 const pDisp: IDispatch; var URL: OleVariant);
 private
 { Private-Deklarationen }
 FirstRun: Boolean;
 public
 { Public-Deklarationen }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
 FirstRun := True;
 WebBrowser1.Navigate('about:blank');
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
 const pDisp: IDispatch; var URL: OleVariant);
var
 WebDoc: HTMLDocument;
 WebBody: HTMLBody;
begin
 if FirstRun then
 if pDisp = WebBrowser1.Application then
 begin
 FirstRun := False;
 WebDoc := WebBrowser1.Document as HTMLDocument;
 WebBody := WebDoc.body as HTMLBody;
 WebBody.insertAdjacentHTML('BeforeEnd', 'Hello World!');
 end;
end;
end.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03464
Category:Связь
Category:WebBrowser
Добавить событие onDblClick на заголовке TListView

=== Добавить событие onDblClick на заголовке TListView ===
{ 
 MS did not see fit to send a notification to the listview when the user 
 Double - clicks on the header. But the header control class does have the 
 CS_DBLCLKS Style, so it does get WM_LBUTTONDBLCLK messages, it just does 
 not do anything with them. To get at these messages requires API - Style 
 subclassing of the header control. 
}
uses commctrl;
function HeaderProc(wnd: HWND; Msg: Cardinal; wParam: wParam; lParam: lParam): Longint; stdcall;
var
 hti: THDHitTestInfo;
begin
 Result := CallWindowProc(Pointer(GetWindowLong(wnd, GWL_USERDATA)),
 wnd, Msg, wParam, lParam);
 if Msg = WM_LBUTTONDBLCLK then
 begin
 FillChar(hti, SizeOf(hti), 0);
 hti.Point := SmallPointToPoint(TSmallPoint(lParam));
 if SendMessage(wnd, HDM_HITTEST, 0, Longint(@hti)) >= 0 then
 if hti.Flags = HHT_ONHEADER then
 // would usually send a custom notification to GetParent(wnd) here
 Form1.Memo1.Lines.Add(Format('doubleclick on header item %d', [hti.Item]));
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 wnd: HWND;
 buffer: array [0..80] of Char;
 oldProc: Integer;
begin
 wnd := GetWindow(Listview1.Handle, GW_CHILD);
 if wnd <> 0 then
 begin
 Windows.GetClassname(wnd, buffer, SizeOf(buffer));
 memo1.Text := buffer;
 if (GetClassLong(wnd, GCL_STYLE) and CS_DBLCLKS) <> 0 then
 begin
 Memo1.Lines.Add('Has doubleclicks style');
 oldproc := GetWIndowLong(wnd, GWL_WNDPROC);
 if GetWindowLong(wnd, GWL_USERDATA) <> 0 then
 raise Exception.Create('Cannot sublcass header, USERDATA already in use');
 SetWIndowLong(wnd, GWL_USERDATA, oldproc);
 SetWindowLong(wnd, GWL_WNDPROC, Integer(@HeaderProc));
 end;
 end
 else
 Memo1.Text := 'No child';
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01131
Добавить цветную строку в TRichEdit

=== Добавить цветную строку в TRichEdit ===
{ 
 To color text in a TRichEdit, follow this two steps: 
 1) Select the text with the SelStart, SelLength properties. 
 2) Set the text attribtutes through the SelAttributes property. 
}
{ 
 1. Example/ Beispiel: 
 Add a colored line to a TRichEdit: 
}
procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
 with ARichEdit do
 begin
 SelStart := Length(Text);
 SelAttributes.Color := AColor;
 SelAttributes.Size := 8;
 SelAttributes.Name := 'MS Sans Serif';
 Lines.Add(AText);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 AddColoredLine(RichEdit1, 'Hallo', clRed);
 AddColoredLine(RichEdit1, 'Hallo', clGreen);
end;
{ 
 2. Example/ Beispiel: 
 To color the 5 characters. 
 Die ersten 5 Zeichen im Richedit blau einfдrben. 
}
procedure TForm1.Button1Click(Sender: TObject);
begin
 RichEdit1.SelStart := 0;
 RichEdit1.SelLength := 5;
 RichEdit1.SelAttributes.Color := clBlue;
end;
{ 
 3. Example/ Beispiel: ( by www.delphimania.de) 
 To color a specified line with a color 
 So kann eine beliebige Zeile mit einer Farbe gefдrbt werden: 
}
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
begin
 with ARichEdit do
 begin
 SelStart := SendMessage(Handle, EM_LINEINDEX, ARow - 1, 0);
 SelLength := Length(Lines[ARow - 1]);
 SelAttributes.Color := AColor;
 SelLength := 0;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ZeileFaerben(RichEdit1, 4, clGreen);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01025
Добавление и удаление страниц Notebook

=== Добавление и удаление страниц Notebook ===
Как во время выполнения программы динамически добавлять и удалять страницы динамически созданного NoteBook?
{ Добавляем новую страницу к NoteBook и новую закладку к tabset
(параметр pagename задает имя страницы), размещаем на странице
компонент Memo и выводим новую страницу на передний план.
Подразумевается, что TabSet (набор закладок) имеет ровно по
одной закладке на каждую страницу NoteBook с точным сохранением порядка. }
procedure AddPage(nbk: TNotebook; Tabset: TTabSet; const PageName: string);
var
 Memo: TMemo;
 Page: TPage;
begin
 if nbk <> nil then
 begin
 nbk.Pages.Add(pagename); { добавляем страницу в TNotebook }
 nbk.PageIndex := nbk.Pages.Count - 1; { делаем новую страницу текущей }
 if Tabset <> nil then
 begin
 Tabset.Tabs.Add(pagename); { добавляем соответствующую закладку }
 Tabset.TabIndex := nbk.PageIndex; { делаем новую закладку текущей }
 end;
 { убедимся что страница существует }
 if nbk.PageIndex > -1 then
 begin
 Page := TPage(nbk.Pages.Objects[nbk.PageIndex]); { получаем объект страницы }
 { создаем TMemo (и страницей в качестве родителя) }
 Memo := TMemo.Create(Page);
 try
 { устанавливаем страницу в качестве Parent }
 Memo.Parent := Page;
 { устанавливаем выравнивание для заполнения области клиента }
 Memo.Align := alClient;
 except
 Memo.Free; { освобождаем TMemo, если что-то идет неправильно }
 end;
 Page.Visible := True; { показываем страницу }
 end;
 end;
end;
{ Удаляем страницу, чей PageIndex = index из nbk и tabset. Подразумевается,
что TabSet имеет ровно по одной закладке на каждую страницу NoteBook с
точным сохранением порядка. }
procedure DeletePage(nbk: TNotebook; Tabset: TTabSet; Index: integer);
var
 SwitchTo: integer;
begin
 if nbk <> nil then
 begin
 if (Index >= 0) and (Index < nbk.Pages.Count) then
 begin
 if Index = nbk.PageIndex then
 begin
 if Index < nbk.Pages.Count - 1 then
 begin { если страница не последняя в списке }
 { выводим страницу за текущей, ставшей ею после удаления }
 SwitchTo := nbk.PageIndex;
 { если первая страница }
 if (Index = 0) and (nbk.Pages.Count > 1) then
 nbk.PageIndex := 1; { теперь показываем вторую страницу }
 end
 else
 { в противном случае показываем страницу, расположенную перед текущей }
 SwitchTo := nbk.PageIndex - 1;
 end;
 { освобождаем страницу и все принадлежавшие ей элементы управления }
 nbk.Pages.Delete(Index);
 if Tabset <> nil then
 begin
 if Index < Tabset.Tabs.Count then
 Tabset.Tabs.Delete(Index); { удаляем соответствующую закладку }
 end;
 nbk.PageIndex := SwitchTo;
 end;
 end;
end;
ID: 01188
----
procedure TForm1.Button1Click(Sender: TObject);
var
 NewPage: TWinControl;
begin
 TabbedNotebook1.Pages.Add(Edit1.Text);
 NewPage := TabbedNotebook1.Pages.Objects[TabbedNotebook1.Pages.Count - 1]
 as TWinControl;
 with TLabel.Create(Self) do
 begin
 Left := 20;
 Top := 20;
 Caption := '&Телефон: ';
 Parent := NewPage;
 end;
 with TEdit.Create(Self) do
 begin
 Left := 100;
 Top := 20;
 Text := '1-800-555-1212';
 Parent := NewPage;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01189
Добавление картинки на кнопку, если используются стили XP

=== Добавление картинки на кнопку, если используются стили XP ===
function Button_SetImageEx(hwndCtl: HWND; 
 Img: HGDIOBJ; 
 ImgType: integer; // IMAGE_BITMAP или IMAGE_ICON
 cx: integer = 16; cy: integer = 16): Integer;
const
 BCM_FIRST = $1600;
 BCM_SETIMAGELIST = $0002;
 BUTTON_IMAGELIST_ALIGN_LEFT = 0;
 BUTTON_IMAGELIST_ALIGN_RIGHT = 1;
 BUTTON_IMAGELIST_ALIGN_TOP = 2;
 BUTTON_IMAGELIST_ALIGN_BOTTOM = 3;
 BUTTON_IMAGELIST_ALIGN_CENTER = 4;
type
 TButtonImageList=record
 himl : HIMAGELIST; // normal, hot, pushed, disabled, focused
 margin : TRECT; // отступы 
 uAlign : DWORD; // выравнивание 
 end;
var
 hIconBlend: HICON;
 bi: TButtonImageList;
begin
 Result := 0;
 if not (ImgType in [IMAGE_BITMAP, IMAGE_ICON]) then Exit;
 ZeroMemory(@bi, SizeOf(bi));
 bi.himl := ImageList_Create(cx, cy, (ILC_COLOR16 or ILC_MASK), 4, 0);
 bi.margin.Left := 10;
 bi.uAlign := BUTTON_IMAGELIST_ALIGN_LEFT;
 if (ImgType = IMAGE_BITMAP) then
 begin
 ImageList_Add(bi.himl, Img, 0); // Normal
 ImageList_Add(bi.himl, Img, 0); // hot
 ImageList_Add(bi.himl, Img, 0); // pushed
 end
 else
 begin
 ImageList_AddIcon(bi.himl, Img); // Normal
 ImageList_AddIcon(bi.himl, Img); // hot
 ImageList_AddIcon(bi.himl, Img); // pushed
 end;
 // disabled
 hIconBlend := ImageList_GetIcon(bi.himl, 0, ILD_BLEND50 or ILD_TRANSPARENT);
 ImageList_AddIcon(bi.himl, hIconBlend);
 DestroyIcon(hIconBlend);
 // focused
 if (ImgType = IMAGE_BITMAP) then
 ImageList_Add(bi.himl, Img, 0)
 else
 ImageList_AddIcon(bi.himl, Img);
 Result := SendMessage(hwndCtl, BCM_FIRST + BCM_SETIMAGELIST, 0, LPARAM(@bi));
 if (Result = 0) then
 begin
 ImageList_Destroy(bi.himl);
 Result := SendMessage(hwndCtl, BM_SETIMAGE, ImgType, Img);
 end;
end;
Пример использования:
 // bitmap
 SetWindowLong(hwndButton, GWL_STYLE, GetWindowLong(hwndButton, GWL_STYLE) or BS_BITMAP); 
 Button_SetImageEx(hwndButton, LoadBitmap(hInstance, 'IDB_BITMAP1'), IMAGE_BITMAP);
 // иконка
 SetWindowLong(hwndButton, GWL_STYLE, GetWindowLong(hwndButton, GWL_STYLE) or BS_ICON);
 Button_SetImageEx(hwndButton, LoadIcon(hInstance, 'IDI_ICON1'), IMAGE_ICON);
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 00403
Добавление колонки в StringGrid

=== Добавление колонки в StringGrid ===
procedure GridAddColumn(StrGrid: TStringGrid; NewColumn: Integer); 
var
 Column: Integer; 
begin 
 StrGrid.ColCount := StrGrid.ColCount+1; 
 for Column := StrGrid.ColCount-1 downto NewColumn do 
 StrGrid.Cols[Column].Assign(StrGrid.Cols[Column-1]); 
 StrGrid.Cols[NewColumn-1].Text := ; 
end; 
ID: 00601
----
procedure AddColumn(SG: TStringGrid; AtColNumber: integer; 
 ColWidth: integer = 0); 
var
 Column: integer; 
 Wdth: integer; 
begin 
 AtColNumber := abs(AtColNumber); 
 SG.ColCount := SG.ColCount + 1; 
 if abs(ColWidth) = 0 then 
 Wdth := SG.DefaultColWidth 
 else 
 Wdth := ColWidth; 
 if AtColNumber <= SG.ColCount then
 begin 
 for Column := SG.ColCount - 1 downto AtColNumber + 1 do
 begin 
 SG.Cols[Column].Assign(SG.Cols[Column - 1]); 
 SG.Colwidths[Column] := SG.Colwidths[Column - 1]; 
 end; 
 SG.Cols[AtColNumber].Text := ; 
 SG.Colwidths[AtColNumber] := Wdth; 
 end; 
end; 
Source: Взято из http://forum.sources.ru
ID: 00602
Добавление псевдонима с помощью функции DbiAddAlias

=== Добавление псевдонима с помощью функции DbiAddAlias ===
var
 pszAliasName: PChar; { Имя псевдонима }
 pszDriverType: PChar; { Тип драйвера для псевдонима }
 pszParams: PChar; { Дополнительные параметры }
 bPersist: Bool; { Постоянный или временный псевдоним }
 dbiRes: Integer; { Возвращаемый код }
begin
 pszAliasName := strAlloc(25);
 pszDriverType := strAlloc(25);
 pszParams := strAlloc(100);
 try
 bPersist := True;
 strPcopy(pszAliasName, 'Lance');
 strPcopy(pszDriverType, 'PARADOX');
 strPcopy(pszParams, 'PATH:' + 'c:\Paradox\');
 dbiRes := DbiAddAlias(nil, pszAliasName, pszDriverType, pszParams, bPersist);
 finally
 strDispose(pszAliasName);
 strDispose(pszDriverType);
 strDispose(pszParams);
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02524
Добавление события OnMouseLeave

=== Добавление события OnMouseLeave ===
Все потомки TComponent могут посылать сообщения CM_MOUSEENTER и CM_MOUSELEAVE во время вхождения и покидания курсора мыши области компонента. Если вам необходимо, чтобы ваши компоненты обладали реакцией на эти события, необходио написать для них соответствующие обработчики. 
procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
implementation
procedure MyComponent.CMMouseEnter(var msg:TMessage);
begin
 inherited;
 { действия на вход мыши в область компонента }
end;
procedure MyComponent.CMMouseLeave(var msg: TMessage);
begin
 inherited;
 { действия на покидание мыши области компонента }
end; 
Дополнение 
Часто приходится сталкиваться с ситуацией, когда необходимо обработать два важных события для визуальных компонентов: 
MouseEnter - когда событие мыши входит в пределы визуального компонента; 
MouseLeave - когда событие мыши оставляет его пределы.
Известно, что все Delphi объявляет эти сообщения в виде: 
 Cm_MouseEnter; 
 Cm_MouseLeave.
Т.е. все визуальные компоненты, которые порождены от TControl, могут отлавливать эти события. Следующий пример показывает как создать наследника от TLabel и добавить два необходимых события OnMouseLeave и OnMouseEnter.
{*///////////////////////////////////////////////////////*)
(*// Author: Briculski Serge
(*// E-Mail: bserge@airport.md
(*// Date: 26 Apr 2000
(*///////////////////////////////////////////////////////*}
unit BS_Label;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TBS_Label = class(TLabel)
 private
 { Private declarations }
 FOnMouseLeave: TNotifyEvent;
 FOnMouseEnter: TNotifyEvent;
 procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 protected
 { Protected declarations }
 public
 { Public declarations }
 published
 { Published declarations }
 property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Custom', [TBS_Label]);
end;
{ TBS_Label }
procedure TBS_Label.CMMouseEnter(var Message: TMessage);
begin
 if Assigned(FOnMouseEnter) then
 FOnMouseEnter(Self);
end;
procedure TBS_Label.CMMouseLeave(var Message: TMessage);
begin
 if Assigned(FOnMouseLeave) then
 FOnMouseLeave(Self);
end;
end.
Source: http://delphiworld.narod.ru
ID: 01592
Добавление строк в Memo

=== Добавление строк в Memo ===
Memo1.Perform(WM_SETREDRAW, 0, 0);
// ... здесь можно добавлять строки
Memo1.Perform(WM_SETREDRAW, 1, 0);
Memo1.Refresh;
Source: http://delphiworld.narod.ru/
ID: 00990
Добавление шума

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Добавление шума в изображение
Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 5 июня 2002 г.
***************************************************** }
{ Если Mono = False, то точки цветные, иначе - чёрно-белые.
 Процедура взята из библиотеки FastLIB и немного переделана }
procedure AddNoise(Bitmap: TBitmap; Amount: Integer; Mono: Boolean);
 function BLimit(B: Integer): Byte;
 begin
 if B < 0 then
 Result := 0
 else if B > 255 then
 Result := 255
 else
 Result := B;
 end;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y, i, a: Integer;
 Dest: pRGB;
begin
 Bitmap.PixelFormat := pf24Bit;
 Randomize;
 i := Amount shr 1;
 if Mono then
 begin
 for y := 0 to Bitmap.Height - 1 do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to Bitmap.Width - 1 do
 begin
 a := Random(Amount) - i;
 with Dest^ do
 begin
 r := BLimit(r + a);
 g := BLimit(g + a);
 b := BLimit(b + a);
 end;
 Inc(Dest);
 end;
 end;
 end
 else
 begin
 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
 begin
 r := BLimit(r + Random(Amount) - i);
 g := BLimit(g + Random(Amount) - i);
 b := BLimit(b + Random(Amount) - i);
 end;
 Inc(Dest);
 end;
 end;
 end;
end;
Пример использования:
AddNoise(FBitmap, 65, False);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03862
Category:Графика
Category:Bitmap
Добавляем компонент в стандартный Message dialog.

=== Добавляем компонент в стандартный Message dialog. ===
Пример показывает стандартное диалоговое окно, которое обычно используется для подтверждения дальнейших действий в любой программе с галочкой "Don't show this message again." 
Используем функцию CreateMessageDialog и добавляем любой компонент до того как будет вызвана ShowModal.
procedure TForm1.Button1Click(Sender: TObject); 
var 
 AMsgDialog: TForm; 
 ACheckBox: TCheckBox; 
begin 
 AMsgDialog := CreateMessageDialog('This is a test message.', mtWarning, [mbYes, mbNo]); 
 ACheckBox := TCheckBox.Create(AMsgDialog); 
 with AMsgDialog do 
 try 
 Caption := 'Dialog Title'; 
 Height := 169; 
 with ACheckBox do 
 begin 
 Parent := AMsgDialog; 
 Caption := 'Do not show me again.'; 
 Top := 121; 
 Left := 8; 
 end; 
 case ShowModal of
 ID_YES: ; // здесь Ваш код после того как диалог будет закрыт 
 ID_NO: ; 
 end; 
 if ACheckBox.Checked then 
 begin 
 // ... 
 end; 
 finally 
 ACheckBox.Free; 
 Free; 
 end; 
end; 
Так же Вы можете изменить диалог по Вашему усмотрению. 
Source: Взято из http://forum.sources.ru
ID: 01194
Добавляем пункты в системное меню Windows

=== Добавляем пункты в системное меню Windows ===
Вы, наверное, задавались вопросом, почему системное меню постоянно одно и тоже ? Пример показывает, как добавить туда такие пункты как "About" или "Information", или что-нибудь ещё.
Нам понадобится две вещи, первая это Item ID, который может быть любым целым числом. Второе это Описание(Caption) для нашего пункта меню. Нам понадобится также процедура, которая будет принимать сообщения Window для определения нажатия на наш пункт меню. 
unit OhYeah; 
interface 
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus; 
type 
 TForm1 = class(TForm) 
 procedure FormCreate (Sender: TObject); 
 public { Public declarations } 
 procedure WinMsg(var Msg: TMsg; var Handled: Boolean); 
 procedure DoWhatEever; 
 end; 
var
 Form1: TForm1; 
implementation 
{$R *.DFM} 
const
 ItemID = 99; // ID номер для пункта меню. Может быть любым 
procedure TForm1.WinMsg(var Msg: TMsg; var Handled: Boolean); 
begin 
 if Msg.Message = WM_SYSCOMMAND then 
 if Msg.WParam = ItemID then
 DoWhatEver; 
end; 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
 Application.OnMessage := WinMsg; 
 AppendMenu(GetSystemMenu(Form1.Handle, False), MF_SEPARATOR, 0, ); 
 AppendMenu(GetSystemMenu(Form1.Handle, False), MF_BYPOSITION, ItemID, '&My menu'); 
 AppendMenu(GetSystemMenu(Application.Handle, False), MF_SEPARATOR, 0, ); 
 AppendMenu(GetSystemMenu(Application.Handle, False), MF_BYPOSITION, ItemID, '&My menu minimized'); 
end; 
procedure TForm1.DoWhatEver; 
begin 
 Exit; // Вы можете добавить здесь всё, что угодно 
end; 
end.
Source: Взято из http://forum.sources.ru
ID: 01296
Добавляем файлы в Recent Documents list?

=== Добавляем файлы в Recent Documents list? ===
Предположим Вам захотелось, чтобы Ваше программа сама умела добавлять файлы "recent documents list" (для тех, кто в танке - это такая менюшка, которая появляется при нажатии на кнопку () и наведении мышкой на "Документы" (Documents). Сама функция API-шная, так что применять её можно в любом компиляторе.
ПускStart
Добавляем следующий код в интерфейсную часть формы: 
const 
 SHARD_PIDL = 1; 
 SHARD_PATH = 2; 
procedure SHAddToRecentDocs(Flags: Word; pfname: Pointer); stdcall; external 'shell32.dll' name'SHAddToRecentDocs'; 
А так выглядит вызов этой функции: 
SHAddTorecentDocs(SHARD_PATH, PChar('C:\mydir\myprogram.exe')); 
файл 'myprogram.exe' будет добавлен в recent documents list 
Source: Взято из http://forum.sources.ru
ID: 01662