D7myYunxiang/样品新云翔(YPGLBOM.dll)/U_SLT_TJHX.pas
DESKTOP-E401PHE\Administrator 1011cb7292 1
2025-01-20 13:04:03 +08:00

341 lines
8.9 KiB
ObjectPascal
Raw 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 U_SLT_TJHX;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,jpeg, cxControls, cxContainer, cxEdit, cxImage,IdFTP,ShellAPI,
StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, Menus,DBClient,IniFiles, cxTextEdit, cxCurrencyEdit;
type
TfrmSLT_TJHX = class(TFrame)
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQuery3: TADOQuery;
ADOQuery4: TADOQuery;
SaveDialog1: TSaveDialog;
Image2: TImage;
Panel2: TPanel;
cxImage1: TcxImage;
Panel1: TPanel;
Label3: TLabel;
Button1: TButton;
XFID: TEdit;
ColorNameEng: TEdit;
SH: TLabel;
ZW: TLabel;
YW: TLabel;
N3: TMenuItem;
Image1: TImage;
procedure cxImage1DblClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
CYID,FileName:string;
lstPat: TStringList;
AJpeg: TJPEGImage;
procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
procedure ReadINIFile10();
procedure SaveImageOther();
// procedure Sharpen(SrcBmp:TBitmap);
{ Private declarations }
public
SKID,FXFID:string;
Formid:string;
procedure Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
{ Public declarations }
end;
implementation
uses
U_DataLink,U_Fun,U_BPZdy_TJHXK,U_CPType_TJHXMX;
{$R *.dfm}
procedure TfrmSLT_TJHX.Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
begin
CYID:=trim(fCYID);
FileName:=trim(fFileName);
lstPat := TStringList.Create;
cxImage1.Picture.Assign(fPicture);
end;
procedure TfrmSLT_TJHX.cxImage1DblClick(Sender: TObject);
begin
try
frmCPType_TJHXMX:=TfrmCPType_TJHXMX.Create(Application);
with frmCPType_TJHXMX do
begin
Label9.Caption:=self.SH.Caption;
label8.Caption:=self.ZW.Caption;
frmCPType_TJHXMX.Name:=self.Name;
FileName:=self.FileName;
FSHID:=self.ZW.Caption;
FMXSKID:=self.ZW.Caption;
FMXXFID:=self.Name;
if ShowModal=1 then
begin
end;
end;
finally
frmCPType_TJHXMX.Free;
end;
end;
procedure TfrmSLT_TJHX.ReadINIFile10();
var
programIni:Tinifile; //<2F><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>
FileName:string;
begin
FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI';
programIni:=Tinifile.create(FileName);
server:=programIni.ReadString('SERVER','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ','127.0.0.1');
programIni.Free;
end;
procedure TfrmSLT_TJHX.SaveImageOther();
var
AJpeg: TJPEGImage;
myStream: TADOBlobStream;
ImgMaxNo:String;
i,j: Integer;
PatFile: String;
FTPPath,FConNo,FTFID:string;
begin
if Image2.Picture=nil then Exit;
AJpeg:=TJpegImage.Create();
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where TFID='''+Trim(self.Name)+'''');
open;
end;
with ADOQueryCmd do
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
//CreThumb(AJpeg,Image1,160, 120);
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
AJpeg.Assign(Image2.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add(' select * from TP_File_SL where TFID='''+Trim(self.Name)+'''');
//ShowMessage(sql.Text);
open;
end;
with ADOQueryCmd do
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
AJpeg.Assign(Image1.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
end;
procedure TfrmSLT_TJHX.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := AJPeg.Width /AJPeg.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));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, AJPeg);
Image1.Picture.Assign(BitMap);
finally
Bitmap.Free;
end;
end;
procedure TfrmSLT_TJHX.N1Click(Sender: TObject);
var
i,j: Integer;
PatFile,fPrintFile,FFName,FileName: String;
FTPPath,FConNo,MaxNo,FWJName:string;
AJpeg: TJPEGImage;
begin
lstPat.Clear;
if ODPat.Execute then
begin
lstPat.AddStrings(ODPat.Files);
end;
if lstPat.Count > 0 then
begin
try
ReadINIFile10();
server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ','127.0.0.1');
IdFTP1.Host :=server;//PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except;
IdFTP1.Quit;
Application.MessageBox('<27>޷<EFBFBD><DEB7><EFBFBD><EFBFBD>ӵ<EFBFBD><D3B5>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>飡', '<27><>ʾ', MB_ICONWARNING);
Exit;
end;
end;
AJpeg:=TJpegImage.Create();
AJpeg.LoadFromFile(ExtractFileName(lstPat[i]));
if AJpeg.Width>450 then
begin
CreThumb(AJpeg,Image2,450, 619);
end;
if AJpeg.Width>150 then
begin
CreThumb(AJpeg,Image1,150, 206);
end;
try
ADOQueryCmd.Connection.BeginTrans;
for i := 0 to lstPat.Count - 1 do
begin
if GetLSNo(ADOQueryCmd,CYID,'H','XD_File',4,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('ȡͼƬ<CDBC><C6AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>','<27><>ʾ',0);
Exit;
end;
PatFile := CYID+ExtractFileName(lstPat[i]);
FWJName:=ExtractFileName(lstPat[i]);
//ShowMessage(PatFile);
if IdFTP1.Connected then
begin
IdFTP1.Put(lstPat[i], 'YP'+'\'+Trim(PatFile));
with ADOQueryCmd do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where XFID='''+Trim(self.Name)+'''');
Open;
end;
with ADOQueryCmd do
begin
edit;
FieldByName('filename').Value:=Trim(PatFile);
FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp);
FieldByName('WJName').Value:=Trim(FWJName);
fieldbyname('FileType').value:=Trim('YP');
Post;
end;
end;
end;
SaveImageOther();
fPrintFile:= ExtractFilePath(Application.ExeName)+'Photo\';
if not DirectoryExists(ExtractFileDir(FPrintFile)) then
CreateDir(ExtractFileDir(fPrintFile));
FFName:=Trim(PatFile);
FFName:=fPrintFile+FFName;
if not FileExists(FFName) then
begin
IdFTP1.Get('YP\'+PatFile,FFName);
end;
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ADOQueryCmd.Connection.CommitTrans;
except;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('ͼƬ<CDBC>ϴ<EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>','<27><>ʾ',0);
end;
if IdFTP1.Connected then IdFTP1.Quit;
if i>0 then
//Application.MessageBox(PChar(inttostr(i)+'<27><><EFBFBD>ļ<EFBFBD><C4BC>ϴ<EFBFBD><CFB4>ɹ<EFBFBD><C9B9><EFBFBD>'),'<27><>ʾ',0);
//frmBPZDY_LRSHK.initimageSH();
end;
procedure TfrmSLT_TJHX.N2Click(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add(' Delete XD_File where XFID='''+Trim(self.Name)+'''');
SQL.Add(' Delete TP_File where TFID='''+Trim(self.Name)+''' ');
SQL.Add(' Delete TJ_Base where XFID='''+Trim(self.Name)+''' ');
ExecSQL;
end;
end;
procedure TfrmSLT_TJHX.N3Click(Sender: TObject);
var
IdFTP1: TIdFTP;
fPrintFile,FFName:string;
FInt:integer;
begin
if Application.MessageBox('ԭͼ<D4AD><CDBC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ҫ<EFBFBD>ȴ<EFBFBD>ʱ<EFBFBD>䣬ȷ<E4A3AC><C8B7>Ҫ<EFBFBD>鿴ԭͼ<D4AD><CDBC><EFBFBD><EFBFBD>','<27><>ʾ',32+4)<>IDYES then Exit;
try
IdFTP1:=TIdFTP.Create(self);
IdFTP1.Host :=PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
IdFTP1.Quit;
IdFTP1.Free;
Application.MessageBox('<27>޷<EFBFBD><DEB7><EFBFBD><EFBFBD>ӵ<EFBFBD><D3B5>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>飡', '<27><>ʾ', MB_ICONWARNING);
Exit;
end;
fPrintFile:= ExtractFilePath(Application.ExeName)+'Photo\';
if not DirectoryExists(ExtractFileDir(FPrintFile)) then
CreateDir(ExtractFileDir(fPrintFile));
FFName:=Trim(FileName);
FFName:=fPrintFile+FFName;
if not FileExists(FFName) then
begin
IdFTP1.Get('TJ\'+FileName,FFName);
end;
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL);
end;
end.