نیاز فوری(ارتباط delphi با کارت tv)

[ladangh]

سلام به دوستان عزیز
ایا میشود با کارت tv ارتبط برقرار کرد.
برای چاپ یک سری عکس از دستگاه اندوسکوپی.
با تشکر.

[hotice]

باعرض سلام
لینک زیر در مورد Video Capture in Delphi است.فکر میکنم بدرتان بخورد.
http://www.undu.com/DN970501/00000024.htm
موفق باشید. :)

[hr110]

با استفاده از اکتیو ایکس Kodak هم میتوانید.

[ladangh]

از راهنمای شما ممنونم .
اما من خیلی وارد نیستم.
اگر ممکنه کمی بیشتر توضیح بدهید.
باتشکر.

[hotice]

سلام

Source for Video Capture

unit vidcap;

interface

type
capturerec = record
dwRequestMicroSecPerFrame: longint;
fMakeUserHitOKToCapture: wordbool;
wPercentDropForError: word;
fYield: wordbool;
dwIndexSize: longint;
wChunkGranularity: word;
fUsingDOSMemory: wordbool;
wNumVideoRequested: word;
fCaptureAudio: wordbool;
wNumAudioRequested: word;
vKeyAbort: word;
fAbortLeftMouse: wordbool;
fAbortRightMouse: wordbool;
fLimitEnabled: wordbool;
wTimeLimit: word;
fMCIControl: wordbool;
fStepMCIDevice: wordbool;
dwMCIStartTime: longint;
dwMCIStopTime: longint;
fStepCaptureAt2x: wordbool;
wStepCaptureAverageFrames: word;
dwAudioBufferSize: longint;
fDisableWriteCache: wordbool;
AVStreamMaster: word;
end;


procedure InitVariables;
function CreateVideo: integer;
procedure CreateCapWin;
procedure ShowCapWin;
procedure HideCapWin;
procedure KillCapWin;
procedure ShowVideoParamsWindow;
procedure ShowCompressionWindow;
procedure UserMessage(msg: string);
function StreamCallback(wnd: THandle; vh: longint): wordbool; export;

var
framespersec,
framecount,
framestopcount: integer;
videofilename: string;
cparams,
captureparams: capturerec;

implementation

{
this prototype needs to be listed to access the AVICAP function
}
function capCreateCaptureWindow(var lpszWindowName;
dwStyle: longint; x: integer; y: integer;
nWidth: integer; nHeight: integer;
anhwnd: THandle; nID: integer): THandle; far; external 'avicap';

procedure InitVariables;
begin
{ This is used by the callback to auto-stop after the given
number of frames have been captured. }

framestopcount := 0;

{ AVICAP will default to creating the file CAPTURE.AVI in the
root directory of the drive the program is called from. This
variable can store a path\name so that you have some better
control over where it gets captured to. }

videofilename := 'c:\mydir\testcap.avi';

