nyuuzyou/wikis huggingface dataset:
Создание заставки при старте программы

Перед появлением главного окна во всех серьёзных приложениях сначала появляется заставка. Теперь и у Вас есть возможность повыёживаться! Для создания заставки выполняем следующую последовательность действий:
* Начинаем создание нового приложение командой "New Application" ("Новое приложение") из меню "File" ("Файл")
* Добавьте ещё одну форму: "New Form"("Новая форма") из меню "File" ("Файл"). Это окно и будет заставкой. У него нужно убрать рамку с полосой заголовка, установив свойство "BorderStyle" в "bsNone". Теперь можно смело разработать дизайн окна заставки.
* Из меню "Project" ("Проект") выбрать команду "Options"("Опции"). Зайти на закладку "Forms"("Формы") и Form2 из списка автоматически создаваемых форм (Auto-Create forms) перенести в список доступных форм (Available forms)
* На форму-заставку с закладки System вынести компонент Timer. В его свойстве Interval установить значение 5000, а в событии OnTimer написать:
 Timer1.Enabled := False;
Это сделано для того, чтобы заставка была видна в период указанного времени - 5000 миллисекунд, т.е. 5 секунд.
* Перейти в файл проекта, нажав Ctrl+F12 и выбрав Project1. Исходный код должен выглядеть так:
program Project1;
uses
 Forms,
 Unit1 in 'Unit1.pas' {Form1},
 Unit2 in 'Unit2.pas' {Form2};
{$R *.RES}
begin
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.
Теперь мы внесём сюда немного изменений и код должен стать таким:
program Project1;
uses
 Forms,
 Unit1 in 'Unit1.pas' {Form1},
 Unit2 in 'Unit2.pas' {Form2};
{$R *.RES}
begin
 Application.Initialize;
 Form2 := TForm2.Create(Application);
 Form2.Show;
 Form2.Update;
 while Form2.Timer1.Enabled do
 Application.ProcessMessages;
 Application.CreateForm(TForm1, Form1);
 Form2.Hide;
 Form2.Free;
 Application.Run;
end.
Source: http://delphiworld.narod.ru
ID: 04570
Category:Разработка приложений
Создание и регистрация Action на низком уровне

=== Создание и регистрация Action на низком уровне ===
Модуль: ActnList
; function CreateAction(AOwner: TComponent;ActionClass: TBasicActionClass): TBasicAction; 
: Функция создает действие (Action) заданного типа, которое отображается во время проектирования в редакторе списка Action.
: Тип Action указывается в параметре ActionClass.
: Вызов функции аналогичен выполнению кода ActionClass.Create(AOwner), за исключением того, что функция CreateAction использует значение параметра Resource процедуры RegisterActions для инициализации значений action-объекта, основанного на данном параметре.
; procedure EnumRegisteredActions(Proc: TEnumActionProc; Info: Pointer); 
; TEnumActionProc = procedure(const Category: string; ActionClass: TBasicActionClass; Info: Pointer) of object;
: Процедура производит итерацию списка зарегистрированных действий (Action), передавая их процедуре повторного вызова, определенной в параметре Proc.
: Параметр Category определяет категорию в списке, к которой относится Action. Для потомков TContainedAction параметр Category должен соответствовать свойству TContainedAction.Category. Для первичных классов значение данного параметра может представлять собой пустую строку.
; procedure RegisterActions(const CategoryName: string; const AClasses: array of TBasicActionClass; Resource: TcomponentClass);
: Процедура регистрирует множество Action так, чтобы ими можно было оперировать с помощью редактора списка Action (Action list editor).
: Зарегистрированный класс будет отображаться в "Action list editor" при выборе команды редактора "New Action".
; procedure UnRegisterActions(const AClasses: array of TBasicActionClass); 
: Отменяет регистрацию множества Action, зарегистрированных ранее процедурой RegisterActions. Множество Action определяется параметром AClasses
Source: Взято с http://atrussk.ru/delphi/
ID: 01191
Category:Справочники
Создание иконок из ресурсов

