D7DJenchuang/检验管理/getpic.pas
DESKTOP-E401PHE\Administrator 6716567ef8 ~
2025-04-28 17:09:12 +08:00

596 lines
16 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit getpic;
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;
type
TFormGetPic = class(TForm)
Twain: TDelphiTwain;
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;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(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);
private
hWndC : THandle;
CapturingAVI : bool;
{ Private declarations }
ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
procedure CreThumb(Width, Height: Integer);
function SaveImage():Boolean;
public
FilePath:string;
FileName:string;
FTFType:string;
pat1:string;
pic1:string;
fkeyNo:string;
fFlileFlag:string;
{ Public declarations }
MyJpeg: TJPEGImage;
// JPStream: TMemoryStream;
end;
var
FormGetPic: TFormGetPic;
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}
procedure TFormGetPic.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 TFormGetPic.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 TFormGetPic.ToolButton1Click(Sender: TObject);
var
Ini: TIniFile;
begin
if Twain.LoadLibrary then
begin
{Load source manager}
Twain.SourceManagerLoaded := TRUE;
{Allow user to select source}
SelectedSource := Twain.SelectSource;
if SelectedSource <> -1 then
begin
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
Ini.WriteInteger( 'SCANNER', 'Scanner', SelectedSource);
finally
Ini.Free;
end;
end {if SelectedSource <> -1}
end
else
ShowMessage(<><CEB4>װɨ<D7B0><C9A8><EFBFBD><EFBFBD>');
end;
procedure TFormGetPic.ToolButton3Click(Sender: TObject);
begin
if Twain.LoadLibrary then
begin
{Load source manager}
Twain.SourceManagerLoaded := TRUE;
if SelectedSource <> -1 then
begin
{Load source, select transference method and enable (display interface)}
Twain.Source[SelectedSource].Loaded := TRUE;
Twain.Source[SelectedSource].SetICapUnits(tuInches);
Twain.Source[SelectedSource].SetImagelayoutFrame(PicLeft/25.4, PicTop/25.4, (PicLeft+PicWidth)/25.4, (PicTop+PicHeight)/25.4);
Twain.Source[SelectedSource].SetIYResolution(200);
Twain.Source[SelectedSource].SetIXResolution(200);
Twain.Source[SelectedSource].TransferMode := ttmMemory;
Twain.Source[SelectedSource].EnableSource(FALSE, TRUE);
while Twain.Source[SelectedSource].Enabled do Application.ProcessMessages;
end; {if SelectedSource <> -1}
// Twain.UnloadLibrary;
end
else
ShowMessage(<><CEB4>װɨ<D7B0><C9A8><EFBFBD><EFBFBD>');
end;
procedure TFormGetPic.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 TFormGetPic.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 TFormGetPic.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 TFormGetPic.FormCreate(Sender: TObject);
begin
MyJpeg := TJpegImage.Create;
// MyJpeg1 := TJpegImage.Create;
Button2.Enabled:=false;
end;
procedure TFormGetPic.FormDestroy(Sender: TObject);
begin
// MyJpeg1.Free;
MyJpeg.Free;
end;
procedure TFormGetPic.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClickPos.x := X;
ClickPos.y := Y;
end;
procedure TFormGetPic.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 TFormGetPic.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 TFormGetPic.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 TFormGetPic.SpeedButton3Click(Sender: TObject);
begin
ModalResult := 2;
end;
procedure TFormGetPic.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,
FormGetPic.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 TFormGetPic.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 TFormGetPic.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 TFormGetPic.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;
end.