Разделы сайта: Новости сайта Форум Файловый архив ∙ Статьи ∙ Компоненты ∙ Исходники ∙ Программы ∙ Библиотека ∙ Игры ∙ Plug-in's ∙ Изображения IRC-канал сайта Регистрация Гостевая книга Вставка кода

Доброго времени суток, уважаемые читатели! Из-за ряда причин (неравномерное поступление новой информации, отсутствие иногда материалов для публикации в том или ином разделе выпуска, переброс усилий на доработку и модернизацию сайта), мной принято решение немного изменить формат рассылки. Как вы могли заметить, в последние два года рассылка выходила гораздо реже, чем до этого, но выпуски при этом были объёмными. Уверен, что такой подход неудобен ни Вам, как читателям, ни мне, как автору. В связи с этим рассылка будет облегчена: вместо прежних 5-7 разделов выпуски будут содержать в среднем 3-4 раздела. Плюсов в этом два: готовить такую рассылку гораздо проще (в каких разделах есть информация для публикации — такие и включаются в выпуск, остальные «отдыхают»), да и читать её проще. Прежний формат был неудобен для чтения: информации много (а в случае, когда имеем дело с программированием, везде есть ещё и фрагменты кода, восприятие которых требует большего времени, чем простой текст) и прочитать выпуск целиком «за раз» достаточно сложно. Новый формат п опытается эти неудобства устранить: материалы будут более сбалансированными порциями. Свои мнения об изменении формата можете оставлять на форуме, либо отправлять по почте. В этом выпуске: Новости портала и экспертной системы; Подборка вопросов и ответов по теме «Мультимедийные приложения»; Статья — Формат файлов RES применительно к BITMAP-ресурсам; Юмор — Как избавиться от компьютера за 10 дней.

Delphi.int.ru Expert Сообщество программистов: общение, помощь, обмен опытом. Количество читателей рассылки (29.07.2010, 12:00): 5161+2119+439= 7719

Новости портала

Наиболее значимым событием прошедших месяцев стало открытие на сайте форума. На форуме Вы можете обсуждать интересующие темы, в т.ч. и касающиеся нашего сайта. Основной акцент планируется делать на темы о программировании и об информационных технологиях, но это не запрещает вести дискуссии и на сторонние темы. Форум НЕ призван отвлечь внимание от экспертной системы — она вполне сформирована и удовлетворяет потребности пользователей. Поэтому, все конкретные вопросы следует как и ранее задавать в Delphi.int.ru Expert. Форум — это именно обсуждения, не подразумевающие точного ответа. Именно на форуме Вы можете высказать свои пожелания и предложения относительно портала.

С июня начал вручаться ежемесячный кубок «Форумчанин месяца». Первым его обладателем стал DNK за высокую активность на форуме в течение месяца.

Участнику serox была вручена юбилейная медаль «4000-ый участник сайта», а участнику min@y™ — «4000-ый вопрос на сайте».

Новости экспертной системы

В начале каждого месяца подводятся итоги голосования «лучший вопрос» и «лучший ответ» месяца — они выбираются на основе тех оценок, которые давали посетители сайта. Каждый из вопросов и ответов может быть оценён по пятибалльной шкале. Лучшими становятся те, за которые было отдано большее количество голосов и которые имеют наивысший средний балл. Победители получают почётные кубки.

За июнь-2010 кубки получили: Amidamaru (лучший ответ) и zloy_nub (лучший вопрос).

Последние достижения среди экспертов:

18 июля 2010, 21:54: Паникаровский Евгений Алексеевич стал экспертом и теперь имеет статус 1-ый класс (прежний статус: Посетитель).
13 июля 2010, 17:44: Паровоз повысил свой уровень и теперь имеет статус 10-ый класс (прежний статус: 9-ый класс).
12 июля 2010, 12:04: DNK повысил свой уровень и теперь имеет статус 9-ый класс (прежний статус: 8-ой класс).
21 июня 2010, 22:04: Amidamaru повысил свой уровень и теперь имеет статус 4-ый класс (прежний статус: 3-ий класс).
17 июня 2010, 05:30: Егор повысил свой уровень и теперь имеет статус 8-ой класс (прежний статус: 7-ой класс).

В раздел статистики добавлена новая страница — Географический портрет. На ней приведена разбивка зарегистрированных пользователей по странам.

Delphi.int.ru Expert — общение, помощь, обмен опытом

Новости портала | Участники и Эксперты | Информация и правила | Тематические разделы | Задать вопрос | Статистика

Вопросы и ответы

Сегодня Вашему вниманию представляется подборка вопросов из раздела «Мультимедийные приложения».

Вопрос # 1 145

Приветствую, уважаемые эксперты! Есть ли в Delphi функция управления громкостью динамиков?

Вопрос задал: Leonardo (статус: Посетитель) Вопрос отправлен: 27 ноября 2007, 20:58 Всего ответов: 2

Ответ #1. Отвечает эксперт: min@y™

Почитай хэлп по функции из модуля mmsystem.pas:

function auxSetVolume; external mmsyst name 'auxSetVolume';

В Delphi World есть несколько примеров её использования. Вот один из них:

procedure SetVolume(X: Word);
var
  iErr: Integer;
  i: integer;
  a: TAuxCaps;
begin
  for i := 0 to auxGetNumDevs do
  begin
    auxGetDevCaps(i, Addr(a), SizeOf(a));
    if a.wTechnology = AUXCAPS_CDAUDIO then
      break;
  end;
 
  // Устанавливаем одинаковую громкость для левого и правого каналов.
  // VOLUME := LEFT*$10000 + RIGHT*1
 
  iErr := auxSetVolume(i, (X * $10001));
  if (iErr‹›0) then
    ShowMessage('No audio devices are available!');
end;

Ответ отправил: min@y™ (статус: Кандидат наук) Ответ отправлен: 28 ноября 2007, 08:28

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Leonardo!
Дополнение к min@y™.
В Приложении еще пару способов и целый компонент... ;-)