=== Создание иконок из ресурсов ===
Вот небольшая статейка, найденная мной в FAQ(http://blackman.km.ru/myfaq/cont4.phtml). Может пригодится?
Функция CreateIconFromResourceEx создает иконку или курсор из битов ресурса, описывающих иконку.
CreateIconFromResourceEx 
Функция CreateIconFromResourceEx создает иконку или курсор из битов ресурса,
описывающих иконку.
 HICON CreateIconFromResourceEx( PBYTE pbIconBits, // указатель на биты ресурса
 DWORD cbIconBits, // число бит в буфере
 BOOL fIcon, // флаг иконки или курсора
 DWORD dwVersion, // версия формата Windows
 int cxDesired, // желаемая ширина иконки или курсора
 int cyDesired, // желаемая высота иконки или курсора
 UINT uFlags
 );
Параметры
* pbIconBits - указывает на буфер, содержащий биты ресурса иконки или курсора. Эти биты обычно загружаются вызовами функций LookupIconIdFromDirectory (в Windows 95 вы также можете использовать функцию LookupIconIdFromDirectoryEx) и LoadResource. 
* cbIconBits - определяет размер, в байтах, набора битов, на который указывает параметр pbIconBits.
* fIcon - определяет, будет ли создаваться иконка или курсор. Если значение этого параметра равно TRUE, создается иконка. Иначе создается курсор.
* dwVersion - определяет номер версии формата иконки или курсора для битов ресурса, на которые указывает параметр pbIconBits. Параметр может принимать одно из следующих значений:
** Windows 2.x - 0x00020000
** Windows 3.x - 0x00030000
: Все Win32 приложения должны использовать для иконок и курсоров формат Windows 3.x.
* cxDesired - определяет желаемую ширину иконки или курсора в пикселях. Если значение этого параметра равно нулю, функция использует значения метрики системы SM_CXICON или SM_CXCURSOR для установки ширины.
* cyDesired - определяет желаемую высоту иконки или курсора в пикселях. Если значение этого параметра равно нулю, функция использует значения метрики системы SM_CXICON или SM_CXCURSOR для установки высоты.
* uFlags - определяет комбинацию из следующих значений:
** LR_DEFAULTCOLOR - Используется цветовой формат по умолчанию.
** LR_MONOCHROME - Создается монохромная иконка или курсор. Возвращаемые значения В случае успеха возвращается дескриптор иконки или курсора.
В случае неудачи возвращается нуль. Для получения дополнительной информации об ошибке вызовите функцию GetLastError. 
Комментарии Функции CreateIconFromResourceEx, CreateIconFromResource, CreateIconIndirect, GetIconInfo и LookupIconIdFromDirectoryEx позволяют приложениям оболочки и браузерам
иконок проверять и использовать ресурсы См. также BITMAPINFOHEADER, CreateIconFromResource, CreateIconIndirect, GetIconInfo, LoadResource,
LookupIconIdFromDirectoryEx .
хелп по WinAPI: http://www.winnt.rsm.org.ru/winapi/win32api.exe
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02354
Создание индекса

=== Создание индекса ===
Ниже приведен код обработчика кнопки OnClick, с помощью которого строится индекс:
procedure TForm1.Button1Click(Sender: TObject);
var
 bActive, bExclusive: Boolean;
begin
 bActive := Table1.Active;
 bExclusive := Table1.Exclusive;
 Table1.IndexDefs.Update;
 with Table1 do
 begin
 Close;
 { таблица dBASE должна быть открыта в монопольном (exclusive) режиме }
 Exclusive := True;
 Open;
 if Table1.IndexDefs.IndexOf('FNAME') <> 0 then
 Table1.AddIndex('FNAME', 'FNAME', []);
 Close;
 Exclusive := bExclusive;
 Active := bActive;
 end;
end;
Если вы собираетесь запускать проект из Delphi, пожалуйста убедитесь в том, что свойство таблицы Active в режиме проектирования установлено в False.
Source: Взято с http://delphiworld.narod.ru
ID: 02625
Создание индексного файла из Delphi

=== Создание индексного файла из Delphi ===
Создание индексного файла из Delphi
Если вы используете таблицы dBASE или Paradox, то для создания нового индекса воспользуйтесь методом AddIndex. Для примера:
 Table1.AddIndex('Articles','Title', []);
создаст индексный файл с именем ARTICLES с использованием поля TITLE в качестве индексного ключа.
При создании вы можете воспользоваться различными индексными опциями (например, уникальность, необслуживаемый и пр.) - для получения дополнительной информации обратитесь к электронной справке по Delphi.
ПРИМЕЧАНИЕ: Ваша таблица должна быть открыта исключительно для того, чтобы только воспользоваться методом AddIndex.
Поддержка/обновление индексного файла, если только при создании вы не выставили флаг "необслуживаемый" (Maintenance-free), происходит автоматически.
Source: Взято с сайта http://blackman.wp-club.net/
ID: 02551
Создание кросс-таблицы

=== Создание кросс-таблицы ===
Вы можете создать их в DBD как QBE-шки. Пользуясь компонентом TQBE для загрузки одной из библиотек, вы можете непосредственно использовать QBE-шки в вашем Delphi-приложении.
В следующем примере предполагается, что каждый служащий каждый день сообщает оператору о своем месторасположении. Код определяет начало трудовой недели с понедельника плюс еще четыре рабочих дня с показом соответствующей даты. Строки с 1 по 5 в QBE1.QBE (нулевая описательная) в нижеприведенной процедуре заменяются кодом. Результат всего этого в том, что строка (если имеется) для каждого человека отображается в колонке установленного результата и значение 'X' включается если только запись существует. Для создания агрегатной таблицы можно было бы подсчитывать результаты.
Текст в QBE1.QBE :
CALLIN.DB | StaffNo | Date |
 | _join1 | 3/10/95 |
 | _join2 | 3/11/95 |
 | _join3 | 3/12/95 |
 | _join4 | 3/13/95 |
 | _join5 | 3/14/95 |
XTAB.DB | StaffNo |Mon |Tue |Wed |Thu |Fri |
 | _join1 |changeto X| | | | |
 | _join2 | |changeto X| | | |
 | _join3 | | |changeto X| | |
 | _join4 | | | |changeto X| |
 | _join5 | | | | |changeto X|
procedure TCallInReport.ButtonSelectClick(Sender: TObject);
begin
 TableXTab.active := false;
 if EditWeekOf.Text = then
 begin
 MessageBeep(0);
 MessageDlg('Для выбора записи необходима дата.', mtInformation, [mbOK], 0);
 exit;
 end;
 Screen.Cursor := crHourGlass;
 dtWeekOf := StrToDate(EditWeekOf.Text);
 dtStartDate := dtWeekOf - DayOfWeek(dtWeekOf) + 2;
 TableXTab.Active := False;
 TableXTab.EmptyTable;
 TableXTab.Active := True;
 {
 Замените строки 1 - 5 в QBE1.QBE реальными датами
 }
 QBE1.QBE.Strings[1] := ' | _join1 | ' + DateToStr(dtStartDate) + ' | ';
 QBE1.QBE.Strings[2] := ' | _join2 | ' + DateToStr(dtStartDate + 1) + ' | ';
 QBE1.QBE.Strings[3] := ' | _join3 | ' + DateToStr(dtStartDate + 2) + ' | ';
 QBE1.QBE.Strings[4] := ' | _join4 | ' + DateToStr(dtStartDate + 3) + ' | ';
 QBE1.QBE.Strings[5] := ' | _join5 | ' + DateToStr(dtStartDate + 4) + ' | ';
 try
 QBE1.active := true;
 except
 on E: EDataBaseError do
 begin
 if E.Message = 'Ошибка создания дескриптора курсора' then
 { Ничего не делайте. Делая TQBE активной, мы пытаемся создать курсор.
 Это вызывает исключительную ситуацию, которую мы должны перехватить.
 Пока я не нашел способа как отделаться от исключения. }
 else
 begin
 Screen.Cursor := crDefault;
 raise;
 end;
 end;
 else
 Screen.Cursor := crDefault;
 raise;
 end;
 TableXTab.Refresh;
 Screen.Cursor := crDefault;
 TableXTab.Active := True;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02594
Создание курсора с процентом выполнения

=== Создание курсора с процентом выполнения ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Создание курсора с процентом выполнения
Функция возвращает хэндл на созданный курсор Windows (hcursor, hicon)
с процентным соотношением, указанным в min,max и pos.
Своего рода ProgressBar, но только зашитый в курсор.
Зависимости: Windows, SysUtils, Graphics, Classes
Copyright: Василенко Роман
Дата: 07 мая 2002 г.
********************************************** }
// Используемые модули
uses Windows, SysUtils, Graphics, Classes;
// Сама функция
function create_prc_cursor(min, max, pos: Integer): hIcon;
var
 cWidth, cHeight: Integer;
 ii: IconInfo;
 bmc, bmm: TBitmap;
 Icon: hIcon;
 tw: Integer;
 tx: string;
 function int_percent(umin, umax, upos, uabs: Integer): Integer;
 begin
 Result := 0;
 if umax < umin then exit;
 if upos < umin then exit;
 if upos > umax then
 begin
 Result := 100;
 exit;
 end;
 if (umin = upos) and (umax = upos) then
 begin
 Result := 100;
 exit;
 end;
 Result := Round((upos - umin)/((umax - umin) / uabs));
 end;
 function create_curspace: TBitmap;
 begin
 Result := TBitmap.Create;
 Result.PixelFormat := pf4bit;
 Result.Width := cWidth;
 Result.Height := cHeight;
 end;
