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, cxImageList, cxGraphics, cxControls, cxLookAndFeels,
  cxLookAndFeelPainters, cxContainer, cxEdit, cxImage;

type
  TfrmPictureUpload = class(TForm)
    ScrollBox1: TScrollBox;
    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;
    cxImageList_bar: TcxImageList;
    Image1: TcxImage;
    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);
          Image1.Picture.LoadFromStream(myStream) ;
          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.LoadFromStream(JPStream);
          }

        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(FDataId)));
      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.