Chip 2002 June

home *** CD-ROM | disk | FTP | other *** search

/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d23456 / WAVICAP.ZIP / avicap / TAviCap / AviCap.pas next >

Wrap

Pascal/Delphi Source File | 2002-04-04 | 18.4 KB | 596 lines

unit AviCap; { This code was written by : A. Waintrub email: alexander@weintrub.de This code is copyright 1997 by A. Waintrub +++++++++++++++++++++++++++++++++++++++++++++++++++ + NUR F▄R PRIVATE NUTZUNG!!! + +++++++++++++++++++++++++++++++++++++++++++++++++++} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, extctrls, AviCapH, {$IFDEF VER140}DesignIntf, DesignEditors, {$ELSE}Dsgnintf, {$ENDIF} AviCapDrvList, Dialogs; type TDriver = string; type TDriverProperty = class(TStringProperty) private public procedure Edit; override; function GetAttributes: TPropertyAttributes; override; end; type TFileNameProperty = class(TStringProperty) public procedure Edit; override; function GetAttributes: TPropertyAttributes; override; end; type TAviCap = class(TCustomPanel) private { Private Declarations } RequestMicroSecPerFrame: dword; MakeUserHitOKToCapture: LongBool; PercentDropForError: Byte; Yield: bool; IndexSize: dword; ChunkGranularity: dword; UsingDOSMemory: Bool; NumVideoRequested: dword; CaptureAudio: Bool; NumAudioRequested: Byte; KeyAbort: Word; AbortLeftMouse: bool; AbortRightMouse: bool; LimitEnabled: bool; TimeLimit: Byte; MCIControl: bool; StepMCIDevice: bool; MCIStartTime: dword; MCIStopTime: dword; StepCaptureAt2x: bool; StepCaptureAverageFrames: Byte; AudioBufferSize: dword; DisableWriteCache: bool; StreamMaster: Word; FConnected: boolean; FDriver: TDriver; FAviFileNAme: TFileName; FOverlay: boolean; FScale: boolean; capturing: boolean; FCaptureParms: TCaptureParms; dummy: Boolean; FOnMouseUp: TMouseMoveEvent; FOnMouseMove: TMouseMoveEvent; FOnMouseDown: TMouseMoveEvent; FOnDblClick: TNotifyevent; FOnClick: TNotifyevent; Pic: TImage; FPicture: TFileName; F_4_to_3: Boolean; FShowBlackScreen: Boolean; function DriverIndex: Integer; procedure SetDriver(const Value: TDriver); procedure Connect(b: Boolean); procedure SetAviFileName(S: TFileName); procedure SetOverlay(b: boolean); procedure SetScale(b: boolean); procedure Disconnect; procedure DlgSource(B: Boolean); procedure DlgFormat(B: Boolean); procedure DlgCompression(B: Boolean); procedure DlgDisplay(B: Boolean); procedure SetOnClick(const Value: TNotifyevent); procedure SetOnDblClick(const Value: TNotifyevent); procedure SetOnMouseDown(const Value: TMouseMoveEvent); procedure SetOnMouseMove(const Value: TMouseMoveEvent); procedure SetOnMouseUp(const Value: TMouseMoveEvent); procedure SetPicture(const Value: TFileName); procedure Set_4_to_3(const Value: Boolean); procedure SetShowBlackScreen(const Value: Boolean); protected { Protected Declarations } public { Public Declarations } DriverDescripton: TStringList; CapWndHandle: THandle; DC: HDC; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure paint; override; procedure StartCapture; procedure StopCApture; property cap_DriverDescripton: TStringList read DriverDescripton; property cap_WndHandle: THandle read CapWndHandle; published property cap_Connected: boolean read FConnected write connect; property cap_DlgVideoCompression: boolean read dummy write DlgCompression; property cap_DlgVideoSourece: boolean read dummy write DlgSource; property cap_DlgVideoDisplay: boolean read dummy write DlgDisplay; property cap_DlgVideoFormat: boolean read dummy write DlgFormat; property cap_AviFileName: TFileName read FAviFileNAme write SetAviFileNAme; property cap_Overlay: Boolean read FOverlay write SetOverlay; property cap_Scale: Boolean read FScale write SetScale; property cap_OptRequestMicroSecPerFrame: DWORD read RequestMicroSecPerFrame write RequestMicroSecPerFrame; property cap_OptMakeUserHitOKToCapture: Bool read MakeUserHitOKToCapture write MakeUserHitOKToCapture; property cap_OptPercentDropForError: Byte read PercentDropForError write PercentDropForError; property cap_OptYield: Bool read Yield write Yield; property cap_OptIndexSize: dword read IndexSize write IndexSize; property cap_OptChunkGranularity: dword read ChunkGranularity write ChunkGranularity; property cap_OptUsingDOSMemory: Bool read UsingDOSMemory write UsingDOSMemory; property cap_OptNumVideoRequested: dword read NumVideoRequested write NumVideoRequested; property cap_OptCaptureAudio: LongBool read CaptureAudio write CaptureAudio; property cap_OptNumAudioRequested: Byte read NumAudioRequested write NumAudioRequested; property cap_OptKeyAbort: Word read KeyAbort write KeyAbort; property cap_OptAbortLeftMouse: Bool read AbortLeftMouse write AbortLeftMouse; property cap_OptAbortRightMouse: Bool read AbortRightMouse write AbortRightMouse; property cap_OptLimitEnabled: Bool read LimitEnabled write LimitEnabled; property cap_OptTimeLimit: Byte read TimeLimit write TimeLimit; property cap_OptMCIControl: Bool read MCIControl write MCIControl; property cap_OptStepMCIDevice: Bool read StepMCIDevice write StepMCIDevice; property cap_OptMCIStartTime: dword read MCIStartTime write MCIStartTime; property cap_OptMCIStopTime: dword read MCIStopTime write MCIStopTime; property cap_OptStepCaptureAt2x: Bool read StepCaptureAt2x write StepCaptureAt2x; property cap_OptStepCaptureAverageFrames: Byte read StepCaptureAverageFrames write StepCaptureAverageFrames; property cap_OptAudioBufferSize: dword read AudioBufferSize write AudioBufferSize; property cap_OptDisableWriteCache: Bool read DisableWriteCache write DisableWriteCache; property cap_OptAVStreamMaster: Word read StreamMaster write StreamMaster; property Picture: TFileName read FPicture write SetPicture; property cap_Driver: string read FDriver write SetDriver; property OnDblClick: TNotifyevent read FOnDblClick write SetOnDblClick; property OnClick: TNotifyevent read FOnClick write SetOnClick; property OnMouseMove: TMouseMoveEvent read FOnMouseMove write SetOnMouseMove; property OnMouseDown: TMouseMoveEvent read FOnMouseDown write SetOnMouseDown; property OnMouseUp: TMouseMoveEvent read FOnMouseUp write SetOnMouseUp; property _4_to_3: Boolean read F_4_to_3 write Set_4_to_3 default false; property ShowBlackScreen: Boolean read FShowBlackScreen write SetShowBlackScreen; end; procedure Register; implementation {$R AviCap.res} var hook: HHOOK; _CapWndHandle, _ParentWindow: THAndle; _AviCap: TAviCap; _FOnMouseUp: TMouseMoveEvent; _FOnMouseMove: TMouseMoveEvent; _FOnMouseDown: TMouseMoveEvent; _FOnDblClick: TNotifyevent; _FOnClick: TNotifyevent; Pressed: Byte = 0; function GetMsgProc(code: Integer; wparam: WPARAM; lparam: pointer): LRESULT stdcall; // <<<---------- // | function MsgToShift(L: LongInt): TShiftState; // | begin // | result := []; // | if (l = WM_LBUTTONDOWN) or (L = WM_LBUTTONUP) then Include(result, ssLeft); // | if (l = WM_MBUTTONDOWN) or (L = WM_MBUTTONUP) then Include(result, ssMiddle); // | if (l = WM_RBUTTONDOWN) or (L = WM_RBUTTONUP) then Include(result, ssRight); // | if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt); // | if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); // | if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); // | end; // | var // | msg: TagMsg; // | move: Boolean; // | begin // | result := CallNextHookEx(// | HOOK, // handle to current hook // | Code, // hook code passed to hook procedure // | wparam, // value passed to hook procedure // | Integer(lparam) // value passed to hook procedure // | ); // | Move := False; // | copymemory(@msg, lparam, Sizeof(tagmsg)); // | if msg.hwnd = _CapWndHandle then // | begin // | case msg.message of // | WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK: // | if assigned(_FOnDblClick) then _FOnDblClick(_AviCap); // | WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN: // | begin // | if assigned(_FOnMouseDown) then _FOnMouseDown(_AviCap, MsgToShift(msg.message), // | LOWORD(msg.lParam), HIWORD(msg.lParam)); // | end; // | WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP: // | if assigned(_FOnMouseUp) then _FOnMouseUP(_AviCap, MsgToShift(msg.message), // | LOWORD(msg.lParam), HIWORD(msg.lParam)); // | WM_MOUSEMOVE: // | begin // | if assigned(_FOnMouseMove) then _FOnMouseMove(_AviCap, MsgToShift(msg.message), // | LOWORD(msg.lParam), HIWORD(msg.lParam)); // | move := true; // | end; // | end; // | case msg.message of // | WM_LBUTTONUP: if (Pressed = 1) and assigned(_FOnClick) then _FOnClick(_AviCap); // | WM_RBUTTONUP: if (Pressed = 2) and assigned(_FOnClick) then _FOnClick(_AviCap); // | WM_MBUTTONUP: if (Pressed = 3) and assigned(_FOnClick) then _FOnClick(_AviCap); // | end; // | if not move then // | case msg.message of // | WM_LBUTTONDOWN: Pressed := 1; // | WM_RBUTTONDOWN: Pressed := 2; // | WM_MBUTTONDOWN: Pressed := 3; // | else Pressed := 0; // | end; // | end; // ------------------------ if (msg.hwnd = _ParentWindow) and (msg.message = WM_MOUSEFIRST) {// |} then PostMessage(_CapWndHandle, WM_PAINT, 0, 0); // | end; // | // | // | constructor TAviCap.Create(AOwner: TComponent); // | var // | a1, a2: array[0..127] of char; // | b: Byte; // | begin // | inherited Create(AOwner); // | parent := AOwner as TWinCOntrol; // | capturing := false; // | width := 260; // | height := 180; // | Pic := TImage.Create(self); // | Pic.Parent := Self; // | Pic.Stretch := True; // | Pic.Align := alClient; // | FPicture := ''; // | SetPicture(FPicture); // | DriverDescripton := TStringList.Create; // | for b := 0 to 8 do // | if capGetDriverDescriptionA(b, a1, 128, a2, 128) then // | DriverDescripton.Add(a1); // | fDriver := DriverDescripton.Strings[0]; // | CapWndHandle := capCreateCaptureWindowA('', WS_CHILD + WS_BORDER, // | 0, 0, 0, 0, handle, 0); // | _CapWndHandle := CapWndHandle; // | capCaptureGetSetup(CapWndHandle, WParam(SizeOf(TCaptureParms)), // | LParam(@(FCaptureParms))); // | dc := Getdc(CapWndHandle); // | ZeroMemory(@a1, 128); // | capFileGetCaptureFile(CapWndHandle, 128, LParam(@a1)); // | FAviFileNAMe := a1; // | with FCaptureParms do // | begin // | RequestMicroSecPerFrame := dwRequestMicroSecPerFrame; // | MakeUserHitOKToCapture := fMakeUserHitOKToCapture; // | PercentDropForError := wPercentDropForError; // | Yield := fYield; // | IndexSize := dwIndexSize; // | ChunkGranularity := wChunkGranularity; // | UsingDOSMemory := fUsingDOSMemory; // | NumVideoRequested := wNumVideoRequested; // | CaptureAudio := fCaptureAudio; // | NumAudioRequested := wNumAudioRequested; // | KeyAbort := vKeyAbort; // | AbortLeftMouse := fAbortLeftMouse; // | AbortRightMouse := fAbortRightMouse; // | LimitEnabled := fLimitEnabled; // | TimeLimit := wTimeLimit; // | MCIControl := fMCIControl; // | StepMCIDevice := fStepMCIDevice; // | MCIStartTime := dwMCIStartTime; // | MCIStopTime := dwMCIStopTime; // | StepCaptureAt2x := fStepCaptureAt2x; // | StepCaptureAverageFrames := wStepCaptureAverageFrames; // | AudioBufferSize := dwAudioBufferSize; // | DisableWriteCache := fDisableWriteCache; // | StreamMaster := AVStreamMaster; // | end; // | FOverlay := True; // | if (not (csDesigning in ComponentState)) and (_CapWndHAndle <> 0) then // | HOOK := SetWindowsHookEx(// | WH_GETMESSAGE, // type of hook to install // | @GetMsgProc, // address of hook procedure >>>>>>>>>---------------- hinstance, // handle of application instance GetCurrentThreadID // identity of thread to install hook for ); _AviCAp := self; _ParentWindow := (AOwner as TWinControl).Handle; end; destructor TAviCap.Destroy; begin if FConnected then disconnect; DriverDescripton.free; ReleaseDC(DC, CapWndHandle); CloseHandle(CapWndHandle); UnhookWindowsHookEx(hook); inherited Destroy; end; procedure TAviCap.Connect(b: Boolean); begin if b then if driverindex >= 0 then begin textout(dc, 10, 10, 'Connecting...', 13); fconnected := capDriverConnect(CapWndHandle, DriverIndex); SetOverlay(FOverlay); pic.Hide; ShowWindow(cap_WndHandle, SW_SHOW); end else exception.Create('No drivers aviable') else disconnect; end; procedure TAviCap.Disconnect; var B: boolean; begin fconnected := False; pic.Show; b := FOverlay; SetOverlay(False); capDriverDisconnect(CapWndHandle); SetOverlay(b); end; procedure TAviCap.Paint; var L: LongINt; begin if _4_to_3 then height := width * 3 div 4; if FConnected then l := SWP_SHOWWINDOW else if FShowBlackScreen then l := SWP_SHOWWINDOW else l := SWP_HIDEWINDOW; SetWindowPos(CapWndHandle, HWND_TOP, 1, 1, width - 3, height - 3, l); if (csDesigning in ComponentState) and FShowBlackScreen then textout(dc, 10, 10, PChar(Name), Length(Name)); inherited Paint; end; procedure TAviCap.SetAviFileName(S: TFileName); begin capFileSetCaptureFile(CapWndHandle, LParam(PChar(s))); FAVIFileNAme := s; end; procedure TAviCap.SetOverlay(b: boolean); begin capOverlay(CapWndHandle, WPARAM(b)); FOverlay := b; end; procedure TAviCap.SetScale(b: boolean); begin capPreviewScale(CapWndHandle, WPARAM(b)); FScale := b; end; procedure TAviCAp.StartCapture; var b: Boolean; begin SetAviFileName(FAviFileNAme); b := FOverlay; SetOverlay(false); capCaptureSetSetup(CapWndHandle, WParam(SizeOf(FCaptureParms)), LParam(@FCaptureParms)); capPreview(CapWndHandle, WPARAM(True)); capCaptureSequence(CapWndHandle); setOverlay(b); end; procedure TAviCAp.StopCapture; begin capCaptureStop(CapWndHandle); end; procedure TAviCap.DlgSource(B: Boolean); begin capDlgVideoSource(CapWndHandle); end; procedure TAviCAp.DlgFormat(B: Boolean); begin capDlgVideoFormat(CapWndHandle); end; procedure TAviCap.DlgCompression(B: Boolean); begin capDlgVideoCompression(CapWndHandle); end; procedure TAviCap.DlgDisplay(B: Boolean); begin capDlgVideoDisplay(CapWndHandle); end; procedure TAviCap.SetDriver(const Value: TDriver); begin if fconnected then capDriverDisconnect(CapWndHandle); if DriverDescripton.IndexOf(Value) >= 0 then FDriver := Value; if FConnected then capDriverConnect(CapWndHandle, DriverIndex); end; function TAviCap.DriverIndex: INteger; begin result := DriverDescripton.IndexOf(FDriver) end; procedure TAviCap.SetOnClick(const Value: TNotifyevent); begin FOnClick := Value; _FOnClick := FOnClick end; procedure TAviCap.SetOnDblClick(const Value: TNotifyevent); begin FOnDblClick := Value; _FOnDblClick := FOnDblClick end; procedure TAviCap.SetOnMouseDown(const Value: TMouseMoveEvent); begin FOnMouseDown := Value; _FOnMouseDown := FOnMouseDown end; procedure TAviCap.SetOnMouseMove(const Value: TMouseMoveEvent); begin FOnMouseMove := Value; _FOnMouseMove := FOnMouseMove end; procedure TAviCap.SetOnMouseUp(const Value: TMouseMoveEvent); begin FOnMouseUp := Value; FOnMouseUp := FOnMouseUp end; procedure TAviCap.SetPicture(const Value: TFileName); procedure LoadDefPic; var res, BufSize: Integer; WMF: TMetaFile; Str: TMemoryStream; begin res := FindResource(hinstance, 'PIC', 'WMF'); BufSize := SizeofResource(HInstance, res); Str := TMemoryStream.Create; Str.SetSize(BufSize); copymemory(str.Memory, LockResource(LoadResource(HInstance, res)), BufSize); wmf := TMetaFile.Create; wmf.LoadFromStream(str); pic.Picture.Assign(wmf); str.Free; wmf.Free; end; begin if Value = '' then LoadDefPic else pic.Picture.LoadFromFile(Value); FPicture := Value; end; procedure TAviCap.Set_4_to_3(const Value: Boolean); begin F_4_to_3 := Value; repaint; end; procedure TAviCap.SetShowBlackScreen(const Value: Boolean); begin FShowBlackScreen := Value; repaint; end; { TDriverProperty } procedure TDriverProperty.Edit; var F: TFDrvList; begin f := TFDrvList.Create(Application); with f do begin ListBox1.Items := TAviCap(GetComponent(0)).DriverDescripton; ShowModal; if modalresult = mrOK then TAviCap(GetComponent(0)).cap_Driver := getValue; free; end; end; function TDriverProperty.GetAttributes: TPropertyAttributes; begin Result := [paDialog]; end; { TFileNameProperty } procedure TFileNameProperty.Edit; begin with TOpenDialog.Create(Application) do begin filename := ExtractFileName(GetValue); InitialDir := ExtractFilePath(GetValue); if Execute then SetValue(FileName); Free end; end; function TFileNameProperty.GetAttributes: TPropertyAttributes; begin Result := [paMultiSelect, paDialog]; end; procedure Register; begin RegisterComponents('Free', [TAviCap]); RegisterPropertyEditor(TypeInfo(TDriver), TAviCap, '', TDriverProperty); RegisterPropertyEditor(TypeInfo(TFileName), TAviCap, '', TFileNameProperty); end; end.