begin
 cWidth := GetSystemMetrics(sm_cxcursor);
 cHeight := GetSystemMetrics(sm_cycursor);
 bmc := create_curspace;
 bmm := create_curspace;
 with bmm.Canvas do
 begin
 Brush.Color := clWhite;
 FillRect(Rect(0, 0, bmm.Width, bmm.Height));
 Brush.Color := clBlack;
 FillRect(Rect(0, bmm.Height-8, bmm.Width, bmm.Height));
 Brush.Color := clWhite;
 FrameRect(Rect(0, bmm.Height-8, bmm.Width, bmm.Height));
 end;
 with bmc.Canvas do
 begin
 Brush.Color := clBlack;
 FillRect(Rect(0 ,0, bmc.Width, bmc.Height));
 Brush.Color := clWhite;
 FillRect(Rect(1+int_percent(min, max, pos, bmc.Width-2),
 bmm.Height-7, bmc.Width-1, bmc.Height-1));
 Brush.Color := clWhite;
 FrameRect(Rect(0, bmc.Height-8, bmc.Width, bmc.Height));
 end;
 tx := IntToStr(int_percent(min, max, pos, 100)) + '%';
 with bmm.Canvas do
 begin
 Font.Size := 8;
 Font.Style := [fsBold];
 Font.Color := clWhite;
 Brush.Color := clWhite;
 tw := TextWidth(tx);
 TextOut((cWidth - tw) div 2, 8, tx);
 end;
 with bmc.Canvas do
 begin
 Font.Size := 8;
 Font.Style := [fsBold];
 Font.Color := clWhite;
 Brush.Color := clBlack;
 TextOut((cWidth - tw) div 2, 8, tx);
 end;
 ii.fIcon := False;
 ii.hbmColor := bmc.Handle;
 ii.hbmMask := bmm.Handle;
 ii.xHotspot := 0;
 ii.yHotspot := 0;
 Icon := CreateIconIndirect(ii);
 Result := CopyIcon(Icon);
 DestroyIcon(Icon);
 bmc.Free;
 bmm.Free;
