324 lines
8.4 KiB
ObjectPascal
324 lines
8.4 KiB
ObjectPascal
unit U_SLT_TJ_CS;
|
|
|
|
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_TJ_CS = class(TFrame)
|
|
PopupMenu1: TPopupMenu;
|
|
N1: TMenuItem;
|
|
ODPat: TOpenDialog;
|
|
IdFTP1: TIdFTP;
|
|
ADOQueryTemp: TADOQuery;
|
|
ADOQueryCmd: TADOQuery;
|
|
SaveDialog1: TSaveDialog;
|
|
Image2: TImage;
|
|
Panel2: TPanel;
|
|
cxImage1: TcxImage;
|
|
Panel1: TPanel;
|
|
XFID: TEdit;
|
|
CPName: TLabel;
|
|
IMID: TLabel;
|
|
N3: TMenuItem;
|
|
Image1: TImage;
|
|
Panel16: TPanel;
|
|
Image11: TImage;
|
|
Image22: TImage;
|
|
N2: TMenuItem;
|
|
procedure cxImage1DblClick(Sender: TObject);
|
|
procedure N2Click(Sender: TObject);
|
|
procedure N3Click(Sender: TObject);
|
|
procedure N1Click(Sender: TObject);
|
|
procedure Image11DblClick(Sender: TObject);
|
|
private
|
|
lstPat: TStringList;
|
|
procedure ReadINIFile10();
|
|
|
|
{ Private declarations }
|
|
public
|
|
FileName,FIMID,FIMNO,FWBID:String;
|
|
procedure Init(fFileName:string;fPicture:TJpegImage);
|
|
procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
|
|
{ Public declarations }
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
U_DataLink,U_Fun,U_HXKTJ,U_TJHXMX;
|
|
{$R *.dfm}
|
|
|
|
|
|
|
|
procedure TfrmSLT_TJ_CS.cxImage1DblClick(Sender: TObject);
|
|
begin
|
|
try
|
|
frmTJHXMX:=TfrmTJHXMX.Create(Application); //230 152
|
|
with frmTJHXMX do
|
|
begin
|
|
Label9.Caption:=self.CPName.Caption;
|
|
label8.Caption:=FIMNO;
|
|
FileName:=self.FileName;
|
|
frmTJHXMX.FIMID:=Self.FIMID;
|
|
frmTJHXMX.FWBID:=Self.FWBID;
|
|
if ShowModal=1 then
|
|
begin
|
|
|
|
end;
|
|
end;
|
|
finally
|
|
frmTJHXMX.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSLT_TJ_CS.ReadINIFile10();
|
|
var
|
|
programIni:Tinifile; //ÅäÖÃÎļþÃû
|
|
FileName:string;
|
|
begin
|
|
FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI';
|
|
programIni:=Tinifile.create(FileName);
|
|
server:=programIni.ReadString('SERVER','·þÎñÆ÷µØÖ·','127.0.0.1');
|
|
programIni.Free;
|
|
end;
|
|
procedure TfrmSLT_TJ_CS.Init(fFileName:string;fPicture:TJpegImage);
|
|
begin
|
|
FileName:=trim(fFileName);
|
|
cxImage1.Picture.Assign(fPicture);
|
|
end;
|
|
procedure TfrmSLT_TJ_CS.N2Click(Sender: TObject);
|
|
begin
|
|
if Application.MessageBox('È·¶¨ÒªÉ¾³ýÊý¾ÝÂð£¿','Ìáʾ',32+4)<>IDYES then Exit;
|
|
with ADOQueryCmd do
|
|
begin
|
|
Close;
|
|
sql.Clear;
|
|
sql.Add('UPdate Image_Info Set Valid=''N'',DelTime=getdate(),Deler='''+Trim(DName)+''',DelerCode='''+Trim(DCode)+'''');
|
|
sql.Add('where IMID='''+trim(FIMID)+'''');
|
|
sql.Add('UPdate Image_File Set Valid=''N'',DelTime=getdate(),Deler='''+Trim(DName)+''',DelerCode='''+Trim(DCode)+'''');
|
|
sql.Add('where IMID='''+trim(FIMID)+'''');
|
|
ExecSQL;
|
|
end;
|
|
frmHXKTJ.initimageSH(FWBID);
|
|
end;
|
|
|
|
procedure TfrmSLT_TJ_CS.N3Click(Sender: TObject);
|
|
var
|
|
IdFTP1: TIdFTP;
|
|
fPrintFile,FFName:string;
|
|
FInt:integer;
|
|
begin
|
|
if Application.MessageBox('ÔͼÏÂÔØÐèÒªµÈ´ýʱ¼ä£¬È·¶¨Òª²é¿´ÔͼÂð£¿','Ìáʾ',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('ÎÞ·¨Á¬½Óµ½Îļþ·þÎñÆ÷£¬Çë¼ì²é£¡', 'Ìáʾ', 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;
|
|
|
|
procedure TfrmSLT_TJ_CS.N1Click(Sender: TObject);
|
|
var
|
|
i,j: Integer;
|
|
AJpeg: TJPEGImage;
|
|
myStream: TADOBlobStream;
|
|
maxnoIMID,maxnoIFID,FWBID,ImageName:String;
|
|
imageDate:TDate;
|
|
begin
|
|
lstPat := TStringList.Create;
|
|
|
|
lstPat.Clear;
|
|
if ODPat.Execute then
|
|
begin
|
|
lstPat.AddStrings(ODPat.Files);
|
|
end;
|
|
if lstPat.Count>1 then
|
|
begin
|
|
Application.MessageBox('²»ÄÜÑ¡Ôñ¶à¸öͼƬ!','Ìáʾ',0);
|
|
Exit;
|
|
end else
|
|
if lstPat.Count<>1 then
|
|
begin
|
|
Exit;
|
|
end;
|
|
begin
|
|
try
|
|
if IdFTP1.Connected then
|
|
begin
|
|
IdFTP1.Quit;
|
|
end;
|
|
ReadINIFile10();
|
|
server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','·þÎñÆ÷µØÖ·','127.0.0.1');
|
|
IdFTP1.Host :=server;
|
|
IdFTP1.Username := 'three';
|
|
IdFTP1.Password := '641010';
|
|
IdFTP1.Connect();
|
|
except
|
|
IdFTP1.Quit;
|
|
Application.MessageBox('ÎÞ·¨Á¬½Óµ½Îļþ·þÎñÆ÷£¬Çë¼ì²é£¡', 'Ìáʾ', MB_ICONWARNING);
|
|
Exit;
|
|
end;
|
|
end;
|
|
Panel16.Visible:=True;
|
|
Panel16.Refresh;
|
|
imageDate:=SGetServerDate(ADOQueryTemp);
|
|
try
|
|
ADOQueryCmd.Connection.BeginTrans;
|
|
for i := 0 to lstPat.Count - 1 do
|
|
begin
|
|
ImageName:=ExtractFileName(lstPat[i]);
|
|
with ADOQueryCmd do
|
|
begin
|
|
Close;
|
|
sql.Clear;
|
|
sql.Add('select * from Image_Info where IMID='''+Trim(FIMID)+'''');
|
|
Open;
|
|
end;
|
|
with ADOQueryCmd do
|
|
begin
|
|
Edit;
|
|
FieldByName('ImageName').Value:=Trim(ImageName);
|
|
FieldByName('Editer').Value:=Trim(DName);
|
|
FieldByName('EditerCode').Value:=Trim(DCode);
|
|
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
|
|
Post;
|
|
end;
|
|
AJpeg:=TJpegImage.Create();
|
|
AJpeg.LoadFromFile(ExtractFileName(lstPat[i]));
|
|
if AJpeg.Width>450 then
|
|
begin
|
|
CreThumb(AJpeg,Image22,450, 619);
|
|
end;
|
|
if AJpeg.Width>150 then
|
|
begin
|
|
CreThumb(AJpeg,Image11,150, 206);
|
|
end;
|
|
with ADOQueryCmd do
|
|
begin
|
|
Close;
|
|
sql.Clear;
|
|
sql.Add('select * from Image_File where IMID='''+Trim(FIMID)+''' and IFType=''С'' ');
|
|
Open;
|
|
end;
|
|
with ADOQueryCmd do
|
|
begin
|
|
Edit;
|
|
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite);
|
|
AJpeg.Assign(Image11.Picture.Graphic);
|
|
AJpeg.SaveToStream(myStream);
|
|
myStream.Free;
|
|
FieldByName('Editer').Value:=Trim(DName);
|
|
FieldByName('EditerCode').Value:=Trim(DCode);
|
|
Post;
|
|
end;
|
|
with ADOQueryCmd do
|
|
begin
|
|
Close;
|
|
sql.Clear;
|
|
sql.Add('select * from Image_File where IMID='''+Trim(FIMID)+''' and IFType=''´ó'' ');
|
|
Open;
|
|
end;
|
|
with ADOQueryCmd do
|
|
begin
|
|
Edit;
|
|
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite);
|
|
AJpeg.Assign(image22.Picture.Graphic);
|
|
AJpeg.SaveToStream(myStream);
|
|
myStream.Free;
|
|
FieldByName('Editer').Value:=Trim(DName);
|
|
FieldByName('EditerCode').Value:=Trim(DCode);
|
|
Post;
|
|
end;
|
|
if IdFTP1.Connected then
|
|
IdFTP1.Put(lstPat[i], 'TJ'+'\'+Trim(ImageName));
|
|
end;
|
|
ADOQueryCmd.Connection.CommitTrans;
|
|
Image11.Visible:=True;
|
|
cxImage1.Visible:=False;
|
|
Image11.Refresh;
|
|
Image11.Align:=alClient;
|
|
except
|
|
Panel16.Visible:=False;
|
|
ADOQueryCmd.Connection.RollbackTrans;
|
|
Application.MessageBox('Êý¾ÝÉÏ´«Ê§°Ü!','Ìáʾ',0);
|
|
Exit;
|
|
end;
|
|
Panel16.Visible:=False;
|
|
end;
|
|
procedure TfrmSLT_TJ_CS.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
|
|
var
|
|
Bitmap: TBitmap;
|
|
Ratio: Double;
|
|
ARect: TRect; //230 152
|
|
AHeight, AHeightOffset: Integer;
|
|
AWidth, AWidthOffset: Integer;
|
|
begin
|
|
Bitmap := TBitmap.Create;
|
|
try
|
|
AWidth :=Width;
|
|
AWidthOffset := 0;
|
|
AHeight := Height;
|
|
AHeightOffset := 0;
|
|
|
|
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_TJ_CS.Image11DblClick(Sender: TObject);
|
|
begin
|
|
try
|
|
frmTJHXMX:=TfrmTJHXMX.Create(Application);
|
|
with frmTJHXMX do
|
|
begin
|
|
Label9.Caption:=self.CPName.Caption;
|
|
label8.Caption:=FIMNO;
|
|
FileName:=self.FileName;
|
|
frmTJHXMX.FIMID:=Self.FIMID;
|
|
frmTJHXMX.FWBID:=Self.FWBID;
|
|
if ShowModal=1 then
|
|
begin
|
|
|
|
end;
|
|
end;
|
|
finally
|
|
frmTJHXMX.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|