⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ufrmmain.~pas

📁 285摄像机源码,学习练习之用
💻 ~PAS
字号:
unit ufrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls;

type
    CAMERA_RUNMODE=(CAMERA_PLAY, CAMERA_PAUSE, CAMERA_STOP);
    IMAGE_FORMAT=(IMAGE_BMP, IMAGE_JPG, IMAGE_RAW);
    RESOLUTION_TYPE=(TYPE_FULL, TYPE_2X2, TYPE_4X4);
    CAPTURE_RET=(CAPTURE_ERROR,CAPTURE_DONE,CAPTURE_LONG_EXP);

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    System1: TMenuItem;
    Start1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Setting1: TMenuItem;
    Capture1: TMenuItem;
    Resolution1: TMenuItem;
    FULL1: TMenuItem;
    N2X21: TMenuItem;
    N4X41: TMenuItem;
    Panel1: TPanel;
    Stop1: TMenuItem;
    savePic: TSaveDialog;
    procedure Exit1Click(Sender: TObject);
    procedure Start1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure FULL1Click(Sender: TObject);
    procedure N2X21Click(Sender: TObject);
    procedure N4X41Click(Sender: TObject);
    procedure Capture1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
//**************变量声明
  hCapture:Thandle;
  m_mode:CAMERA_RUNMODE;
  m_PreviewMode:RESOLUTION_TYPE;
  m_ae,m_long:BOOL;
  m_gamma,m_constrast,m_exposal,m_target,m_longexposal,m_gain:Integer;

 
//************************************************************************/
//*         General Control Function                                     */
//************************************************************************/
function InitVideo(pic:HWND; hand:PHandle):Boolean; cdecl; external 'Sony285DLL.DLL';
function CloseVideo(hand:THandle) : Boolean; cdecl; external 'Sony285dll.dll';

//************************************************************************/
//*          Camera Control Function								        */
//************************************************************************/
function START_CAMERA(hand:THandle):Boolean; cdecl; external 'Sony285DLL.dll';

function SET_MODE(hand:THandle; binning:RESOLUTION_TYPE):Boolean; cdecl; external 'Sony285DLL.dll';
function SET_EXPOSURE(hand:THandle; autoexptime:Boolean; exptime:Integer; target:Integer ):Boolean; cdecl; external 'Sony285DLL.dll';
function SET_GAMMA(hand:THandle; gamma:real; gain:word; contrast:integer):Boolean; cdecl; external 'Sony285DLL.dll';
function SET_LONEXPOSURE(hand:THandle; longexptime:Integer):Boolean; cdecl; external 'Sony285DLL.dll';
function SAVE_TO_FILE(hand:THandle; nResolution:Integer; nFormat:Integer; cstrFileName:PCHAR):Boolean; cdecl; external 'Sony285DLL.dll';
function GET_STATUS(hand:THandle):CAPTURE_RET; cdecl; external 'Sony285DLL.dll';
function GET_CAPTURINGTIME(hand:THandle):word; cdecl; external 'Sony285DLL.dll';

implementation

{$R *.dfm}

//***********  窗体显示时
procedure TForm1.FormShow(Sender: TObject);
begin
    m_mode:=CAMERA_STOP;
    m_PreviewMode:=TYPE_FULL;

    m_gamma:= 64;
	  m_constrast:= 3;
	  m_gain:= 31;
	  m_exposal:= 1020;
	  m_target:= 0;
	  m_longexposal:= 0;
	  m_ae:= TRUE;
	  m_long:= FALSE;
    
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  close;
end;

//************  启动摄像机
procedure TForm1.Start1Click(Sender: TObject);
begin

  if m_mode=CAMERA_STOP then
    begin
      if InitVideo(Panel1.Handle,@hCapture) then
      begin
        if START_CAMERA(hCapture) then
          begin
          SET_MODE(hCapture, m_PreviewMode);
          m_mode:=CAMERA_PLAY;
          end;
      end;
    end;
end;

//***********   关闭摄像机
procedure TForm1.Stop1Click(Sender: TObject);
begin
  if m_mode=CAMERA_PLAY then
   begin
    CloseVideo(hCapture);
    m_mode:=CAMERA_STOP;
    self.Caption:='Sony285Demo';
  end;
end;

//*************  FULL model
procedure TForm1.FULL1Click(Sender: TObject);
begin
  if m_mode=CAMERA_PLAY then
  begin
    m_PreviewMode:=TYPE_FULL;
    SET_MODE(hCapture,m_PreviewMode);
  end;
end;

//*************  2X2 model
procedure TForm1.N2X21Click(Sender: TObject);
begin
  if m_mode=CAMERA_PLAY then
  begin
    m_PreviewMode:=TYPE_2X2;
    SET_MODE(hCapture,m_PreviewMode);
  end;
end;

//*************  4X4 model
procedure TForm1.N4X41Click(Sender: TObject);
begin
  if m_mode=CAMERA_PLAY then
  begin
     m_PreviewMode:=TYPE_4X4;
     SET_MODE(hCapture,m_PreviewMode);
  end;
end;

procedure TForm1.Capture1Click(Sender: TObject);
var
  filename,format:string;
  nFormat:Integer;
begin
  if m_mode=CAMERA_PLAY then
  begin
     if savePic.Execute then
     begin
        filename:=savePic.FileName;

        format:=copy(filename,length(filename)-2,3);
        showMessage(format);

        if format='bmp' then
          nFormat:=0;
        if format='jpg' then
          nFormat:=1;
        if format='raw' then
          nFormat:=2;

        if SAVE_TO_FILE(hCapture, 0, nFormat, PCHAR(filename)) then
           ShowMessage('相片保存成功');
     end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -