 |
 |
 |
|
|||||||||
|
 | |||||||||||
|
 |
||||||||
|
МЕНЮ
|
БОЛЬШАЯ ЛЕНИНГРАДСКАЯ БИБЛИОТЕКА - РЕФЕРАТЫ - Универсальный проигрыватель WinMediaУниверсальный проигрыватель WinMedia
Универсальный проигрыватель Win media позволяет воспроизвести аудио-, видео-форматы, вести мультимедиа библиотеку, сохранять плейлисты. Проигрыватель обладает интуитивно понятным интерфейсом и прост в эксплуатации. На рисунке 1 Программа представлена виде начальной контекстной диаграммы потоков данных: Рисунок 1 - Диаграмма потоков данных 1.2 Требования к функциональным характеристикам Универсальный проигрыватель Win media должен воспроизводить популярные мультимедиа форматы (wav, mp3, mpg, wma, avi, mpeg). После запуска программы необходимо указать необходимый мультимедиа файл с помощью окна открытия файла либо указать плейлист. Открытые файлы записываются в плейлист и сохраняются на жесткий диск. В последствии можно будет вновь загрузить сохраненный плейлист. 1.3 Требования к надежности Универсальный проигрыватель Win media должен корректно воспроизводить мультимедиа файлы и бесперебойно работать на протяжении всего сеанса работы(воспроизведение мультимедиа файла) 1.4 Требования к составу и параметрам технических средств Для нормального функционирования Универсальный проигрыватель Win media необходима следующая минимальная конфигурация ПК: - частота процессора: 800 Мгц - объем оперативной памяти: 64 мб - необходимый объем свободного дискового пространства: 10 мб и размер базы данных. - разрешение монитора: 800x600 - наличие CD-ROM или FDD. 1.5 Требования к информационной и программной совместимости Данная программа предназначена для работы в следующих операционных системах: Windows 98 SE/2000/XP. 2. Разработка технического проекта 2.1 Построение диаграммы потоков данных Целью построения диаграммы потоков данных является отображение процессов существующих в системе и связи между этими процессами, а так же процесс преобразования входных данных в выходной результат. Основные элементы диаграммы потоков данных: - Внешняя сущность - представляющая собой материальный предмет или физическое лицо, который является источником или приемником данных. Определение некоторого объекта в качестве внешней сущности указывает на то, что она находится за пределами границ анализируемой ИС. - Система и подсистема. При построении модели сложной ИС она может быть представлена в самом общем виде на так называемой контекстной диаграмме в виде одной системы как единого целого, либо может быть декомпозирована на ряд подсистем. - Процесс - представляет собой преобразование входных потоков данных в выходные в соответствии с определенным алгоритмом. Физически процесс может быть реализован различными способами: это может быть подразделение организации, выполняющее обработку входных документов и выпуск отчетов, программа, аппаратно реализованное логическое устройство и т.д. - Накопитель данных - представляет собой абстрактное устройство для хранения информации, которую можно в любой момент поместить в накопитель и спустя некоторое время извлечь, причем способы помещения и извлечения могут быть любыми. Накопитель данных может быть реализован физически в виде таблицы в оперативной памяти, файла на магнитном носителе и т.д. Накопитель данных в общем случае является прообразом базы данных и описание хранящихся в нем данных должно быть увязано с информационной моделью. - Поток данных - определяет информацию, передаваемую через некоторое соединение от источника к преемнику. Реальный поток данных может быть информацией, передаваемой по кабелю между двумя устройствами, пересылаемыми по почте письмами, магнитными лентами или дискетами, переносимыми с одного компьютера на другой и т.д. Внешними сущностями в Универсальном проигрывателе Win media являются медиа файл, пользователь и сам плеер. Задачей пользователя является: указание мультимедиа файла (процесс 1.2), занесение фалов в мультимедиа библиотеку(процесс 1.3). Задачей плеера является открытие мультимедиа файла(процесс 1.5) и его воспроизведение (процесс 1.10). При открытии пользователем нового файла автоматически создается плейлист. При добавлении пользователем файла в мультимедиа библиотеку информация о файле записывается в библиотеку. Впоследствии файлы из базы данных можно добавить в текущий плейлист. Диаграмма потоков данных изображена на рисунке 2. 2.2 Проектирование модели данных На основании диаграммы потоков данных строится концептуальная модель данных. В ней отображается подробное описание структуры данных, связи между объектами данных, структура этих связей. Структура модели данных универсального проигрывателя Win media: Таблица “библиотека мультимедиа файлов” - содержит информацию о добавленных в библиотеку мультимедиа файлах Поле “Код” - уникальный идентификатор записи таблицы (ключевое поле) Поля “ Название композиции”, “Исполнитель”, “Альбом” - имеют строковый тип и используются для хранения Названия композиции, Исполнителя и альбома мультимедиа файла. Поле “Жанр” имеет целочисленный тип и используется для хранения кода жанра к которому принадлежит композиция. Таблица “Жанры” - содержит перечень жанров. Поле “Код” - уникальный идентификатор каждой записи таблицы (ключевое поле) Поле “Жанр” - имеет строковый тип и содержит наименование жанра. Модель данных универсального проигрывателя Win media изображена на рисунке 3. 2.3 Детальное проектирование программного обеспечения Программа состоит из нескольких основных окон: Главного окна (в которой производится воспроизведение аудио файлов) и Видео окна (в которой производится воспроизведение видео фалов). На рисунке 4 представлена главная форма программы для воспроизведения аудио файлов Рисунок 4 - Форма приложения для воспроизведения аудио файлов. На рисунке 5 представлена форма программы для воспроизведения видео файлов Рисунок 5 - Форма приложения для воспроизведения видео файлов. На рисунке 6 представлена диаграмма последовательностей экранных форм. Символом 1 обозначено действие по вызову главной формы. Символом 2 обозначено действие по вызову файла справочной системы, для получения какой-либо справочной информации по программе. Символом 3 обозначено действие по вызову формы , отображающей сведения о программном продукте. Символом 4. действие по завершению работы программы На рисунке 7 представлена форма программы для редактирования/создания/сохранения плейлистов. Рисунок 7 - Форма приложения для редактирования/создания/сохранения плейлистов. На рисунке 8 представлена форма программы для изменение настроек проигрывателя. Рисунок 8 - форма программы для изменение настроек проигрывателя. 3. Реализация 3.1 Обоснование выбора средств разработки Для написания курсового проекта, я выбрал систему программирования Delphi 7.0. Delphi - объектно-ориентированная, визуальная среда программирования, относящаяся к классу RAD - (Rapid Application Development _ «Средство быстрой разработки приложений») средств CASE - технологии. Delphi сделала разработку мощных приложений быстрым процессом. При проектировании программы и добавлении на форму новых компонентов Delphi автоматически заносит необходимый программный код в модуль программы и подключает соответствующие библиотеки, избавляя разработчика от рутинной работы и позволяя сосредоточиться на написании Отличительной особенностью Delphi является богатая библиотека визуальных компонентов (VCL). Эта библиотека объектов включает в себя стандартные объекты построения пользовательского интерфейса, объекты управления данными, графические объекты, объекты мультимедиа, диалоги и объекты управления файлами. Еще Delphi позволяет добавить различные сторонние компоненты созданные сторонними разработчиками. В данной программе использовался компонент MMTOOL версии 7.0. Этот компонент позволяет облегчить создание программы для работы со звуком/видео. Так же плюсом в пользу использования Delphi является удобный отладчик, который позволяет анализировать работу программы во время ее исполнения. С его помощью можно последовательно выполнять отдельные операторы исходного текста последовательно, наблюдая при этом, как меняются значения различных переменных. 3.2 Описание основных программных модулей На рисунке 9 представлен алгоритм открытие файла Символом 1 обозначено начало процедуры. Символом 2 обозначены операторы открытия файла. Символом 3 обозначен оператор условия принадлежности мультимедиа файла к видео файлу. Символом 4 обозначен оператор воспроизведения файла в главной форме при значении «нет» в цикле под номером 3. Символом 5 обозначен оператор открытия файла в специальной форме для видео файлов при значении «да» в цикле под номером 3. Символом 5 обозначен оператор выхода из программы
На рисунке 10 представлен алгоритм занесения файла в библиотеку Символом 1 обозначено начало процедуры. Символом 2 обозначен открытие файла Символом 3 обозначен цикл с предусловием выдающий запрос записывать ли файл в базу данных. Символом 4 обозначен оператор, читающий информацию о файле. Символом 5 обозначен условный оператор, заносящий полученную информацию в библиотеку. Символом 6 обозначен оператор выхода из процедуры.
4 Тестирование программного продукта Целью проведения тестирования является проверка правильности работы универсального проигрывателя Win Media. Тестирование программы проводилось по мере написания ее модулей в процессе отладки, при стыковке написанных модулей и после окончания написания программы. Тестирование программы осуществлялось на следующей аппаратной платформе: Процессор: 2 Ггц Объем оперативной памяти 512 Мб Размер свободного дискового пространства 500 Мб Для тестирования программы использовались операционные системы: Windows XP SP2. Тестирование программы проводилось в следующем порядке: 1. Проверка соответствия программы техническому заданию. При этом проверялось наличие и корректность выполнения программой функций описанных в техническом задании. 2. Проверка правильности выполнения вычислений. Для этого вычисления были предварительно рассчитаны вручную, а после сверены с результатами программы. 3. Проверка работы программы с граничными значениями. Для этого при работе программы вводились граничные данные, на что в ответ от программы были получены сообщения о некорректности введенных данных и просьбе ввести их заново. 4. Определение времени выполнения программой расчетов. При этом тестировались наиболее ресурсоемкие задачи - непосредственное проведение тестирования и построение отчетов. При этом программа показала хорошие показатели. 5. Проверка защищенности данных с которыми оперирует программ от посторонних пользователей. При этом использовались попытки выполнить действия приводящие и изменениям данных: редактирование, удаление. В ответ на эти действия программа предлагала ввести пароль. При ложном вводе пароля программа отказывала в доступе на модификацию данных. 6. Проверка работы всех пунктов меню и вызова всех экранных форм. При этом были проверены пункты меню на соответствие функций выполняемых ими их описанию. 7. Проверка работы программы на компьютерах различной конфигурации. Помимо указанной выше тестовой конфигурации программа была протестирована на следующей платформе: - Процессор: 1200 Мгц - Объем оперативной памяти 256 Мб - Размер свободного дискового пространства 300 Мб - Для тестирования программы использовалась операционная система: Windows 2000. Заключение На курсовое проектирование мне была предложена задача: создание Универсального проигрывателя win media При разработке программного продукта была изучена предметная область для данной задачи, выявлены информационные потоки, на основании которых была построена диаграмма потоков данных. Универсальный проигрыватель win media позволяет: - Воспроизводить мультимедиа файлы различных форматов. - Создавать плейлисты. - Вести базу данных мультимедиа файлов. Приложение А (обязательное) Листинг программы. Программа RadLe unit UMain; interface uses Windows, Messages, ShellAPI, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, ComCtrls, StdCtrls, ExtCtrls, Menus, MMSystem, MMUtils, MMAbout, MMObj, MMDSPObj, MMWaveIO, MMMPType, MMMPEG, MMDesign, MMWavOut, MMDIBCv, MMLevel, MMConect, MMSpectr, MMHTimer, MMSlider, MMLEDS, MMPanel, MMSpin, MMLEDLbl, MMButton, MMWave, MMLabel, MMVolume, MMHook, MMPitch, MMAudio, MMWheel, MMAVI; type TMainForm = class(TForm) OpenDialog: TOpenDialog; WaveOut: TMMWaveOut; MMDesigner1: TMMDesigner; MMConnector1: TMMConnector; HiTimer: TMMHiTimer; MMPanel2: TMMPanel; ButtonPanel: TMMPanel; DisplayPanel: TMMPanel; MMPanel7: TMMPanel; MMLevelScale1: TMMLevelScale; digit: TMMLEDDigit; MMLevel2: TMMLevel; MMLevel1: TMMLevel; Label2: TLabel; Label3: TLabel; Label4: TLabel; MMSpectrum1: TMMSpectrum; ss1: TMMLEDDigit; ss2: TMMLEDDigit; mm1: TMMLEDDigit; mm2: TMMLEDDigit; btnStop: TMMSpeedButton; btnPlay: TMMSpeedButton; btnPause: TMMSpeedButton; btnOpen: TMMSpeedButton; btnPrev: TMMSpeedButton; btnSkipL: TMMSpeedButton; btnSkipR: TMMSpeedButton; btnNext: TMMSpeedButton; btnClose: TMMSpeedButton; btnMenu: TMMSpeedButton; btnIncVolume: TMMSpeedButton; btnDecVolume: TMMSpeedButton; Bevel1: TBevel; btnPlayList: TMMSpeedButton; Gauge: TMMLevel; Bevel2: TBevel; ledMode: TMMLEDMode; ledRate: TMMLEDPanel; Label18: TLabel; lblBitRate: TLabel; ledBitRate: TMMLEDPanel; lblLayer: TLabel; lblLayer2: TLabel; lblFile: TMMLEDLABEL; PopupMenu: TPopupMenu; Preferences1: TMenuItem; N1: TMenuItem; Play1: TMenuItem; Stop1: TMenuItem; Pause1: TMenuItem; N2: TMenuItem; Previous1: TMenuItem; Next1: TMenuItem; N3: TMenuItem; PlayList1: TMenuItem; WaveFile: TMMWaveFile; N4: TMenuItem; Info1: TMenuItem; ImageEOF: TImage; ImageState: TImage; MPEGFile: TMMMPEGFile; SpeedButton1: TSpeedButton; N5: TMenuItem; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure HiTimerTimer(Sender: TObject); procedure WaveOutStop(Sender: TObject); procedure btnCloseClick(Sender: TObject); procedure btnOpenClick(Sender: TObject); procedure btnStopClick(Sender: TObject); procedure btnPauseClick(Sender: TObject); procedure btnPlayClick(Sender: TObject); procedure btnPrevClick(Sender: TObject); procedure btnSkipLClick(Sender: TObject); procedure btnSkipRClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure btnDecVolumeClick(Sender: TObject); procedure btnIncVolumeClick(Sender: TObject); procedure btnPlayListClick(Sender: TObject); procedure WaveOutStart(Sender: TObject); procedure MMPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure MMPanelMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); procedure MMPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GaugeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Приложение А (продолжение) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure btnMenuClick(Sender: TObject); procedure PopupMenuPopup(Sender: TObject); procedure PreferencesClick(Sender: TObject); procedure Info1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure WaveOutPause(Sender: TObject); procedure WaveOutRestart(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure N5Click(Sender: TObject); public oMin, oSec: Word; Dragging: Boolean; DragStart: TPoint; Seeking: Boolean; OldTime,CurTime: Longint; PlayListName: TFileName; PlayList : TStringList; PlayIndex: integer; IncPlayList: Boolean; DisplayColor: TColor; TimeCnt : Longint; procedure LoadImage(Image: TImage; Name: PChar); procedure DrawTime(Time: Longint); procedure SetFileParams; function LoadFile(FileName: TFileName): Boolean; function AddFile(FileName: TFileName): Boolean; procedure SelectFile(index: integer); procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest; procedure WMDropFiles(var Msg: TMessage); message WM_DropFiles; procedure LoadSettings; procedure SaveSettings; procedure DrawLevelBar(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; nSpots,Peak: integer); end; var MainForm: TMainForm; implementation {$R *.DFM} {$R IMAGE.RES} uses upref,ulist, UMe, UVideo; const REGBASENAME = 'Software\SwiftSoft\MPEGPlay'; procedure TMainForm.WMNCHitTest(var Msg: TWMNCHitTest); begin inherited; { is the click in the client area? } if (Msg.Result = htClient) then { if so, make Windows think it's } Msg.Result := htCaption; { on the caption bar. } end; procedure TMainForm.LoadImage(Image: TImage; Name: PChar); begin with Image.Picture do begin { load the bitmap } Bitmap.Handle := LoadBitmap(hInstance,Name); Приложение А (продолжение) { change the black/white resource to a colored bitmap } ChangeColors(Bitmap,False,DisplayColor,clBlack,clBlack); end; end; procedure TMainForm.LoadSettings; var L,T: integer; begin try L := (Screen.Width-Width) div 2; T := (Screen.Height-Height) div 2; Left := GetFromRegistry(HKEY_CURRENT_USER, REGBASENAME, 'Left', L); Top := GetFromRegistry(HKEY_CURRENT_USER, REGBASENAME, 'Top', T); WaveOut.NumBuffers := GetFromRegistry(HKEY_CURRENT_USER, REGBASENAME, 'Buffers', WaveOut.NumBuffers); WaveOut.BufferSize := GetFromRegistry(HKEY_CURRENT_USER, REGBASENAME, 'BufferSize', WaveOut.BufferSize); WaveOut.DeviceID := GetFromRegistry(HKEY_CURRENT_USER, REGBASENAME, 'DeviceID', WaveOut.DeviceID); WaveOut.CallBackMode := GetFromRegistry(HKEY_CURRENT_USER, REGBASENAME, 'CBMode', WaveOut.CallBackMode); except end; end; procedure TMainForm.SaveSettings; begin SaveInRegistry(HKEY_CURRENT_USER, REGBASENAME, 'Left', Left); SaveInRegistry(HKEY_CURRENT_USER, REGBASENAME, 'Top', Top); SaveInRegistry(HKEY_CURRENT_USER, REGBASENAME, 'Buffers', WaveOut.NumBuffers); SaveInRegistry(HKEY_CURRENT_USER, REGBASENAME, 'BufferSize', WaveOut.BufferSize); SaveInRegistry(HKEY_CURRENT_USER, REGBASENAME, 'DeviceID', WaveOut.DeviceID); SaveInRegistry(HKEY_CURRENT_USER, REGBASENAME, 'CBMode', WaveOut.CallBackMode); end; procedure TMainForm.FormCreate(Sender: TObject); begin MMLevel1.DIBCanvas.BackGroundBitmap.LoadFromResourceName(hInstance,'BM_BAR1'); MMLevel2.DIBCanvas.BackGroundBitmap.LoadFromResourceName(hInstance,'BM_BAR1'); MMSpectrum1.DIBCanvas.BackGroundBitmap.LoadFromResourceName(hInstance,'BM_BAR2'); MMLevel1.DIBCanvas.PaletteRealize := True; MMLevel2.DIBCanvas.PaletteRealize := True; MMSpectrum1.DIBCanvas.PaletteRealize := True; DragAcceptFiles(Handle,True); PlayListName := 'noname.m3u'; PlayList := TStringList.Create; PlayIndex := 0; DisplayColor := clLime; LoadImage(ImageEOF,'BM_EOF'); LoadImage(ImageState,'BM_PLAY'); LoadSettings; MMLevel1.OnDrawBar := DrawLevelBar; MMLevel2.OnDrawBar := DrawLevelBar; MMSpectrum1.OnDrawBar := DrawLevelBar; end; procedure TMainForm.FormDestroy(Sender: TObject); begin PlayList.Free; end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin IncPlayList := False; WaveOut.Close; Приложение А (продолжение) SaveSettings; end; procedure TMainForm.FormShow(Sender: TObject); begin if (ParamStr(1) <> '') then if LoadFile(ParamStr(1)) then begin btnPlayClick(nil); end else MessageDlg(ParamStr(1)+' is not a valid Audiofile',mtError, [mbOK],0); end; procedure TMainForm.WMDropFiles(var Msg: TMessage); var i,cnt: integer; Buf: array[0..255]of Char; begin try cnt := DragQueryFile(Msg.wParam,$FFFFFFFF,@Buf,255); if (cnt > 0) then begin IncPlayList := False; WaveOut.Stop; PlayList.Clear; for i := 0 to cnt-1 do begin DragQueryFile(Msg.wParam,i,@Buf,255); if not AddFile(StrPas(Buf)) then MessageDlg(StrPas(Buf)+' is not a valid Audiofile',mtError, [mbOK],0); end; PlayIndex := 0; SelectFile(0); if (PlayList.Count > 0) then btnPlayClick(nil); end; finally DragFinish(Msg.wParam); end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.DrawTime(Time: Longint); Var Hour, Min, Sec, MSec: Word; begin { Display the "Time" } TimeDecode(Time, Hour, Min, Sec, MSec); if (oSec <> Sec) then begin ss1.Value := Sec; oSec := Sec; end; if (oMin <> Min) then begin mm1.Value := Min; oMin := Min; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.SetFileParams; begin Приложение А (продолжение) if not MpegFile.Empty then with MpegFile do begin ss1.Enabled := True; ss2.Enabled := True; mm1.Enabled := True; mm2.Enabled := True; digit.Enabled:= True; lblFile.Caption := IntToStr(PlayIndex+1)+':'+UpperCase(ExtractFileName(Filename)); ledRate.Value := PlaybackRate div 1000; ledRate.Enabled := True; lblLayer.Visible := True; lblLayer2.Visible := True; case Layer of 1: lblLayer2.Caption := 'I'; 2: lblLayer2.Caption := 'II'; 3: lblLayer2.Caption := 'III'; end; if (Mode = smJointStereo) or (Mode = smStereo) then ledMode.Mode := mStereo else ledMode.Mode := mMono; ledMode.Enabled := True; ledBitRate.Value := BitRate; ledBitRate.Enabled := True; lblBitRate.Caption := 'KBit/s'; end else if not WaveFile.Wave.Empty then with WaveFile.Wave do begin ss1.Enabled := True; ss2.Enabled := True; mm1.Enabled := True; mm2.Enabled := True; digit.Enabled:= True; lblFile.Caption := IntToStr(PlayIndex+1)+':'+UpperCase(ExtractFileName(Filename)); ledRate.Value := SampleRate div 1000; ledRate.Enabled := True; lblLayer.Visible := False; lblLayer2.Visible := False; ledMode.Mode := Mode; ledMode.Enabled := True; ledBitRate.Value := BitLength; ledBitRate.Enabled := True; lblBitRate.Caption := 'Bit'; end else begin ss1.Enabled := False; ss2.Enabled := False; mm1.Enabled := False; mm2.Enabled := False; digit.Enabled:= False; lblFile.Caption := 'Нет Файла'; ledRate.Enabled := False; lblLayer.Visible := False; lblLayer2.Visible := False; ledMode.Enabled := False; ledBitRate.Enabled:= False; end; Приложение А (продолжение) end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.HiTimerTimer(Sender: TObject); var Time: Longint; begin MMConnector1.Trigger; inc(TimeCnt); if (TimeCnt mod 5 = 0) and (wosPlay in Waveout.State) and not Seeking then begin Time := WaveOut.Position; inc(CurTime,Time-OldTime); DrawTime(CurTime); OldTime := Time; if not MpegFile.Empty then begin Gauge.Value := MulDiv(MpegFile.Position, 100, MpegFile.Frames); ImageEOF.Visible := MpegFile.Position >= MpegFile.Frames; end else begin Gauge.Value := MulDiv(WaveFile.Wave.Position, 100, WaveFile.Wave.DataSize); ImageEOF.Visible := WaveFile.Wave.Position >= WaveFile.Wave.DataSize; end; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.WaveOutStart(Sender: TObject); begin TimeCnt := 0; HiTimer.Enabled := True; LoadImage(ImageState,'BM_PLAY'); ImageState.Visible := True; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.WaveOutStop(Sender: TObject); begin HiTimer.Enabled := False; WaveOut.Close; Seeking := False; DrawTime(0); Gauge.Value := 0; ImageEOF.Visible := False; ImageState.Visible := False; if IncPlayList then begin if (PlayIndex < PlayList.Count-1) then begin inc(PlayIndex); SelectFile(PlayIndex); WaveOut.Start; end else begin PlayIndex := 0; SelectFile(PlayIndex); end; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.WaveOutPause(Sender: TObject); Приложение А (продолжение) begin LoadImage(ImageState,'BM_PAUSE'); end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.WaveOutRestart(Sender: TObject); begin LoadImage(ImageState,'BM_PLAY'); end; {-- TMainForm -----------------------------------------------------------} function TMainForm.LoadFile(FileName: TFileName): Boolean; begin Result := False; if (FileName <> '') and FileExists(FileName) then begin PlayIndex := 0; PlayList.Clear; MpegFile.FileName := ''; WaveFile.Wave.FileName := ''; if IsMpegFile(FileName) or wioIsWaveFile(FileName, RIFF_FILE) then begin PlayListName := 'noname.m3u'; PlayList.Add(FileName); end else begin PlayListName := FileName; LoadPlayList(FileName,PlayList); end; Result := (PlayList.Count > 0); SelectFile(0); end; caption := filename; end; {-- TMainForm -----------------------------------------------------------} function TMainForm.AddFile(FileName: TFileName): Boolean; begin Result := False; if (FileName <> '') and FileExists(FileName) then begin if IsMpegFile(FileName) or wioIsWaveFile(FileName, RIFF_FILE) then begin PlayList.Add(FileName); Result := True; end else begin Result := LoadPlayList(FileName,PlayList); end; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.SelectFile(index: integer); var FileName: TFileName; begin MpegFile.FileName := ''; WaveFile.Wave.FileName := ''; if (index >= 0) and (index < PlayList.Count) then begin FileName := PlayList[index]; Приложение А (продолжение) if (FileName <> '') and FileExists(FileName) then begin if IsMpegFile(FileName) then begin MpegFile.FileName := FileName; WaveOut.Input := MpegFile; end else if wioIsWaveFile(FileName, RIFF_FILE) then begin WaveFile.Wave.FileName := FileName; WaveOut.Input := WaveFile; end end; CurTime := 0; OldTime := 0; end; SetFileParams; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.PopupMenuPopup(Sender: TObject); begin { adjust menu entrys } PopupMenu.Items[6].Enabled := PlayList.Count > 1; PopupMenu.Items[7].Enabled := PlayList.Count > 1; if (wosPlay in WaveOut.State) then begin PopupMenu.Items[0].Enabled := False; PopupMenu.Items[2].Caption := '&Рестарт'; PopupMenu.Items[3].Enabled := True; PopupMenu.Items[4].Enabled := True; end else begin PopupMenu.Items[0].Enabled := True; PopupMenu.Items[2].Caption := '&Воспроизвести'; PopupMenu.Items[3].Enabled := False; PopupMenu.Items[4].Enabled := False; end; if (wosPause in WaveOut.State) then PopupMenu.Items[3].Caption := '&Пауза' else PopupMenu.Items[3].Caption := '&Пауза'; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.PreferencesClick(Sender: TObject); begin with TPreferencesForm.Create(Self) do try ShowModal; finally Free; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnOpenClick(Sender: TObject); var Idx: WORD; begin if (OpenDialog.Execute) and (opendialog.FileName = '*.avi') then begin Video.Show; Video.Visible:=true; mainform.Visible:=false; if video.AVIOpenDialog.Execute then Приложение А (продолжение) begin video.AVIFile.FileName := opendialog.FileName; video.Caption := ExtractFileName(opendialog.FileName); video.AVIFile.OpenFile; video.AVIControl.FreeStreams; video.AVIControl.AddFile(video.AVIFile); video.AVIDisplay.Refresh; video.Icon.Handle := ExtractassociatedIcon(0,PChar(opendialog.FileName),Idx); end; end else if OpenDialog.Execute then begin IncPlayList := False; WaveOut.Stop; if not LoadFile(OpenDialog.FileName) then MessageDlg('Итс файл из нот карренли',mtWarning, [mbOK],0); SetFileParams; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnCloseClick(Sender: TObject); begin if (MessageDlg('ВЫ дестительно хотите выйте из программы??', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then Close; end; procedure TMainForm.btnMenuClick(Sender: TObject); var P: TPoint; begin P := ButtonPanel.ClientToScreen(Point(btnMenu.Left,btnMenu.Top+btnMenu.Height)); PopupMenu.Popup(P.X,P.Y); end; procedure TMainForm.btnPlayClick(Sender: TObject); begin if (PlayList.Count = 0) then begin btnOpenClick(nil); Refresh; end; IncPlayList := False; if (PlayList.Count > 0) then begin if not (wosPlay in WaveOut.State) then begin SelectFile(PlayIndex); WaveOut.Start; end else if (wosPause in WaveOut.State) then WaveOut.Restart else begin WaveOut.Stop; WaveOut.Start; end; end; Приложение А (продолжение) IncPlayList := True; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnPauseClick(Sender: TObject); begin if (wosPlay in WaveOut.State) then begin if (wosPause in WaveOut.State) then WaveOut.Restart else WaveOut.Pause; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnStopClick(Sender: TObject); begin IncPlayList := False; WaveOut.Stop; end; //предыдущая композиция procedure TMainForm.btnPrevClick(Sender: TObject); begin IncPlayList := False; if (PlayIndex > 0) then begin dec(PlayIndex); if (wosPlay in WaveOut.State) then begin WaveOut.Stop; SelectFile(PlayIndex); WaveOut.Start; end else SelectFile(PlayIndex); end; IncPlayList := True; end; ////следующая композиция procedure TMainForm.btnNextClick(Sender: TObject); begin IncPlayList := False; if (PlayIndex < PlayList.Count-1) then begin inc(PlayIndex); if (wosPlay in WaveOut.State) then begin WaveOut.Stop; SelectFile(PlayIndex); WaveOut.Start; end else SelectFile(PlayIndex); end; IncPlayList := True; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.GaugeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var aPos: Longint; Приложение А (продолжение) begin if (wosOpen in WaveOut.State) then begin Seeking := True; WaveOut.Pause; if not MpegFile.Empty then begin with Gauge do aPos := MulDiv(X-BevelExtend,MpegFile.Frames,(Width-2*BevelExtend)-1); if aPos >= MpegFile.Frames then begin WaveOut.Stop; exit; end else begin MpegFile.Position := aPos; CurTime := MpegFile.Position*MpegFile.TimePerFrame; end; end else begin with Gauge do aPos := MulDiv(X-BevelExtend,WaveFile.Wave.DataSize,(Width-2*BevelExtend)-1); if aPos > WaveFile.Wave.DataSize then begin WaveOut.Stop; exit; end else begin WaveFile.Wave.Position := aPos; CurTime := WaveFile.Wave.Position; end; end; WaveOut.Reset; WaveOut.Restart; OldTime := 0; Seeking := False; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnSkipLClick(Sender: TObject); begin if (wosPlay in WaveOut.State) then begin Seeking := True; WaveOut.Pause; if not MpegFile.Empty then begin MpegFile.Position := MpegFile.Position-(5000 div MpegFile.TimePerFrame); CurTime := MpegFile.Position*MpegFile.TimePerFrame; end else begin WaveFile.Wave.Position := WaveFile.Wave.Position-5000; CurTime := WaveFile.Wave.Position; end; WaveOut.Reset; WaveOut.Restart; OldTime := 0; Seeking := False; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnSkipRClick(Sender: TObject); Приложение А (продолжение) begin if (wosPlay in WaveOut.State) then begin if not MpegFile.Empty then begin if MpegFile.Position+(5000 div MpegFile.TimePerFrame) > MpegFile.Frames then WaveOut.Stop; end else begin if WaveFile.Wave.Position+5000 > WaveFile.Wave.DataSize then WaveOut.Stop; end; Seeking := True; WaveOut.Pause; if not MpegFile.Empty then begin MpegFile.Position := MpegFile.Position+(5000 div MpegFile.TimePerFrame); CurTime := MpegFile.Position*MpegFile.TimePerFrame; end else begin WaveFile.Wave.Position := WaveFile.Wave.Position+5000; CurTime := WaveFile.Wave.Position; end; WaveOut.Reset; WaveOut.Restart; OldTime := 0; Seeking := False; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnDecVolumeClick(Sender: TObject); var Volume,L,R: Longint; begin if (wosOpen in WaveOut.State) then begin WaveOutGetVolume(WaveOut.Handle,@Volume); L := LoWord(Volume); R := HiWord(Volume); L := Max(L - 5000,0); R := Max(R - 5000,0); Volume := (R shl 16) + L; WaveOutSetVolume(WaveOut.Handle,Volume); end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnIncVolumeClick(Sender: TObject); var Volume,L,R: Longint; begin if (wosOpen in WaveOut.State) then begin WaveOutGetVolume(WaveOut.Handle,@Volume); L := LoWord(Volume); R := HiWord(Volume); L := Min(L + 5000,$FFFF); R := Min(R + 5000,$FFFF); Volume := (R shl 16) + L; WaveOutSetVolume(WaveOut.Handle,Volume); Приложение А (продолжение) end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnPlayListClick(Sender: TObject); var wasPlaying: Boolean; begin with TPlayListEditor.Create(Self) do try if ShowModal = mrOK then begin IncPlayList := False; wasPlaying := (wosPlay in WaveOut.State); WaveOut.Stop; PlayList.Assign(TempPlayList); PlayListName := ListName; PlayIndex := 0; SelectFile(0); if wasPlaying then btnPlayClick(nil); end; finally Free; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.MMPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then begin Dragging := True; DragStart := TControl(Sender).ClientToScreen(Point(X,Y)); end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.MMPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then Dragging := False; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.MMPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var Diff: TPoint; begin if Dragging then begin Diff := TControl(Sender).ClientToScreen(Point(X,Y)); Diff := Point(Diff.X-DragStart.X,Diff.Y-DragStart.Y); SetBounds(Left+Diff.X,Top+Diff.Y,Width,Height); DragStart.X := DragStart.X+Diff.X; DragStart.Y := DragStart.Y+Diff.Y; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.Info1Click(Sender: TObject); begin autor.show; end; {-- TMainForm -----------------------------------------------------------} Приложение А (продолжение) procedure TMainForm.DrawLevelBar(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; nSpots,Peak: integer); begin with DIB,Rect do begin if Sender = MMSpectrum1 then begin DIB_CopyDIBBits(MMSpectrum1.DIBCanvas.BackSurface,Left,Bottom-nSpots,Right-Left-1,Bottom,0,Bottom-nSpots); DIB_CopyDIBBits(MMSpectrum1.DIBCanvas.BackSurface,Left,Bottom-Peak,Right-Left-1,2,0,Bottom-Peak); end else if Sender = MMLevel1 then begin DIB_SetTColor(MMLevel1.Color); DIB_Clear; DIB_CopyDIBBits(MMLevel1.DIBCanvas.BackSurface,0,Top,2*nSpots,Bottom,0,0); DIB_CopyDIBBits(MMLevel1.DIBCanvas.BackSurface,2*Peak-2,Top,2,Bottom,2*Peak,0); end else begin DIB_SetTColor(MMLevel2.Color); DIB_Clear; DIB_CopyDIBBits(MMLevel2.DIBCanvas.BackSurface,0,Top,2*nSpots,Bottom,0,0); DIB_CopyDIBBits(MMLevel2.DIBCanvas.BackSurface,2*Peak-2,Top,2,Bottom,2*Peak,0); end; end; end; procedure TMainForm.SpeedButton1Click(Sender: TObject); begin Application.Minimize; end; procedure TMainForm.N5Click(Sender: TObject); begin video.Show; mainform.Visible:=false; end; end. unit UMe; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, MMObj, MMLEDLbl, MMScroll, MMLEDS, ExtCtrls; type TAutor = class(TForm) MMLEDLABEL1: TMMLEDLABEL; MMLEDLABEL2: TMMLEDLABEL; MMLEDLABEL3: TMMLEDLABEL; MMLEDPanel1: TMMLEDPanel; MMLEDLABEL4: TMMLEDLABEL; MMLED1: TMMLED; procedure MMLED1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Autor: TAutor; implementation Приложение А (продолжение) {$R *.dfm} procedure TAutor.MMLED1Click(Sender: TObject); begin close; end; end. unit UML; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, Grids, DBGrids; type TML = class(TForm) DBGrid1: TDBGrid; MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; procedure N2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var ML: TML; implementation {$R *.dfm} procedure TML.N2Click(Sender: TObject); begin close; end; end. unit UDM; interface uses SysUtils, Classes, DB, ADODB; type TDM = class(TDataModule) DataSource1: TDataSource; ADOCommand1: TADOCommand; ADOConnection1: TADOConnection; ADOQuery1: TADOQuery; private { Private declarations } public { Public declarations } end; var DM: TDM; implementation {$R *.dfm} end. unit UList; interface uses Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, FileCtrl, Menus, ComCtrls, MMMPType, MMMpeg, MMWaveIO, MMRiff; type TPlaylistEditor = class(TForm) OKButton: TButton; CancelButton: TButton; MainMenu1: TMainMenu; File1: TMenuItem; Label5: TLabel; Label6: TLabel; PlayListBox: TListBox; AddButton: TButton; RemoveButton: TButton; ClearButton: TButton; RandomizeButton: TButton; FileListBox: TFileListBox; DirectoryListBox1: TDirectoryListBox; DriveComboBox1: TDriveComboBox; Bevel1: TBevel; NewPlaylist1: TMenuItem; OpenPlaylist1: TMenuItem; SavePlaylist1: TMenuItem; SavePlaylistAs1: TMenuItem; AppendPlaylist1: TMenuItem; N1: TMenuItem; Exit1: TMenuItem; OpenDialog: TOpenDialog; SaveDialog: TSaveDialog; InfoLabel: TLabel; procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); procedure ListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure RandomizeButtonClick(Sender: TObject); procedure AddButtonClick(Sender: TObject); Приложение А (продолжение) procedure RemoveButtonClick(Sender: TObject); procedure ListDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ListDragDrop(Sender, Source: TObject; X, Y: Integer); procedure ListEndDrag(Sender, Target: TObject; X, Y: Integer); procedure FormHide(Sender: TObject); procedure Exit1Click(Sender: TObject); procedure NewPlaylist1Click(Sender: TObject); procedure OpenPlaylist1Click(Sender: TObject); procedure SavePlaylist1Click(Sender: TObject); procedure SavePlaylistAs1Click(Sender: TObject); procedure AppendPlaylist1Click(Sender: TObject); private FListName : TFileName; DragTarget: TListBox; aTimer : TTimer; aBitmap1 : TBitmap; aBitmap2 : TBitmap; aIcon : TIcon; oldIndex : integer; oldCaption: String; procedure CreateParams(var Params: TCreateParams); override; procedure SetListName(aValue: TFileName); procedure SetButtons; function FirstSelection(aList: TCustomListBox): Integer; function LastSelection(aList: TCustomListBox): Integer; function FindIndex(aList: TListBox; aPos: TPoint): integer; procedure ClearSelected(aList: TCustomListBox); procedure AddSelected(aIndex: integer); procedure ResortSelected(aIndex: integer); procedure RemoveSelected; procedure DrawIndexPtr(oldIndex, newIndex: integer); procedure DragTimerExpired(Sender: TObject); procedure UpdatePlayListBox; procedure SetFileInfo; public TempPlayList: TStringList; ListChanged: Boolean; property ListName: TFileName read FListName write SetListName; end; var PlaylistEditor: TPlaylistEditor; function LoadPlayList(FileName: TFileName; aPlayList: TStringList): Boolean; function SavePlayList(FileName: TFileName; aPlayList: TStringList): Boolean; implementation uses umain; {$R *.DFM} const crTrackDrag = 1; crTrackAdd = 2; crTrackDelete = 3; {------------------------------------------------------------------------} function LoadPlayList(FileName: TFileName; aPlayList: TStringList): Boolean; var i: integer; F: TextFile; S: String; Приложение А (продолжение) begin i := 0; if (FileName <> '') and FileExists(FileName) then begin AssignFile(F, FileName); {$I+} Reset(F); try while not EOF(F) do begin ReadLn(F, S); if (S <> '') then begin if FileExists(S) then begin if IsMpegFile(S) or wioIsWaveFile(S, RIFF_FILE) then begin aPlayList.Add(S); inc(i); end else MessageDlg(S+' is not a valid Audiofile',mtError, [mbOK],0); end; end; end; finally CloseFile(F); end; {$I+} end; Result := (i > 0); end; {------------------------------------------------------------------------} function SavePlayList(FileName: TFileName; aPlayList: TStringList): Boolean; var i: integer; F: TextFile; begin Result := True; if (FileName <> '') then begin AssignFile(F, FileName); {$I-} Rewrite(F); try if (IOResult <> 0) then Result := False else begin for i := 0 to aPlayList.Count-1 do begin WriteLn(F,aPlayList[i]); if (IOResult <> 0) then begin Result := False; break; end; end; end; finally CloseFile(F); end; {$I+} end; end; Приложение А (продолжение) {-- TPlayListEditor -----------------------------------------------------} procedure TPlayListEditor.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.Style := Params.Style and not WS_SIZEBOX; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.FormCreate(Sender: TObject); begin oldCaption := Caption; TempPlayList := TStringList.Create; ListName := 'noname.m3u'; aTimer := TTimer.Create(Self); aTimer.Interval := 50; aTimer.Enabled := False; aTimer.OnTimer := DragTimerExpired; aBitmap1 := TBitmap.Create; aBitmap2 := TBitmap.Create; aBitmap1.Handle := LoadBitmap(HInstance, 'BM_NOTE'); aBitmap2.Width := aBitmap1.Width; aBitmap2.Height := aBitmap1.Height; BitBlt(aBitmap2.Canvas.Handle, 0,0, aBitmap1.Width, aBitmap1.Height, aBitmap1.Canvas.Handle, 0,0, NOTSRCCOPY); aIcon := TIcon.Create; aIcon.Handle := LoadIcon(HInstance, 'MARKERICON'); Icon.Handle := LoadIcon(HInstance, 'PLAYLISTICON'); oldIndex := -1; Screen.Cursors[crTrackDrag] := LoadCursor(HInstance, 'CR_TRACKDRAG'); Screen.Cursors[crTrackAdd] := LoadCursor(HInstance, 'CR_TRACKADD'); Screen.Cursors[crTrackDelete] := LoadCursor(HInstance, 'CR_TRACKDELETE'); DragTarget := Nil; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.FormDestroy(Sender: TObject); begin aTimer.Free; aBitmap1.Free; aBitmap2.Free; aIcon.Free; TempPlayList.Free; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.FormShow(Sender: TObject); begin PlayListBox.Clear; TempPlayList.Assign(MainForm.PlayList); ListName := MainForm.PlayListName; UpdatePlayListBox; ListChanged := not ((ListName <> '') and (ListName <> 'noname.m3u')); SetFileInfo; SetButtons; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.FormHide(Sender: TObject); begin Приложение А (продолжение) if ModalResult = mrOK then begin if ListChanged then if MessageDlg('Сохранить изменения в плейлисте ?', mtConfirmation, [mbYes,mbNo],0) = mrYes then begin if (ListName <> 'noname.m3u') then SavePlaylist1Click(nil) else SavePlaylistAs1Click(nil); end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlayListEditor.SetListName(aValue: TFileName); begin FListName := aValue; Caption := oldCaption; if FListName <> '' then Caption := Caption + ' - ' + FListName; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.SetButtons; begin AddButton.Enabled := (FileListBox.SelCount > 0); RemoveButton.Enabled := (PlayListBox.SelCount > 0); ClearButton.Enabled := (PlayListBox.Items.Count > 0); RandomizeButton.Enabled := (PlayListBox.Items.Count > 0); end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlayListEditor.UpdatePlayListBox; var i: integer; begin PlayListBox.Clear; for i := 0 to TempPlayList.Count-1 do PlayListBox.Items.Add(ExtractFileName(TempPlayList[i])); end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlayListEditor.SetFileInfo; var FileName,S: String; lpwio: PWaveIOCB; MpegInfo: TMpegFileInfo; begin if (TempPlayList.Count > 0) and (PlayListBox.ItemIndex >= 0) then begin FileName := TempPlayList[PlayListBox.ItemIndex]; if IsMpegFile(FileName) then begin if GetMpegFileInfo(FileName, MpegInfo) then begin S := 'ISO MPEG '; with MpegInfo do begin case Version of v1 : S := S + '1 - '; v2LSF: S := S + '2 - '; end; case Layer of 1: S := S + 'Layer I; '; 2: S := S + 'Layer II; '; 3: S := S + 'Layer III; '; end; S := S + Format('%2.3f kHz; %d KBit/s; ',[SampleRate/1000,BitRate]); case SampleMode of smStereo : S := S + 'Stereo;'; smJointStereo : S := S + 'Joint Stereo;'; smDualChannel : S := S + 'Dual Channel;'; smSingleChannel: S := S + 'Mono;'; end; InfoLabel.Caption := S; end; exit; end; end else if wioIsWaveFile(FileName, RIFF_FILE) then begin if wioReadFileInfo(lpwio, PChar(FileName), mmioFOURCC('W', 'A', 'V', 'E'), RIFF_FILE) = 0 then try InfoLabel.Caption := 'WAVE - '; wioGetFormatName(@lpwio.wfx, S); InfoLabel.Caption := InfoLabel.Caption+' '+S; wioGetFormat(@lpwio.wfx, S); InfoLabel.Caption := InfoLabel.Caption+' '+S; exit; finally wioFreeFileInfo(lpwio); end; end; InfoLabel.Caption := 'Незнай че за файл...'; end else InfoLabel.Caption := ''; end; {-- TPlayListEditor -----------------------------------------------------} function TPlaylistEditor.FirstSelection(aList: TCustomListBox): Integer; begin for Result := 0 to aList.Items.Count - 1 do if aList.Selected[Result] then exit; Result := LB_ERR; end; {-- TPlayListEditor -----------------------------------------------------} function TPlaylistEditor.LastSelection(aList: TCustomListBox): Integer; begin for Result := aList.Items.Count - 1 downTo 0 do if aList.Selected[Result] then exit; Result := LB_ERR; end; {-- TPlayListEditor -----------------------------------------------------} function TPlaylistEditor.FindIndex(aList: TListBox; aPos: TPoint): integer; begin with aList do begin Result := ItemAtPos(aPos, False); if Items.Count > (Height div ItemHeight)-1 then if Result = TopIndex + (Height div ItemHeight)-1 then if aPos.Y > Height-(ItemHeight div 2) then inc(Result); end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ClearSelected(aList: TCustomListBox); Var aIndex: integer; begin aIndex := FirstSelection(aList); Приложение А (продолжение) if aIndex > LB_Err then begin while aIndex <= LastSelection(aList) do begin if aList.Selected[aIndex] then begin aList.Selected[aIndex] := False; ListChanged := True; end; inc(aIndex); end; SetFileInfo; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.AddSelected(aIndex: integer); Var i: Integer; begin with TempPlayList do begin if (aIndex = -1) then aIndex := Count; for i := 0 to FileListBox.Items.Count - 1 do begin if FileListBox.Selected[i] then begin Insert(aIndex, FileListBox.Items[i]); ListChanged := True; inc(aIndex); end; end; UpdatePlayListBox; if aIndex >= PlayListBox.Height div PlayListBox.ItemHeight then PlayListBox.TopIndex := aIndex-((PlayListBox.Height div PlayListBox.ItemHeight)-1); end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ResortSelected(aIndex: integer); Var i: Integer; begin if (PlayListBox.Items.Count > 1) then with PlayListBox do begin if (aIndex = -1) then aIndex := 0; i := 0; while i < Items.Count do begin if Selected[i] then begin Selected[i] := False; ListChanged := True; if aIndex > i then begin TempPlayList.Move(i, aIndex-1); Items.Move(i, aIndex-1); dec(i); end else begin Приложение А (продолжение) TempPlayList.Move(i, aIndex); Items.Move(i, aIndex); inc(aIndex); end; end; inc(i); end; if (Items.Count > 0) then begin TopIndex := 0; Selected[0] := True; Selected[0] := False; end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.RemoveSelected; Var i: Integer; begin with PlayListBox do begin ItemIndex := 0; for i := Items.Count - 1 downTo 0 do if Selected[i] then begin Items.Delete(i); TempPlayList.Delete(i); ListChanged := True; end; if (Items.Count > 0) then begin TopIndex := 0; Selected[0] := True; Selected[0] := False; end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin if (Sender = PlayListBox) then SetFileInfo; SetButtons; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ListKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Sender = PlayListBox) then SetFileInfo; SetButtons; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Var Offset: Integer; begin with (Control as TListBox), (Control as TListBox).Canvas do begin FillRect(Rect); Offset := 1; if (odSelected in State) then BrushCopy(Bounds(Rect.Left + Offset, Rect.Top, aBitmap2.Width, aBitmap2.Height), aBitmap2, Bounds(0, 0, aBitmap2.Width, aBitmap2.Height), clBlack) else BrushCopy(Bounds(Rect.Left + Offset, Rect.Top, aBitmap1.Width, aBitmap1.Height), aBitmap1, Bounds(0, 0, aBitmap1.Width, aBitmap1.Height), clWhite); Offset := Offset + aBitmap1.Width + 5; TextOut(Rect.Left + Offset, Rect.Top, Items[Index]); end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.AddButtonClick(Sender: TObject); begin AddSelected(-1); SetButtons; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.RemoveButtonClick(Sender: TObject); begin RemoveSelected; SetButtons; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ClearButtonClick(Sender: TObject); begin TempPlayList.Clear; PlayListBox.Clear; ListChanged := True; SetFileInfo; SetButtons; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.RandomizeButtonClick(Sender: TObject); var i,j: integer; begin Randomize; for i := 0 to TempPlayList.Count-1 do begin j := Random(TempPlayList.Count); TempPlayList.Move(i, j); PlayListBox.Items.Move(i, j); end; ListChanged := True; SetButtons; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.DragTimerExpired(Sender: TObject); Var Приложение А (продолжение) MousePos: TPoint; begin if DragTarget <> Nil then begin GetCursorPos(MousePos); MousePos := ScreenToClient(MousePos); with DragTarget do begin if (MousePos.X > Left) And (MousePos.X < Left + Width) then begin { scroll the listbox up } if (MousePos.Y < Top) And (TopIndex > 0) then TopIndex := TopIndex - 1 else { scroll the listbox down } if (MousePos.Y > Top + Height) And (TopIndex < Items.Count - (Height div ItemHeight)) then TopIndex := TopIndex + 1; end; end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.DrawIndexPtr(oldIndex, newIndex: integer); const Offset: integer = 2; begin with Canvas do begin if oldIndex <> LB_Err then begin with PlayListBox do oldIndex := (oldIndex - TopIndex) * ItemHeight + Top - 5; Brush.Color := Self.Color; FillRect(Rect(Offset,oldIndex, Offset+15, oldIndex+15)); end; if newIndex <> LB_Err then begin with PlayListBox do newIndex := (newIndex - TopIndex) * ItemHeight + Top - 5; Draw(Offset, newIndex, aIcon); end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ListDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; Var Accept: Boolean); Var curIndex: integer; begin if (Source is TCustomListBox) And (Sender is TCustomListBox) then begin Accept := True; { set the right drag cursors } if (State = dsDragEnter) then begin if Source = PlayListBox then begin if Sender = PlayListBox then Приложение А (продолжение) TListBox(Source).DragCursor := crTrackDrag else TFileListBox(Source).DragCursor := crTrackDelete; end else begin if Sender = FileListBox then TFileListBox(Source).DragCursor := crTrackDrag else TListBox(Source).DragCursor := crTrackAdd; end; aTimer.Enabled := False; DragTarget := TListBox(Sender); end else if (State = dsDragLeave) then aTimer.Enabled := True; { don't accept if on the scrollbars } with TCustomListBox(Sender) do begin CurIndex := ItemAtPos(Point(X,Y),False); if CurIndex = LB_Err then Accept := False; end; { now draw the index arrow } if (Sender = PlayListBox) then begin {special case for the last visible item } CurIndex := FindIndex(TListBox(Sender), Point(X, Y)); if (CurIndex <> oldIndex) Or (State = dsDragLeave) then begin if (State = dsDragEnter) then oldIndex := LB_Err; if (State = dsDragLeave) then curIndex := LB_Err; DrawIndexPtr(oldIndex, curIndex); oldIndex := curIndex; end; end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ListDragDrop(Sender, Source: TObject; X, Y: Integer); Var aIndex: Integer; begin { make sure source and destination components are list boxes } if (Source is TCustomListBox) and (Sender is TCustomListBox) then begin if (Sender = FileListBox) then begin { delete selected items } if (Source = PlayListBox) then RemoveSelected; end else begin { copy from one list to another } if (Source = FileListBox) then begin Приложение А (продолжение) { find destination position in list box } aIndex := FindIndex(TListBox(Sender), Point(X, Y)); AddSelected(aIndex); end else { rearrange list } begin { find destination position in list box } aIndex := FindIndex(TListBox(Sender), Point(X, Y)); ResortSelected(aIndex); end; end; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.ListEndDrag(Sender, Target: TObject; X, Y: Integer); begin aTimer.Enabled := False; DragTarget := Nil; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.Exit1Click(Sender: TObject); begin Close; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.NewPlaylist1Click(Sender: TObject); begin if SaveDialog.Execute then begin TempPlayList.Clear; PlayListBox.Clear; ListChanged := True; ListName := SaveDialog.FileName; end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.OpenPlaylist1Click(Sender: TObject); begin if OpenDialog.Execute then begin TempPlayList.Clear; PlayListBox.Clear; if LoadPlayList(OpenDialog.FileName,TempPlayList) then begin UpdatePlayListBox; ListChanged := False; ListName := OpenDialog.FileName; end else MessageDlg('Unable to load Playlist!',mtError, [mbOK],0); end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.SavePlaylist1Click(Sender: TObject); begin if SavePlayList(ListName,TempPlayList) then begin ListChanged := False; end else MessageDlg('Unable to save Playlist!',mtError, [mbOK],0); end; Приложение А (продолжение) {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.SavePlaylistAs1Click(Sender: TObject); begin SaveDialog.InitialDir := ExtractFilePath(ListName); SaveDialog.FileName := ExtractFileName(ListName); if SaveDialog.Execute then begin if SavePlayList(SaveDialog.FileName,TempPlayList) then begin ListChanged := False; ListName := SaveDialog.FileName; end else MessageDlg('Unable to save Playlist!',mtError, [mbOK],0); end; end; {-- TPlayListEditor -----------------------------------------------------} procedure TPlaylistEditor.AppendPlaylist1Click(Sender: TObject); begin if OpenDialog.Execute then begin if LoadPlayList(OpenDialog.FileName,TempPlayList) then begin UpdatePlayListBox; ListChanged := True; end else MessageDlg('Unable to append Playlist!',mtError, [mbOK],0); end; end; end. unit UPref; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Tabnotbk, StdCtrls, ExtCtrls, MMObj, MMUtils, MMSlider, MMRegs, MMWaveIO, MMWavIn, MMWavOut, MMSpin; type TPreferencesForm = class(TForm) PageControl1: TPageControl; OptAudio: TTabSheet; btnOk: TButton; btnCancel: TButton; GroupBox1: TGroupBox; GroupBox2: TGroupBox; GroupBox3: TGroupBox; PlayCombo: TComboBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label6: TLabel; radioWindow: TRadioButton; radioThread: TRadioButton; radioInterrupt: TRadioButton; labelBufferSize: TLabel; sliderBufferSize: TMMSlider; spinBufferSize: TMMSpinButton; procedure FormShow(Sender: TObject); procedure BufferSizeChange(Sender: TObject); procedure btnOkClick(Sender: TObject); private BufferSize: integer; procedure UpdateBufferSize; end; var PreferencesForm: TPreferencesForm; implementation uses umain; {$R *.DFM} {========================================================================} { Initialization and Settings } {========================================================================} {-- TPreferencesForm ----------------------------------------------------} procedure TPreferencesForm.FormShow(Sender: TObject); var i: integer; begin with MainForm do begin {-- Audio Page --} sliderBufferSize.Position := WaveOut.NumBuffers; spinBufferSize.Value := sliderBufferSize.Position; BufferSize := sliderBufferSize.Position*WaveOut.BufferSize; UpdateBufferSize; if WaveOut.NumDevs > 0 then begin PlayCombo.Items.Add(WaveOutGetDeviceName(WAVE_MAPPER)); for i := 0 to WaveOut.NumDevs-1 do begin PlayCombo.Items.Add(WaveOutGetDeviceName(i)); end; PlayCombo.ItemIndex := WaveOut.DeviceId+1; end; if not _win95_ then radioInterrupt.Enabled := False; case WaveOut.CallbackMode of cmWindow : radioWindow.Checked := True; cmThread : radioThread.Checked := True; cmCallback: radioInterrupt.Checked := True; end; end; end; {-- TPreferencesForm ----------------------------------------------------} procedure TPreferencesForm.btnOkClick(Sender: TObject); Приложение А (продолжение) begin with MainForm do begin {-- Audio Page --} WaveOut.DeviceID := PlayCombo.ItemIndex-1; WaveOut.NumBuffers := BufferSize div WaveOut.BufferSize; if radioWindow.Checked then WaveOut.CallbackMode := cmWindow else if radioThread.Checked then WaveOut.CallbackMode := cmThread else WaveOut.CallbackMode := cmCallback end; end; {========================================================================} { Audio Page } {========================================================================} {-- TPreferencesForm ----------------------------------------------------} procedure TPreferencesForm.UpdateBufferSize; begin labelBufferSize.Caption := IntToStr(BufferSize div 1024)+' Kb'; if (MainForm.WaveOut.PWaveFormat <> nil) then labelBufferSize.Caption := labelBufferSize.Caption+ Format(' - %f seconds',[wioBytesToTime(MainForm.WaveOut.PWaveFormat,BufferSize)/1000]); end; {-- TPreferencesForm ----------------------------------------------------} procedure TPreferencesForm.BufferSizeChange(Sender: TObject); begin if (Sender = sliderBufferSize) then spinBufferSize.Value := sliderBufferSize.Position else sliderBufferSize.Position := spinBufferSize.Value; BufferSize := sliderBufferSize.Position * MainForm.WaveOut.BufferSize; UpdateBufferSize; end; end. unit UVideo; interface uses Windows, ShellAPI, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Menus, MMAbout, MMObj, MMAVICtl, MMCstDlg, MMAVI, MMHook, MMDesign; type TVideo = class(TForm) AVIFile: TMMAVIFile; AVIOpenDialog: TMMAVIOpenDialog; AVIControl: TMMAVIControl; AVIDisplay: TMMAVIVideoDisplay; Bevel1: TBevel; PopupMenu1: TPopupMenu; OpenFile1: TMenuItem; N1: TMenuItem; Play1: TMenuItem; Pause1: TMenuItem; Stop1: TMenuItem; N2: TMenuItem; ShowDisplay1: TMenuItem; ShowControls1: TMenuItem; N3: TMenuItem; Properties1: TMenuItem; N4: TMenuItem; Info1: TMenuItem; MMDesigner1: TMMDesigner; N5: TMenuItem; SaveFrame1: TMenuItem; SaveDialog: TSaveDialog; procedure AVIDisplayDblClick(Sender: TObject); procedure OpenFile1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure PopupMenu1Popup(Sender: TObject); procedure Play1Click(Sender: TObject); procedure Pause1Click(Sender: TObject); procedure Stop1Click(Sender: TObject); procedure ShowDisplay1Click(Sender: TObject); procedure ShowControls1Click(Sender: TObject); procedure Properties1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure Info1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure SaveFrame1Click(Sender: TObject); private MinWidth,MinHeight: integer; procedure WMGetMinMaxInfo(Var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; procedure SetminMax; end; var Video: TVideo; implementation uses Upref, UMain, UMe; {$R *.DFM} {-- TMainForm ------------------------------------------------------------} procedure TVideo.WMGetMinMaxInfo(Var Msg: TWMGetMinMaxInfo); begin if (MinWidth <> 0) then begin with Msg.MinMaxInfo^ do begin ptMinTrackSize.X := MinWidth; { Minimum width } ptMinTrackSize.Y := MinHeight; { Minimum height } end; Msg.Result := 0; { Tell windows you have changed minmaxinfo } end; inherited; Приложение А (продолжение) end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.SetMinMax; begin MinWidth := (Width-ClientWidth)+AVIControl.MinWidth; MinHeight:= (Height-ClientHeight)+AVIControl.MinHeight; if Height < MinHeight then Height := MinHeight; with AVIControl do begin if (not ShowDisplay and not ShowControls) then begin Bevel1.Visible := False; AVIControl.Visible := False; end else begin AVIControl.Visible := True; Bevel1.Visible := True; Bevel1.Top := 0; end; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.FormResize(Sender: TObject); begin if Height <= MinHeight then Bevel1.Visible := False else with AVIControl do if (AVIControl.ShowDisplay and ShowControls) then begin Bevel1.Visible := True; Bevel1.Top := 0; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.FormCreate(Sender: TObject); begin MinWidth := 0; Icon.Handle := LoadIcon(0,IDI_WINLOGO); end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.FormShow(Sender: TObject); begin SetMinMax; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.FormClose(Sender: TObject; var Action: TCloseAction); begin AVIControl.FreeStreams; AVIFile.CloseFile; mainform.Visible:=true; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.PopupMenu1Popup(Sender: TObject); begin with AVIControl do begin Play1.Enabled := (hasAudio or hasVideo) and not Playing or Paused; Pause1.Enabled := Playing and not Paused; Приложение А (продолжение) Stop1.Enabled := Playing; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.OpenFile1Click(Sender: TObject); var Idx: WORD; begin if AVIOpenDialog.Execute then begin AVIFile.FileName := AVIOpenDialog.FileName; Caption := ExtractFileName(AVIOpenDialog.FileName); AVIFile.OpenFile; AVIControl.FreeStreams; AVIControl.AddFile(AVIFile); AVIDisplay.Refresh; Icon.Handle := ExtractassociatedIcon(0,PChar(AVIOpenDialog.FileName),Idx); end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.AVIDisplayDblClick(Sender: TObject); begin with AVIControl do if hasAudio or hasVideo then begin if not Playing or Paused then Play else Stop; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.Play1Click(Sender: TObject); begin AVIControl.Play; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.Pause1Click(Sender: TObject); begin AVIControl.Pause; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.Stop1Click(Sender: TObject); begin AVIControl.Stop; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.ShowDisplay1Click(Sender: TObject); begin with AVIControl do begin ShowDisplay := not ShowDisplay; ShowDisplay1.Checked := ShowDisplay; SetMinMax; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.ShowControls1Click(Sender: TObject); begin with AVIControl do Приложение А (продолжение) begin ShowControls := not ShowControls; ShowControls1.Checked := ShowControls; SetMinMax; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.Properties1Click(Sender: TObject); begin with TPreferencesForm.Create(Self) do try ShowModal; finally Free; end; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.Info1Click(Sender: TObject); begin autor.show; end; {-- TMainForm -----------------------------------------------------------------} procedure TVideo.SaveFrame1Click(Sender: TObject); var Bmp: TBitmap; begin if SaveDialog.Execute then begin // make sure the display is up-to-date AVIDisplay.Refresh; Bmp := TBitmap.Create; try Bmp.Width := AVIDisplay.Width-2*AVIDisplay.BevelExtend; Bmp.Height:= AVIDisplay.Height-2*AVIDisplay.BevelExtend; Bmp.Canvas.CopyRect(Rect(0,0,Bmp.Width,Bmp.Height), AVIDisplay.Canvas, AVIDisplay.BeveledRect); Bmp.SaveToFile(SaveDialog.FileName); finally Bmp.Free; end; end; end; end. Приложение Б (обязательное) Примеры отчетов Пример Отчета Вывода на печать содержимого мультимедиа библиотеки:
Пример отчета вывода на печать содержимого плейлиста:
Список литературы [1] Архангельский А.Я. Программирование в Delphi. Учебник по классическим версиям Delphi. - М.: 00О «Бином-Пресс», 2006 [2] Голицына О.Л., Попов И.И. Основы алгоритмизации и программирования : Учеб. пособие.- М.: ФОРУМ: ИНФРА-М, 2004 [3] Тверских Н., Microsoft Access 2000 Шаг за шагом, - М., шагом, -М., издательство Эком., 1999 [4] Хомоненко А.Д., Цыганков В.М., Мальцев М.Г. - “Базы данных”, учебное пособие. |
РЕКЛАМА
|
|||||||||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||||||||||
| БОЛЬШАЯ ЛЕНИНГРАДСКАЯ БИБЛИОТЕКА | ||
 |
© 2010 | |