home *** CD-ROM | disk | FTP | other *** search
- 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.
-
-