nyuuzyou/wikis huggingface dataset:
Зачем нужен внешний ключ?

=== Зачем нужен внешний ключ? ===
Внешний ключ (FK - Foreign Key) используется для создания жесткой связи (многие к одному) между двумя таблицами.
Внешний ключ задается только в том случае, если в первой таблице есть поле, содержащее значение первичного ключа из второй таблицы.
При изменении значения первичного ключа во второй таблице, могут быть изменены все соответствующие значения связанного поля в первой таблице.
При удалении записи с определенным первичным ключом из второй таблице, могут быть удалены все записи с соответствующим значением связанного поля в первой таблице.
Обычно, при определении внешнего ключа, по нему автоматически создается индекс, который используется в запросах при объединении этих двух таблиц.
Source: http://delphiworld.narod.ru/
ID: 02432
Зачем нужны транзакции?

=== Зачем нужны транзакции? ===
Во многих случаях, необходимо проведение группы операций по изменению данных таким образом, чтобы эта группа обладала свойством атомарности (либо вся целиком выполняется, либо вся целиком не выполняется).
Такая группа операций называется транзакцией.
В SQL-серверах существуют операторы, позволяющие обозначить начало транзакции (begin transaction), ее успешное завершение (commit transaction), либо откат транзакции (rollback transaction).
Source: http://delphiworld.narod.ru/
ID: 02428
Защита Shareware програм

В качестве примера приведен небольшой участок программного кода, позволяющий быстро создать защиту для программ SHAREWARE, которая, не влияет на функциональность самой программы, но настоятельно «просит» ее зарегистрировать и закрывает при каждом повторном запуске.
Технология данного метода заключается в том, что пользователь может запустить программу только один раз за текущий сеанс Windows. Используйте обработчик события FormShow:
procedure TForm1.FormShow(Sender: TObject);
var
 atom: Integer;
 CRLF: string;
begin
 if GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then
 atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')
 else
 begin
 CRLF := #10 + #13;
 ShowMessage('Данная версия предусматривает только один запуск'
 + 'в текущем сеансе Windows.' + CRLF
 + 'Для повторного запуска необходимо перезапустить Windows, или,'
 + CRLF + 'что лучше, - ' + CRLF + 'ЗАРЕГИСТРИРУЙТЕСЬ !');
 Close;
 end;
end;
Преимущество данного метода в том, что пользователю доступны все возможности программы, но только до момента ее закрытия, или перезапуска системы. Вся хитрость заключается в сохранении некоторой строки в системных глобальных переменных («атомах») и последующей проверке ее в таблице «атомов» системы.
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04509
Category:Разработка приложений
Category:Защита и взлом
Защита данных

=== Защита данных ===
Давайте принципиально различать 2 ситуации:
==== Ситуация I ====
Нужно чтобы программа где-то хранила свои данные в зашифрованном виде. Пользователь никаких паролей не вводит. Такой сценарий обычно нужен чтобы предупредить возможность пользователя напрямую манипулировать теми или иными данными, позволяя ему общение только через программу.
Для этого случая сила криптографических алгоритмов не принципиальна. Против ламера поможет любая защита, против хакера - никакая защита не сработает, так как пароль/ключ и алгоритм уже находятся в руках, всё зашито в базе данных, exe и т.п. у пользователя на компьютере, то так или иначе эта защита вскрывается - программа дизассемблируется, трассируется, запросы к базе перехватываются и т.д. В данном случае что Парадокс, что MS Access, что любая другая база данных - не имеет значения, вопрос в том сломают её за 5 минут или за час.
==== Ситуация II ====
Есть конфиденциальные данные конкретного пользователя. Чтобы получить свои данные пользователь должен руками ввести свой пароль. Сам пароль известен только пользователю, ни в программном коде, ни в базе данных он нигде не хранится.
Вот здесь надо обратить внимание на базу данных. Сразу скажу - базы данных типа Парадокс, Foxpro, MS Access - подходят только если использовать шифрование данных, надеяться на их встроенные системы защиты нельзя. Лучше всего защищены промышленные сервера, типа MS SQL Server, Oracle, DB/2, SyBase. И тем ни менее, даже при их использовании, для максимальной защиты лучше шифровать вносимые данные по какому-нибудь криптостойкому алгоритму, например:
* берётся строка: "Логин+Пароль", введенные пользователем
* на этой строке делается MD5 - получается 32 битный ключ
* Все данные читаются и пишутся с предварительной шифровкой/дешифровкой с полученным ключом использую алгоритм "Triple-DES"
При таком раскладе можно и в парадоксе хранить - расшифровать практически невозможно. Только надо понимать что при таком алгоритме нет никакой возможности восстановить утерянный пароль, обнулить пароль и восстановить инфу при потере логина или пароля - информация будет утеряна навсегда.
Рассмотренные сценарии относятся к случаю, когда база данных поставляется с программой, если используется удалённый сервер баз данных или например для web приложений, то там правила немного другие, надо принимать в расчёт многочисленные возможности защиты информации на удалённом компьютере.
Author: Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято из http://forum.sources.ru
ID: 02409
Category:Базы данных
Защита от копирования с CD

