Здравствуйте! У меня TPanel класс. Я строю cavcas.LineTo - все нормально - прямая строися. Строю DShow графы ..VideoWindow.Put_Owner(panel1.Hand le)..
..MediaControl.Pause... и у меня получается TPanel авишная картинка .
Я еще раз строю cavcas.LineTo - но прямая не строися, почему так?
Када я строил все тоже самое в TMediaPlayer, но прямая строилась. (P.S.а если кто-нть знает, как в TMediaPlayer CaptureBitmap делать, я буду оч благодарен. В TMediaPlayer меня устраивает, только CaptureBitmap не могу найти)
Код:
unit Hysto;
interface
uses Controls,Graphics,Types,Classes,ExtCtrls,Dshow,ActiveX,Windows;
type
TPanelVideo=class(TPanel)
private
IsDown: Boolean;
RectColor: TColor;
MouseRect: TRect;
GraphBuilder: IGraphBuilder;
MediaControl: IMediaControl;
VideoDeviceID: integer;
VideoWindow: IVideoWindow;
procedure CanvasMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CanvasMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure CanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure CanvasDblClick(Sender: TObject);
public
constructor Create(AOwner :TComponent);override;
end;
implementation
constructor TPanelVideo.Create(AOwner :TComponent);
begin
inherited;
Width := 202;
Height := 202;
Left:=30;
Top:=30;
CoInitialize(nil);
OnMouseDown:=CanvasMouseDown;
OnMouseUp:=CanvasMouseUp;
OnMouseMove:=CanvasMouseMove;
OnDblClick:=CanvasDblClick;
end;
//построение прямой
procedure TPanelVideo.CanvasMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then with MouseRect do
begin
IsDown := True;
Left := X; Top := Y; Right := X; Bottom := Y;
end;
end;
procedure TPanelVideo.CanvasMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not IsDown then Exit;
Canvas.MoveTo(MouseRect.Left,MouseRect.Top);
Canvas.Pen.Color := $FFFF00;
Canvas.Pen.Mode := pmNotXor;
Canvas.LineTo(MouseRect.Right,MouseRect.Bottom);
with MouseRect do
begin
Right := X;
Bottom := Y;
end;
Canvas.MoveTo(MouseRect.Left,MouseRect.Top);
Canvas.Pen.Mode := pmNotXor;
Canvas.LineTo(MouseRect.Right,MouseRect.Bottom);
end;
procedure TPanelVideo.CanvasMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
IsDown := False;
with MouseRect do
Canvas.LineTo(Right, Bottom);
end;
//Видео-плеер
procedure TPanelVideo.CanvasDblClick(Sender: TObject);
begin
if CoCreateInstance(CLSID_FilterGraph,nil,CLSCTX_INPROC_SERVER,IID_IGraphBuilder,GraphBuilder)=S_OK then
if GraphBuilder.RenderFile(StringToOleStr('d:\TH12_42_06 26_09_08 540s 3f.avi'),nil)=S_OK then
GraphBuilder.QueryInterface(IID_IMediaControl,MediaControl);
{получаем интерфейс IVideoWindow}
GraphBuilder.QueryInterface(IID_IVideoWindow, VideoWindow);
VideoWindow.Put_Owner(Self.Handle);
VideoWindow.Put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
VideoWindow.SetWindowPosition(0, 0, Self.ClientRect.Right,
Self.ClientRect.Bottom);
MediaControl.Run;
sleep(100);
MediaControl.Pause;
end;
end.