{ The frame capture rate is dependant on many conditions. These
are addressed in the article. For now, we'll set it to MAX. }

framespersec := 30;

end;

procedure CreateVideo;
begin
InitVariables;
CreateCapWin;
{ Delete any capture file if it exists }
if(FileExists(videofilename)) then
DeleteFile(videofilename);
{ There are no frames captured yet }
framecount := 0;
{ Tell AVICAP to begin capturing }
smreturn := SendMessage(hWndC, WM_USER + 62, 0, 0);
KillCapWin;
end;

{
Callback from AVICAP.DLL... every frame that gets captured
generates a function call from AVICAP. In this case we are
using it strictly to count the number of captured frames.
This callback gets initialized by CreateCapWin().
}
function StreamCallback(wnd: THandle; vh: longint): wordbool;
begin
if(framestopcount > 0) then begin
inc(framecount); { note the frame number }
if(framecount > framestopcount ) then
{ Tell AVICAP to abort the operation. }
SendMessage(hWndC, WM_USER + 69, 0, 0);
end;
{ Reassure AVICAP that all is OK. }
result := wordbool(1);
end;

{
This procedure creates the capture window and initializes
all of the capture parameters.
}

procedure CreateCapWin;
var
capavi: array[0..40] of char;
captit: array[0..40] of char;
smreturn: longint;
apntr: pointer;
asize: integer;
begin
{
STEP 1: INIT THE CAPTURE WINDOW AND GET CONNECTED TO
THE DRIVER
}
strpcopy(capavi, videofilename); { captured video file name }
strpcopy(captit, 'capture win'); { capture window }
(*
SEE THE ARTICLE TEXT ABOUT THE FOLLOWING WINDOW CREATION ROUTINE
*)
hWndC := capCreateCaptureWindow ( captit, WS_CHILD or WS_VISIBLE, 0, 0,
320, 240, main.handle, 0);
ShowWindow(hWndC, SW_SHOW);
{ Tell AVICAP to connect to the Capture driver. }
smreturn := SendMessage(hWndC, WM_USER + 10, 0, 0);

if(smreturn <> 0) then begin
usermessage( 'Connected' ); { feedback }
{ tell AVICAP what the name of the file to capture to is }
apntr := addr(capavi);
SendMessage(hWndC, WM_USER + 20, 0, longint(apntr));

{ STEP 2: SET IMAGE PREVIEW UP }
{ Set preview rate at 30 frames per second, in mSec.
1000 mSec/30 frames = 33 mSec. }
SendMessage(hWndC, WM_USER + 52, 33, 0);
{ Now go ahead and preview }
SendMessage(hWndC, WM_USER + 50, 1, 0);

{ STEP 3: INITIALIZE CAPTURE PARAMETERS }
{ First, the capture parameters structure gets initialized
by asking AVICAP to fill it in for us. }
apntr := addr(captureparams);
asize := sizeof(captureparams);
SendMessage(hWndC, WM_USER + 65, asize, longint(apntr));

{ Then start setting up the preferences: }
{ 1 = capture audio, 0 = disable }
captureparams.fCaptureAudio := wordbool(0);

(*
The time limit params are used to force a stop of the
video capture at a specified time, just in case
anything goes wrong. The params here are filled out
to stop capture automatically after 15 seconds just
for the sake of illustration.
*)

{ 1 = enable time limiting, 0 = disable }
captureparams.fLimitEnabled := wordbool(1);
{ In this case, 15 seconds of video, translated to hex }
captureparams.wTimeLimit := word($0E);

{ max error rate = 1%. This is somewhat hardware dependant. }
captureparams.wPercentDropForError := 1;

{ these are the most common frame rates }
if(framespersec = 30) then
captureparams.dwRequestMicroSecPerFrame := 33334 { 30 fps }
else
captureparams.dwRequestMicroSecPerFrame := 41667; { 24 fps }

{ 0 = automatic mode, 1 = put up an OK button to initiate }
captureparams.fMakeUserHitOKToCapture := wordbool(0);
{ 1 = abort capture on Left button click, 1 = disable }
captureparams.fAbortLeftMouse := wordbool(0);
{ 1 = abort capture on Right button click, 1 = disable }
captureparams.fAbortRightMouse := wordbool(0);
{ escape key aborts capturing }
captureparams.vKeyAbort := VK_ESCAPE;

(*
These parameters are listed but aren't required for general
purpose video capture. Refer to the Win32 SDK discussion of
AVICAP to see if your intended application will be affected.

captureparams.wChunkGranularity := 0;
captureparams.dwIndexSize := 0;
captureparams.fUsingDOSMemory := byte(0); { don't use DOS memory }
captureparams.fStepMCIDevice := 0;
captureparams.fMCIControl := 0;
captureparams.fStepCaptureAt2x := 0;
captureparams.fDisableWriteCache := byte(0);
captureparams.wStepCaptureAverageFrames := 3;
*)

{ Now write the capture parameters }
apntr := addr(captureparams);
asize := sizeof(captureparams);
SendMessage(hWndC, WM_USER + 64, asize, longint(apntr));

{ tell AVICAP where to find the framecount callback }
SendMessage(hWndC, WM_USER + 6, 0, longint(addr(StreamCallback)));

end else begin
usermessage( 'Invalid video driver.');
killcapwin; { just to be safe. It *is* windows, after all... }
end;
end;

{ show the capture window (including the live video) }
procedure ShowCapWin;
begin
ShowWindow(hWndC, SW_SHOW);
end;

{ hide the capture window }
procedure HideCapWin;
begin
ShowWindow(hWndC, SW_HIDE);
end;

{ destroy the capture window used by AVICAP }
procedure KillCapWin;
begin
ShowWindow(hWndC, SW_HIDE);
DestroyWindow(hWndC);
end;

{ Show the video format dialog. This is supplied by
the capture driver. All we need to do is tell
AVICAP to make the proper call to the driver. }
procedure ShowVideoParamsWindow;
begin
ShowCapWin;
SendMessage(hWndC, WM_USER + 41, 0, 0);
{ allow this to happen }
application.processmessages;
HideCapWin;
end;

{ Show the video compression options dialog supplied by the
capture driver. This works like the ShowVideoParamsWindow
procedure. }
procedure ShowCompressionWindow;
begin
ShowCapWin;
SendMessage(hWndC, WM_USER + 46, 0, 0);
{ allow this to happen }
application.processmessages;
HideCapWin;
end;

{ display a message to the user }
procedure UserMessage(msg: string);
begin
{
use for troubleshooting or your own messages...
main.messagelabel.caption := msg;
}
end;

end.
موفق باشی. :)

[ladangh]

آقای hotice از لطفتون ممنون.
ولی من اصلا وارد نیستم.
نمیدونم باید از کجا شروع کنم. :(
خواهش میکنم کمکم کنید.

[hotice]

سلام
احتمالا کمی بعد مقاله ای تحت همین عنوان در بخش مقالات دلفی میگذارم.
موفق باشی. :)