end;
 Пример использования:
Screen.Cursors[1] := create_prc_cursor(0, 100, 25);
Screen.Cursor := crNone;
Screen.Cursor := 1;
Author: Роман Василенко, romix@nm.ru, Пятигорск
ID: 02333
Создание мышиного перехватчика

=== Создание мышиного перехватчика ===
library Hookdemo;
uses
 Beeper in '\DELDEMOS\HOOKDEMO\BEEPER.PAS';
exports
 SetHook index 1,
 UnHookHook index 2,
 HookProc index 3;
begin
 HookedAlready := False;
end.
, где beeper.pas содержит следующий код:
unit Beeper;
interface
uses Wintypes, Winprocs, Messages;
function SetHook: Boolean; export;
function UnHookHook: Boolean; export;
function HookProc(Code: integer; wParam: Word;
 lParam: Longint): Longint; export;
var
 HookedAlready: Boolean;
implementation
var
 ourHook: HHook;
function SetHook: Boolean;
begin
 if HookedAlready then
 exit;
 ourHook := SetWindowsHookEx(WH_MOUSE, HookProc, HInstance, 0);
 HookedAlready := True;
end;
function UnHookHook: Boolean;
begin
 UnHookWindowsHookEx(ourHook);
 HookedAlready := False;
end;
function HookProc(Code: integer; wParam: Word; lParam: Longint): Longint;
begin
 if (wParam = WM_LBUTTONDOWN) then
 MessageBeep(0);
 Result := CallNextHookEx(ourHook, Code, wParam, lParam);