procedure craye_file_inc;
var
 j: Int64;
 buf: array[Word] of Byte;
 st: TFileStream;
begin
 for j:=0 to 32766 do
 buf[j] := Byte(j); // ne pas craye un fichier de moins de 32k
 st := TFileStream.Create('Protection.dat', fmCreate);
 try
 for j:=0 to 10 do
 st.Write(Buf, Sizeof(Buf));
 finally
 st.Free;
 end;
end;
// dans votre programme
function CheckIfOriginalCd: Boolean
var
 f: THandle;
 b: array[0..500] of Byte;
 lus: Integer;
 Totlus: Int64;
begin
 Result := False;
 Totlus := 0;
 if not FileExist('Protection.dat') then exit;
 f := FileCreate('Protection.dat', fmRead);
 while true do
 begin
 try
 FileRead(f, b, lus);
 exept
 break;
 end;
 totlus := totlus + lus;
 if lus = 0 then
 break;
 end;
 if FileSize('Protection.dat') <> Totlus then
 if attributs, time etc etc... then
 Result := True;
end;
ID: 04577
Category:Разработка приложений
Защита программы паролем

Защита программы паролем 
Как видно из примера, программист может поместить любой код до обращения к методу Application.Run. В частности, он может показать диалоговое окно с запросом пароля и блокировать вызов Application.Run, если введенный пользователем пароль неверен. В следующем примере (листинг 4 - password.dpr) в проекте используются две формы: стандартная форма InputQuery и главная форма MainForm. Форма InputQuery создается при обращении к одноименной функции, определенной в модуле Dialogs. Она представляет собой небольшое диалоговое окно с однострочным редактором TEdit и двумя кнопками - ОК и Cancel. В окне пользователь должен ввести пароль (delphi) и нажать enter.
Листинг 4
program password;
uses
 Forms,
 Dialogs, // В этом модуле определена функция InputQuery
 Unit1 in 'unit1.pas' {MainForm};
{$r *.res}
var
 passwrd: string;
begin
 // Запрашиваем пароль:
 if InputQuery('Окно ввода пароля', 'Введите пароль:', passwrd) then
 // Проверяем его:
 if passwrd = 'delphi' then
 begin // Все в порядке, пароль верен
 Application.CreateForm(TMainForm, MainForm);
 Application.Run;
 end
 else
 ShowMessage('Пароль не верен!');
end.
Пробные версии программ 
Вышеописанным способом можно создавать пробные версии программ, которые будут функционировать только до определенной даты или до исчерпания заданного количества запусков. В листинге 5 представлен файл проекта (trial.dpr), в котором пробная версия программы может запускаться не более 5 раз. Для запоминания номера очередного прогона используется системный реестр.
Листинг 5
program trial;
uses
 Forms,
 Unit1 in 'unit1.pas' {Form1},
 Registry, Dialogs; // Для TRegistry и ShowMessage
{$r *.res}
var
 reg: TRegistry;
 n: Integer;