function GetVolume: Word; var iErr : Integer; i: integer; a: TAuxCaps; vol: word; begin for i := 0 to auxGetNumDevs do begin auxGetDevCaps(i,Addr(a),SizeOf(a)); If a.wTechnology = AUXCAPS_CDAUDIO Then break; end; iErr:=auxGetVolume(i,addr(vol)); GetVolume := vol; if (iErr‹›0) then ShowMessage('No audio devices are available!'); end; Пример №2. procedure GetVolume(var volL, volR: Word); var hWO: HWAVEOUT; waveF: TWAVEFORMATEX; vol: DWORD; begin volL := 0; volR := 0; // init TWAVEFORMATEX FillChar(waveF, SizeOf(waveF), 0); // open WaveMapper = std output of playsound waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0); // get volume waveOutGetVolume(hWO, @vol); volL := vol and $FFFF; volR := vol shr 16; waveOutClose(hWO); end; procedure SetVolume(const volL, volR: Word); var hWO: HWAVEOUT; waveF: TWAVEFORMATEX; vol: DWORD; begin // init TWAVEFORMATEX FillChar(waveF, SizeOf(waveF), 0); // open WaveMapper = std output of playsound waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0); vol := volL + volR shl 16; // set volume waveOutSetVolume(hWO, vol); waveOutClose(hWO); end; Пример №3. uses mmsystem; function GetWaveVolume: DWord; var Woc : TWAVEOUTCAPS; Volume : DWord; begin result:=0; if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then begin WaveOutGetVolume(WAVE_MAPPER, @Volume); Result := Volume; end; end; procedure SetWaveVolume(const AVolume: DWord); var Woc : TWAVEOUTCAPS; begin if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then WaveOutSetVolume(WAVE_MAPPER, AVolume); end; procedure TForm1.Button1Click(Sender: TObject); begin Beep; end; procedure TForm1.Button2Click(Sender: TObject); var LeftVolume: Word; RightVolume: Word; begin LeftVolume := StrToInt(Edit1.Text); RightVolume := StrToInt(Edit2.Text); SetWaveVolume(MakeLong(LeftVolume, RightVolume)); end; procedure TForm1.Button3Click(Sender: TObject); begin Caption := IntToStr(GetWaveVolume); end; Пример №4. Компонент. unit Volumes; interface uses Windows, Messages, Classes, ExtCtrls, ComCtrls, MMSystem; const CDVolume = 0; WaveVolume = 1; MidiVolume = 2; type TVolumeControl = class(TComponent) private FDevices : array[0..2] of Integer; FTrackBars : array[0..2] of TTrackBar; FTimer : TTimer; function GetInterval: Integer; procedure SetInterval(AInterval: Integer); function GetVolume(AIndex: Integer): Byte; procedure SetVolume(AIndex: Integer; aVolume: Byte); procedure InitVolume; procedure SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar); { Private declarations } procedure Update(Sender: TObject); procedure Changed(Sender: TObject); protected { Protected declarations } procedure Notification(AComponent: TComponent; AOperation: TOperation); override; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } property Interval: Integer read GetInterval write SetInterval default 500; property CDVolume: Byte index 0 read GetVolume write SetVolume stored False; property CDTrackBar: TTrackBar index 0 read FTrackBars[0] write SetTrackBar; property WaveVolume: Byte index 1 read GetVolume write SetVolume stored False; property WaveTrackBar: TTrackBar index 1 read FTrackBars[1] write SetTrackBar; property MidiVolume: Byte index 2 read GetVolume write SetVolume stored False; property MidiTrackBar: TTrackBar index 2 read FTrackBars[2] write SetTrackBar; end; procedure Register; implementation procedure Register; begin RegisterComponents('Any', [TVolumeControl]); end; type TVolumeRec = record case Integer of 0: (LongVolume: Longint); 1: (LeftVolume, RightVolume : Word); end; function TVolumeControl.GetInterval: Integer; begin Result := FTimer.Interval; end; procedure TVolumeControl.SetInterval(AInterval: Integer); begin FTimer.Interval := AInterval; end; function TVolumeControl.GetVolume(AIndex: Integer): Byte; var Vol: TVolumeRec; begin Vol.LongVolume := 0; if FDevices[AIndex] < > -1 then case AIndex of 0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume); 1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume); 2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume); end; Result := (Vol.LeftVolume + Vol.RightVolume) shr 9; end; procedure TVolumeControl.SetVolume(aIndex: Integer; aVolume: Byte); var Vol: TVolumeRec; begin if FDevices[AIndex] < > -1 then begin Vol.LeftVolume := aVolume shl 8; Vol.RightVolume := Vol.LeftVolume; case AIndex of 0: auxSetVolume(FDevices[AIndex], Vol.LongVolume); 1: waveOutSetVolume(FDevices[AIndex], Vol.LongVolume); 2: midiOutSetVolume(FDevices[AIndex], Vol.LongVolume); end; end; end; procedure TVolumeControl.SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar); begin if ATrackBar < > FTrackBars[AIndex] then begin FTrackBars[AIndex] := ATrackBar; Update(Self); end; end; AOperation: TOperation); var I: Integer; begin inherited Notification(AComponent, AOperation); if (AOperation = opRemove) then for I := 0 to 2 do if (AComponent = FTrackBars[I]) then FTrackBars[I] := Nil; end; procedure TVolumeControl.Update(Sender: TObject); var I: Integer; begin for I := 0 to 2 do if Assigned(FTrackBars[I]) then with FTrackBars[I] do begin Min := 0; Max := 255; if Orientation = trVertical then Position := 255 - GetVolume(I) else Position := GetVolume(I); OnChange := Self.Changed; end; end; constructor TVolumeControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FTimer := TTimer.Create(Self); FTimer.OnTimer := Update; FTimer.Interval := 500; InitVolume; end; destructor TVolumeControl.Destroy; var I: Integer; begin FTimer.Free; for I := 0 to 2 do if Assigned(FTrackBars[I]) then FTrackBars[I].OnChange := Nil; inherited Destroy; end; procedure TVolumeControl.Changed(Sender: TObject); var I: Integer; begin for I := 0 to 2 do if Sender = FTrackBars[I] then with FTrackBars[I] do begin if Orientation = trVertical then SetVolume(I, 255 - Position) else SetVolume(I, Position); end; end; procedure TVolumeControl.InitVolume; var AuxCaps : TAuxCaps; WaveOutCaps : TWaveOutCaps; MidiOutCaps : TMidiOutCaps; I,J : Integer; begin FDevices[0] := -1; for I := 0 to auxGetNumDevs - 1 do begin auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps)); if (AuxCaps.dwSupport and AUXCAPS_VOLUME) < > 0 then begin FTimer.Enabled := True; FDevices[0] := I; break; end; end; FDevices[1] := -1; for I := 0 to waveOutGetNumDevs - 1 do begin waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps)); if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) < > 0 then begin FTimer.Enabled := True; FDevices[1] := I; break; end; end; FDevices[2] := -1; for I := 0 to midiOutGetNumDevs - 1 do begin MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps)); if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) < > 0 then begin FTimer.Enabled := True; FDevices[2] := I; break; end; end; end; end.

Ответ отправил: Feniks (статус: Бакалавр) Ответ отправлен: 28 ноября 2007, 10:09 Оценка за ответ: 5

Вопрос # 1 990

