umain.pas

delphi控制数码相机的例子.不知道要用哪个版本的驱动程序.

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Jpeg, cdType, cdAPI, cdError;

type
  TfrmMain = class(TForm)
    btnStartSDK: TButton;
    btnStartViewFinder: TButton;
    StopViewFinder: TButton;
    GetPicture: TButton;
    ViewFinderTimer: TTimer;
    Image1: TImage;
    procedure btnStartViewFinderClick(Sender: TObject);
    procedure ViewFinderTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StopViewFinderClick(Sender: TObject);
    procedure btnStartSDKClick(Sender: TObject);
  private
    { Private declarations }
    function ConnectDC():cdErr;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  m_SourceInfo :cdSourceInfo;
  m_hSource    :cdUInt32;
  BmpData      :TBitMap;

  function ViewFinder_CallbackFunction(pBuf:pointer;Size:cdUInt32;Format:cdUInt32;Context : cdContext) : cdUInt32 stdcall;
  function Rel_CallBackFunc(EventID:cdReleaseEventID;pData:Pointer;DataSize:cdUInt32;Context:cdContext): cdUInt32 stdcall;

implementation

uses uCamSelect;

{$R *.dfm}
function ViewFinder_CallbackFunction(pBuf:pointer;Size:cdUInt32;Format:cdUInt32;Context : cdContext) : cdUInt32 stdcall;
var BmpStream:TMemoryStream;
begin
    BmpStream :=TMemoryStream.Create;
    Try
      BmpStream.WriteBuffer(pBuf^,Size);
      BmpStream.Position :=0;
      BmpData.LoadFromStream(BmpStream);
      Result :=cdOK;
    finally
      BmpStream.Free;
    end;  
end;

function Rel_CallBackFunc(EventID:cdReleaseEventID;pData:Pointer;DataSize:cdUInt32;Context:cdContext): cdUInt32 stdcall;
begin
  Result :=cdOK;
end;

function TfrmMain.ConnectDC: cdErr;
var  Err:cdErr;
     Ver:cdVersionInfo;
begin
  Ver.MajorVersion :=7;
  Ver.MinorVersion :=1;
  Ver.Size :=Sizeof(ver);
  Result :=cdINVALID;
  Err := CDStartSDK(Ver, 0);
  if Err<>cdOK then
    exit;

  With TFrmCamSelect.Create(Self) do
  Try
    if ShowModal=mrOK then
    begin
       if (m_SourceInfo.SurceType = cdSRC_TYPE_INVALID) then
         exit;

       Err := CDOpenSource(m_SourceInfo, m_hSource);
       if Err <> cdOK Then
         exit;
       
       Err := CDLockUI(m_hSource);
       If Err <> cdOK Then
         exit;

       Err := CDEnterReleaseControl(m_hSource,@Rel_CallBackFunc,0 );
       If Err <> cdOK Then
         exit;

       Err := CDUnlockUI(m_hSource);
       If Err <> cdOK Then
         exit;
       Result :=cdOK;
    end;
  finally
    free;
  end;
end;

procedure TfrmMain.btnStartViewFinderClick(Sender: TObject);
begin
  cdStartViewFinder(m_hSource,1,@ViewFinder_CallbackFunction,0);
  ViewFinderTimer.Enabled :=True;
end;

procedure TfrmMain.ViewFinderTimerTimer(Sender: TObject);
begin
  Image1.Canvas.CopyRect(Image1.Canvas.ClipRect,BmpData.Canvas,BmpData.Canvas.ClipRect);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  BmpData:= TBitmap.Create;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  ViewFinderTimer.Enabled :=False;
  BmpData.Free;
  CDFinishSDK;
end;

procedure TfrmMain.StopViewFinderClick(Sender: TObject);
begin
  ViewFinderTimer.Enabled :=False;
end;

procedure TfrmMain.btnStartSDKClick(Sender: TObject);
begin
  if ConnectDC=cdOK then
    btnStartViewFinder.Enabled :=True
  else
    CDFinishSDK;
end;

end.