nyuuzyou/wikis huggingface dataset:
Как экспортировать таблицу в MS Word в TStringGrid?

uses
 ComObj;
procedure TForm1.Button1Click(Sender: TObject);
const
 AWordDoc = 'C:\xyz\testTable.doc';
var
 MSWord, Table: OLEVariant;
 iRows, iCols, iGridRows, jGridCols, iNumTables, iTableChosen: Integer;
 CellText: string;
 InputString: string;
begin
 try
 MSWord := CreateOleObject('Word.Application');
 except
 // Error....
 Exit;
 end;
 try
 MSWord.Visible := False;
 MSWord.Documents.Open(AWordDoc);
 // Get number of tables in document
 iNumTables := MSWord.ActiveDocument.Tables.Count;
 InputString := InputBox(IntToStr(iNumTables) +
 ' Tables in Word Document', 'Please Enter Table Number', '1');
 // Todo: Validate string for integer, range...
 iTableChosen := StrToInt(InputString);
 // access table
 Table := MSWord.ActiveDocument.Tables.Item(iTableChosen);
 // get dimensions of table
 iCols := Table.Rows.Count;
 iRows := Table.Columns.Count;
 // adjust stringgrid columns
 StringGrid1.RowCount := iCols;
 StringGrid1.ColCount := iRows + 1;
 // loop through cells
 for iGridRows := 1 to iRows do
 for jGridCols := 1 to iCols do
 begin
 CellText := Table.Cell(jGridCols, iGridRows).Range.FormattedText;
 if not VarisEmpty(CellText) then
 begin
 // Remove Tabs
 CellText := StringReplace(CellText,
 #$D, , [rfReplaceAll]);
 // Remove linebreaks
 CellText := StringReplace(CellText, #$7, , [rfReplaceAll]);
 // fill Stringgrid
 Stringgrid1.Cells[iGridRows, jGridCols] := CellText;
 end;
 end;
 //..
 finally
 MSWord.Quit;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04412
Category:COM
Category:MS Office
Как экстрагировать аудиодорожку из AVI файла?

uses
 vfw;
var
 abort: Boolean;
{$R *.DFM}
{ Special thanks to Jailbird, who developed a big part of this Code
Please download th vfw.pas first }
{ The 'SaveCallback' function allows the user to get the
 process status and abort the save progress. This function
 needn't to call by the user.}
function SaveCallback(nPercent: Int): Bool; pascal;
begin
 Application.ProcessMessages;
 Form1.Progressbar1.Position := nPercent;
 // Save Status in Percent
 if abort = True then
 Result := True
 else // If then function returns "True", the Process will continue
 Result := False;
end; // If it returns "False" the process will abort
{ The following function needs two parameters:
 InputFile: PChar
 Enter a Dir + Filename of a AVI File.
 OutputFile: PChar
 Enter a Dir + Filename of a WAVE File where do you want to
 put the audiodata of the movie.
 TIP:
 Enter jus a Filename of a WAVE File if the audiodata of the
 movie is in uncompressed PCM Format.
 ###########################################################
 IMPORTANT:
 Before calling the 'ExtractAVISound' function be sure that the
 Inputfile has a audiotrace.
 }
function TForm1.ExtractAVISound(InputFile, Outputfile: PChar): Boolean;
var
 PFile: IAviFile;
 PAvi: IAviStream;
 plpOptions: PAviCompressOptions;
begin
 Abort := False;
 if FileExists(StrPas(Outputfile)) then
 begin
 case MessageDlg('Output file exists. Overwrite?', mtWarning, [mbYes, mbNo], 0) of
 mrYes:
 begin
 DeleteFile(StrPas(Outputfile));
 end;
 // Important because the function overwrite just
 // the part of the file which is needed.
 mrNo:
 begin
 Exit;
 end;
 end;
 end;
 try
 AviFileInit; // Init the API
 if AviFileOpen(PFile, Inputfile, 0, nil) <> 0 then
 begin
 // Opens a AVI File
 MessageDlg('Ошибка загрузки видео. Файл может использоваться другим процессом.'
 + #13#10 +
 'Закройте все подходящие приложения и попробуйте еще раз.',
 mtError, [mbOK], 0);
 Result := False;
 Exit;
 end;
 if AviFileGetStream(PFile, PAvi, StreamTypeAudio, 0) <> 0 then
 begin
 MessageDlg(
 'Ошибка загрузки аудиопотока. Пожалуйста, проверьте, есть ли у этого видео аудиопоток.',
 mtError, [mbOK], 0);
 AviFileExit();
 Result := False;
 Exit;
 end;
 // Saves the AudioStream
 if AviSaveV(Outputfile, nil, @SaveCallback, 1, PAvi, plpOptions) <> 0 then
 begin
 MessageDlg('Ошибка при сохранении аудиопотока или вы отменили процесс сохранения.',
 mtError, [mbOK], 0);
 AviStreamRelease(PAvi);
 AviFileExit();
 Result := False;
 Exit;
 end;
 finally
 AviStreamRelease(PAvi);
 AviFileExit();
 end;
 Result := True;
 // return 'TRUE' if all right
end;
// Example how to call the function:
procedure TForm1.Button1Click(Sender: TObject);
begin
 if ExtractAVISound(PChar('D:\test.avi'), PChar('D:\test.wav')) = True then
 ShowMessage('Audio sucessfully saved');
 else
 ShowMessage('Error while saving...');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03604
Category:Звук
Как эмулировать нажатия клавиш в другой программе?

=== Как эмулировать нажатия клавиш в другой программе? ===
Как эмулировать нажатия клавиш в другой программе
 http://delfaq.wallst.ru/faq/emul.html
Этот модуль является почти полным аналогом методу SendKeys из VB.
* Програмная эмуляция нажатия клавиш#Почти полный аналог метода SendKeys из VB
ID: 02106
Как я могу работать с IB с клиентского компьютера?

=== Как я могу работать с IB с клиентского компьютера? ===
Можно использовать IB API (либо наборы компонт FreeIBComponents, IBObjects, IBX или FIBPlus, работающие напрямую с IB API), BDE+SQL Links, либо ODBC-драйвер.
Схема обмена данными между этими компонентами следующая
 GDS32.DLL -> IB прямое обращение к IB API
 ODBC -> GDS32.DLL -> IB работа через ODBC
 BDE -> SQL Link -> GDS32.DLL -> IB работа через BDE
 BDE -> ODBC -> GDS32.DLL -> IB работа через BDE, ODBC вместо SQL Link.
Практически во всех случаях вам не требуется производить какие-либо специфические настройки.
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02891
Category:Базы данных
Category:Interbase
Каким драйвером пользуется TDATABASE?

=== Каким драйвером пользуется TDATABASE? ===
Вы можете использовать вызов IDAPI dbiGetDatabaseDesc. Вот быстрая справка (не забудьте добавить DB в список используемых модулей):
var
 pDatabase: DBDrsc;
begin
 { pAlias - PChar, содержащий имя псевдонима }
 dbiGetDatabaseDesc(pAlias, @pDatabase);
Для получения дополнительной информации обратитесь к описанию свойства pDatabase.szDbType.
Source: Взято с http://delphiworld.narod.ru
ID: 02530
Каким обpазом выбиpать pазмеp шpифта?

=== Каким обpазом выбиpать pазмеp шpифта? ===
Каким обpазом выбирать размер шрифта, т.к. все мои страдания по выборy параметров шрифта в CreateFont() никак не отражались на его размере. Все что я придумал, это юзать glScale(), но в этом случае полyчаем плохое качество (по сравнению с той-же Вордой) при малом размере символов 
Вот часть работающего примера на Си (переведенного мною на Паскаль (АА)).
procedure GLSetupRC(pData: Pointer)
//void GLSetupRC(void *pData)
//{
var
 // HDC hDC;
 hDC: HDC;
 // HFONT hFont;
 hFont: HFONT;
 // GLYPHMETRICSFLOAT agmf[128];
 agmf: array[0..127] of GLYPHMETRICSFLOAT;
 // LOGFONT logfont;
 logfont: LOGFONT;
begin
 logfont.lfHeight := -10;
 logfont.lfWidth := 0;
 logfont.lfEscapement := 0;
 logfont.lfOrientation := 0;
 logfont.lfWeight := FW_BOLD;
 logfont.lfItalic := FALSE;
 logfont.lfUnderline := FALSE;
 logfont.lfStrikeOut := FALSE;
 logfont.lfCharSet := ANSI_CHARSET;
 logfont.lfOutPrecision := OUT_DEFAULT_PRECIS;
 logfont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
 logfont.lfQuality := DEFAULT_QUALITY;
 logfont.lfPitchAndFamily := DEFAULT_PITCH;
 //strcpy(logfont.lfFaceName,"Arial");
 // strcpy(logfont.lfFaceName,"Decor");
 StrPCopy(logfont.lfFaceName, 'Decor');
 glDepthFunc(GL_LESS);
 glEnable(GL_DEPTH_TEST); // Hidden surface removal
 glFrontFace(GL_CCW); // Counter clock-wise polygons face out
 glEnable(GL_CULL_FACE); // Do not calculate insides
 glShadeModel(GL_SMOOTH); // Smooth shading
 glEnable(GL_AUTO_NORMAL);
 glEnable(GL_NORMALIZE);
 glEnable(GL_COLOR_MATERIAL);
 glClearColor(0.0, 0.0, 0.0, 1.0);
 glEnable(GL_LIGHTING);
 glLightfv(GL_LIGHT0, GL_AMBIENT, ambientLight);
 glLightfv(GL_LIGHT0, GL_DIFFUSE, diffuseLight);
 glLightfv(GL_LIGHT0, GL_SPECULAR, specular);
 glLightfv(GL_LIGHT0, GL_POSITION, lightPos);
 glEnable(GL_LIGHT0);
 glColorMaterial(GL_FRONT, GL_AMBIENT_AND_DIFFUSE);
 glMaterialfv(GL_FRONT, GL_SPECULAR, specular);
 glMateriali(GL_FRONT, GL_SHININESS, 100);
 // Blue 3D Text
 glRGB(0, 0, 255);
 // Select the font into the DC
 hDC := (HDC)pData;
 // hFont = CreateFontIndirect(&logfont);
 hFont := CreateFontIndirect(Addr(logfont));
 SelectObject(hDC, hFont);
 // create display lists for glyphs 0 through 255 with 0.3 extrusion
 // and default deviation. The display list numbering starts at 1000
 // (it could be any number).
 // if(!wglUseFontOutlines(hDC, 0, 128, 1000, 0., 0.3,
 // WGL_FONT_POLYGONS, agmf))
 if not wglUseFontOutlines(hDC, 0, 128, 1000, 0., 0.3,
 //> ``` - это тебе поможет
 //> Выводить текст можно в любым масштабе
 WGL_FONT_POLYGONS, agmf) then
 Windows.MessageBox(nil, 'Could not create Font Outlines',
 'Error', MB_OK or MB_ICONSTOP);
 // Delete the font now that we are done
 DeleteObject(hFont);
 //}
end;
// void GLRenderScene(void *pData)
procedure GLRenderScene(pData: Pointer);
begin
 // Draw 3D text
 glListBase(1000);
 glPushMatrix();
 // Set up transformation to draw the string.
 glTranslatef(-35.0, 0.0, -5.0);
 glScalef(60.0, 60.0, 60.0);
 glCallLists(3, GL_UNSIGNED_BYTE, 'Decor');
 glPopMatrix(); // Clear the window with current clearing color
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01946
Каким образом задать прозрачный цвет иконки?

=== Каким образом задать прозрачный цвет иконки? ===
По умолчанию цвет нижнего левого пикселя считается прозрачным, только та программа/контрол/компонент который отражает эту иконку должна поддерживать прозрачность... 
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01253
Каков максимальный размер базы данных IB?

=== Каков максимальный размер базы данных IB? ===
Borland и независимые эксперты сообщают, что IB может обслуживать файлы БД размером в ~10-20 гигабайт. Существует также ограничение на размер одного файла БД, которое в основном зависит от ограничений используемой файловой системы, и составляет от 2 до 4 гигабайт. В любом случае не стоит допускать увеличения размера одного файла БД выше 2 гигабайт (создайте один или более вторичных файлов заранее). 
Многофайловая БД может состоять из 65535 файлов, таким образом теоретический предел для одной базы данных IB - 132 терабайта. Известны реально используемые базы данных в 180 гигабайт и 980 гигабайт, не содержащие blob-полей.
Author: Дмитрий Кузьменко (http://www.ibase.ru)
ID: 02902
Category:Базы данных
Category:Interbase
Какой формат данных предпочесть в Delphi? DBase или Paradox?

=== Какой формат данных предпочесть в Delphi? DBase или Paradox? ===
Если вам действительно все равно, то вот несколько пунктов "за" формат Paradox:
# Широкий выбор типов полей, включая автоинкремент, BLOBs, и т.п.
# Соблюдение целостности данных, контроля данных, обновления индексов на уровне ядра BDE.
# Первичный индекс таблицы автоматически соблюдает уникальность записей, вторичные индексы обеспечивают отсортированный "вид" на записи таблицы.
Copyright © 1996 Epsylon Technologies
Source: Взято из FAQ Epsylon Technologies (095)-913-5608; (095)-913-2934; (095)-535-5349
ID: 02636
Какой шрифт установлен (крупный или мелкий)?

=== Какой шрифт установлен (крупный или мелкий)? ===
{ Значение функции TRUE если мелкий шрифт }
function SmallFonts: Boolean;
var
 DC: HDC;
begin
 DC := GetDC(0);
 Result := (GetDeviceCaps(DC, LOGPIXELSX) = 96);
 { В случае крупного шрифта будет 120}
 ReleaseDC(0, DC);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01927
Какой язык на данный момент на клавиатуре?

=== Какой язык на данный момент на клавиатуре? ===
Используй GetKeyboardLayoutName()
Author: Mikel
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01953
----
var
 Form1: TForm1;
 LAYOUT: String;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
 RA: Array[0..$FFF] of Char;
begin
 GetKeyboardLayoutName(RA);
 Layout := StrPas(RA);
 if Layout = '00000419' then 
 ShowMessage(' CCCP ')
 else
 if Layout = '00000409' then 
 ShowMessage(' USA ')
 else 
 ShowMessage(' X 3 ' );
end; 
Author: Radmin
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01954
----
function WhichLanguage: string; 
var 
 ID: LangID; 
 Language: array [0..100] of char; 
begin 
 ID := GetSystemDefaultLangID(); 
 VerLanguageName(ID, Language, 100); 
 Result := String(Language); 
end; 
Пример вызова этой функции:
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 Edit1.Text := WhichLanguage; 
end;
Также, для определения активного языка можно воспользоваться функцией GetUserDefaultLangID.
Source: Взято из http://forum.sources.ru
ID: 01955
Какую ветвь реестра использовать для своей проги?

Для настроек уникальных для компьютера:
 HKEY_LOCAL_MACHINE\SOFTWARE\наименование твоей организации\имя программы
Для настроек уникальных для пользователя в пределах одного компьютера:
 HKEY_CURRENT_USER\SOFTWARE\наименование твоей организации\имя программы
Author: Pegas, Vit
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04533
Category:Разработка приложений
Кам при прокрутке зафиксировать левое поле сетки?

=== Кам при прокрутке зафиксировать левое поле сетки? ===
unit Fcdgrid;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, Grids, DBGrids, DBCtrls, DB, Menus;
type
 TFixedColDBGrid = class(TDBGrid)
 private
 FUserFixedCols: Integer;
 protected
 procedure LayoutChanged; override;
 procedure SetUserFixedCols(I: Integer);
 published
 property UserFixedCols: Integer read FUserFixedCols write SetUserFixedCols;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Data Controls', [TFixedColDBGrid]);
end;
procedure TFixedColDBGrid.LayoutChanged;
begin
 inherited LayoutChanged; { присваиваем FixedCols 1 если индикатор, иначе 0 }
 if ((inherited FixedCols + FUserFixedCols) < inherited ColCount) then
 inherited FixedCols := (FUserFixedCols + inherited FixedCols);
end;
procedure TFixedColDBGrid.SetUserFixedCols(I: Integer);
begin
 FUserFixedCols := I;
 LayoutChanged;
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 03069
Category:Базы данных
Category:DBGrid
Квадратное уравнение

// решает квадратное уравнение
{ a, b, c - коэффициенты уравнения
 x1, x2 - корни уравнения
 Result = True - решение есть; False - решения нет }
function SqRoot(a, b, c: Real; var x1, x2: Real): Boolean;
var
 d: Real; // дискриминант
begin
 d := Sqr(b) - 4 * a * c;
 if d < 0 then
 Result := False // уравнение не имеет решения
 else
 begin
 Result := True;
 x1 := (-b + Sqrt(d)) / (2 * a);
 x2 := (b + Sqrt(d)) / (2 * a);
 end;
end;
// Пример использования
procedure TForm1.Button1Click(Sender: TObject);
var
 k1, k2: Real; // корни уравнения
 rez: Boolean; // True - решение есть, False - решения нет
 mes: string; // сообщение
begin
 rez := SqRoot(StrToFloat(Edit1.Text), StrToFloat(Edit2.Text),
 StrToFloat(Edit3.Text), k1, k2, rez);
 if rez then
 mes := 'Корни уравнения' + #13 +
 'x1=' + FloatToStrF(k1, ffGeneral, 4, 2) + #13 +
 'x2=' + FloatToStrF(k2, ffGeneral, 4, 2) + #13
 else
 mes := 'Уравнение не имеет решения';
 Label5.Caption := mes;
end;
Source: http://delphiworld.narod.ru/
ID: 04094
Category:Алгоритмы
Category:Математика
Кириллица в параметрах CGI-запроса

Вопрос: Я хочу реализовать регистрацию своей программы через Internet. Для этого я вызываю CGI-скрипт, которому в качестве параметра передается имя пользователя. Однако, если имя набрано кириллицей, происходит ошибка. В чем дело?
Дело в том, что при передаче запроса по протоколу HTTP служебные символы и символы с кодами 128..255 надо кодировать. То есть, если пользователь ввел имя 'Вася Пупкин', то запрос для регистрации должен выглядеть не так:
 http://site/cgi-bin/reg.pl?user=Вася Пупкин
а вот так:
 http://site/cgi-bin/reg.pl?user=%C2%E0%F1%FF+%CF%F3%EF%EA%E8%ED
Решить проблему перекодировки туда и обратно может компонент TNMURL.
DK: Дополнительную информацию про кодирование URL'ов, можно прочитать в RFC1738
Source: http://delphiworld.narod.ru
ID: 03428
Category:Связь
Category:Web
Клонирование объектов

=== Клонирование объектов ===
Создать копию объекта в Delphi очень просто. Конвертируем объект в текст, а затем - обратно. При этом будут продублированы все свойства, кроме ссылок на обработчики событий. Для преобразования компонента в файл и обратно нам понадобятся функции потоков WriteComponent(TComponent) и ReadComponent(TComponent). При этом в поток записывается двоичный ресурс. Последний с помощью функции ObjectBinaryToText можно преобразовать в текст.
Создадим на их основе функции преобразования:
function ComponentToString(Component: TComponent): string; 
var 
 ms: TMemoryStream; 
 ss: TStringStream; 
begin 
 ss := TStringStream.Create(' '); 
 ms := TMemoryStream.Create; 
 try 
 ms.WriteComponent(Component); 
 ms.position := 0; 
 ObjectBinaryToText(ms, ss); 
 ss.position := 0; 
 Result := ss.DataString; 
 finally 
 ms.Free; 
 ss.free; 
 end; 
end; 
procedure StringToComponent(Component: TComponent; Value: string); 
var 
 StrStream:TStringStream; 
 ms: TMemoryStream; 
begin 
 StrStream := TStringStream.Create(Value); 
 try 
 ms := TMemoryStream.Create; 
 try 
 ObjectTextToBinary(StrStream, ms); 
 ms.position := 0; 
 ms.ReadComponent(Component); 
 finally 
 ms.Free; 
 end; 
 finally 
 StrStream.Free; 
 end; 
end;
С помощью пары этих функций мы можем преобразовать любой компонент в текст, а затем проинициализировать другой компонент того же класса этими данными.
Ниже приведен ресурс формы с одной кнопкой и текст обработчика нажатия на эту кнопку.
object Form1: TForm1 
 Left = 262 
 Top = 129 
 Width = 525 
 Height = 153 
 Caption = 'Form1' 
 Color = clBtnFace 
 Font.Charset = DEFAULT_CHARSET 
 Font.Color = clWindowText 
 Font.Height = -11 
 Font.Name = 'MS Sans Serif' 
 Font.Style = [] 
 OldCreateOrder = False 
 Scaled = False 
 PixelsPerInch = 96 
 TextHeight = 13 
 object Button1: TButton 
 Left = 16 
 Top = 32 
 Width = 57 
 Height = 49 
 Caption = 'Caption' 
 TabOrder = 0 
 OnClick = Button1Click 
 end 
end 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 Button: TButton; 
 OldName: string; 
begin 
 Button := TButton.Create(self); 
 //...сохраняем имя компонента 
 OldName := (Sender as TButton).Name; 
 //...стираем имя компонента, чтобы избежать конфликта имен.
 //...После этого Button1 станет = nil. 
 (Sender as TButton).Name := ; 
 //...преобразуем в текст и обратно 
 StringToComponent( Button, ComponentToString(Sender as TButton) ); 
 //...дадим компоненту уникальное(?) имя 
 Button.Name := 'Button' + IntToStr(random(1000)); 
 //...вернем исходному компоненту имя.
 //...После этого Button1 станет снова указывать на объект. 
 (Sender as TButton).Name := OldName; 
 //...размещаем новую кнопку справа от исходной 
 Button.parent := self; 
 Button1.Tag := Button1.Tag + 1; 
 Button.Left := Button.Left + Button.Width * Button1.Tag + 1; 
end; 
Приведенный метод не дублирует указатели на обработчики событий. Однако, если таким образом дублировать формы, то все дочерние компоненты и все обработчики сохранятся. 
Author: Андрей Чудин, ЦПР ТД Библио-Глобус
Source: http://delphi.chertenok.ru
ID: 00126
Кнопка в MainMenu с правой стороны

=== Кнопка в MainMenu с правой стороны ===
ModifyMenu(MainMenu.Handle, 3, { индекс меню, начиная слева с нуля } 
 mf_ByPosition or mf_Popup or mf_Help, mnuHelp.Handle, 
 PChar('Help'));
Author: Smike
Source: Взято из http://forum.sources.ru
ID: 01311
Кнопка или пункт меню выполняет другую функцию при нажатой кнопке shift

=== Кнопка или пункт меню выполняет другую функцию при нажатой кнопке shift ===
Если вы хотите, чтобы кнопка или пункт меню выполнял другую функцию при нажатой кнопке shift, вы можете использовать функцию GetKeyState.
GetKeyState принимает в качестве параметра виртуальный код кнопки и возвращает значение меньше 0, если кнопка нажата.
Вот пример события OnClick для кнопки: 
procedure Form1.Button1Click(Sender: TObject);
begin
 if GetKeyState(VK_SHIFT) < 0 then
 ShowMessage('Кнопка Shift нажата')
 else
 ShowMessage('Обычное нажатие кнопки');
end; 
Отмечу, что вы можете также использовать параметры VK_CONTROL или VK_MENU для проверки нажатия кнопок control и alt, соответственно!
Author: Matt Hamilton
Source: Взято с сайта http://blackman.wp-club.net/
ID: 01235
Кнопка программы в IE

procedure CreateExplorerButton(Path: string);
const
 Tagit = '\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\';
var
 Reg: TRegistry;
 Path1: string;
 Merge: string;
begin
 Path := 'c:\your_program_path';
 Reg := TRegistry.Create;
 try
 with Reg do
 begin
 RootKey := HKEY_LOCAL_MACHINE;
 Path1 := 'Software\Microsoft\Internet Explorer\Extensions';
 Merge := Path1 + Tagit;
 OpenKey(Merge, True);
 WriteString('ButtonText', 'ButtonText');
 WriteString('MenuText', 'Tools Menu Item');
 WriteString('MenuStatusBar', 'Run Script');
 WriteString('ClSid', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
 WriteString('Default Visible', 'Yes');
 WriteString('Exec', Path + '\ProgramName.exe');
 WriteString('HotIcon', ',4');
 WriteString('Icon', ',4');
 end
 finally
 Reg.CloseKey;
 Reg.Free;
 end;
end;
Author: Rouse_
Source: http://forum.sources.ru
ID: 03522
Category:Связь
Category:WebBrowser
Кнопка с многострочным заголовком

=== Кнопка с многострочным заголовком ===
procedure TForm1.Button1Click(Sender: TObject); 
var 
 i: Integer; 
begin 
 i := GetWindowLong(Button1.Handle, GWL_STYLE); 
 SetWindowLong(Button1.Handle, GWL_STYLE, i or BS_MULTILINE); 
 Button1.Caption := 'Delphi World - ' + #13#10 + 'лучше не бывает!';
end;
Source: http://delphiworld.narod.ru/
ID: 01246
----
Приведу способ, как сделать кнопку с тремя (или более) строчками текста. Разместите на форме компонент TBitBtn и задайте ему достаточно длинный заголовок. Не волнуйтесь о том, что такой длинный заголовок "раздувает" кнопку налево и направо. Создайте обработчик формы OnCreate как показано ниже: 
var
 R: TRect;
 N: Integer;
 Buff: array[0..255] of Char;
begin
 ...WITH BitBtn1 do
 Glyph.Canvas.Font := Self.Font;
 Glyph.Width := Width - 6;
 Glyph.Height := Height - 6;
 R := Bounds(0, 0, Glyph.Width, 0);
 StrPCopy(Buff, Caption);
 Caption := ;
 DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,
 DT_CENTER or DT_WORDBREAK or DT_CALCRECT);
 OffsetRect(R, (Glyph.Width - R.Right) div 2,
 (Glyph.Height - R.Bottom) div 2);
 DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,
 DT_CENTER or DT_WORDBREAK);
end;
Source: http://delphiworld.narod.ru/
ID: 01247
Кнопка со звуком

=== Кнопка со звуком ===
Когда Вы нажимаете на кнопку, то видите трёхмерный эффект нажатия. А как же насчёт четвёртого измерения, например звука ? Ну тогда нам понадобится звук для нажатия и звук для отпускания кнопки. Если есть желание, то можно добавить даже речевую подсказку, однако не будем сильно углубляться.
Компонент звуковой кнопки имеет два новых свойства:
type
 TDdhSoundButton = class(TButton)
 private
 FSoundUp, FSoundDown: string;
 protected
 procedure MouseDown(Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer); override;
 procedure MouseUp(Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer); override;
 published
 property SoundUp: string
 read FSoundUp write FSoundUp;
 property SoundDown: string
 read FSoundDown write FSoundDown;
 end;
Звуки будут проигрываться при нажатии и отпускании кнопки:
procedure TDdhSoundButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 inherited;
 PlaySound(PChar(FSoundDown), 0, snd_Async);
end;
procedure TDdhSoundButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 inherited;
 PlaySound(PChar(FSoundUp), 0, snd_Async);
end;
Source: Взято из http://forum.sources.ru
ID: 01234