Доброго времени суток, уважаемые эксперты!
Меня интересует такой вопрос: Можно ли как-то проигрывать различные mp3 файлы при помощи одного проигрывателя TMediaPlayer (если на каждый mp3 будет баттон отдельны)? Если да, то как это можно сделать, если mp3 файлы будут лежать в папке, например Folder, которая, в свою очередь будет лежать рядом с экзешником программы? Спасибо.

Вопрос задал: Вечперик (статус: Посетитель) Вопрос отправлен: 12 октября 2008, 19:31 Всего ответов: 2; сообщений в мини-форуме вопроса: 4

Ответ #1. Отвечает эксперт: min@y™

Надо создать список этих файлов в памяти (например, TStringList), чтобы поочерёдно подсовывать их имена медиаплееру в свойство FileName.
Для составления такого списка можно использовать функции FindFirst(), FindNext(), FindClose().
Если же такой список хранить в доступном и видимом юзеру ListBox'e, то это будет подобие плей-листа, как в WinAmp, на строки которого можно быдет тыкать, т.е. запускать на воспроизведение нужный файл.

Ответ отправил: min@y™ (статус: Кандидат наук) Ответ отправлен: 13 октября 2008, 08:19 Оценка за ответ: 5

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Вечперик!
В дополнении min@y™.
А когда вы научитесь создавать список всех файлов, то можете еще и информацию из ID3Tag вытащить ;-) Примерчик в Приложении.

{ Byte 1-3 = ID 'TAG' Byte 4-33 = Titel / Title Byte 34-63 = Artist Byte 64-93 = Album Byte 94-97 = Jahr / Year Byte 98-127 = Kommentar / Comment Byte 128 = Genre } type TID3Tag = record ID: string[3]; Titel: string[30]; Artist: string[30]; Album: string[30]; Year: string[4]; Comment: string[30]; Genre: Byte; end; const Genres : array[0..146] of string = ('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge', 'Hip- Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B', 'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska', 'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient', 'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical', 'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise', 'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop', 'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic', 'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta', 'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave', 'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk', 'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk', 'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival', 'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock', 'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus', 'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera', 'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove', 'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad', 'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo', 'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House', 'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat', 'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C', 'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop'); var Form1: TForm1; implementation {$R *.dfm} function readID3Tag(FileName: string): TID3Tag; var FS: TFileStream; Buffer: array [1..128] of Char; begin FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try FS.Seek(-128, soFromEnd); FS.Read(Buffer, 128); with Result do begin ID := Copy(Buffer, 1, 3); Titel := Copy(Buffer, 4, 30); Artist := Copy(Buffer, 34, 30); Album := Copy(Buffer, 64, 30); Year := Copy(Buffer, 94, 4); Comment := Copy(Buffer, 98, 30); Genre := Ord(Buffer[128]); end; finally FS.Free; end; end; procedure TfrmMain.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin with readID3Tag(OpenDialog1.FileName) do begin LlbID.Caption := 'ID: ' + ID; LlbTitel.Caption := 'Titel: ' + Titel; LlbArtist.Caption := 'Artist: ' + Artist; LlbAlbum.Caption := 'Album: ' + Album; LlbYear.Caption := 'Year: ' + Year; LlbComment.Caption := 'Comment: ' + Comment; if (Genre >= 0) and (Genre <=146) then LlbGenre.Caption := 'Genre: ' + Genres[Genre] else LlbGenre.Caption := 'N/A'; end; end; end;

Ответ отправил: Feniks (статус: Бакалавр) Ответ отправлен: 13 октября 2008, 11:57 Оценка за ответ: 5

Вопрос # 2 042

Доброго времени суток, уважаемые эксперты!
Я как-то задавал подобный вопрос уже - но ответа не получил - а только кучу критики - и теперь понимаю, что не зря. Вообщем у меня остался всего один не разрешенный вопрос - а именно как с помощью одного компонента TMediaPlayer поигрывать по очереди песни -т. е. при нажатии на баттон MediaPlayer1 проигрывал сначала первый трек, закончил второй и т. д.! Желательно не через StringList - ато это я вообще не понимаю - если это возможно окнечно... Огромное спасибо! Ато очень хочу разобраться - но не выходи никак...

Вот принцип работы проги: procedure TForm1.PNGButton1Click(Sender: TObject); begin MediaPlayer1.FileName := ExtractFilePath(Application.ExeName)+'Sound1.mp3'; MediaPlayer1.Open; MediaPlayer1.Play; end; procedure TForm1.PNGButton2Click(Sender: TObject); begin MediaPlayer1.FileName := ExtractFilePath(Application.ExeName)+'Sound2.mp3'; MediaPlayer1.Open; MediaPlayer1.Play; end; и т. д.

Вопрос задал: Вечперик (статус: Посетитель) Вопрос отправлен: 4 ноября 2008, 11:10 Всего ответов: 2; сообщений в мини-форуме вопроса: 4

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, Вечперик!
У TMediaPlayer есть событие OnNotify. С помощью его вы можете определить, что проигрывание песни окончено. Вот тогда и берите следующую, какую вам нужно.
Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
  MediaPlayer1.Notify   := True;
  MediaPlayer1.OnNotify := NotifyProc;
end;
 
procedure TForm1.NotifyProc(Sender: TObject);
begin
  with Sender as TMediaPlayer do
   begin
    case Mode of
      mpStopped: 
// Проигрывание остановлено, значит берем следующий трек
      end;
//must set to true to enable next-time notification 
   Notify := True;
  end;
end;

Что тут не понятного ? В чем у вас сложности ?

P.S. Желаю удачи.

Ответ отправил: Feniks (статус: Бакалавр) Ответ отправлен: 4 ноября 2008, 11:37 Оценка за ответ: 5

Ответ #2. Отвечает эксперт: min@y™

Надо использовать событие TMediaPlayer.OnNotify. Оно генерируется при возникновении любого события, связанного с воспроизведением: (Back, Close, Eject, Next, Open, Pause, PauseOnly, Play, Previous, Resume, Rewind, StartRecording, Step, Stop), причём свойство TMediaPlayer.Notify должно быть установлено в True. Имей в виду ещё, что это свойство сбрасывается в False при каждом вызове OnNotify и его в обработчике этого события надо снова ставить в True, чтобы следующее событие OnNotify вызвало его обработчик.

Чтобы отловить момент окончания воспроизведения очередного файла, нужно написать что-то типа:

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
  if MediaPlayer1.Mode = mpStopped
    then begin
           MediaPlayer1.Close();
           MediaPlayer1.FileName:= 'Следующее_имя_файла.mp3';
           MediaPlayer1.Open();
           MediaPlayer1.Play();
         end;
 
  Notify:= True; // Чтобы вызвалось следующее событие
end;

“Цитата”

Желательно не через StringList - ато это я вообще не понимаю - если это возможно окнечно... Огромное спасибо! Ато очень хочу разобраться - но не выходи никак...