begin
 reg := TRegistry.Create;
 with reg do
 begin
 OpenKey('Software', True);
 OpenKey('TrialProg', True);
 if ValueExists('MaxRun') then // Первый запуск?
 begin // - Нет
 n := ReadInteger('MaxRun')-1;
 if n >= 0 then
 WriteInteger('MaxRun', n)
 end
 else
 begin // -Да, первый запуск
 n := 5;
 WriteInteger('MaxRun', n)
 end;
 Free;
 end;
 if n > 0 then
 begin
 Application.CreateForm(TForm1, Form1);
 Application.Run;
 end
 else
 ShowMessage('Исчерпано максимальное количество запусков'
 + ' пробной версии программы')
end.
Здесь следует дать небольшой комментарий. Модуль Registry декларирует класс TRegistry, который представляет программисту доступ к системному реестру Windows. С помощью двух обращений к функции TRegistry.OpenKey создается и/или открывается ключ HKEY_CURRENT_USER/Software/TrialProg системного реестра. Функция TRegistry.ValueExists возвращает True, если этот ключ содержит параметр с именем MaxRun и для него определено значение. При первом запуске приложения это не так, поэтому процедурой WriteInteger создается параметр и для него указывается начальное значение 5 (максимальное количество прогонов программы). При каждом следующем запуске этот параметр уменьшается на 1 и в момент, когда он становится равен 0, приложение блокирует создание и отображение главного окна.
Source: http://www.delphi.h5.ru/
ID: 04521
Category:Разработка приложений
Category:Защита и взлом
Зеркальное преобразование

procedure flip_horizontal(Quelle, Ziel: TBitMap);
begin
 Ziel.Assign(nil);
 Ziel.Width := Quelle.Width;
 Ziel.Height := Quelle.Height;
 StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
 0, Quelle.Height, Quelle.Width, Quelle.Height, srccopy);
end;
procedure flip_vertikal(Quelle, Ziel: TBitMap);
begin
 Ziel.Assign(nil);
 Ziel.Width := Quelle.Width;
 Ziel.Height := Quelle.Height;
 StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
 Quelle.Width, 0, Quelle.Width, Quelle.Height, srccopy);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 temp: TBitMap;
begin
 temp := TBitMap.Create;
 try
 temp.Assign(Image1.Picture.BitMap);
 flip_vertikal(Temp, Image1.Picture.Bitmap);
 finally
 Temp.Free;
 end;
end;
Source: http://www.swissdelphicenter.ch
ID: 03850
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Зеркальное отражение изображения
Зависимости: Windows, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор: Федоровских Николай
Дата: 16 июля 2002 г.
***************************************************** }
procedure FlipBitmap(Bitmap: TBitmap; FlipHor: Boolean);
{ Зеркальное отражение изображения.
 Если FlipHor = True, то отражение по горизонтали,
 иначе по вертикали. }
var
 x, y, W, H: Integer;
 Pixel_1, Pixel_2: PRGBTriple;
 MemPixel: TRGBTriple;
begin
 Bitmap.PixelFormat := pf24Bit;
 W := Bitmap.Width - 1;
 H := Bitmap.Height - 1;
 if FlipHor then { отражение по горизонтали }
 begin
 for y := 0 to H do
 begin
 { помещаем оба указателя на строку H }
 Pixel_1 := Bitmap.ScanLine[y];
 Pixel_2 := Bitmap.ScanLine[y];
 { помещаем второй указатель в конец строки }
 Inc(Pixel_2, W);
 { цикл идёт только до середины строки }
 for x := 0 to W div 2 do
 begin
 { симметричные точки обмениваются цветами }
 MemPixel := Pixel_1^;
 Pixel_1^ := Pixel_2^;
 Pixel_2^ := MemPixel;
 Inc(Pixel_1); { смещаем указатель вправо }
 Dec(Pixel_2); { смещаем указатель влево }
 end;
 end;
 end
 else { отражение по вертикали }
 begin
 { цикл идёт только до средней строки }
 for y := 0 to H div 2 do
 begin
 { помещаем первый указатель на строку H,
 а второй на строку симметричную H }
 Pixel_1 := Bitmap.ScanLine[y];
 Pixel_2 := Bitmap.ScanLine[H - y];
 for x := 0 to W do
 begin
 { симметричные точки обмениваются цветами }
 MemPixel := Pixel_1^;
 Pixel_1^ := Pixel_2^;
 Pixel_2^ := MemPixel;
 Inc(Pixel_1); { смещаем указатель вправо }
 Inc(Pixel_2); { смещаем указатель вправо }
 end;
 end;
 end;
