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

347 lines
8.7 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 U_BJTJXX;
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
TfrmBJTJXX = 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;
XFID: TEdit;
ColorNameEng: TEdit;
YW: TLabel;
N3: TMenuItem;
N2: TMenuItem;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Edit1: TEdit;
Label5: TLabel;
Edit2: TEdit;
Button1: TButton;
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;
var
frmBJTJXX: TfrmBJTJXX;
implementation
uses
U_DataLink,U_Fun,U_BPZdy_LRSHK,U_MLManage_LRRS;
{$R *.dfm}
procedure TfrmBJTJXX.Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
begin
CYID:=trim(fCYID);
FileName:=trim(fFileName);
lstPat := TStringList.Create;
//Panel1.Caption:=FileName;
cxImage1.Picture.Assign(fPicture);
end;
procedure TfrmBJTJXX.cxImage1DblClick(Sender: TObject);
var
IdFTP1: TIdFTP;
FPath,FFName:string;
FInt:integer;
maxno:string;
j,i:Integer;
begin
if Formid='1' then
begin
self.Visible:=false;
if TScrollBox(Self.Parent).ParentCtl3D then
begin
frmMLManage_LRRS.imagePL(1);
end else
begin
frmMLManage_LRRS.imagePL(2);
end;
end;
if Formid='' then
begin
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;
FPath:='D:\Right1209\';
if not DirectoryExists(ExtractFileDir(FPath)) then
CreateDir(ExtractFileDir(FPath));
FFName:=Trim(FileName);
FFName:=FPath+FFName;
if DirectoryExists(ExtractFileDir(FFName)) then
DeleteFile(FFName);
if FileExists(FFName) then
begin
FInt:=1;
end;
if FInt<>1 then
IdFTP1.Get('YP\'+FileName,FFName);
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL);
end;
end;
procedure TfrmBJTJXX.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 TfrmBJTJXX.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);
AJpeg.Assign(Image2.Picture.Graphic);
//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;
end;
procedure TfrmBJTJXX.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 TfrmBJTJXX.N1Click(Sender: TObject);
var
i,j: Integer;
PatFile: String;
FTPPath,FConNo,MaxNo: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();
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select filename from XD_File where XFID='''+Trim(self.Name)+''' ');
SQL.Add('and filetype=''YP''');
//ShowMessage(sql.Text);
Open;
end;
Image2.Picture.LoadFromFile(ODPat.FileName);
AJpeg.Assign(Image2.Picture.Graphic);
CreThumb(AJpeg,Image2,216, 187);
try
ADOQueryCmd.Connection.BeginTrans;
for i := 0 to lstPat.Count - 1 do
begin
PatFile := ExtractFileName(lstPat[i]);
PatFile:=ADOQueryTemp.fieldbyname('Filename').AsString;
//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('FileType').value:=Trim('YP');
Post;
end;
end;
end;
SaveImageOther();
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 TfrmBJTJXX.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;
//frmBPZDY_LRSHK.initimageSH();
end;
procedure TfrmBJTJXX.N3Click(Sender: TObject);
var
IdFTP1: TIdFTP;
FPath,FFName:string;
FInt:integer;
begin
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;
FPath:='D:\Right1209\';
if not DirectoryExists(ExtractFileDir(FPath)) then
CreateDir(ExtractFileDir(FPath));
FFName:=Trim(FileName);
FFName:=FPath+FFName;
if DirectoryExists(ExtractFileDir(FFName)) then
DeleteFile(FFName);
if FileExists(FFName) then
begin
FInt:=1;
end;
if FInt<>1 then
IdFTP1.Get('YP\'+FileName,FFName);
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL);
end;
end.