Это, конечно, возможно, но рекомендуется только мазохистам. :))
Относительно большие куски кода мне вставлять не разрешают, поэтому смотри приложение.

З.Ы. Никак не вкурю, что такого СТРАШНОГО в TStringList? Обясни на форуме, плиз.

var FileIndex: Integer = 1; procedure TForm1.PNGButton1Click(Sender: TObject); begin MediaPlayer1.FileName := ExtractFilePath(Application.ExeName) + 'Sound' + IntToStr(FileIndex) + '.mp3'; MediaPlayer1.Open; MediaPlayer1.Play; end; procedure TForm1.MediaPlayer1Notify(Sender: TObject); var FileName: string; begin if MediaPlayer1.Mode = mpStopped then begin MediaPlayer1.Close(); Inc(FileIndex); FileName:= 'Sound' + IntToStr(FileIndex) + '.mp3'; if FileExists(FileName) then begin MediaPlayer1.FileName:= FileName; MediaPlayer1.Open(); MediaPlayer1.Play(); end else Application.MessageBox(PChar('Файл ' + FileName + ' не найден.'), PChar('Ошибка'), mb_Ok + mb_IconError); end; Notify:= True; // Чтобы вызвалось следующее событие end;

Ответ отправил: min@y™ (статус: Кандидат наук) Ответ отправлен: 4 ноября 2008, 12:06 Оценка за ответ: 5

Вопрос # 1 461

Здравствуйте! У меня такой вопрос:
Я хочу написать аналог виндосовского регулятора громкости но без всяких настроек звучания и тд,то есть просто шкалу с громкостью колонок,и галочку для вкл/выкл микрофона.
Просто стандартный слишком долго открывается и сидит в трее.

Вопрос задал: Дмитрий С. - 1148 (статус: Посетитель) Вопрос отправлен: 31 марта 2008, 11:44 Всего ответов: 2; сообщений в мини-форуме вопроса: 4

Ответ #1. Отвечает эксперт: Бубырь Александр Николаевич

Здравствуйте, Дмитрий С. - 1148!
Существует замечательный сборник ответов на многие вопросы по делфи под названием Kuliba.
Найти его в интернете не составит труда.
Просто копирую отрывок оттуда (см. приложение).