end;
end.
Теперь, при вызове из приложения функции SetHook, при каждом нажатии левой кнопки мыши будет раздаваться сигнал - до тех пор, пока вы не вызовете функцию UnHookHook. В действующем приложении возвращаемое функцией CallNextHookEx значение < 0 свидетельствует об отсутствии манипуляций с мышью. 
Source: http://delphiworld.narod.ru/
ID: 01605
Создание нового пользователя NetUserAdd

=== Создание нового пользователя NetUserAdd ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
 LPUSER_INFO_2 = ^USER_INFO_2;
 {$EXTERNALSYM LPUSER_INFO_2}
 PUSER_INFO_2 = ^USER_INFO_2;
 {$EXTERNALSYM PUSER_INFO_2}
 _USER_INFO_2 = record
 usri2_name: LPWSTR;
 usri2_password: LPWSTR;
 usri2_password_age: DWORD;
 usri2_priv: DWORD;
 usri2_home_dir: LPWSTR;
 usri2_comment: LPWSTR;
 usri2_flags: DWORD;
 usri2_script_path: LPWSTR;
 usri2_auth_flags: DWORD;
 usri2_full_name: LPWSTR;
 usri2_usr_comment: LPWSTR;
 usri2_parms: LPWSTR;
 usri2_workstations: LPWSTR;
 usri2_last_logon: DWORD;
 usri2_last_logoff: DWORD;
 usri2_acct_expires: DWORD;
 usri2_max_storage: DWORD;
 usri2_units_per_week: DWORD;
 usri2_logon_hours: PBYTE;
 usri2_bad_pw_count: DWORD;
 usri2_num_logons: DWORD;
 usri2_logon_server: LPWSTR;
 usri2_country_code: DWORD;
 usri2_code_page: DWORD;
 end;
 {$EXTERNALSYM _USER_INFO_2}
 USER_INFO_2 = _USER_INFO_2;
 {$EXTERNALSYM USER_INFO_2}
 TUserInfo2 = USER_INFO_2;
 PUserInfo2 = puser_info_2; 
 function NetUserAdd(ServerName: LPCWSTR; Level: DWORD;
 Buff: PByte; var Parm_Err: DWORD): DWORD; stdcall;
 external 'netapi32.dll';
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
 NERR_Success = 0;
 USER_PRIV_USER = 1;
 UF_SCRIPT = $0001;
 UF_DONT_EXPIRE_PASSWD = $10000;
var
 UserInfo: TUserInfo2;
 Parm_Err: DWORD;