end;
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03851
Category:Графика
Category:Bitmap
Из ресурсов поочередно загружать глифы для кнопок SpeedButton

=== Из ресурсов поочередно загружать глифы для кнопок SpeedButton ===
Могу ли я из ресурсов поочередно загружать глифы для кнопок speedbutton и, если да, то как это сделать? 
Например, если в вашем проекте используется TDBGrid, то иконки кнопок компонента DBNavigator могут линковаться вашей программой, и их можно загрузить для использования в ваших speedbutton следующим образом:
SpeedButton.Caption := ;
SpeedButton1.Glyph.LoadFromResourcename(HInstance, 'DBN_REFRESH');
SpeedButton1.NumGlyphs := 2;
Другие зарезервированные имена:
 DBN_PRIOR, DBN_DELETE, DBN_CANCEL, DBN_EDIT, DBN_FIRST, DBN_INSERT, DBN_LAST, DBN_NEXT, DBN_POST 
Все имена должны использовать верхний регистр.
Source: http://delphiworld.narod.ru/
ID: 01244
Из строки в массив и наоборот

=== Из строки в массив и наоборот ===
function StrToArrays(str, r: string; out Temp: TStrings): Boolean;
var
 j: integer;
begin
 if temp <> nil then
 begin
 temp.Clear;
 while str <> do
 begin
 j := Pos(r, str);
 if j = 0 then
 j := Length(str) + 1;
 temp.Add(Copy(Str, 1, j-1));
 Delete(Str, 1, j+length(r)-1);
 end;
 Result:=True;
 end
 else
 Result:=False;
end;
function ArrayToStr(str: TStrings; r: string): string;
var
 i: integer;
begin
 Result := ;
 if str = nil then
 Exit;
 for i := 0 to Str.Count-1 do
 Result := Result + Str.Strings[i] + r;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00144
Избавление от скролов в MDI форме

=== Избавление от скролов в MDI форме ===
{ Избавление от ScrollBar'ов в MDI-форме. (С) Peter Below (TeamB) }
{ Не надо VCL переписывать :-) }
unit MainForm;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Menus;
type
 TfMain = class(TForm)
 MainMenu1: TMainMenu;
 Newchild1: TMenuItem;
 Newchild2: TMenuItem;
 procedure Newchild2Click(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 fMain: TfMain;
implementation
uses ChildForm;
{$R *.DFM}
procedure TfMain.Newchild2Click(Sender: TObject);
begin
 with TfChild.Create(Application) do
 Show();
end;
function ClientWindowProc( wnd: HWND; msg: Cardinal; wparam, lparam: Integer ): Integer; stdcall;
var
 f: Pointer;
begin
 f := Pointer( GetWindowLong( wnd, GWL_USERDATA ));
 case msg of
 WM_NCCALCSIZE:
 if (GetWindowLong(wnd, GWL_STYLE) and (WS_HSCROLL or WS_VSCROLL)) <> 0 then
 SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not (WS_HSCROLL or WS_VSCROLL));
 end;
 Result := CallWindowProc(f, wnd, msg, wparam, lparam);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
 if ClientHandle <> 0 then
 begin
 if GetWindowLong(ClientHandle, GWL_USERDATA) <> 0 then
 Exit; { cannot subclass client window, userdata already in use }
 SetWindowLong(ClientHandle, GWL_USERDATA, SetWindowLong(ClientHandle, GWL_WNDPROC, integer(@ClientWindowProc)));
 end; // ^ maybe GetWindowLong? 