Как реализовать регулятор громкости? Nomadic советует: Да всё пpосто. Даже, я бы сказал, тyпо. :-) INT GetMasterVolumeControlID() { // get dwLineID MIXERLINE mxl; mxl.cbStruct = sizeof(MIXERLINE); mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS; if (::mixerGetLineInfo((HMIXEROBJ)ghmx, &mxl, MIXER_OBJECTF_HMIXER | MIXER_GETLINEINFOF_COMPONENTTYPE) != MMSYSERR_NOERROR) return 34; // get dwControlID MIXERCONTROL mxc; MIXERLINECONTROLS mxlc; mxlc.cbStruct = sizeof(MIXERLINECONTROLS); mxlc.dwLineID = mxl.dwLineID; mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME; mxlc.cControls = 1; mxlc.cbmxctrl = sizeof(MIXERCONTROL); mxlc.pamxctrl = &mxc; if (::mixerGetLineControls((HMIXEROBJ)ghmx, &mxlc, MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE) != MMSYSERR_NOERROR) return 34; return mxc.dwControlID; } BOOL SetMasterVolume(DWORD dwVolume) { MIXERCONTROLDETAILS mxcd; MIXERCONTROLDETAILS_UNSIGNED mxcd_u; mxcd.cbStruct = sizeof(mxcd); mxcd.dwControlID = MasterVolumeControlID; mxcd.cChannels = 1; mxcd.cMultipleItems = 0; mxcd.cbDetails = 4; mxcd.paDetails = &mxcd_u; mmr = mixerGetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L); if (MMSYSERR_NOERROR != mmr) return FALSE; mxcd_u.dwValue = dwVolume; mmr = mixerSetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L); if (MMSYSERR_NOERROR != mmr) return FALSE; return TRUE; } Переписывать на Delphi, думаю, ни к чему. Надо лишь не забыть добавить uses MMSystem; Громкость отдельных каналов очень просто устанавливается через auxSetVolume и аналогичные.

Ответ отправил: Бубырь Александр Николаевич (статус: Студент) Ответ отправлен: 1 апреля 2008, 02:09 Оценка за ответ: 4 Комментарий к оценке: Так это по Си этот сборник? А по делфи подобный не посоветуете?

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Дмитрий С. - 1148!
Держите в Приложении несколько примеров по вкл/выкл громкости устройст и регулированию громкости.
Желаю удачи.

Пример №1. Вкл/Выкл громкости устройства. {********************************************************} // Enable/disable "Mute" for several mixer line sources. uses MMSystem; type TMixerLineSourceType = (lsDigital, lsLine, lsMicrophone, lsCompactDisk, lsTelephone, lsWaveOut, lsAuxiliary, lsAnalog, lsLast); function SetMixerLineSourceMute(AMixerLineSourceType: TMixerLineSourceType; bMute: Boolean): Boolean; var hMix: HMIXER; mxlc: MIXERLINECONTROLS; mxcd: TMIXERCONTROLDETAILS; vol: TMIXERCONTROLDETAILS_UNSIGNED; mxc: MIXERCONTROL; mxl: TMixerLine; intRet: Integer; nMixerDevs: Integer; mcdMute: MIXERCONTROLDETAILS_BOOLEAN; begin Result := False; // Check if Mixer is available nMixerDevs := mixerGetNumDevs(); if (nMixerDevs < 1) then begin Exit; end; // open the mixer intRet := mixerOpen(@hMix, 0, 0, 0, 0); if intRet = MMSYSERR_NOERROR then begin ZeroMemory(@mxl, SizeOf(mxl)); case AMixerLineSourceType of lsDigital: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_DIGITAL; lsLine: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_LINE; lsMicrophone: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE; lsCompactDisk: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC; lsTelephone: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE; lsWaveOut: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT; lsAuxiliary: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY; lsAnalog : mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_ANALOG; lsLast: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_LAST; end; // mixerline info mxl.cbStruct := SizeOf(mxl); intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE); if intRet = MMSYSERR_NOERROR then begin ZeroMemory(@mxlc, SizeOf(mxlc)); mxlc.cbStruct := SizeOf(mxlc); mxlc.dwLineID := mxl.dwLineID; mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE; mxlc.cControls := 1; mxlc.cbmxctrl := SizeOf(mxc); mxlc.pamxctrl := @mxc; // Get the mute control intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE); if intRet = MMSYSERR_NOERROR then begin ZeroMemory(@mxcd, SizeOf(mxcd)); mxcd.cbStruct := SizeOf(TMIXERCONTROLDETAILS); mxcd.dwControlID := mxc.dwControlID; mxcd.cChannels := 1; mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN); mxcd.paDetails := @mcdMute; mcdMute.fValue := Ord(bMute); // set, unset mute intRet := mixerSetControlDetails(hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE); { mixerGetControlDetails(hMix, @mxcd, IXER_GETCONTROLDETAILSF_VALUE); Result := Boolean(mcdMute.fValue); } Result := intRet = MMSYSERR_NOERROR; if intRet <> MMSYSERR_NOERROR then ShowMessage('SetControlDetails Error'); end else ShowMessage('GetLineInfo Error'); end; intRet := mixerClose(hMix); end; end; // Example Call; procedure TForm1.Button1Click(Sender: TObject); begin SetMixerLineSourceMute(lsLine, True); end; Пример №2. Изменение громкости. Вариант 1. procedure SetVolume(X: Word); var iErr: Integer; i: integer; a: TAuxCaps; begin for i := 0 to auxGetNumDevs do begin auxGetDevCaps(i, Addr(a), SizeOf(a)); if a.wTechnology = AUXCAPS_CDAUDIO then break; end; // Устанавливаем одинаковую громкость для левого и правого каналов. // VOLUME := LEFT*$10000 + RIGHT*1 iErr := auxSetVolume(i, (X * $10001)); if (iErr‹›0) then ShowMessage('No audio devices are available!'); end; function GetVolume: Word; var iErr: Integer; i: integer; a: TAuxCaps; vol: word; begin for i := 0 to auxGetNumDevs do begin auxGetDevCaps(i, Addr(a), SizeOf(a)); if a.wTechnology = AUXCAPS_CDAUDIO then break; end; iErr := auxGetVolume(i, addr(vol)); GetVolume := vol; if (iErr‹›0) then ShowMessage('No audio devices are available!'); end; Вариант 2. unit Volumes; interface uses Windows, Messages, Classes, ExtCtrls, ComCtrls, MMSystem; const CDVolume = 0; WaveVolume = 1; MidiVolume = 2; type TVolumeControl = class(TComponent) private FDevices : array[0..2] of Integer; FTrackBars : array[0..2] of TTrackBar; FTimer : TTimer; function GetInterval: Integer; procedure SetInterval(AInterval: Integer); function GetVolume(AIndex: Integer): Byte; procedure SetVolume(AIndex: Integer; aVolume: Byte); procedure InitVolume; procedure SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar); { Private declarations } procedure Update(Sender: TObject); procedure Changed(Sender: TObject); protected { Protected declarations } procedure Notification(AComponent: TComponent; AOperation: TOperation); override; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } property Interval: Integer read GetInterval write SetInterval default 500; property CDVolume: Byte index 0 read GetVolume write SetVolume stored False; property CDTrackBar: TTrackBar index 0 read FTrackBars[0] write SetTrackBar; property WaveVolume: Byte index 1 read GetVolume write SetVolume stored False; property WaveTrackBar: TTrackBar index 1 read FTrackBars[1] write SetTrackBar; property MidiVolume: Byte index 2 read GetVolume write SetVolume stored False; property MidiTrackBar: TTrackBar index 2 read FTrackBars[2] write SetTrackBar; end; procedure Register; implementation procedure Register; begin RegisterComponents('Any', [TVolumeControl]); end; type TVolumeRec = record case Integer of 0: (LongVolume: Longint); 1: (LeftVolume, RightVolume : Word); end; function TVolumeControl.GetInterval: Integer; begin Result := FTimer.Interval; end; procedure TVolumeControl.SetInterval(AInterval: Integer); begin FTimer.Interval := AInterval; end; function TVolumeControl.GetVolume(AIndex: Integer): Byte; var Vol: TVolumeRec; begin Vol.LongVolume := 0; if FDevices[AIndex] < > -1 then case AIndex of 0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume); 1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume); 2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume); end; Result := (Vol.LeftVolume + Vol.RightVolume) shr 9; end; procedure TVolumeControl.SetVolume(aIndex: Integer; aVolume: Byte); var Vol: TVolumeRec; begin if FDevices[AIndex] < > -1 then begin Vol.LeftVolume := aVolume shl 8; Vol.RightVolume := Vol.LeftVolume; case AIndex of 0: auxSetVolume(FDevices[AIndex], Vol.LongVolume); 1: waveOutSetVolume(FDevices[AIndex], Vol.LongVolume); 2: midiOutSetVolume(FDevices[AIndex], Vol.LongVolume); end; end; end; procedure TVolumeControl.SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar); begin if ATrackBar < > FTrackBars[AIndex] then begin FTrackBars[AIndex] := ATrackBar; Update(Self); end; end; AOperation: TOperation); var I: Integer; begin inherited Notification(AComponent, AOperation); if (AOperation = opRemove) then for I := 0 to 2 do if (AComponent = FTrackBars[I]) then FTrackBars[I] := Nil; end; procedure TVolumeControl.Update(Sender: TObject); var I: Integer; begin for I := 0 to 2 do if Assigned(FTrackBars[I]) then with FTrackBars[I] do begin Min := 0; Max := 255; if Orientation = trVertical then Position := 255 - GetVolume(I) else Position := GetVolume(I); OnChange := Self.Changed; end; end; constructor TVolumeControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FTimer := TTimer.Create(Self); FTimer.OnTimer := Update; FTimer.Interval := 500; InitVolume; end; destructor TVolumeControl.Destroy; var I: Integer; begin FTimer.Free; for I := 0 to 2 do if Assigned(FTrackBars[I]) then FTrackBars[I].OnChange := Nil; inherited Destroy; end; procedure TVolumeControl.Changed(Sender: TObject); var I: Integer; begin for I := 0 to 2 do if Sender = FTrackBars[I] then with FTrackBars[I] do begin if Orientation = trVertical then SetVolume(I, 255 - Position) else SetVolume(I, Position); end; end; procedure TVolumeControl.InitVolume; var AuxCaps : TAuxCaps; WaveOutCaps : TWaveOutCaps; MidiOutCaps : TMidiOutCaps; I,J : Integer; begin FDevices[0] := -1; for I := 0 to auxGetNumDevs - 1 do begin auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps)); if (AuxCaps.dwSupport and AUXCAPS_VOLUME) < > 0 then begin FTimer.Enabled := True; FDevices[0] := I; break; end; end; FDevices[1] := -1; for I := 0 to waveOutGetNumDevs - 1 do begin waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps)); if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) < > 0 then begin FTimer.Enabled := True; FDevices[1] := I; break; end; end; FDevices[2] := -1; for I := 0 to midiOutGetNumDevs - 1 do begin MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps)); if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) < > 0 then begin FTimer.Enabled := True; FDevices[2] := I; break; end; end; end; end. Вариант 3. Выставьте на форму 2 тракбара и двигайте их. Если у вас звучит музыка, вы должны услышать изменения громкости правого и левого каналов. Свойство Max в каждом TrackBar'e должно равняться 65535 (то есть MaxWord) procedure TForm1.TrackBar1Change(Sender: TObject); var s: dword; a,b: word; h: hWnd; begin a:=trackbar1.position; b:=trackbar2.position; s:=(a shl 16) or b; waveOutSetVolume(h,s); end;

Ответ отправил: Feniks (статус: Бакалавр) Ответ отправлен: 2 апреля 2008, 17:03

Вопрос # 2 143

Здравствуйте!
Эх, почти закончил программу, но осталось сделать последний шаг, который для меня пока что нереальным является! Поэтому и снова обращаюсь к вам... Мне нужно добавить mp3 файл в экзешник проги! Мне говорили - что с помощью ресурсов можно сделать - но сколько инфы я не перечитал - ничего не понял! Я даже с принципом работы не разобрался... получается как - при запуски проги mp3 файл из ресурсов копируется куда-то в глубокий темп, если на него сослаться - он воспроизводится - а по закрытии проги автоматически удаляется, так? Ну вот и все, впринципе, как добавить mp3 файл в ресурсы или куда-то еще, но чтобы небыло его на жестком... может где-то есть статья, как это сделать, написанная для гиперчайников, как я, или кому-то объяснить не лень будет! Был бы не то, что бы очень признателен - а гипер признателен! Спасибо)

