Сам WindowsMediaPlayer в качестве компонента мы установили в статье про создание MP3 плеера, здесь же мы создадим видео плеер с изменяемыми размерами, который будет проигрывать MP4.
Получится примерно так…
Проигрыватель находится на панели, которую можно растягивать за нижний правый уголок. WMP проигрывает многие форматы, но я поставил пока ограничение в коде использования компонента ограничение на ‘.mp4’ так как мне в дальнейшем нужно транслировать файл в браузер, а многие браузеры поддерживают ‘.mp4’. Код создания компонента получился таким…
Код разработки компонента
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 |
unit uVideoPanelBPL; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.OleCtrls, WMPLib_TLB, Vcl.Buttons, Vcl.StdCtrls; type TVideoPanelWMP = class(TPanel) private // Для растягивания мышкой за уголок MouseButtonDown, Sizing: Boolean; StartPosition, MousePosition: TPoint; MemoRect: TRect; FpBackgroundPanel:TPanel; FpTopPanel:TPanel; FstbStatusBar:TStatusBar; FsbCloseButton:TSpeedButton; procedure CloseClick(Sender:TObject); procedure stbStatusBarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure stbStatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure stbStatusBarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); protected { Protected declarations } public FlFileName:TLabel; FWMP:TWindowsMediaPlayer; constructor Create(AOwner:TComponent); override; published { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TVideoPanelWMP]); end; { TVideoPanelWMP } constructor TVideoPanelWMP.Create(AOwner: TComponent); var Panel:TStatusPanel; begin inherited; Self.Width:=400; Self.Height:=300; //Создание FpTopPanel:=TPanel.Create(Self); FWMP:=TWindowsMediaPlayer.Create(Self); FstbStatusBar:=TStatusBar.Create(Self); FsbCloseButton:=TSpeedButton.Create(Self); FlFileName:=TLabel.Create(Self); //Верхняя панель FpTopPanel.Parent:=Self; FpTopPanel.Align:=alTop; FpTopPanel.Height:=23; //Лабель имени файла FlFileName.Parent:=FpTopPanel; FlFileName.SetBounds(5,3,30,30); FlFileName.Caption:='NoFileName'; //Кнопка Close FsbCloseButton.Parent:=FpTopPanel; FsbCloseButton.Height:=20; FsbCloseButton.SetBounds(FpTopPanel.Width-10,1,20,20); FsbCloseButton.Left:=Self.Width-25; FsbCloseButton.Flat:=true; FsbCloseButton.Font.Size:=10; FsbCloseButton.Caption:='X'; FsbCloseButton.OnClick:=CloseClick; //Статус-бар FstbStatusBar.Parent:=Self; FstbStatusBar.Align:=alBottom; FstbStatusBar.Height:=15; FstbStatusBar.OnMouseDown:=stbStatusBarMouseDown; FstbStatusBar.OnMouseMove:=stbStatusBarMouseMove; FstbStatusBar.OnMouseUp:=stbStatusBarMouseUp; //FstbStatusBar.Panels.Create(FstbStatusBar); FstbStatusBar.Panels.Add; FstbStatusBar.Panels[0].Width:=200; FstbStatusBar.Panels[0].Alignment:=taRightJustify; // FstbStatusBar.Panels[0].Text:='///'; FstbStatusBar.Panels[0].Bevel:=pbLowered; FWMP.Parent:=Self; FWMP.Align:=alClient; end; procedure TVideoPanelWMP.CloseClick(Sender: TObject); begin // Фокусируем и отправляем программно нажатие / отпускание VK_DELETE Self.SetFocus; keybd_event(VK_DELETE, 0, 0, 0); keybd_event(VK_DELETE, 0, KEYEVENTF_KEYUP, 0); //А в программе, использующей TAudioPanelWMP нужно будет обработать VK_DELETE //Уничтожить и так далее end; //--------------------Обработчики мышки, для растягивания панели------------------- procedure TVideoPanelWMP.stbStatusBarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin Self.Parent.DoubleBuffered:=true; FWMP.Visible:=false; StartPosition := Point(X, Y); MemoRect := Self.BoundsRect; MouseButtonDown := True; end; end; procedure TVideoPanelWMP.stbStatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var InnerRect: TRect; XOffset: Integer; YOffset: Integer; begin //Выделяем маленький квадратик в нижнем правом углу InnerRect := Bounds(FstbStatusBar.Width - 20, FstbStatusBar.Height - 20, 20, 20); MousePosition := Point(X, Y); if (PtInRect(InnerRect, MousePosition)) or Sizing then begin Cursor := crSizeNWSE; if MouseButtonDown then begin Sizing := True; XOffset := MousePosition.x - StartPosition.x; YOffset := MousePosition.y - StartPosition.y; StartPosition := MousePosition; Inc(MemoRect.Right, XOffset); Inc(MemoRect.Bottom, YOffset); Self.BoundsRect := MemoRect; FsbCloseButton.Left:=FpTopPanel.Width-25; end; end else Cursor := crDefault; end; procedure TVideoPanelWMP.stbStatusBarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // Self.Parent.DoubleBuffered:=false; FWMP.Visible:=true; Cursor := crDefault; MouseButtonDown := False; Sizing := False; end; end. |
Как пользоваться компонентом?
Пример тестовой программы…
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
unit uMain_TestVideoPanelWMP; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, uVideoPanelBPL, Vcl.StdCtrls; type TfTestVideoPanelWMP = class(TForm) bCreateAndOpen: TButton; OpenDialog: TOpenDialog; procedure bCreateAndOpenClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var fTestVideoPanelWMP: TfTestVideoPanelWMP; implementation {$R *.dfm} procedure TfTestVideoPanelWMP.bCreateAndOpenClick(Sender: TObject); var VideoPanelWMP:TVideoPanelWMP; FileName: string; begin if (OpenDialog.Execute) and (ExtractFileExt(OpenDialog.filename)='.mp4') then begin VideoPanelWMP:=TVideoPanelWMP.Create(Self); VideoPanelWMP.Parent:=Self; //Обрезаем строку имени файла FileName:=ExtractFileName(OpenDialog.FileName); if length(FileName)>20 then FileName:=FileName.Substring(0,20)+'...'; VideoPanelWMP.FlFileName.Caption:=FileName; //------------ VideoPanelWMP.Left:=20; VideoPanelWMP.Top:=20; VideoPanelWMP.FWMP.URL:=OpenDialog.FileName; VideoPanelWMP.FWMP.controls.play; VideoPanelWMP.FWMP.controls.stop; VideoPanelWMP.Show; end else raise Exception.Create('Only *.mp4 files supported for the moment'+#13#10+'Please choose *.mp4'); end; end. |