end;
end.
Source: Взято из http://forum.sources.ru
ID: 00501
Извлечение изображения из BLOB-поля

=== Извлечение изображения из BLOB-поля ===
Извлечение изображения из BLOB-поля таблицы dBASE или Paradox - без первой записи изображения в файл - простейший процесс использования метода Assign для сохранения содержимого BLOB-поля в объекте, имеющим тип TBitmap. Отдельный объект TBitmap или свойство Bitmap объекта Picture, в свою очередь являющегося свойством компонента TIMage, могут служить примером совместимой цели для данной операции.
Вот пример кода, демонстрирующего использование метода Assign для копирования изображения из BLOB-поля в компонент TImage.
procedure TForm1.Button1Click(Sender: TObject);
begin
 Image1.Picture.Bitmap.Assign(Table1Bitmap);
end;
В данном примере, объект Table1Bitmap типа TBLOBField - BLOB-поле таблицы dBASE. Данный TBLOBField-объекты был создан с помощью редактора полей (Fields Editor). Если редактор полей для создания TFields для полей таблицы не используется, получить доступ к полям можно с помощью метода FieldByName или свойства Fields, оба они являются членами компонентов TTable или TQuery. В случае ссылки на BLOB-поле таблицы с помощью одного из приведенных членов, перед использованием метода Assign указатель на поле должен быть прежде приведен к типу объекта TBLOBField. Для примера:
procedure TForm1.Button1Click(Sender: TObject);
begin
 Image1.Picture.Bitmap.Assign(TBLOBField(Table1.Fields[1]));
end;
Изображение, хранящееся в BLOB-поле, может быть скопировано непосредственно в отдельный TBitmap объект. Ниже приведен пример, демонстрирующий создание объекта TBitmap и сохранения в нем изображения из BLOB-поля.
procedure TForm1.Button2Click(Sender: TObject);
var
 B: TBitmap;
begin
 B := TBitmap.Create;
 try
 B.Assign(Table1Bitmap);
 Image1.Picture.Bitmap.Assign(B);
 finally
 B.Free;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02466
Извлечение текста из TMemoField

=== Извлечение текста из TMemoField ===
var
 P: PChar;
 S: TMemoryStream;
 Size: LongInt;
begin
 S := TMemoryStream.Create;
 MyMemoField.SaveToStream(S);
 Size := S.Position;
 GetMem(P, Size + 1);
 S.Position := 0;
 S.Read(P^, Size);
 P[Size] := #0;
 S.Free;
 { используем текст в PChar }
 FreeMem(P, Size + 1);
end;
Author: Steve Schafer
Source: Взято с http://delphiworld.narod.ru
ID: 02483
Изменение вида сортировки объектов в диалогах