Вопрос задал: Вечперик (статус: Посетитель) Вопрос отправлен: 30 ноября 2008, 11:42 Всего ответов: 2; сообщений в мини-форуме вопроса: 41

Ответ #1. Отвечает эксперт: Блазер

Здравствуйте, Вечперик!
Сначала кидаем mp3 на диск с (для быстрого доступа) обзываем его например: music.mp3
Создаем файл music.RC и в него записываем: music music "music.mp3" сохраняем.
Входим в командную строку (cmd) и пишем команду: brcc32 C:\music.RC
На диске с появится файл music.res с запакованым в нём music.mp3, осталось его только подключить и использовать...
Распаковать этот mp3 пишем процедуру:

 procedure ExtractRes(ResType, ResName, ResNewName : String);
var
Res : TResourceStream;
Begin
Res:=TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
Res.SavetoFile(ResNewName);
Res.Free;
 end;

И собственно воспроизведение:

 ExtractRes('music', 'music', 'music.mp3');
 with MediaPlayer1 do
begin
  FileName:='music.mp3';
 Open;
   Play
   end;

Т.e. сначало файл распаковывается в папку с exe, а потом воспроизводится...при выходе из проги его можно удалить...
П.с. еще файл ресурса надо подключить, вписав строку {$R music.res} под строкой {$R *.dfm}...

Удачи, надеюсь все написал правильно...ибо со звуком давно не работал...если что то не получится, пишите на мф....

(редактировалось 1 раз)

Ответ отправил: Блазер (статус: 4-ый класс) Ответ отправлен: 30 ноября 2008, 12:18 Оценка за ответ: 5

Ответ #2. Отвечает эксперт: Ученый

Здравствуйте, Вечперик! Создаете music.RC, точно так как вам сказал Блазер, только писать надо music WAV music.mp3. Далее создаем ресурс music.res, надеюсь в этом вы не затруднитесь.
Собственно сама процедур а выглядит так:
procedure joue;
var
h: THandle;
p: pointer;
begin
h := FindResource(hInstance,'music','WAV');
h := LoadResource(hInstance, h);
p := LockResource(h);
sndPlaySound(p,
SND_MEMORY or SND_SYNC);
UnLockResource(h);
FreeResource(h);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
joue('music');
end;

Но есть один недостаток, пока звук не проиграет до конца, ни один объект на форме не будет доступен. Решить эту проблему можно при помощи потоков.

Ответ отправил: Ученый (статус: 8-ой класс) Ответ отправлен: 30 ноября 2008, 19:16 Оценка за ответ: 5

Вопрос # 1 485

Здравствуйте!
Ищу программу преобразования различных звуковых файлов (в частности в формате WAV) в формат MP3.
Заранее благодарен.
Рубин.

Вопрос задал: Рубин Я.И. (статус: Посетитель) Вопрос отправлен: 9 апреля 2008, 10:10 Всего ответов: 2

Ответ #1. Отвечает эксперт: Бубырь Александр Николаевич

Здравствуйте, Рубин Я.И.!
Подобных программ тысячи.
Наберите в поисковике "преобразовать wav mp3" и будет вам радость.
А вообще здесь задают вопросы по программированию, а не по поиску программ.
Если задача преобразовывать из своей программы, советую вызывать конвертор Lame - один из лучших конверторов в МП3 и работает из коммандной строки.
Успехов.

Ответ отправил: Бубырь Александр Николаевич (статус: Студент) Ответ отправлен: 9 апреля 2008, 10:57 Оценка за ответ: 4

Ответ #2. Отвечает эксперт: T$imokhin

Здравствуйте, Рубин Я.И.!
Как до этого сказал Бубырь Александр Николаевич. Таких программ много. В нете их можно найти миллионы.
И повторю слова Бубырь Александр Николаевич это программирование:Создание программ, а не их поиск.

P.S. Я редко этим пользуюсь. Но если надо у меня есть Vegas 4

Ответ отправил: T$imokhin (статус: 1-ый класс) Ответ отправлен: 9 апреля 2008, 17:25

Вопрос # 1 798

Доброго времени суток, уважаемые эксперты! У меня к Вам такой вопрос: можно ли сделать такую программу, которая бы при нажатии на button воспроизводила бы видео файл (который будет лежать в одной папке с exe файлом программы) не через компонент MediaPlayer а через player, который установлен в винде по умолчанию для данного типа файлов? Спасибо

Вопрос задала: Violina (статус: Посетитель) Вопрос отправлен: 4 августа 2008, 17:59 Всего ответов: 2; сообщений в мини-форуме вопроса: 18

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, Violina!
Надо использовать функцию ShellExecute.
Вот здесь есть описание.
попробуйте сделать, неполучиться- пишите в минифорум - разберёмся

Ответ отправил: Вадим К (статус: Академик) Ответ отправлен: 4 августа 2008, 18:13 Оценка за ответ: 5

Ответ #2. Отвечает эксперт: Бубырь Александр Николаевич

Здравствуйте, Violina!
Добавлю к предыдущему оратору то, что для открытия любого файла приложением по умолчанию можно выполнить start "имя файла".
В Вашем случае достаточно следующего: WinExec('start '+filename, SW_SHOW);

Ответ отправил: Бубырь Александр Николаевич (статус: Студент) Ответ отправлен: 4 августа 2008, 18:26 Оценка за ответ: 5

Вопрос # 3 042

