unit U_PictureUpload;

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, System.ImageList,
  Vcl.ImgList;

type
  TfrmPictureUpload = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    Image2: TImage;
    SpeedButton3: TSpeedButton;
    ADOQuery1: TADOQuery;
    SaveDialog1: TSavePictureDialog;
    adoqueryImage: TADOQuery;
    IdFTP1: TIdFTP;
    ToolBar1: TToolBar;
    TBSave: TToolButton;
    TBClose: TToolButton;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ImageList1: TImageList;
    ADOConnection1: TADOConnection;
    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 Initimage();
    procedure TBCloseClick(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure TBSaveClick(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
  private
    hWndC: THandle;
    CapturingAVI: bool;
    ClickPos: TPoint;
    SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
    FilePath, FileName: string;
    MyJpeg: TJPEGImage;
    procedure CreThumb(Width, Height: Integer);
    function SaveImage(): Boolean;
    procedure Rotate90(Source: TGraphic; Target: TJpegImage);
  public
    FTFType, fFlileFlag: string;
    FWidth, FHeight: Integer;
    FPictureName, FDataId: string;
    { Public declarations }

  end;

var
  frmPictureUpload: TfrmPictureUpload;

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 TfrmPictureUpload.Rotate90(Source: TGraphic; Target: TJpegImage);
var
  SourceBmp, TargetBmp: TBitmap;
  r, c: Integer;
  x, y: Integer;
begin
  SourceBmp := TBitmap.Create;
  SourceBmp.Assign(Source);
  TargetBmp := TBitmap.Create;
  TargetBmp.Width := SourceBmp.Height;
  TargetBmp.Height := SourceBmp.Width;
  for r := 0 to SourceBmp.Height - 1 do
  begin
    for c := 0 to SourceBmp.Width - 1 do
    begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
      x := r; //90
      y := (SourceBmp.Width - 1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
      TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
    end;
  end;
  Target.Assign(TargetBmp);
  SourceBmp.Free;
  TargetBmp.Free;
end;

procedure TfrmPictureUpload.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(FDataId)));
      sql.Add('and TFType=' + quotedstr(trim(FTFType)));
      open;
      if not IsEmpty then
      begin

        if not fieldbyname('FilesOther').IsNull then
        begin
          myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname('FilesOther')), 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('FileName').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 TfrmPictureUpload.SaveImage(): Boolean;
var
  myStream: TADOBlobStream;
  maxNo: string;
  fNewFileName: string;
begin
  //取文件后缀 ExtractFileExt(FilePath)

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

  result := false;
  try
    with adoqueryImage do
    begin
      close;
      sql.Clear;
      sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
      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 := FDataId;
      end
      else
      begin
        edit;
      end;
      fieldByName('FileName').AsString := trim(FPictureName);
      fieldByName('Filler').AsString := trim(dName);
      fieldByName('TFType').AsString := trim(FTFType);
      myStream := TADOBlobStream.Create(TBlobField(FieldByName('FilesOther')), 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(FPictureName));
        IdFTP1.Quit;
      except
        IdFTP1.Quit;
        Application.MessageBox('上传客户图样文件失败，请检查文件服务器！', '提示', MB_ICONWARNING);
      end;
    end;
    IdFTP1.Quit;

    result := true;
  except
    myStream.Free;
  end;
end;

procedure TfrmPictureUpload.TBCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmPictureUpload.TBSaveClick(Sender: TObject);
begin
  if SaveImage() then
  begin
    ModalResult := 1;
  end
  else
  begin
    application.MessageBox('数据保存失败！', '提示信息', 0)
  end;
end;

procedure TfrmPictureUpload.ToolButton1Click(Sender: TObject);
var
  Jpeg: TJPEGImage;
begin
  if OpenPictureDialog1.Execute then
  begin
    Image1.Top := 0;
    Image1.Left := 0;
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    FilePath := OpenPictureDialog1.FileName;
    FileName := ExtractFileName(FilePath);

//    Jpeg := TJPEGImage.Create;
//    Rotate90(Image1.Picture.Graphic, Jpeg);
//    Image1.Picture.Assign(Jpeg);
//    Jpeg.Free;

    CreThumb(FWidth, FHeight);
    TBSave.Enabled := TRUE;
  end;

end;

procedure TfrmPictureUpload.ToolButton2Click(Sender: TObject);
begin
  try
    with adoqueryImage do
    begin
      close;
      sql.Clear;
      sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FPictureName)));
      open;
      if RecordCount > 0 then
      begin
        edit;
        fieldByName('FileName').Value := null;
        FieldByName('FilesOther').Value := null;
        post;
        Image1.Picture.Assign(nil);
        Image2.Picture.Assign(nil);
      end;
    end;
  except
  end;
end;

procedure TfrmPictureUpload.ToolButton3Click(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 TfrmPictureUpload.ToolButton4Click(Sender: TObject);
begin
  ModalResult := 2;
end;

procedure TfrmPictureUpload.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
  Image1.Picture.Assign(Image);
  Cancel := TRUE;
  CreThumb(150, 150);
  TBSave.Enabled := TRUE;
end;

procedure TfrmPictureUpload.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 TfrmPictureUpload.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 > 0.75 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));
    ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
    Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
    Image2.Picture.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure TfrmPictureUpload.FormCreate(Sender: TObject);
begin
  MyJpeg := TJpegImage.Create;
  TBSave.Enabled := false;
  if FWidth = 0 then
    FWidth := 197;
  if FHeight = 0 then
    FHeight := 110;
  try
    with ADOConnection1 do
    begin
      Connected := false;
      ConnectionString := DConString;
      Connected := true;
    end;
//    ADOQueryBaseCmd.Connection := ADOConnection1;
//    ADOQueryBaseTemp.Connection := ADOConnection1;
  except
    application.MessageBox('网络连接失败！', '提示信息');
  end;
end;

procedure TfrmPictureUpload.FormDestroy(Sender: TObject);
begin
//  MyJpeg1.Free;
  MyJpeg.Free;
end;

procedure TfrmPictureUpload.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ClickPos.x := X;
  ClickPos.y := Y;
end;

procedure TfrmPictureUpload.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;

end.