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

335 lines
8.3 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_SLT_YH_SX;
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_YH_SX = class(TFrame)
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
PopupMenu1: TPopupMenu;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQuery3: TADOQuery;
ADOQuery4: TADOQuery;
SaveDialog1: TSaveDialog;
Image2: TImage;
Panel2: TPanel;
cxImage1: TcxImage;
Panel1: TPanel;
TJMLNo: TLabel;
Button1: TButton;
WBID: TEdit;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
SH: TLabel;
ZW: TLabel;
YW: TLabel;
N3: TMenuItem;
N1: TMenuItem;
Memo1: TMemo;
procedure cxImage1DblClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure cxImage1Click(Sender: TObject);
procedure Memo1Click(Sender: TObject);
procedure N2Click(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,FIMID,FImagePath,FTJHX,FIMNO,FWBID,FTJTPID:string;
Formid:string;
procedure Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
{ Public declarations }
end;
implementation
uses
U_DataLink,U_Fun,U_BPZdy_LRSHK,U_MLManage_LRTJ,U_BPZdy_ColTJ,U_MLManage_LRYH;
{$R *.dfm}
procedure TFrmSLT_YH_SX.Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
begin
CYID:=trim(fCYID);
FileName:=trim(fFileName);
lstPat := TStringList.Create;
cxImage1.Picture.Assign(fPicture);
end;
procedure TFrmSLT_YH_SX.cxImage1DblClick(Sender: TObject);
var
IdFTP1: TIdFTP;
FPath,FFName:string;
FInt:integer;
maxno:string;
j,i:Integer;
begin
frmMLManage_LRYH.Panel16.Refresh;
frmMLManage_LRYH.Panel16.Visible:=true;
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);
if FIMNO='' then
FFName:=FPath+FFName+'.jpg'
else
FFName:=FPath+FFName;
if DirectoryExists(ExtractFileDir(FFName)) then
DeleteFile(FFName);
if FileExists(FFName) then
begin
FInt:=1;
end;
if FInt<>1 then
begin
if FIMNO='' then
IdFTP1.Get('TJ\'+FileName,FFName)
else
IdFTP1.Get('YP\'+FileName,FFName);
end;
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL);
frmMLManage_LRYH.Panel16.Visible:=false;
end;
procedure TFrmSLT_YH_SX.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_YH_SX.SaveImageOther();
begin
end;
procedure TFrmSLT_YH_SX.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_YH_SX.N1Click(Sender: TObject);
begin
with ADOQuery3 do
begin
Close;
SQL.Clear;
SQL.Add('select * from Image_Info ');
sql.Add('where IMID='''+trim(FIMID)+''' and Valid=''Y''');
Open;
end;
with ADOQuery3 do
begin
if ADOQuery3.IsEmpty=False then
begin
frmMLManage_LRYH.TJNo.Text:=Trim(FieldByName('TJHX').asstring);
frmMLManage_LRYH.TJCol.Text:=Trim(FieldByName('TJCol').asstring);
frmMLManage_LRYH.TJColNo.Text:=Trim(FieldByName('TJColNo').asstring);
frmMLManage_LRYH.TJPTID.Text:=Trim(FieldByName('TJPTID').asstring);
frmMLManage_LRYH.TJCPID.Text:=Trim(FieldByName('TJCPID').asstring);
frmMLManage_LRYH.TJTPID.Text:=Trim(FieldByName('TJTPID').asstring);
frmMLManage_LRYH.TJNote.Text:=Trim(FieldByName('TJNote').asstring);
frmMLManage_LRYH.ShowImage();
end;
end;
with frmMLManage_LRYH do
begin
N4.Click;
SaveImage1(Trim(Self.FTJTPID));
initimageSH();
end;
end;
procedure TFrmSLT_YH_SX.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+'.jpg';
if DirectoryExists(ExtractFileDir(FFName)) then
DeleteFile(FFName);
if FileExists(FFName) then
begin
FInt:=1;
end;
if FInt<>1 then
IdFTP1.Get('TJ\'+FileName,FFName);
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL);
end;
procedure TFrmSLT_YH_SX.cxImage1Click(Sender: TObject);
var FTJNo:string;
begin
if Formid<>'' then
begin
if Memo1.Text='' then
begin
Memo1.Text:='<27><>';
memo1.Color:=clRed;
end
else
begin
Memo1.Text:='';
memo1.Color:=clWindow;
end;
end
else
begin
with ADOQuery3 do
begin
Close;
SQL.Clear;
SQL.Add('select * from Image_Info ');
sql.Add('where IMID='''+trim(FIMID)+''' and Valid=''Y''');
Open;
end;
with ADOQuery3 do
begin
if ADOQuery3.IsEmpty=False then
begin
frmMLManage_LRYH.TJNo.Text:=Trim(FieldByName('TJHX').asstring);
frmMLManage_LRYH.TJCol.Text:=Trim(FieldByName('TJCol').asstring);
frmMLManage_LRYH.TJColNo.Text:=Trim(FieldByName('TJColNo').asstring);
frmMLManage_LRYH.TJPTID.Text:=Trim(FieldByName('TJPTID').asstring);
frmMLManage_LRYH.TJCPID.Text:=Trim(FieldByName('TJCPID').asstring);
frmMLManage_LRYH.TJTPID.Text:=Trim(FieldByName('TJTPID').asstring);
frmMLManage_LRYH.TJNote.Text:=Trim(FieldByName('TJNote').asstring);
frmMLManage_LRYH.ShowImage();
end;
end;
frmMLManage_LRYH.Panel6.Visible:=true;
end;
{frmBPZDY_ColTJ:=TfrmBPZDY_ColTJ.Create(self);
with frmBPZDY_ColTJ do
begin
FIMID:=Trim(Self.FIMID);
if ShowModal=1 then
begin
//initimageSH();
end;
free;
end;}
end;
procedure TFrmSLT_YH_SX.Memo1Click(Sender: TObject);
begin
if Memo1.Text='' then
begin
Memo1.Text:='<27><>';
memo1.Color:=clRed;
end
else
begin
Memo1.Text:='';
memo1.Color:=clWindow;
end;
end;
procedure TFrmSLT_YH_SX.N2Click(Sender: TObject);
begin
with ADOQuery3 do
begin
Close;
SQL.Clear;
SQL.Add('delete from Image_Info ');
sql.Add('where IMID='''+trim(FIMID)+''' and Valid=''Y''');
execsql;
end;
application.MessageBox(<><C9BE><EFBFBD>ɹ<EFBFBD>','<27><>ʾ');
frmMLManage_LRYH.initimageSH();
end;
end.