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','服务器地址','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('客户图样文件不存在', '提示', MB_ICONWARNING);
                IdFTP1.Quit;
                Exit;
              end;
            end
            else
            begin
              Application.MessageBox('无法连接文件服务器', '提示', 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('取最大号失败！','提示',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','服务器地址','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('上传客户图样文件失败，请检查文件服务器！', '提示', 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('未安装扫描仪');
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('未安装扫描仪');
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('数据保存失败！','提示信息',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('连接摄像头失败！','错误信息',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('文件['+trim(pathFile)+']已存在，是否要替换它？'),'提示信息',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.