UnitMain.pas ( File view )

  • By lobsterlobster 2016-07-14
  • View(s):0
  • Download(s):0
  • Point(s): 1
			unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, StrUtils, inifiles, jpeg;
type
  TGetCameraList = function(): PChar; stdcall;
  TSetCameraID = function(const value: Integer): integer; stdcall;
  TStartCamera = function(const Handle: HWND): integer; stdcall;
  TCloseCamera = function(const hWndC: HWND): integer; stdcall;
  TSaveBmp = function(const hWndC: HWND; const cFileName: PChar): integer; stdcall;
  TCamera = record
    SetCameraID: TSetCameraID;
    CloseCamera: TCloseCamera;
    StartCamera: TStartCamera;
    SaveBmp: TSaveBmp;
  end;


type
  TFormMain = class(TForm)
    DevList: TStringGrid;
    btn1: TButton;
    ScrollBox: TScrollBox;
    btnOpen: TButton;
    btnTakePic: TButton;
    btnClose: TButton;
    pnTop: TPanel;
    pnlLeft: TPanel;
    pnlMain: TPanel;
    edtCodeNum: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnTakePicClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure edtCodeNumKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
  private
    {
 Private declarations 
}
    iCameraCount, iWidth, iPicturesCount ,iCodeNumIndex, iSleepTime: integer;
    sExeName: string;
    dllhwnd: HWND;
    dllhandle : array  of HWND;
    camerah : array  of HWND;
    panels: array of TPanel;
    GetCameraList: TGetCameraList;
    procedure p_CameraOpen;
    procedure p_TakePicture;
    procedure SetInfor(const Value: string);
    procedure p_GetCameraList;
    procedure ClearDevList();
    procedure AddDevList(ID: string; Name: string);
  public
    {
 Public declarations 
}
    AppPath: string;
    cameras: array of TCamera;
    property Infor: string write SetInfor;
    function f_readini(vgroup:string;vname:string;vdefaultvalue:string;bVISStr:Boolean = True):string;//读ini文件种中指定内容值
    function f_getIndexStr(vlinestr:string;vIndex:Integer;vSourceStr:AnsiString):AnsiString;//取出字符串中以指定字符为分隔符指定位置的字符串并返回
  end;

var
  FormMain: TFormMain;

implementation

uses UnitCamera;

{
$R *.dfm
}

procedure TFormMain.AddDevList(ID, Name: string);
begin
  if DevList.Cells[0, DevList.RowCount - 1] <> '' then
    DevList.RowCount := DevList.RowCount + 1;
  DevList.Cells[0, DevList.RowCount - 1] := ID;
  DevList.Cells[1, DevList.RowCount - 1] := Name;
end;

procedure TFormMain.ClearDevList;
var
  i: integer;
begin
  for i := 1 to DevList.RowCount - 1 do
    DevList.Rows[i].Clear;
  DevList.RowCount := 2;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  AppPath := ExtractFilePath(Application.ExeName);
  dllhwnd := LoadLibrary(PChar(AppPath + 'VedioCapture.dll'));
  //dllhwnd2 := LoadLibrary(PChar(AppPath + 'Camera.dll'));
  if dllhwnd <= 32 then
  begin
    MessageBox(Handle, '类库加载错误...', '错误', 0);
    exit;
  end;
  GetCameraList := GetProcAddress(dllhwnd, 'GetCameraList');
  DevList.Rows[0].Text := '设备ID' + #13 + '设备名称';
  //读取配置文件中每个摄像头 拍照数量
  iPicturesCount := strtoint(f_readini('main','PicturesCount','10'));
  iCodeNumIndex := strtoint(f_readini('main','CodeNumIndex','1'));
  iSleepTime := strtoint(f_readini('main','SleepTime','100'));
  sExeName := f_readini('main','ExeName','扫码拍照程序');
  FormMain.Caption := sExeName;
  Application.Title := sExeName;
  //获取 摄像头 数量 列表
  p_GetCameraList;
  if not DirectoryExists(AppPath + 'Pictures') then //判断目录是否存在
  try
    begin
      CreateDir(AppPath + 'Pictures');
    end;
  except
    raise Exception.Create('Cannot Create ' + AppPath + 'Pictures');
  end;
end;

procedure TFormMain.p_GetCameraList;
var
  strdev: string;
  i: integer;
  StrList: TStringList;
  procedure GetDevList();
  var
    index: integer;
    strindex: string;
  begin
    if strdev = '' then Exit;
    if StrList = nil then StrList := TStringList.Create;
    index := pos('|', strdev);
    if (index = 0) or (index = -1) then
    begin
      Exit;
    end;
    strindex := LeftStr(strdev, index - 1);
    StrList.Add(strindex);
    Delete(strdev, 1, index);
    GetDevList();
  end;
begin
  if dllhwnd <= 32 then exit;
  ClearDevList();
  strdev :=  GetCameraList();
  Infor := strdev;
  GetDevList();
  i := 0;
  iCameraCount := 0;
  while i < StrList.Count do
  begin
    AddDevList(StrList.Strings[i], StrList.Strings[i + 1]);
    i := i + 2;
    //获取摄像头的数量
    Inc(iCameraCount);
  end;
end;

procedure TFormMain.SetInfor(const Value: string);
begin
  //
end;

procedure TFormMain.btn1Click(Sender: TObject);
var
  iResult: Integer;