=== Изменение вида сортировки объектов в диалогах ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 SaveDialog1: TSaveDialog;
 Button1: TButton;
 procedure SaveDialog1Show(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
// Стили: $7029 - значки, $702B - список, $702C - таблица, $702D - эскизы, $702E - плитка
// ставим, например таблицу
function NewSaveDlgProc(wnd:HWND; uMsg:integer; wParam:integer; lParam:integer):integer; stdcall;
begin
 if uMsg = WM_SHOWWINDOW then
 begin
 MoveWindow(wnd, 10, 30, 500, 300, True) ;
 SendMessage(FindWindowEx(wnd, 0, 'SHELLDLL_DefView', nil), WM_COMMAND, $702C, 0);
 end;
 Result := CallWindowProc(Pointer(GetWindowLong(wnd, GWL_USERDATA)), wnd, uMsg, wParam, lParam);
end;
procedure TForm1.SaveDialog1Show(Sender: TObject);
begin
 SetWindowLong(GetParent(SaveDialog1.Handle), GWL_USERDATA,
 SetWindowLong(GetParent(SaveDialog1.Handle), DWL_DLGPROC, DWORD(@NewSaveDlgProc)));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 SaveDialog1.Execute();
end;
end.
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 01218
Изменение гаммы рисунка

{
 **** UBPFD *********** by delphibase.endimus.com ****
>> Изменение гаммы рисунка
Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 5 июня 2002 г.
***************************************************** }
{0.0 < L < 7.0}
procedure Gamma(Bitmap: TBitmap; L: Double);
 function Power(Base, Exponent: Extended): Extended;
 begin
 Result := Exp(Exponent * Ln(Base));
 end;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 Dest: pRGB;
 X, Y: Word;
 GT: array[0..255] of Byte;
begin
 Bitmap.PixelFormat := pf24Bit;
 GT[0] := 0;
 if L = 0 then
 L := 0.01;
 for X := 1 to 255 do
 GT[X] := Round(255 * Power(X / 255, 1 / L));
 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 := GT[R];
 G := GT[G];
 B := GT[B];
 end;
 Inc(Dest);
 end;
 end;
end;
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03854
Category:Графика
Category:Bitmap
Изменение глубины цвета изображения

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 public
 function ChangeColorDepth(const FromBMP: TBitmap; out ToBMP: TBitmap;
 const ColorDepth: TPixelFormat): Boolean;
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
 B24, B16: TBitmap;
begin
 B24 := TBitmap.Create;
 try
 B24.LoadFromFile('c:\1.bmp');
 if ChangeColorDepth(B24, B16, pf4bit) then
 try
 B16.SaveToFile('c:\2.bmp');
 finally
 B16.Free;
 end;
 finally
 B24.Free;
 end;
end;
function TForm1.ChangeColorDepth(const FromBMP: TBitmap;
 out ToBMP: TBitmap; const ColorDepth: TPixelFormat): Boolean;
begin
 Result := True;
 try
 ToBMP := TBitmap.Create;
 ToBMP.Width := FromBMP.Width;
 ToBMP.Height := FromBMP.Height;
 ToBMP.PixelFormat := ColorDepth;
 ToBMP.Canvas.Draw(0, 0, FromBMP);
 except
 if ToBMP <> nil then ToBMP.Free;
 Result := False;
 end;
end;
end.
Author: Rouse_
Source: http://forum.sources.ru
ID: 03713
ID: 03867
Category:Графика
Category:Bitmap
Category:Цвета и палитры
Изменение громкости в TMediaPlayer

unit MpVolume;
interface
uses Windows, MPlayer;
const
 MCI_SETAUDIO = $0873;
 MCI_DGV_SETAUDIO_VOLUME = $4002;
 MCI_DGV_SETAUDIO_ITEM = $00800000;
 MCI_DGV_SETAUDIO_VALUE = $01000000;
 MCI_DGV_STATUS_VOLUME = $4019;
type
 MCI_DGV_SETAUDIO_PARMS = record
 dwCallback: DWORD;
 dwItem: DWORd;
 dwValue: DWORD;
 dwOver: DWORD;
 lpstrAlgorithm: PChar;
 lpstrQuality: PChar;
 end;
type
 MCI_STATUS_PARMS = record
 dwCallback: DWORD;
 dwReturn: DWORD;
 dwItem: DWORD;
 dwTrack: DWORD;
 end;
// Remember to add the name of your form to the procedures
function GetMPVolume(MP: TMediaPlayer): Integer;
procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);
implementation
uses mmsystem;
function GetMPVolume(MP: TMediaPlayer): Integer;
var
 p: MCI_STATUS_PARMS;
begin
 p.dwCallback := 0;
 p.dwItem := MCI_DGV_STATUS_VOLUME;
 mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p));
 Result := p.dwReturn;
 { Volume: 0 - 1000 }
end;
procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);
var
 p: MCI_DGV_SETAUDIO_PARMS;
begin
 { Volume: 0 - 1000 }
 p.dwCallback := 0;
 p.dwItem := MCI_DGV_SETAUDIO_VOLUME;
 p.dwValue := Volume;
 p.dwOver := 0;
 p.lpstrAlgorithm := nil;
 p.lpstrQuality := nil;
 mciSendCommand(MP.DeviceID, MCI_SETAUDIO,
 MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p));
end;
end.
Author: Smike
Source: http://forum.sources.ru
ID: 03621
Category:Звук