RTFormwork/项目代码/RTBasicsV1/A01基础公司管理/getpic.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

626 lines
17 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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', '<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(pat1).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 TFormGetPic.SaveImage(): Boolean;
var
myStream: TADOBlobStream;
maxNo: string;
fNewFileName: string;
begin
//ȡ<>ļ<EFBFBD><C4BC><EFBFBD>׺ 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(<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ', 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', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ', '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('<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 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('δ<><CEB4>װɨ<D7B0><C9A8><EFBFBD><EFBFBD>');
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('δ<><CEB4>װɨ<D7B0><C9A8><EFBFBD><EFBFBD>');
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('<27><><EFBFBD>ݱ<EFBFBD><DDB1><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 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('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͷʧ<CDB7>ܣ<EFBFBD>', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ', 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('<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 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.