unit getpic;

interface

uses
  Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
  Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Buttons,
  StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdFTP, IdExplicitTLSClientServerBase;

type
  TFormGetPic = 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;
    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, FMainId: string;
    fFlileFlag: string;
    { Public declarations }
    MyJpeg: TJPEGImage;
//    JPStream: TMemoryStream;
  end;

var
  FormGetPic: TFormGetPic;

implementation

uses
  U_DataLink, U_RTFun;

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(FMainId)));
      sql.Add('and TFType=' + quotedstr(trim(FTFType)));
      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
  //取文件后缀 ExtractFileExt(FilePath)

  if fkeyNO = '' then
  begin
    fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
    fkeyNO := fNewFileName;
  end;

  result := false;
  try
    with adoqueryImage do
    begin
      close;
      sql.Clear;
      sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FMainId)));
      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 := FMainId;
      end
      else
      begin
        edit;
      end;
      fieldByName(pat1).AsString := trim(fkeyNO);
      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.Delete(fFlileFlag + '\' + Trim(fNewFileName));
        IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(fkeyNO));
        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(197, 110);
    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.