1411 lines
39 KiB
ObjectPascal
1411 lines
39 KiB
ObjectPascal
unit getpic2;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
|
||
Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs,
|
||
DelphiTwain, Buttons, StdCtrls, DB, ADODB, IdBaseComponent, IdComponent,
|
||
IdTCPConnection, IdTCPClient, IdFTP, CameraParamsUnit, ToolFunctionUnit,
|
||
TypInfo;
|
||
|
||
type
|
||
TFormGetPic2 = class(TForm)
|
||
ScrollBox1: TScrollBox;
|
||
Image1: TImage;
|
||
OpenPictureDialog1: TOpenPictureDialog;
|
||
Image2: TImage;
|
||
SpeedButton1: TSpeedButton;
|
||
SpeedButton2: TSpeedButton;
|
||
SpeedButton3: TSpeedButton;
|
||
Button1: TButton;
|
||
Button2: TButton;
|
||
ADOQuery1: TADOQuery;
|
||
SpeedButton4: TSpeedButton;
|
||
SaveDialog1: TSavePictureDialog;
|
||
adoqueryImage: TADOQuery;
|
||
IdFTP1: TIdFTP;
|
||
SpeedButton5: TSpeedButton;
|
||
Button3: TButton;
|
||
IMAGE_GRAB_GroupBox: TGroupBox;
|
||
START_GRABBING_BUTTON: TButton;
|
||
STOP_GRABBING_BUTTON: TButton;
|
||
CONTINUS_MODE_RadioButton: TRadioButton;
|
||
TRIGGER_MODE_RadioButton: TRadioButton;
|
||
SOFTWARE_TRIGGER_CheckBox: TCheckBox;
|
||
SOFTWARE_ONCE_BUTTON: TButton;
|
||
SAVE_IMAGE_GroupBox: TGroupBox;
|
||
SAVE_BMP_BUTTON: TButton;
|
||
SAVE_JPG_BUTTON: TButton;
|
||
PARAMETER_GroupBox: TGroupBox;
|
||
EXPOSURE_StaticText: TStaticText;
|
||
GAIN_StaticText: TStaticText;
|
||
EXPOSURE_Edit: TEdit;
|
||
GAIN_Edit: TEdit;
|
||
GET_PARAMETER_BUTTON: TButton;
|
||
SET_PARAMETER_BUTTON: TButton;
|
||
DEVICE_COMBO: TComboBox;
|
||
OPEN_BUTTON: TButton;
|
||
ENUM_BUTTON: TButton;
|
||
CLOSE_BUTTON: TButton;
|
||
procedure ToolButton1Click(Sender: TObject);
|
||
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
|
||
procedure FormShow(Sender: TObject);
|
||
procedure FormCreate(Sender: TObject);
|
||
procedure FormDestroy(Sender: TObject);
|
||
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||
procedure SpeedButton1Click(Sender: TObject);
|
||
procedure SpeedButton2Click(Sender: TObject);
|
||
procedure SpeedButton3Click(Sender: TObject);
|
||
procedure Button1Click(Sender: TObject);
|
||
procedure Button2Click(Sender: TObject);
|
||
procedure SpeedButton4Click(Sender: TObject);
|
||
procedure Initimage();
|
||
procedure SpeedButton5Click(Sender: TObject);
|
||
procedure Button3Click(Sender: TObject);
|
||
procedure ENUM_BUTTONClick(Sender: TObject);
|
||
procedure OPEN_BUTTONClick(Sender: TObject);
|
||
procedure CLOSE_BUTTONClick(Sender: TObject);
|
||
procedure CONTINUS_MODE_RadioButtonClick(Sender: TObject);
|
||
procedure TRIGGER_MODE_RadioButtonClick(Sender: TObject);
|
||
procedure START_GRABBING_BUTTONClick(Sender: TObject);
|
||
procedure STOP_GRABBING_BUTTONClick(Sender: TObject);
|
||
procedure SOFTWARE_TRIGGER_CheckBoxClick(Sender: TObject);
|
||
procedure SOFTWARE_ONCE_BUTTONClick(Sender: TObject);
|
||
procedure SAVE_BMP_BUTTONClick(Sender: TObject);
|
||
procedure SAVE_JPG_BUTTONClick(Sender: TObject);
|
||
procedure GET_PARAMETER_BUTTONClick(Sender: TObject);
|
||
procedure SET_PARAMETER_BUTTONClick(Sender: TObject);
|
||
procedure OnBnClickedTriggerModeRadio(Sender: TObject);
|
||
procedure OnBnClickedContinusModeRadio(Sender: TObject);
|
||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||
private
|
||
hWndC: THandle;
|
||
CapturingAVI: bool;
|
||
{ Private declarations }
|
||
ClickPos: TPoint;
|
||
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
|
||
procedure CreThumb(Width, Height: Integer);
|
||
function SaveImage(): Boolean;
|
||
function UpdateVars(bUpdateDir: Bool): Integer;
|
||
function EnableControls(bIsCameraReady: Bool): Integer;
|
||
//ch:<3A><><EFBFBD>á<EFBFBD><C3A1><EFBFBD>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> | en:Set and get parameters operation
|
||
function GetTriggerMode(): Integer; // ch:<3A><><EFBFBD>ô<EFBFBD><C3B4><EFBFBD>ģʽ | en:Set Trigger Mode
|
||
function SetTriggerMode(): Integer;
|
||
function GetExposureTime(): Integer; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD>ع<EFBFBD>ʱ<EFBFBD><CAB1> | en:Set Exposure Time
|
||
function SetExposureTime(): Integer;
|
||
function GetGain(): Integer; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> | en:Set Gain
|
||
function SetGain(): Integer;
|
||
function GetTriggerSource(): Integer; // ch:<3A><><EFBFBD>ô<EFBFBD><C3B4><EFBFBD>Դ | en:Set Trigger Source
|
||
function SetTriggerSource(): Integer;
|
||
function SaveImage2(): Integer;
|
||
public
|
||
FilePath: string;
|
||
FileName: string;
|
||
FTFType: string;
|
||
pat1: string;
|
||
pic1: string;
|
||
fkeyNo: string;
|
||
fFlileFlag: string;
|
||
{ Public declarations }
|
||
MyJpeg: TJPEGImage;
|
||
// JPStream: TMemoryStream;
|
||
end;
|
||
|
||
var
|
||
FormGetPic2: TFormGetPic2;
|
||
m_nRet: Integer; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> | en:Error code
|
||
m_stDevList: MV_CC_DEVICE_INFO_LIST; // ch:<3A>豸<EFBFBD><E8B1B8>Ϣ<EFBFBD>б<EFBFBD><D0B1>ṹ<EFBFBD><E1B9B9><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>洢<EFBFBD>豸<EFBFBD>б<EFBFBD> | //en:Device information list structure variable used to store device list
|
||
m_pstDevList: PMV_CC_DEVICE_INFO_LIST; // ch:<3A>豸<EFBFBD><E8B1B8>Ϣ<EFBFBD>б<EFBFBD><D0B1>ṹ<EFBFBD><E1B9B9><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>洢<EFBFBD>豸<EFBFBD>б<EFBFBD> | //en:Device information list structure variable used to store device list
|
||
m_hDevHandle: PPointer = nil; // ch:<3A><EFBFBD><F2BFAAB5>豸<EFBFBD><E8B1B8><EFBFBD><EFBFBD> | en:Current device Handle
|
||
|
||
m_bOpenDevice: Bool = False; // ch:<3A>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>豸 | en:Whether to open device
|
||
m_bStartGrabbing: Bool = False; // ch:<3A>Ƿ<EFBFBD><C7B7><EFBFBD>ʼץͼ | en:Whether to start grabbing
|
||
m_bSoftWareTriggerCheck: Bool = False; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ƿ<EFBFBD><C7B7><EFBFBD>ѡ | en:Whether SoftwareTrigger was checked
|
||
m_nTriggerMode: Integer = 0; // ch:<3A><><EFBFBD><EFBFBD>ģʽ | en:Trigger Mode
|
||
|
||
m_nSaveImageType: MV_SAVE_IAMGE_TYPE; //c h:<3A><><EFBFBD><EFBFBD>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD>ʽ | en:Save Image Type
|
||
m_pBufForSaveImage: PAnsiChar = nil; // ch:<3A><><EFBFBD>ڱ<EFBFBD><DAB1><EFBFBD>ͼ<EFBFBD><CDBC><EFBFBD>Ļ<EFBFBD><C4BB><EFBFBD> | en:Buffer to save image
|
||
m_nBufSizeForSaveImage: Cardinal = 0;
|
||
m_pBufForDriver: PAnsiChar = nil; // ch:<3A><><EFBFBD>ڴ<EFBFBD><DAB4><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ȡͼ<C8A1><CDBC><EFBFBD>Ļ<EFBFBD><C4BB><EFBFBD> | en:Buffer to get image from driver
|
||
m_nBufSizeForDriver: Cardinal = 0;
|
||
m_hwndDisplay: HWND;
|
||
|
||
implementation
|
||
|
||
uses
|
||
U_DataLink, U_Fun10;
|
||
|
||
const
|
||
WM_CAP_START = WM_USER;
|
||
|
||
const
|
||
WM_CAP_STOP = WM_CAP_START + 68;
|
||
|
||
const
|
||
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
|
||
|
||
const
|
||
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
|
||
|
||
const
|
||
WM_CAP_SAVEDIB = WM_CAP_START + 25;
|
||
|
||
const
|
||
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
|
||
|
||
const
|
||
WM_CAP_SEQUENCE = WM_CAP_START + 62;
|
||
|
||
const
|
||
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
|
||
|
||
const
|
||
WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
|
||
|
||
const
|
||
WM_CAP_SET_OVERLAY = WM_CAP_START + 51;
|
||
|
||
const
|
||
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
|
||
|
||
const
|
||
WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;
|
||
|
||
const
|
||
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
|
||
|
||
const
|
||
WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
|
||
|
||
const
|
||
WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
|
||
|
||
const
|
||
WM_CAP_SET_SCALE = WM_CAP_START + 53;
|
||
|
||
const
|
||
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
|
||
|
||
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';
|
||
|
||
{$R *.dfm}
|
||
function TFormGetPic2.SetExposureTime(): Integer;
|
||
begin
|
||
SetEnumValue(m_hDevHandle, 'ExposureMode', TypInfo.GetEnumValue(TypeInfo(MV_CAM_EXPOSURE_MODE), 'MV_EXPOSURE_MODE_TIMED'));
|
||
SetEnumValue(m_hDevHandle, 'ExposureAuto', TypInfo.GetEnumValue(TypeInfo(MV_CAM_EXPOSURE_AUTO_MODE), 'MV_EXPOSURE_AUTO_MODE_OFF'));
|
||
Result := SetFloatValue(m_hDevHandle, 'ExposureTime', StrToFloat(EXPOSURE_Edit.Text));
|
||
end;
|
||
|
||
function TFormGetPic2.GetGain(): Integer;
|
||
var
|
||
fFloatValue: Single;
|
||
begin
|
||
Result := GetFloatValue(m_hDevHandle, 'Gain', @fFloatValue);
|
||
if Result <> MV_OK then
|
||
begin
|
||
exit
|
||
end;
|
||
GAIN_Edit.Text := FormatFloat('0.000', fFloatValue);
|
||
end;
|
||
|
||
function TFormGetPic2.SetTriggerSource(): Integer;
|
||
begin
|
||
if m_bSoftWareTriggerCheck then
|
||
begin
|
||
Result := SetEnumValue(m_hDevHandle, 'TriggerSource', TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_SOURCE), 'MV_TRIGGER_SOURCE_SOFTWARE'));
|
||
if Result <> MV_OK then
|
||
begin
|
||
exit
|
||
end;
|
||
SOFTWARE_ONCE_BUTTON.Enabled := True;
|
||
end
|
||
else
|
||
begin
|
||
Result := SetEnumValue(m_hDevHandle, 'TriggerSource', TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_SOURCE), 'MV_TRIGGER_SOURCE_LINE0'));
|
||
if Result <> MV_OK then
|
||
begin
|
||
exit
|
||
end;
|
||
SOFTWARE_ONCE_BUTTON.Enabled := False;
|
||
end;
|
||
end;
|
||
|
||
function TFormGetPic2.GetTriggerSource(): Integer;
|
||
var
|
||
nEnumValue: Cardinal;
|
||
begin
|
||
// Result := GetEnumValue(m_hDevHandle, 'TriggerSource', @nEnumValue);
|
||
// if Result <> MV_OK then
|
||
// begin
|
||
// exit
|
||
// end;
|
||
//
|
||
// if TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_SOURCE), 'MV_TRIGGER_SOURCE_SOFTWARE') = nEnumValue then // Todo:<3A><><EFBFBD><EFBFBD><EFBFBD>ó<EFBFBD><C3B3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
// begin
|
||
// SOFTWARE_TRIGGER_CheckBox.Checked := True;
|
||
// end
|
||
// else
|
||
// begin
|
||
// SOFTWARE_TRIGGER_CheckBox.Checked := False;
|
||
// end;
|
||
end;
|
||
|
||
function TFormGetPic2.SetGain(): Integer;
|
||
begin
|
||
SetEnumValue(m_hDevHandle, 'GainAuto', 0);
|
||
Result := SetFloatValue(m_hDevHandle, 'Gain', StrToFloat(GAIN_Edit.Text));
|
||
end;
|
||
|
||
function TFormGetPic2.SetTriggerMode(): Integer;
|
||
begin
|
||
Result := SetEnumValue(m_hDevHandle, 'TriggerMode', m_nTriggerMode);
|
||
end;
|
||
|
||
function TFormGetPic2.GetExposureTime(): Integer;
|
||
var
|
||
fFloatValue: Single;
|
||
begin
|
||
Result := GetFloatValue(m_hDevHandle, 'ExposureTime', @fFloatValue);
|
||
if Result <> MV_OK then
|
||
begin
|
||
exit
|
||
end;
|
||
EXPOSURE_Edit.Text := FloatToStr(fFloatValue);
|
||
end;
|
||
|
||
function TFormGetPic2.GetTriggerMode(): Integer;
|
||
var
|
||
nEnumValue: Cardinal;
|
||
begin
|
||
// Result := GetEnumValue(m_hDevHandle, 'TriggerMode', @nEnumValue);
|
||
// if Result <> MV_OK then
|
||
// begin
|
||
// exit
|
||
// end;
|
||
// m_nTriggerMode := nEnumValue;
|
||
end;
|
||
|
||
function TFormGetPic2.EnableControls(bIsCameraReady: Bool): Integer;
|
||
begin
|
||
if m_bOpenDevice then
|
||
begin
|
||
OPEN_BUTTON.Enabled := False;
|
||
SOFTWARE_TRIGGER_CheckBox.Enabled := True;
|
||
EXPOSURE_Edit.Enabled := True;
|
||
GAIN_Edit.Enabled := True;
|
||
//FRAME_RATE_Edit.Enabled := True;
|
||
GET_PARAMETER_BUTTON.Enabled := True;
|
||
SET_PARAMETER_BUTTON.Enabled := True;
|
||
CONTINUS_MODE_RadioButton.Enabled := True;
|
||
TRIGGER_MODE_RadioButton.Enabled := True;
|
||
// ch: <20>ر<EFBFBD><D8B1>豸 | en:CLOSE_BUTTON
|
||
if bIsCameraReady then
|
||
begin
|
||
CLOSE_BUTTON.Enabled := True;
|
||
end
|
||
else
|
||
begin
|
||
CLOSE_BUTTON.Enabled := False;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
CLOSE_BUTTON.Enabled := False;
|
||
SOFTWARE_TRIGGER_CheckBox.Enabled := False;
|
||
EXPOSURE_Edit.Enabled := False;
|
||
GAIN_Edit.Enabled := False;
|
||
GET_PARAMETER_BUTTON.Enabled := False;
|
||
SET_PARAMETER_BUTTON.Enabled := False;
|
||
CONTINUS_MODE_RadioButton.Enabled := False;
|
||
TRIGGER_MODE_RadioButton.Enabled := False;
|
||
// ch: <20><><EFBFBD><EFBFBD><EFBFBD>豸 | en:OPEN_BUTTON
|
||
if bIsCameraReady then
|
||
begin
|
||
OPEN_BUTTON.Enabled := True;
|
||
end
|
||
else
|
||
begin
|
||
OPEN_BUTTON.Enabled := False;
|
||
end;
|
||
end;
|
||
|
||
if m_bStartGrabbing then
|
||
begin
|
||
STOP_GRABBING_BUTTON.Enabled := True;
|
||
SAVE_BMP_BUTTON.Enabled := True;
|
||
SAVE_JPG_BUTTON.Enabled := True;
|
||
// ch: <20><>ʼȡ<CABC><C8A1><EFBFBD><EFBFBD>ť | en:START_GRABBING_BUTTON
|
||
if bIsCameraReady then
|
||
begin
|
||
START_GRABBING_BUTTON.Enabled := False;
|
||
end
|
||
else if m_bOpenDevice then
|
||
begin
|
||
START_GRABBING_BUTTON.Enabled := True;
|
||
end
|
||
else
|
||
begin
|
||
START_GRABBING_BUTTON.Enabled := False;
|
||
end;
|
||
// ch: <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ť | en:SOFTWARE_ONCE_BUTTON
|
||
if m_bSoftWareTriggerCheck then
|
||
begin
|
||
SOFTWARE_ONCE_BUTTON.Enabled := True;
|
||
end
|
||
else
|
||
begin
|
||
SOFTWARE_ONCE_BUTTON.Enabled := False;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
STOP_GRABBING_BUTTON.Enabled := False;
|
||
SAVE_BMP_BUTTON.Enabled := False;
|
||
SAVE_JPG_BUTTON.Enabled := False;
|
||
SOFTWARE_ONCE_BUTTON.Enabled := False;
|
||
if m_bOpenDevice then
|
||
begin
|
||
START_GRABBING_BUTTON.Enabled := True;
|
||
end
|
||
else
|
||
begin
|
||
START_GRABBING_BUTTON.Enabled := False;
|
||
end;
|
||
end;
|
||
|
||
Result := MV_OK;
|
||
end;
|
||
|
||
procedure TFormGetPic2.OnBnClickedContinusModeRadio(Sender: TObject);
|
||
begin
|
||
CONTINUS_MODE_RadioButton.Checked := True;
|
||
TRIGGER_MODE_RadioButton.Checked := False;
|
||
m_nTriggerMode := TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_OFF');
|
||
m_nRet := SetTriggerMode();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Set TriggerMode Fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
SOFTWARE_ONCE_BUTTON.Enabled := False;
|
||
end;
|
||
|
||
procedure TFormGetPic2.OnBnClickedTriggerModeRadio(Sender: TObject);
|
||
begin
|
||
CONTINUS_MODE_RadioButton.Checked := False;
|
||
TRIGGER_MODE_RadioButton.Checked := True;
|
||
m_nTriggerMode := TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_ON');
|
||
m_nRet := SetTriggerMode();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Set TriggerMode Fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
if m_bStartGrabbing and SOFTWARE_TRIGGER_CheckBox.Checked then
|
||
begin
|
||
SOFTWARE_ONCE_BUTTON.Enabled := True;
|
||
end;
|
||
|
||
end;
|
||
|
||
function AnsiStrAlloc(Size: Cardinal): PAnsiChar;
|
||
begin
|
||
Inc(Size, SizeOf(Cardinal));
|
||
GetMem(Result, Size);
|
||
Cardinal(Pointer(Result)^) := Size;
|
||
Inc(Result, SizeOf(Cardinal));
|
||
end;
|
||
|
||
function TFormGetPic2.SaveImage2(): Integer;
|
||
var
|
||
nRecvBufSize: Cardinal;
|
||
stImageInfo: MV_FRAME_OUT_INFO_EX;
|
||
stParam: MV_SAVE_IMAGE_PARAM_EX;
|
||
chImageName: string; //ch: ͼ<><CDBC><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD> | en:ImageName
|
||
hFile: THandle; // ch:<3A>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD> | en: handle of the imageFile
|
||
dwWriteLen: Cardinal; //ch:ʵ<><CAB5>д<EFBFBD><D0B4>ͼ<EFBFBD><CDBC><EFBFBD>ļ<EFBFBD><C4BC>ij<EFBFBD><C4B3><EFBFBD> | en:Length that was written in the imageFile
|
||
|
||
begin
|
||
if not m_bStartGrabbing then
|
||
begin
|
||
Result := MV_E_CALLORDER;
|
||
exit
|
||
end;
|
||
|
||
// ch:<3A>ļ<EFBFBD><C4BC><EFBFBD>ʽ<EFBFBD>ж<EFBFBD> | en: SaveImageType whether supported
|
||
if not ((MV_Image_Bmp = m_nSaveImageType) or (MV_Image_Jpeg = m_nSaveImageType)) then
|
||
begin
|
||
Result := MV_E_SUPPORT;
|
||
exit
|
||
end;
|
||
|
||
nRecvBufSize := 0;
|
||
if nil = m_pBufForDriver then
|
||
begin
|
||
// ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>л<EFBFBD>ȡһ֡ͼ<D6A1><CDBC><EFBFBD><EFBFBD>С | en:Get size of one frame from camera
|
||
Result := GetIntValue(m_hDevHandle, 'PayloadSize', @nRecvBufSize);
|
||
if Result <> MV_OK then
|
||
begin
|
||
ShowMessage('failed in get PayloadSize.' + IntToHex(Result, 8));
|
||
exit
|
||
end;
|
||
m_nBufSizeForDriver := nRecvBufSize;
|
||
m_pBufForDriver := AnsiStrAlloc(m_nBufSizeForDriver);
|
||
if (nil = m_pBufForDriver) or (not (StrBufSize(m_pBufForDriver) > 0)) then
|
||
begin
|
||
ShowMessage('malloc m_pBufForDriver failed, run out of memory.' + IntToStr(m_nBufSizeForDriver));
|
||
exit
|
||
end;
|
||
end;
|
||
|
||
// ch:<3A><>ʼȡͼ | en:Start get one frame
|
||
ZeroMemory(@stImageInfo, sizeof(MV_FRAME_OUT_INFO_EX));
|
||
Result := MV_CC_GetOneFrameTimeout(m_hDevHandle^, m_pBufForDriver, m_nBufSizeForDriver, @stImageInfo, 1000);
|
||
if Result = MV_OK then
|
||
begin
|
||
if nil = m_pBufForSaveImage then
|
||
begin
|
||
// ch:BMPͼƬ<CDBC><C6AC>С<EFBFBD><D0A1>width * height * 3 + 2048(Ԥ<><D4A4>BMPͷ<50><CDB7>С)
|
||
// en:BMP image size: width * height * 3 + 2048 (Reserved BMP header size)
|
||
m_nBufSizeForSaveImage := stImageInfo.nWidth * stImageInfo.nHeight * 3 + 2048;
|
||
m_pBufForSaveImage := AnsiStrAlloc(m_nBufSizeForSaveImage);
|
||
if (nil = m_pBufForSaveImage) or (not (StrBufSize(m_pBufForSaveImage) > 0)) then
|
||
begin
|
||
ShowMessage('malloc m_pBufForSaveImage failed, run out of memory.' + IntToStr(m_nBufSizeForSaveImage));
|
||
exit
|
||
end;
|
||
end;
|
||
|
||
// ch:<3A><><EFBFBD>ö<EFBFBD>Ӧ<EFBFBD><D3A6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> | en:Set camera parameter
|
||
ZeroMemory(@stParam, sizeof(MV_SAVE_IMAGE_PARAM_EX));
|
||
stParam.enImageType := m_nSaveImageType; // ch:<3A><>Ҫ<EFBFBD><D2AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD><EFBFBD><EFBFBD> | en:Image format to save
|
||
stParam.enPixelType := stImageInfo.enPixelType; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӧ<EFBFBD><D3A6><EFBFBD><EFBFBD><EFBFBD>ظ<EFBFBD>ʽ | en:Camera pixel type
|
||
stParam.nWidth := stImageInfo.nWidth; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӧ<EFBFBD>Ŀ<EFBFBD> | en:Width
|
||
stParam.nHeight := stImageInfo.nHeight; // ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӧ<EFBFBD>ĸ<EFBFBD> | en:Height
|
||
stParam.nDataLen := stImageInfo.nFrameLen;
|
||
stParam.pData := m_pBufForDriver;
|
||
stParam.pImageBuffer := m_pBufForSaveImage;
|
||
stParam.nBufferSize := m_nBufSizeForSaveImage; // ch:<3A>洢<EFBFBD>ڵ<EFBFBD><DAB5>Ĵ<EFBFBD>С | en:Buffer node size
|
||
stParam.nJpgQuality := 80; // ch:jpg<70><67><EFBFBD>룬<EFBFBD><EBA3AC><EFBFBD>ڱ<EFBFBD><DAB1><EFBFBD>Jpgͼ<67><CDBC>ʱ<EFBFBD><CAB1>Ч<EFBFBD><D0A7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>BMPʱSDK<44>ں<EFBFBD><DABA>Ըò<D4B8><C3B2><EFBFBD>
|
||
// en:jpg encoding, only valid when saving as Jpg. SDK ignore this parameter when saving as BMP
|
||
Result := MV_CC_SaveImageEx2(m_hDevHandle^, @stParam);
|
||
if Result <> MV_OK then
|
||
exit;
|
||
|
||
// <20><><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD>뱾<EFBFBD><EBB1BE> | en:Save imageFile
|
||
if MV_Image_Bmp = stParam.enImageType then
|
||
begin
|
||
chImageName := FormatCName('%s%d%s%d%s%03d%s', 'Image_w', stImageInfo.nWidth, '_h', stImageInfo.nHeight, '_fn', stImageInfo.nFrameNum, '.bmp');
|
||
end
|
||
else if True then
|
||
begin
|
||
chImageName := FormatCName('%s%d%s%d%s%03d%s', 'Image_w', stImageInfo.nWidth, '_h', stImageInfo.nHeight, '_fn', stImageInfo.nFrameNum, '.jpg');
|
||
end
|
||
else
|
||
begin
|
||
Result := MV_E_SUPPORT;
|
||
end;
|
||
hFile := CreateFileA(PAnsiChar(AnsiString(chImageName)), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
|
||
if hFile = 0 then
|
||
exit;
|
||
WriteFile(hFile, m_pBufForSaveImage^, stParam.nImageLen, dwWriteLen, nil);
|
||
CloseHandle(hFile);
|
||
|
||
end;
|
||
|
||
Result := MV_OK;
|
||
end;
|
||
|
||
function TFormGetPic2.UpdateVars(bUpdateDir: Bool): Integer;
|
||
begin
|
||
if bUpdateDir then
|
||
begin
|
||
// <20>ӿؼ<D3BF><D8BC><EFBFBD><EFBFBD>±<EFBFBD><C2B1><EFBFBD>
|
||
if SOFTWARE_TRIGGER_CheckBox.Checked then
|
||
begin
|
||
m_bSoftWareTriggerCheck := true;
|
||
end
|
||
else
|
||
begin
|
||
m_bSoftWareTriggerCheck := false;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
// <20>ӱ<EFBFBD><D3B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>¿ؼ<C2BF>
|
||
if m_bSoftWareTriggerCheck then
|
||
begin
|
||
SOFTWARE_TRIGGER_CheckBox.Checked := true;
|
||
end
|
||
else
|
||
begin
|
||
SOFTWARE_TRIGGER_CheckBox.Checked := false;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.Initimage();
|
||
var
|
||
jpg: TJpegImage;
|
||
myStream: TADOBlobStream;
|
||
sFieldName: string;
|
||
JPStream: TMemoryStream;
|
||
begin
|
||
jpg := TJpegImage.Create();
|
||
JPStream := TMemoryStream.Create;
|
||
try
|
||
|
||
with adoqueryImage do
|
||
begin
|
||
close;
|
||
sql.Clear;
|
||
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
|
||
open;
|
||
if not IsEmpty then
|
||
begin
|
||
if not fieldbyname(pic1).IsNull then
|
||
begin
|
||
myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname(pic1)), bmread);
|
||
jpg.LoadFromStream(myStream);
|
||
Image2.Picture.Assign(jpg);
|
||
myStream.Free;
|
||
|
||
try
|
||
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ', '127.0.0.1');
|
||
IdFTP1.Username := 'three';
|
||
IdFTP1.Password := '641010';
|
||
IdFTP1.Connect();
|
||
except
|
||
;
|
||
end;
|
||
|
||
JPStream.Clear;
|
||
if IdFTP1.Connected then
|
||
begin
|
||
try
|
||
IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname(pat1).AsString), JPStream);
|
||
except
|
||
Application.MessageBox('<27>ͻ<EFBFBD>ͼ<EFBFBD><CDBC><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
|
||
IdFTP1.Quit;
|
||
Exit;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
Application.MessageBox('<27><EFBFBD><DEB7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
|
||
IdFTP1.Quit;
|
||
Exit;
|
||
end;
|
||
|
||
if IdFTP1.Connected then
|
||
IdFTP1.Quit;
|
||
JPStream.Position := 0;
|
||
jpg.LoadFromStream(JPStream);
|
||
Image1.Picture.Assign(jpg);
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
jpg.free;
|
||
JPStream.Free;
|
||
end;
|
||
end;
|
||
|
||
function TFormGetPic2.SaveImage(): Boolean;
|
||
var
|
||
myStream: TADOBlobStream;
|
||
maxNo: string;
|
||
fNewFileName: string;
|
||
begin
|
||
fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
|
||
if fkeyNO = '' then
|
||
fkeyNO := fNewFileName;
|
||
result := false;
|
||
try
|
||
with adoqueryImage do
|
||
begin
|
||
close;
|
||
sql.Clear;
|
||
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
|
||
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
|
||
open;
|
||
if RecordCount <= 0 then
|
||
begin
|
||
Append;
|
||
if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
|
||
begin
|
||
Application.MessageBox('ȡ<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ', 0);
|
||
Exit;
|
||
end;
|
||
fieldByName('TFID').AsString := maxNo;
|
||
fieldByName('WBID').AsString := fkeyNO;
|
||
end
|
||
else
|
||
begin
|
||
edit;
|
||
end;
|
||
fieldByName(pat1).AsString := trim(fNewFileName);
|
||
fieldByName('Filler').AsString := trim(dName);
|
||
fieldByName('TFType').AsString := trim(FTFType);
|
||
myStream := TADOBlobStream.Create(TBlobField(FieldByName(pic1)), bmWrite);
|
||
MyJpeg.Assign(Image2.Picture.Graphic);
|
||
MyJpeg.SaveToStream(myStream);
|
||
myStream.Free;
|
||
Post;
|
||
end;
|
||
|
||
if FilePath <> '' then
|
||
begin
|
||
try
|
||
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ', '127.0.0.1');
|
||
IdFTP1.Username := 'three';
|
||
IdFTP1.Password := '641010';
|
||
IdFTP1.Connect();
|
||
IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(fNewFileName));
|
||
IdFTP1.Quit;
|
||
except
|
||
IdFTP1.Quit;
|
||
Application.MessageBox('<27>ϴ<EFBFBD><CFB4>ͻ<EFBFBD>ͼ<EFBFBD><CDBC><EFBFBD>ļ<EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD><DCA3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
|
||
end;
|
||
end;
|
||
IdFTP1.Quit;
|
||
|
||
result := true;
|
||
except
|
||
myStream.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.ToolButton1Click(Sender: TObject);
|
||
var
|
||
Ini: TIniFile;
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TFormGetPic2.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
|
||
begin
|
||
Image1.Picture.Assign(Image);
|
||
Cancel := TRUE;
|
||
CreThumb(150, 150);
|
||
SpeedButton2.Enabled := TRUE;
|
||
end;
|
||
|
||
procedure TFormGetPic2.FormShow(Sender: TObject);
|
||
var
|
||
Ini: TIniFile;
|
||
begin
|
||
{ Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
|
||
try
|
||
SelectedSource := Ini.ReadInteger( 'SCANNER', 'Scanner', 0);
|
||
PicLeft := Ini.ReadInteger( 'SCANNER', 'Left', 0);
|
||
PicTop := Ini.ReadInteger( 'SCANNER', 'Top', 0);
|
||
PicWidth := Ini.ReadInteger( 'SCANNER', 'Width', 100);
|
||
PicHeight := Ini.ReadInteger( 'SCANNER', 'Height', 100);
|
||
finally
|
||
Ini.Free;
|
||
end; }
|
||
Initimage();
|
||
end;
|
||
|
||
{
|
||
procedure TFormGetPic.ToolButton6Click(Sender: TObject);
|
||
var
|
||
Ini: TIniFile;
|
||
begin
|
||
FormGetPos := TFormGetPos.Create(Self);
|
||
FormGetPos.SpinEdit1.Value := PicLeft;
|
||
FormGetPos.SpinEdit2.Value := PicTop;
|
||
FormGetPos.SpinEdit3.Value := PicWidth;
|
||
FormGetPos.SpinEdit4.Value := PicHeight;
|
||
if FormGetPos.ShowModal = 1 then
|
||
begin
|
||
PicLeft := FormGetPos.SpinEdit1.Value;
|
||
PicTop := FormGetPos.SpinEdit2.Value;
|
||
PicWidth := FormGetPos.SpinEdit3.Value;
|
||
PicHeight := FormGetPos.SpinEdit4.Value;
|
||
|
||
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
|
||
try
|
||
Ini.WriteInteger( 'SCANNER', 'Left', PicLeft);
|
||
Ini.WriteInteger( 'SCANNER', 'Top', PicTop);
|
||
Ini.WriteInteger( 'SCANNER', 'Width', PicWidth);
|
||
Ini.WriteInteger( 'SCANNER', 'Height', PicHeight);
|
||
finally
|
||
Ini.Free;
|
||
end;
|
||
end;
|
||
FormGetPos.Free;
|
||
end;
|
||
}
|
||
|
||
procedure TFormGetPic2.CreThumb(Width, Height: Integer);
|
||
var
|
||
Bitmap: TBitmap;
|
||
Ratio: Double;
|
||
ARect: TRect;
|
||
AHeight, AHeightOffset: Integer;
|
||
AWidth, AWidthOffset: Integer;
|
||
begin
|
||
Bitmap := TBitmap.Create;
|
||
try
|
||
Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
|
||
if Ratio > 1.333 then
|
||
begin
|
||
AHeight := Round(Width / Ratio);
|
||
AHeightOffset := (Height - AHeight) div 2;
|
||
AWidth := Width;
|
||
AWidthOffset := 0;
|
||
end
|
||
else
|
||
begin
|
||
AWidth := Round(Height * Ratio);
|
||
AWidthOffset := (Width - AWidth) div 2;
|
||
AHeight := Height;
|
||
AHeightOffset := 0;
|
||
end;
|
||
Bitmap.Width := Width;
|
||
Bitmap.Height := Height;
|
||
Bitmap.Canvas.Brush.Color := clBtnFace;
|
||
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
|
||
// StretchDraw original image
|
||
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
|
||
Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
|
||
// Assign back to the Jpeg, and save to the file
|
||
Image2.Picture.Assign(Bitmap);
|
||
// MyJpeg1.Assign(Image2.Picture.Graphic);
|
||
finally
|
||
Bitmap.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.FormCreate(Sender: TObject);
|
||
begin
|
||
MyJpeg := TJpegImage.Create;
|
||
// MyJpeg1 := TJpegImage.Create;
|
||
Button2.Enabled := false;
|
||
m_nTriggerMode := TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_OFF'); // ch:<3A><><EFBFBD><EFBFBD>ģʽ | en:Trigger Mode
|
||
m_nSaveImageType := MV_Image_Undefined;
|
||
m_hwndDisplay := ScrollBox1.Handle;
|
||
|
||
EnableControls(FALSE);
|
||
end;
|
||
|
||
procedure TFormGetPic2.FormDestroy(Sender: TObject);
|
||
begin
|
||
// MyJpeg1.Free;
|
||
MyJpeg.Free;
|
||
end;
|
||
|
||
procedure TFormGetPic2.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||
begin
|
||
ClickPos.x := X;
|
||
ClickPos.y := Y;
|
||
end;
|
||
|
||
procedure TFormGetPic2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||
var
|
||
NewPos: TPoint;
|
||
begin
|
||
{The left button was pressed}
|
||
if ssLeft in Shift then
|
||
begin
|
||
{Calculate new position}
|
||
NewPos.X := Image1.Left + X - ClickPos.x;
|
||
NewPos.Y := Image1.Top + Y - ClickPos.y;
|
||
if NewPos.x + Image1.Width < ScrollBox1.Width then
|
||
NewPos.x := ScrollBox1.Width - Image1.Width;
|
||
if NewPos.y + Image1.Height < ScrollBox1.Height then
|
||
NewPos.y := ScrollBox1.Height - Image1.Height;
|
||
if NewPos.X > 0 then
|
||
NewPos.X := 0;
|
||
if NewPos.Y > 0 then
|
||
NewPos.Y := 0;
|
||
|
||
Image1.Top := NewPos.Y;
|
||
Image1.Left := NewPos.X;
|
||
end {if ssLeft in Shift}
|
||
end;
|
||
|
||
procedure TFormGetPic2.SpeedButton1Click(Sender: TObject);
|
||
begin
|
||
if OpenPictureDialog1.Execute then
|
||
begin
|
||
Image1.Top := 0;
|
||
Image1.Left := 0;
|
||
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
|
||
FilePath := OpenPictureDialog1.FileName;
|
||
FileName := ExtractFileName(FilePath);
|
||
CreThumb(240, 180);
|
||
SpeedButton2.Enabled := TRUE;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SpeedButton2Click(Sender: TObject);
|
||
begin
|
||
|
||
if SaveImage() then
|
||
begin
|
||
ModalResult := 1;
|
||
end
|
||
else
|
||
begin
|
||
application.MessageBox('<27><><EFBFBD>ݱ<EFBFBD><DDB1><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 0)
|
||
end;
|
||
// JPStream := TMemoryStream.Create;
|
||
// MyJPeg.Assign(Image1.Picture.Graphic);
|
||
// MyJPeg.SaveToStream(JPStream);
|
||
|
||
end;
|
||
|
||
procedure TFormGetPic2.SpeedButton3Click(Sender: TObject);
|
||
begin
|
||
ModalResult := 2;
|
||
end;
|
||
|
||
procedure TFormGetPic2.Button1Click(Sender: TObject);
|
||
begin
|
||
hWndC := 0;
|
||
try
|
||
hWndC := capCreateCaptureWindowA('My Own Capture Window', WS_CHILD or WS_VISIBLE, ScrollBox1.Left, ScrollBox1.Top, ScrollBox1.Width, ScrollBox1.Height, FormGetPic2.Handle, 0);
|
||
if hWndC <> 0 then
|
||
begin
|
||
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
|
||
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
|
||
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
|
||
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
|
||
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
|
||
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
|
||
//SendMessage(hWndC, WM_CAP_SEQUENCE_NOFILE, 1, 0);
|
||
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
|
||
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
|
||
Button1.Enabled := false;
|
||
Button2.Enabled := true;
|
||
end
|
||
else
|
||
begin
|
||
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͷʧ<CDB7>ܣ<EFBFBD>', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ', MB_ICONERROR);
|
||
end;
|
||
except
|
||
end;
|
||
application.ProcessMessages;
|
||
end;
|
||
|
||
procedure TFormGetPic2.Button2Click(Sender: TObject);
|
||
var
|
||
sFieldName: string;
|
||
MBMP: TBitmap;
|
||
MJPG: TJpegImage;
|
||
begin
|
||
|
||
sFieldName := 'D:\ץͼ';
|
||
if not DirectoryExists(pchar(sFieldName)) then
|
||
CreateDirectory(pchar(sFieldName), nil);
|
||
|
||
sFieldName := sFieldName + '\' + formatdateTime('yyyyMMddhhnnss', SGetServerDateTime(ADOQuery1));
|
||
|
||
FileName := ExtractFileName(sFieldName);
|
||
if hWndC <> 0 then
|
||
begin
|
||
SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar(sFieldName + '.BMP')));
|
||
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
|
||
hWndC := 0;
|
||
application.ProcessMessages;
|
||
Button1.Enabled := true;
|
||
Button2.Enabled := false;
|
||
try
|
||
MBMP := TBitmap.Create;
|
||
MJPG := TJpegImage.Create;
|
||
MBMP.LoadFromFile(pchar(sFieldName + '.BMP'));
|
||
MJPG.assign(MBMP);
|
||
Image1.Picture.Bitmap.Assign(MJPG);
|
||
application.ProcessMessages;
|
||
MJPG.SaveToFile(pchar(sFieldName + '.JPG'));
|
||
CreThumb(240, 180);
|
||
finally
|
||
MBMP.Free;
|
||
MJPG.Free;
|
||
if Fileexists(pchar(sFieldName + '.BMP')) then
|
||
DeleteFile(pchar(sFieldName + '.BMP'));
|
||
FilePath := sFieldName + '.JPG';
|
||
FileName := ExtractFileName(FilePath);
|
||
end;
|
||
SpeedButton2.Enabled := true;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SpeedButton4Click(Sender: TObject);
|
||
var
|
||
MJPG: TJpegImage;
|
||
pathFile: string;
|
||
begin
|
||
if Image1.Picture.Graphic = nil then
|
||
exit;
|
||
|
||
MJPG := TJpegImage.Create;
|
||
try
|
||
SaveDialog1.FileName := FileName;
|
||
if SaveDialog1.Execute then
|
||
begin
|
||
if SaveDialog1.FileName <> '' then
|
||
begin
|
||
pathFile := trim(SaveDialog1.FileName);
|
||
|
||
if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
|
||
begin
|
||
pathFile := pathFile + '.JPG';
|
||
end;
|
||
MJPG.Assign(Image1.Picture.Graphic);
|
||
if fileexists(pathFile) then
|
||
begin
|
||
if application.MessageBox(pchar('<27>ļ<EFBFBD>[' + trim(pathFile) + ']<5D>Ѵ<EFBFBD><D1B4>ڣ<EFBFBD><DAA3>Ƿ<EFBFBD>Ҫ<EFBFBD>滻<EFBFBD><E6BBBB><EFBFBD><EFBFBD>'), '<27><>ʾ<EFBFBD><CABE>Ϣ', MB_YESNO + mb_iconinformation + MB_DEFBUTTON2) = idyes then
|
||
MJPG.SaveToFile(pathFile);
|
||
end
|
||
else
|
||
MJPG.SaveToFile(pathFile);
|
||
|
||
end;
|
||
end;
|
||
finally
|
||
MJPG.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SpeedButton5Click(Sender: TObject);
|
||
begin
|
||
|
||
try
|
||
with adoqueryImage do
|
||
begin
|
||
close;
|
||
sql.Clear;
|
||
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
|
||
open;
|
||
if RecordCount > 0 then
|
||
begin
|
||
edit;
|
||
fieldByName(pat1).Value := null;
|
||
FieldByName(pic1).Value := null;
|
||
post;
|
||
Image1.Picture.Assign(nil);
|
||
Image2.Picture.Assign(nil);
|
||
end;
|
||
end;
|
||
except
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.Button3Click(Sender: TObject);
|
||
var
|
||
handle: Pointer;
|
||
nIndex: Word;
|
||
nPacketSize: Integer;
|
||
begin
|
||
UpdateVars(TRUE);
|
||
nIndex := DEVICE_COMBO.ItemIndex;
|
||
|
||
if m_bOpenDevice then
|
||
begin
|
||
m_nRet := MV_E_CALLORDER;
|
||
ShowMessage('Execution order error.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
|
||
// ch:<3A><><EFBFBD>豸<EFBFBD><E8B1B8>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD><EFBFBD>豸ʵ<E8B1B8><CAB5> | en:Device instance created by device information
|
||
m_hDevHandle := @handle;
|
||
if m_stDevList.pDeviceInfo[nIndex] = nil then
|
||
begin
|
||
ShowMessage('Device does not exist.');
|
||
exit
|
||
end;
|
||
|
||
m_nRet := MV_CC_CreateHandle(m_hDevHandle, (m_stDevList.pDeviceInfo[nIndex])^);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Create handle Failed.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
|
||
// ch: <20><><EFBFBD><EFBFBD><EFBFBD>豸 | en:Open Device
|
||
m_nRet := MV_CC_OpenDevice(m_hDevHandle^);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Open Fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end
|
||
else
|
||
begin
|
||
m_bOpenDevice := True;
|
||
GET_PARAMETER_BUTTONClick(Sender);
|
||
EnableControls(TRUE);
|
||
end;
|
||
|
||
// ch:̽<><CCBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ѱ<EFBFBD><D1B0><EFBFBD>С(ֻ<><D6BB>GigE<67><45><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ч) | en:Detection network optimal package size(It only works for the GigE camera)
|
||
if m_stDevList.pDeviceInfo[nIndex].nTLayerType = MV_GIGE_DEVICE then
|
||
begin
|
||
nPacketSize := MV_CC_GetOptimalPacketSize(m_hDevHandle^);
|
||
if nPacketSize > 0 then
|
||
begin
|
||
m_nRet := SetIntValue(m_hDevHandle, 'GevSCPSPacketSize', nPacketSize);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Warning: Set Packet Size fail!.' + IntToHex(m_nRet, 8));
|
||
end
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('Warning: Get Packet Size fail!' + IntToStr(nPacketSize));
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TFormGetPic2.ENUM_BUTTONClick(Sender: TObject);
|
||
var
|
||
pDeviceInfo: ^MV_CC_DEVICE_INFO;
|
||
strInfoToShow: string;
|
||
nLoopID: Integer;
|
||
begin
|
||
// ch:<3A><><EFBFBD><EFBFBD><EFBFBD>豸<EFBFBD>б<EFBFBD><D0B1><EFBFBD><EFBFBD>е<EFBFBD><D0B5><EFBFBD>Ϣ | en:Clear Device List Information
|
||
DEVICE_COMBO.Clear();
|
||
ZeroMemory(@m_stDevList, sizeof(MV_CC_DEVICE_INFO_LIST));
|
||
|
||
// ch:ö<><C3B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>豸 | en:Enumerate all devices within subnet
|
||
m_nRet := MV_CC_EnumDevices(MV_GIGE_DEVICE or MV_USB_DEVICE, m_stDevList);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Enum devices Failed.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
|
||
// ch:<3A><>ֵ<EFBFBD><D6B5><EFBFBD>뵽<EFBFBD><EBB5BD>Ϣ<EFBFBD>б<EFBFBD><D0B1><EFBFBD><EFBFBD>в<EFBFBD><D0B2><EFBFBD>ʾ<EFBFBD><CABE><EFBFBD><EFBFBD> | en:Add value to the information list box and display
|
||
for nLoopID := 0 to m_stDevList.nDeviceNum - 1 do
|
||
begin
|
||
pDeviceInfo := @m_stDevList.pDeviceInfo[nLoopID].nMajorVer;
|
||
if pDeviceInfo = nil then
|
||
begin
|
||
continue;
|
||
end;
|
||
if pDeviceInfo.nTLayerType = MV_GIGE_DEVICE then
|
||
begin
|
||
GigeDeviceInfoToShow(pDeviceInfo^, strInfoToShow);
|
||
end
|
||
else if pDeviceInfo.nTLayerType = MV_USB_DEVICE then
|
||
begin
|
||
USB3DeviceInfoToShow(pDeviceInfo^, strInfoToShow);
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('Unknown device enumerated.');
|
||
end;
|
||
strInfoToShow := '[' + IntToStr(nLoopID) + '] ' + strInfoToShow;
|
||
DEVICE_COMBO.Items.Add(strInfoToShow);
|
||
end;
|
||
|
||
if (m_stDevList.nDeviceNum = 0) then
|
||
begin
|
||
ShowMessage('No device');
|
||
end;
|
||
DEVICE_COMBO.ItemIndex := 0; //default selection
|
||
EnableControls(True);
|
||
end;
|
||
|
||
procedure TFormGetPic2.OPEN_BUTTONClick(Sender: TObject);
|
||
var
|
||
handle: Pointer;
|
||
nIndex: Word;
|
||
nPacketSize: Integer;
|
||
begin
|
||
UpdateVars(TRUE);
|
||
nIndex := DEVICE_COMBO.ItemIndex;
|
||
|
||
if m_bOpenDevice then
|
||
begin
|
||
m_nRet := MV_E_CALLORDER;
|
||
ShowMessage('Execution order error.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
|
||
// ch:<3A><><EFBFBD>豸<EFBFBD><E8B1B8>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD><EFBFBD>豸ʵ<E8B1B8><CAB5> | en:Device instance created by device information
|
||
m_hDevHandle := @handle;
|
||
if m_stDevList.pDeviceInfo[nIndex] = nil then
|
||
begin
|
||
ShowMessage('Device does not exist.');
|
||
exit
|
||
end;
|
||
|
||
m_nRet := MV_CC_CreateHandle(m_hDevHandle, (m_stDevList.pDeviceInfo[nIndex])^);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Create handle Failed.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
|
||
// ch: <20><><EFBFBD><EFBFBD><EFBFBD>豸 | en:Open Device
|
||
m_nRet := MV_CC_OpenDevice(m_hDevHandle^);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Open Fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end
|
||
else
|
||
begin
|
||
m_bOpenDevice := True;
|
||
GET_PARAMETER_BUTTONClick(Sender);
|
||
EnableControls(TRUE);
|
||
end;
|
||
|
||
// ch:̽<><CCBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ѱ<EFBFBD><D1B0><EFBFBD>С(ֻ<><D6BB>GigE<67><45><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ч) | en:Detection network optimal package size(It only works for the GigE camera)
|
||
if m_stDevList.pDeviceInfo[nIndex].nTLayerType = MV_GIGE_DEVICE then
|
||
begin
|
||
nPacketSize := MV_CC_GetOptimalPacketSize(m_hDevHandle^);
|
||
if nPacketSize > 0 then
|
||
begin
|
||
m_nRet := SetIntValue(m_hDevHandle, 'GevSCPSPacketSize', nPacketSize);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Warning: Set Packet Size fail!.' + IntToHex(m_nRet, 8));
|
||
end
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('Warning: Get Packet Size fail!' + IntToStr(nPacketSize));
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TFormGetPic2.CLOSE_BUTTONClick(Sender: TObject);
|
||
begin
|
||
if nil = m_hDevHandle then
|
||
begin
|
||
m_nRet := MV_E_PARAMETER;
|
||
end;
|
||
|
||
m_nRet := MV_CC_CloseDevice(m_hDevHandle^);
|
||
|
||
m_nRet := MV_CC_DestroyHandle(m_hDevHandle^);
|
||
m_hDevHandle := nil;
|
||
|
||
m_bOpenDevice := False;
|
||
m_bStartGrabbing := False;
|
||
|
||
StrDispose(m_pBufForDriver);
|
||
m_pBufForDriver := nil;
|
||
m_nBufSizeForDriver := 0;
|
||
|
||
StrDispose(m_pBufForSaveImage);
|
||
m_pBufForSaveImage := nil;
|
||
m_nBufSizeForSaveImage := 0;
|
||
|
||
EnableControls(TRUE);
|
||
end;
|
||
|
||
procedure TFormGetPic2.CONTINUS_MODE_RadioButtonClick(Sender: TObject);
|
||
begin
|
||
CONTINUS_MODE_RadioButton.Checked := True;
|
||
TRIGGER_MODE_RadioButton.Checked := False;
|
||
m_nTriggerMode := TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_OFF');
|
||
m_nRet := SetTriggerMode();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Set TriggerMode Fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
SOFTWARE_ONCE_BUTTON.Enabled := False;
|
||
end;
|
||
|
||
procedure TFormGetPic2.TRIGGER_MODE_RadioButtonClick(Sender: TObject);
|
||
begin
|
||
CONTINUS_MODE_RadioButton.Checked := False;
|
||
TRIGGER_MODE_RadioButton.Checked := True;
|
||
m_nTriggerMode := TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_ON');
|
||
m_nRet := SetTriggerMode();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Set TriggerMode Fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
if m_bStartGrabbing and SOFTWARE_TRIGGER_CheckBox.Checked then
|
||
begin
|
||
SOFTWARE_ONCE_BUTTON.Enabled := True;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.START_GRABBING_BUTTONClick(Sender: TObject);
|
||
begin
|
||
if (m_bOpenDevice = False) or (m_bStartGrabbing = True) then
|
||
begin
|
||
exit
|
||
end;
|
||
|
||
m_nRet := MV_CC_StartGrabbing(m_hDevHandle^);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Start grabing Fail.' + IntToHex(m_nRet, 8));
|
||
end
|
||
else
|
||
begin
|
||
m_nRet := MV_CC_Display(m_hDevHandle^, m_hwndDisplay);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Display Fail.' + IntToHex(m_nRet, 8));
|
||
end
|
||
else
|
||
begin
|
||
m_bStartGrabbing := True;
|
||
EnableControls(TRUE);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.STOP_GRABBING_BUTTONClick(Sender: TObject);
|
||
begin
|
||
if (m_bOpenDevice = False) or (m_bStartGrabbing = False) then
|
||
begin
|
||
exit
|
||
end;
|
||
|
||
m_nRet := MV_CC_StopGrabbing(m_hDevHandle^);
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
exit
|
||
end
|
||
else
|
||
begin
|
||
m_bStartGrabbing := False;
|
||
EnableControls(TRUE);
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SOFTWARE_TRIGGER_CheckBoxClick(Sender: TObject);
|
||
begin
|
||
if SOFTWARE_TRIGGER_CheckBox.Checked then
|
||
begin
|
||
m_bSoftWareTriggerCheck := true;
|
||
end
|
||
else
|
||
begin
|
||
m_bSoftWareTriggerCheck := false;
|
||
end;
|
||
|
||
m_nRet := SetTriggerSource();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Set Trigger Source Fail.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SOFTWARE_ONCE_BUTTONClick(Sender: TObject);
|
||
begin
|
||
if m_bStartGrabbing then
|
||
begin
|
||
m_nRet := SetCommandValue(m_hDevHandle, 'TriggerSoftware');
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SAVE_BMP_BUTTONClick(Sender: TObject);
|
||
begin
|
||
m_nSaveImageType := MV_Image_Bmp;
|
||
m_nRet := SaveImage2();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Save bmp fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
ShowMessage('Save bmp succeed.');
|
||
end;
|
||
|
||
procedure TFormGetPic2.SAVE_JPG_BUTTONClick(Sender: TObject);
|
||
begin
|
||
m_nSaveImageType := MV_Image_Jpeg;
|
||
m_nRet := SaveImage2();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Save jpg fail.' + IntToHex(m_nRet, 8));
|
||
exit
|
||
end;
|
||
ShowMessage('Save jpg succeed.');
|
||
end;
|
||
|
||
procedure TFormGetPic2.GET_PARAMETER_BUTTONClick(Sender: TObject);
|
||
begin
|
||
m_nRet := GetTriggerMode();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Get TriggerMode Fail.' + IntToHex(m_nRet, 8));
|
||
end
|
||
else
|
||
begin
|
||
if m_nTriggerMode = TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_ON') then
|
||
begin
|
||
OnBnClickedTriggerModeRadio(Sender);
|
||
end
|
||
else if m_nTriggerMode = TypInfo.GetEnumValue(TypeInfo(MV_CAM_TRIGGER_MODE), 'MV_TRIGGER_MODE_OFF') then
|
||
begin
|
||
OnBnClickedContinusModeRadio(Sender);
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('Unsupport TriggerMode.');
|
||
end;
|
||
end;
|
||
|
||
// ch:<3A><>ȡ<EFBFBD>ع<EFBFBD>ʱ<EFBFBD><CAB1> | en:Get Exposure Time
|
||
m_nRet := GetExposureTime();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Get ExposureTime Fail.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
|
||
// ch:<3A><>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD> | en:Get Gain
|
||
m_nRet := GetGain();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Get Gain Fail.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
|
||
// ch:<3A><>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD>Դ | en:Get Trigger Source
|
||
m_nRet := GetTriggerSource();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
ShowMessage('Get Trigger Source Fail.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.SET_PARAMETER_BUTTONClick(Sender: TObject);
|
||
var
|
||
bIsSetSucceed: Bool;
|
||
begin
|
||
bIsSetSucceed := True;
|
||
|
||
// ch:<3A><><EFBFBD><EFBFBD><EFBFBD>ع<EFBFBD>ʱ<EFBFBD><CAB1> | en:Set Exposure Time
|
||
m_nRet := SetExposureTime();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
bIsSetSucceed := False;
|
||
ShowMessage('Set Exposure Time Fail.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
|
||
// ch:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> | en:Set Gain
|
||
m_nRet := SetGain();
|
||
if m_nRet <> MV_OK then
|
||
begin
|
||
bIsSetSucceed := False;
|
||
ShowMessage('Set Gain Fail.' + IntToHex(m_nRet, 8));
|
||
end;
|
||
|
||
if bIsSetSucceed then
|
||
begin
|
||
ShowMessage('Set Parameter Succeed');
|
||
end;
|
||
end;
|
||
|
||
procedure TFormGetPic2.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
CLOSE_BUTTONClick(Sender);
|
||
end;
|
||
|
||
end.
|
||
|