Здравствуйте!
Необходимо при клике мышью по любому месту формы воспроизвести звук MySound лежащий в ресурсах в папке SND_RESOURCE, этот же звук необходимо воспроизводить при клике по Image. Delphi 2009 если это имеет значение.

Вопрос задал: Pessimist (статус: Посетитель) Вопрос отправлен: 25 июля 2009, 16:48 Всего ответов: 2; сообщений в мини-форуме вопроса: 15

Ответ #1. Отвечает эксперт: min@y™

Есть не мало статей с примерами на тему проигрывания звука из ресурсов.
Вот одна из них.

Ответ отправил: min@y™ (статус: Кандидат наук) Ответ отправлен: 25 июля 2009, 17:12 Оценка за ответ: 5 Комментарий к оценке: Спасибо, искал сам сонный, не замечал модуль который надо подключить, а тут он 1, сразу заметил и код стал рабочим. Еще раз спасибо

Ответ #2. Отвечает эксперт: Ученый

Здравствуйте, Pessimist!
Вообщем делай так:
Открываешь блокнот и пишешь:
MYWAVFILE WAVE MYWAVFILE.Wav
где MYWAVFILE.Wav это имя файла звука.
Далее сохраняешь это все в Res.RC, кидаешь его в папку с проектом, тудаже кидаешь файл со звуком MYWAVFILE.Wav
Далее запускаешь Проект, в Project Manager правой кнопкой на проекте и выбираете add, в окне выбираете Res.RC
Дальше в Юните пишешь:

unit ResProverka;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MMSystem;
 
type
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
{$R res.res}
procedure TForm1.FormClick(Sender: TObject);
begin
PlaySound('MyWavFile', Hinstance, SND_RESOURCE);
end;
 
end.

Компилируешь и вауаля....

Ответ отправил: Ученый (статус: 8-ой класс) Ответ отправлен: 25 июля 2009, 19:59 Оценка за ответ: 5 Комментарий к оценке: Сработало, спасибо.

Вопрос # 1 988

Здравствуйте, уважаемые эксперты! Моя программа использует avi файл. Подскажите как упаковать этот файл в ресурс, а то приходится указывать путь к нему, а это очень не удобно.

Вопрос задал: Ученый (статус: 8-ой класс) Вопрос отправлен: 12 октября 2008, 17:30 Всего ответов: 2; сообщений в мини-форуме вопроса: 7

Ответ #1. Отвечает эксперт: Блазер

Здравствуйте, Ученый!
Сначала кидаем avi ролик на диск с (для быстрого доступа) обзываем его например: avi.avi
Создаем файл avi.RC и в него записываем: avi RCDATA "avi.avi" сохраняем.
Входим в командную строку (cmd) и пишем команду: brcc32 C:\avi.RC
На диске с появится файл avi.res с запакованым в нём avi роликом, осталось его только подключить и использовать...

Ответ отправил: Блазер (статус: 4-ый класс) Ответ отправлен: 12 октября 2008, 17:49 Оценка за ответ: 5

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Ученый!
Сначала вы заворачиваете авик в ресурс, как описал Блазер. А когда вам надо его проиграть, то сперва выворачиваете ваш ресурс во временный файл, а затем проигрываете его проигрывателем MediaPlayer. После того, как файл стал не нужным, то удаляете его.

{ Генерим имя врменненого файла }
function GetTempFile : String;
var
   TempDir,
   TempFile : packed array [0..MAX_PATH] of Char;
begin
   GetTempPath(MAX_PATH, TempDir);
   Windows.GetTempFileName(TempDir, 'avi', 0, TempFile);
   Result := TempFile;
end;
procedure PlayMyAvi;
var
   ResStream : TResourceStream;
   tmpFile : String;
begin
   tmpFile := GetTempFile;
   ResStream := TResourceStream.Create(Handle, '<имя ресурса>', RT_RCDATA);
   ResStream.SaveToFile(tmpFile);
   ResStream.Free;
{ тут проигрываем его с помощью MediaPlayer. Оставляю это за вами. }
   DeleteFile(tmpFile);
end;

P.S. Жклаю удачи.

Ответ отправил: Feniks (статус: Бакалавр) Ответ отправлен: 13 октября 2008, 11:27 Оценка за ответ: 5 Комментарий к оценке: СПАСИБО!

Вопрос # 3 150

Здравствуйте, уважаемые эксперты!
Есть задача, с которой не могу справиться:
Программа должна проигрывать видео, при этом анализировать его и дорисовывать крестик-"прицел" в месте, определяемом программой.
Пробую для отображения видео использовать компонент MediaPlayer, но при этом не могу "достучаться" до изображения чтобы проанализировать и дорисовать "прицел".

Вопрос задал: BlackRanger (статус: Посетитель) Вопрос отправлен: 3 сентября 2009, 21:30 Всего ответов: 1; сообщений в мини-форуме вопроса: 3

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, BlackRanger!
Итак, начните знакомство с http://www.kansoftware.ru/?tid=1298
потом с http://directshow.wonderu.com/first5
и под завязку http://www.codeproject.com/KB/directx/DirectShowVMR9.aspx
После знакомства с первой статьей придет понимание, как это всё работает, и почему у Вас не получалось.
А дальше будут эксперименты:)

Ответ отправил: Вадим К (статус: Академик) Ответ отправлен: 4 сентября 2009, 19:29 Оценка за ответ: 5

Статья

Формат файлов RES применительно к BITMAP-ресурсам

Автор: SOA

Написать данную статью автора побудило недостаточное количество информации в рунете и за его пределами для написания своего компилятора ресурсов типа BITMAP. Начнём!

RES-файл представляет собой файл, в котором записаны поверх друг друга заголовки ресурсов и соответственно сами данные ресурсов:

Header (Заголовок)
DATA (Данные)
Header (Заголовок)
DATA (Даные)

Заголовок из себя представляет некую структуру с полями:

typedef struct {
  DWORD DataSize;
  DWORD HeaderSize;
  DWORD TYPE;
  DWORD NAME;
  DWORD DataVersion;
  WORD  MemoryFlags;
  WORD  LanguageId;
  DWORD Version;
  DWORD Characteristics;
} RESOURCEHEADER;

Но эта структура лишь является эталонной моделью, как в сетях является эталонной моделью модель ISO/OSI. На практике же чаще используется менее ромоздкая конструкция:

typedef struct {
  DWORD DataSize;
  DWORD HeaderSize;
  DWORD TYPE;
  DWORD NAME;
} RESOURCEHEADER;

Разберемся, что значат поля в этой структуре.

DataSize— размер данных ресурса, т.е. данных, копируемых из файла bmp. Он всегда меньше реального размера файла на 14 бит ввиду того, что отбрасываются несколько полей заголовка файла bmp (да-да, у bmp файлов тоже есть заголовок, как впрочем и у всех остальных типов файлов).

