523 lines
13 KiB
ObjectPascal
523 lines
13 KiB
ObjectPascal
unit U_PictureUpload22;
|
||
|
||
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
|
||
TfrmPictureUpload22 = 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, SCFlag: string;
|
||
{ Public declarations }
|
||
|
||
end;
|
||
|
||
var
|
||
frmPictureUpload22: TfrmPictureUpload22;
|
||
|
||
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 TfrmPictureUpload22.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 TfrmPictureUpload22.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', '<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('FileName').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 TfrmPictureUpload22.SaveImage(): Boolean;
|
||
var
|
||
myStream: TADOBlobStream;
|
||
maxNo: string;
|
||
fNewFileName: string;
|
||
begin
|
||
//ȡ<>ļ<EFBFBD><C4BC><EFBFBD> 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('ȡ<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ', 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', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ', '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('<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 TfrmPictureUpload22.TBCloseClick(Sender: TObject);
|
||
begin
|
||
Close;
|
||
end;
|
||
|
||
procedure TfrmPictureUpload22.TBSaveClick(Sender: TObject);
|
||
begin
|
||
if SaveImage() then
|
||
begin
|
||
SCFlag := '1';
|
||
ModalResult := 1;
|
||
end
|
||
else
|
||
begin
|
||
application.MessageBox('<27><><EFBFBD>ݱ<EFBFBD><DDB1><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 0)
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmPictureUpload22.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 TfrmPictureUpload22.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 TfrmPictureUpload22.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('<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 TfrmPictureUpload22.ToolButton4Click(Sender: TObject);
|
||
begin
|
||
ModalResult := 2;
|
||
end;
|
||
|
||
procedure TfrmPictureUpload22.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 TfrmPictureUpload22.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 TfrmPictureUpload22.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 TfrmPictureUpload22.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('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ');
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmPictureUpload22.FormDestroy(Sender: TObject);
|
||
begin
|
||
// MyJpeg1.Free;
|
||
MyJpeg.Free;
|
||
end;
|
||
|
||
procedure TfrmPictureUpload22.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||
begin
|
||
ClickPos.x := X;
|
||
ClickPos.y := Y;
|
||
end;
|
||
|
||
procedure TfrmPictureUpload22.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.
|
||
|