begin
 ZeroMemory(@UserInfo, SizeOf(TUserInfo2));
 UserInfo.usri2_name := 'TestUser';
 UserInfo.usri2_password := '123';
 UserInfo.usri2_priv := USER_PRIV_USER;
 UserInfo.usri2_flags := UF_SCRIPT or UF_DONT_EXPIRE_PASSWD;
 if NetUserAdd(nil, 2, @UserInfo, Parm_Err) <> NERR_Success then
 RaiseLastOSError
 else
 ShowMessage('Пользователь TestUser с паролем 123 успешно добавлен.');
end;
end.
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 01729
Создание новой MS Access базы данных

=== Создание новой MS Access базы данных ===
Приведенная ниже процедура создает пустую базу данных MS Access
procedure CreateMSAccessDatabase(filename: string);
var
 DAO: Variant;
 i: integer;
const
 Engines: array[0..2] of string = ('DAO.DBEngine.36', 'DAO.DBEngine.35', 'DAO.DBEngine');
 function CheckClass(OLEClassName: string): boolean;
 var Res: HResult;
 begin
 Result := CoCreateInstance(ProgIDToClassID(OLEClassName), nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IDispatch, Res) = S_OK;
 end;
begin
 for i := 0 to 2 do
 begin
 if CheckClass(Engines[i]) then
 begin
 DAO := CreateOleObject(Engines[i]);
 DAO.Workspaces[0].CreateDatabase(filename, ';LANGID=0x0409;CP=1252;COUNTRY=0', 32);
 exit;
 end;
 end;
 raise Exception.Create('DAO engine could not be initialized');
end;
Кусочек кода, который должен распознавать какая версия DAO установлена на компьютере мной не мог быть оттестирован, так как только одна работающая версия DAO может быть установлена на компьютере. У меня установлен Office XP (DAO36) и на нем все работает нормально. Интересно было бы узнать работает ли логика для Office 2000 (DAO35) и Office 97 (DAO30)
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02770
----
Here is an OP function that will do it for you:
procedure CreateMSAccessDB(filename: string);
var
 DBEngine, Workspace: Variant;
const
 { Important to use the following constant as is }
 dbLangGeneral = ;
 LANGID = 0x0409;
 CP = 1252;
 COUNTRY = '0';
 dbVersion30 = 32;
begin
 DBEngine := CreateOleObject('DAO.DBEngine');
 {DBEngine := CreateOleObject('DAO.DBEngine.35'); For DAO 3.5}
 Workspace := DBEngine.Workspaces[0];
 try
 Workspace.CreateDatabase(filename, dbLangGeneral, dbVersion30);
 except
 on EOleException do
 ShowMessage('Database already exists');
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02771
----
It's very simple to create a empty Access-Database (*.mdb File) using OLE. It's not necessary to have MS-Access installed on your computer. If an exception occures the error message will returned. After creating the DB you can create Tables with simple SQL-Statements.
uses comobj, sysutils;
function CreateAccessDatabase(FileName: string): string;
var
 cat: OLEVariant;
begin
 result := ;
 try
 cat := CreateOleObject('ADOX.Catalog');
 cat.create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Filename + ';');
 cat := NULL;
 except
 on e: Exception do
 result := e.message;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02772
----
const
 CLASS_DBEngine: TGUID = '{00000100-0000-0010-8000-00AA006D2EA4}';
 dbLangCyrillic = ';LANGID=0x0409;CP=1252;COUNTRY=0';
 dbOption = 0
// or $20 // ? похоже создание в формате Access 97
 ;
procedure CreateMSAccessDatabase(FileName :String);
begin
 Variant(CreateOleObject(ClassIDToProgID(CLASS_DBEngine)))
 .Workspaces[0]
 .CreateDatabase (FileName, dbLangCyrillic, dbOption);
end;
Author: Петрович
Source: Взято из http://forum.sources.ru
ID: 02773
Создание пустого wav-файла