HeaderSize — размер заголовка ресурса, т.е. размер, занимаемый всей структурой RESOURCEHEADER в байтах.
Эта структура разделена на две части: базу ResourceHeaderBase, значение которой всегда 32 и, по-видимому, отражает принадлежность ресурса к 32 битному приложению; вторая часть — ResourceHeaderOffset равна разнице между размером заголовка и базой.

TYPE — тип ресурса, в нашем случае это значение равно FFFF0200, где ключевым числом является 2 т.к. именно оно является числовым эквивалентом типа BITMAP.
Значения для других типов можно посмотреть здесь: http://msdn.microsoft.com/en-us/library/ms648009(VS.85).aspx
Записываем, конечно, в шестнадцатеричном виде.

NAME — официально это поле имеет тип DWORD. MS пишет, что на самом деле это поле является строкой с нулевым окончанием. На практике было выяснено, что в поле NAME записывается по одному коду символа в ASCII кодировке с отделением символов друг от друга нулевым битом, после чего по неизвестному автору алгоритму строка добивается нулевыми битами, после чего ставится ASCII код нуля.

Также стоит заметить, что в начале заголовка ставится значение типа DWORD, равное нулю, и в конце заголовка ставится два значения типа DWORD, равные нулю.

Рассмотрим, как на практике пишется файл ресурса по смещениям:

Смещение	Поле
4	ResourceHeaderBase
8	FFFF
12	FFFF
32	DataSize
36	ResourceHeaderOffset
40	TYPE
44	NAME

Далее, после заголовка записываются данные из bmp-файла, начиная с 14 бита, потому что, как я уже писал, часть заголовка bmp-файла отбрасывается.

Ниже приведена программа, записывающая из-bmp файла ресурс. Однако у этой программы есть одно ограничение ввиду того, что, как я уже писал, я не знаю, каким образом высчитывается количество нулевых битов в поле NAME до ASCII значения нуля, поэтому размер имени ресурса не может превышать двух символов.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
type Header = Record
DataSize:DWORD;
HeaderSize:DWORD;
Base:DWORD;
RcType:DWORD;
NAME:String;
End;
 
const
HearedSizeBase = 4;
HeaderSizeOffset = 36;
DataSizeOffset = 32;
TypeOffset = 40;
NameOffset = 44;
 
var
  Form1: TForm1;
  MyRes,SrcFile: TFileStream;
  Heder:Header;
  NULL: array [0..43] of byte;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
i:Integer;
Buf: BYTE;
Count: LongInt;
FFFF:DWORD;
CHR:WORD;
 
begin
for i:=0 to 43 do
NULL[i]:=0;
i:=FileCreate('Resource.res');//Создаем сам файл ресурса
FileClose(i);
 
MyRes:=TFileStream.Create('Resource.res',fmOpenWrite);
If OpenDialog1.Execute=true then
SrcFile:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
 
 Heder.NAME:=Edit1.Text;//Имя текущего файла для записи в ресурсы
 Heder.DataSize:=SrcFile.Size-14;//Размер ресурса (-14 это отбрасываемая часть заголовка файла bmp)
 Heder.RcType:=$0002FFFF; //ffff0200 тип ресурса
 
 //Записываем описание ресурса
 MyRes.Write(NULL,SizeOf(NULL));
 MyRes.Seek(8,soFromBeginning);
 FFFF:=$0000FFFF;
 MyRes.Write(FFFF,SizeOf(FFFF));//Не знаю почему но эти биты должны иметь именно такое значение
 MyRes.Write(FFFF,SizeOf(FFFF));
 MyRes.Seek(HearedSizeBase,soFromBeginning);
 Heder.Base:=32;
 MyRes.Write(Heder.Base,SizeOf(Heder.Base));//записываем базу заголовка
 MyRes.Seek(DataSizeOffset,soFromBeginning);
 MyRes.Write(Heder.DataSize,SizeOf(Heder.DataSize));//записываем размер данных
 
 MyRes.Seek(NameOffset-2,soFromBeginning);//Записываем имя ресурса
 For i:=0 to Length(Heder.Name) do
 Begin
  CHR:=Ord(Heder.Name[i]);
  MyRes.Write(CHR,SizeOf(CHR));
 End;
 
 buf:=0;                     //Выравнивание
 if Length(Heder.Name)=1 Then
 For i:=1 to 6 do
 MyRes.Write(buf,SizeOf(buf))
 Else
 Begin
 FFFF:=$00000000;
 For i:=1 to 2 do//расчет
 MyRes.Write(FFFF,SizeOf(FFFF));
 End;
 FFFF:=$00001030;
 MyRes.Write(FFFF,SizeOf(FFFF));
 
 i:=MyRes.Seek(0,soFromCurrent);
 MyRes.Seek(TypeOffset,soFromBeginning);
 MyRes.Write(Heder.RcType,SizeOf(Heder.RcType));//Записываем тип ресурса
 MyRes.Seek(i,soFromBeginning);
 
 FFFF:=$00000000;
 MyRes.Write(FFFF,SizeOf(FFFF));
 MyRes.Write(FFFF,SizeOf(FFFF));
 
 i:=MyRes.Seek(0,soFromCurrent);
 Heder.HeaderSize:=i-32;//Размер описания ресурса
 MyRes.Seek(HeaderSizeOffset,soFromBeginning);
 MyRes.Write(Heder.HeaderSize,SizeOf(Heder.HeaderSize));//записываем разницу между размером и базой заголовка
 MyRes.Seek(i,soFromBeginning);
 
 //пишем сам ресурс
 Count:=14;//Отбрасываем часть заголовка bmp файла
 SrcFile.Seek(14,soFromBeginning);
 While Count<SrcFile.Size do
 Begin
 SrcFile.Read(Buf,1);
 MyRes.Write(Buf,1);
 Count:=Count+1;
 End;
 
 SrcFile.Free;
 MyRes.Free;
 ShowMessage('Готово');
end;
 
end.

В данной статье использованы материалы:

1. http://msdn.microsoft.com/en-us/library/ms648027(VS.85).aspx
2. http://msdn.microsoft.com/en-us/library/ms648007(VS.85).aspx
3. http://msdn.microsoft.com/en-us/library/ms648009(VS.85).aspx

При использовании материалов статьи просьба давать ссылку на ресурс и на автора SOA.

Оценить статью | Оставить комментарий

Юмор

Как избавиться от компьютера за 10 дней

WWW: http://www.delphi.int.ru/ E-mail: admin@delphi.int.ru | support@delphi.int.ru

Если Вы хотите где-либо разместить материалы, представленные на www.delphi.int.ru или в данной рассылке, свяжитесь, пожалуйста, с их автором или ведущим рассылки.