Универсальный проигрыватель WinMedia

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.

Приложение Б (обязательное)

Примеры отчетов

Пример Отчета Вывода на печать содержимого мультимедиа библиотеки:

Библиотека файлов
Название композиции	Исполнитель	Альбом	Продолжительность	<различные столбцы по запросу пользователя>
Toxicity ….	SoAD …	Toxicity …	3:20 …

Пример отчета вывода на печать содержимого плейлиста:

Плейлист <название плейлиста>
Название композиции	Исполнитель	Альбом	Продолжительность	<различные столбцы по запросу пользователя>
Toxicity ….	SoAD …	Toxicity …	3:20 …

Список литературы

[1] Архангельский А.Я. Программирование в Delphi. Учебник по классическим версиям Delphi. - М.: 00О «Бином-Пресс», 2006

[2] Голицына О.Л., Попов И.И. Основы алгоритмизации и программирования : Учеб. пособие.- М.: ФОРУМ: ИНФРА-М, 2004

[3] Тверских Н., Microsoft Access 2000 Шаг за шагом, - М., шагом, -М., издательство Эком., 1999

[4] Хомоненко А.Д., Цыганков В.М., Мальцев М.Г. - “Базы данных”, учебное пособие.