Как мне создать пустой wav-файл? Это просто пустой двоичный файл?
The TMediaPlayer может открыть звуковой файл, если он содержит, по крайней мере, один байт данных. Я обнаружил это, когда с помощью данного компонента пытался создать и открыть звуковой файл, содержащий только заголовок звукового файла. The TMediaplayer не захотел этого делать.
Нижеприведенный код создаст звуковой файл размером 1 байт. Конечно это криво, но это работает. Вам необходимо лишь добавить MMSYSTEM ко всем модулям, использующим данную функцию.
function CreateNewWave(NewFileName: string): Boolean;
var
 DeviceID: Word;
 Return: LongInt;
 MciOpen: TMCI_Open_Parms;
 MciRecord: TMCI_Record_Parms;
 MciPlay: TMCI_Play_Parms;
 MciSave: TMCI_SaveParms;
 MCIResult: LongInt;
 Flags: Word;
 TempFileName: array[0..255] of char;
begin
 MediaPlayer.Close;
 StrPCopy(TempFileName, NewFileName);
 MciOpen.lpstrDeviceType := 'waveaudio';
 MciOpen.lpstrElementName := ;
 Flags := Mci_Open_Element or Mci_Open_Type;
 MCIResult := MciSendCommand(0, MCI_OPEN, Flags, LongInt(@MciOpen));
 DeviceID := MciOpen.wDeviceId;
 MciRecord.dwTo := 1;
 Flags := Mci_To or Mci_Wait;
 MCIResult := MciSendCommand(DeviceID, Mci_Record, Flags, LongInt(@MciRecord));
 mciPlay.dwFrom := 0;
 Flags := Mci_From or Mci_Wait;
 MciSendCommand(DeviceId, Mci_Play, Flags, LongInt(@MciPlay));
 mciSave.lpfileName := TempFilename;
 Flags := MCI_Save_File or Mci_Wait;
 MCIResult := MciSendCommand(DeviceID, MCI_Save, Flags, LongInt(@MciSave));
 Result := MciSendCommand(DeviceID, Mci_Close, 0, LongInt(nil)) = 0;
end;
Как мне очистить содержимое Wav-файла? Просто заново создать пустой?
Вот небольшой компонент, позволяющий стирать любую часть wave-файла:
unit Nickmp;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, MPlayer, MMSystem;
type
 TNickMediaPlayer = class(TMediaPlayer)
 public
 function DeleteWaveChunk(aFrom, aTo: LongInt): Longint;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Samples', [TNickMediaPlayer]);
end;
function TNickMediaPlayer.DeleteWaveChunk(aFrom, aTo: LongInt): Longint;
var
 DeleteParms: TMCI_WAVE_DELETE_PARMS;
 Flags: LongInt;
begin
 Flags := 0;
 if Wait then Flags := mci_Wait;
 if Notify then Flags := Flags or mci_Notify;
 DeleteParms.dwCallback := Handle;
 Flags := Flags or mci_From;
 DeleteParms.dwFrom := aFrom;
 Flags := Flags or mci_To;
 DeleteParms.dwTo := aTo;
 Result := mciSendCommand(DeviceID, mci_Delete, Flags, Longint(@DeleteParms));
end;
end.
Author: Nick Hodges
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03617
Category:Звук
Создание редактора свойства

=== Создание редактора свойства ===
Если вы присвоили свойству имя TableName, то полный цикл создания редактора свойств включает следующие шаги:
Опишите класс редактора свойства:
type
 TTableNameProperty = class(TStringProperty)
 function GetAttributes: TPropertyAttributes; override;
 procedure GetValues(Proc: TGetStrProc); override;
 end;
implementation
{ TTableNameProperty }
function TTableNameProperty.GetAttributes: TPropertyAttributes;
begin
 Result := [paValueList];
end;
procedure TTableNameProperty.GetValues(Proc: TGetStrProc);
var
 TableName: String;
 I: Integer;
begin
 { здесь вы должны добавить свой код, чтобы с помощью цикла обойти имена всех
 таблиц, включенных в список }
 for I := 0 to ???? do 
 begin
 TableName := ????[I];
 Proc(TableName);
 end;
end; 
Затем зарегистрируйте данный редактор свойства следующим образом: 
 RegisterPropertyEditor(TypeInfo(string), TcsNotebook, 'TableName', TTableNameProperty); 
Source: http://forum.vingrad.ru
ID: 00032