begin
  SetLength(cameras,5);
  cameras[0].SetCameraID := GetProcAddress(dllhwnd, 'SetCameraID');
                                                                    
  cameras[0].CloseCamera := GetProcAddress(dllhwnd, 'CloseCamera');
  cameras[0].StartCamera := GetProcAddress(dllhwnd, 'StartCamera');

  iResult := cameras[0].SetCameraID(0);
  if iResult <> 0 then
  begin
    MessageBox(Handle, '设备打开失败', '', 0);
    Exit;
  end;
  cameras[0].StartCamera(ScrollBox.Handle);
end;

procedure TFormMain.btnOpenClick(Sender: TObject);
begin
  p_CameraOpen;
end;

procedure TFormMain.btnTakePicClick(Sender: TObject);
begin
  p_TakePicture;
end;

procedure TFormMain.btnCloseClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to iCameraCount - 1 do
  begin
    if dllhandle[i] <= 32 then exit;
    cameras[i].CloseCamera(camerah[i]);
    panels[i].Free;
  end;
end;

procedure TFormMain.edtCodeNumKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_return then
  begin 
    p_TakePicture;
  end; 
end;

procedure TFormMain.p_CameraOpen;
var
  i, iResult: integer;
begin
  iWidth := ScrollBox.Height div 2 - 2;
  SetLength(dllhandle,iCameraCount);
  SetLength(cameras,iCameraCount);
  SetLength(camerah,iCameraCount);
  SetLength(panels,iCameraCount);
  for i := 0 to iCameraCount - 1 do
  begin
    dllhandle[i] := LoadLibrary(PChar(AppPath + 'Camera' + IntToStr(i) + '.dll'));
    if dllhandle[i] <= 32 then
    begin
      MessageBox(Handle, '类库加载错误...', '错误', 0);
    end;

    cameras[i].SetCameraID := GetProcAddress(dllhandle[i], 'SetCameraID');
    cameras[i].CloseCamera := GetProcAddress(dllhandle[i], 'CloseCamera');
    cameras[i].StartCamera := GetProcAddress(dllhandle[i], 'StartCamera');
    cameras[i].SaveBmp := GetProcAddress(dllhandle[i], 'SaveBmp');

    iResult := cameras[i].SetCameraID(i);
    if iResult <> 0 then
    begin
      MessageBox(Handle, '设备打开失败', '', 0);
    end;

    panels[i] := TPanel.Create(ScrollBox);
    panels[i].Parent := ScrollBox;

    if i > 2 then
    begin
      panels[i].Top := iWidth;
      panels[i].Left := (i - 3) * iWidth;
    end else
    begin
      panels[i].Top := 0;
      panels[i].Left := i * iWidth;
    end;
    panels[i].Width := iWidth;
    panels[i].Height := iWidth;

    camerah[i] := cameras[i].StartCamera(panels[i].Handle);
  end;

end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  p_CameraOpen;
  edtCodeNum.SetFocus;
end;

procedure TFormMain.p_TakePicture;
var
  bmp: TBitmap;
  jpg: TJpegImage;
  i, y: integer;
  sPicDirName: string;
  sCodeNum:string;
begin
  if edtCodeNum.Text =  '' then exit;
  sCodeNum := StringReplace(edtCodeNum.Text,'
...
...
(Please download the complete source code to view)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
01.97 kB
Camera0.dll520.00 kB2016-06-16|16:39
Camera1.dll520.00 kB2016-06-16|16:39
Camera2.dll520.00 kB2016-06-16|16:39
Camera3.dll520.00 kB2016-06-16|16:39
Camera4.dll520.00 kB2016-06-16|16:39
Camera5.dll520.00 kB2016-06-16|16:39
ico.ico9.44 kB2016-06-16|16:39
MultipleCameras.cfg638.00 B2016-06-21|14:12
MultipleCameras.dof4.89 kB2016-06-21|14:12
MultipleCameras.dpr210.00 B2016-06-16|16:39
MultipleCameras.exe539.50 kB2016-06-21|15:02
MultipleCameras.gif77.00 B2016-06-21|15:03
MultipleCameras.res10.16 kB2016-06-21|14:12
MultipleCameras.stat163.00 B2016-06-16|16:49
MultipleCameras.~dpr210.00 B2016-06-16|16:39
UnitCamera.dcu4.94 kB2016-06-21|14:12
UnitCamera.ddp51.00 B2016-06-16|16:39
UnitCamera.dfm709.00 B2016-06-16|16:39
UnitCamera.pas1.63 kB2016-06-16|16:39
UnitCamera.~ddp51.00 B2016-06-16|16:39
UnitCamera.~dfm709.00 B2016-06-16|16:39
UnitCamera.~pas1.64 kB2016-06-16|16:39
UnitMain.dcu15.05 kB2016-06-21|14:12
UnitMain.ddp51.00 B2016-06-21|14:12
UnitMain.dfm2.51 kB2016-06-16|16:39
UnitMain.pas11.20 kB2016-06-21|14:12
UnitMain.~ddp51.00 B2016-06-21|14:08
UnitMain.~dfm2.51 kB2016-06-16|16:39
UnitMain.~pas11.17 kB2016-06-21|14:08
VedioCapture.dll520.00 kB2016-06-16|16:39
...

UnitMain.pas (2.18 MB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D