D7myChengxie/贸易管理/U_FjList_RZ1.pas
DESKTOP-E401PHE\Administrator e4d35a6883 1234
2025-08-25 10:39:41 +08:00

544 lines
14 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_FjList_RZ1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, Menus, cxLookAndFeelPainters, StdCtrls,
cxButtons, DB, ADODB, ImgList,shellapi, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, ExtDlgs,jpeg,IniFiles, cxContainer, cxImage,
cxDBEdit,StrUtils;
type
TfrmFjList_RZ1 = class(TForm)
ListView1: TListView;
Panel1: TPanel;
FileName: TcxButton;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
ImageList1: TImageList;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
DataSource1: TDataSource;
OpenPictureDialog1: TOpenPictureDialog;
SaveDialog1: TSavePictureDialog;
Image2: TImage;
Picture4: TcxDBImage;
ADOQuery1: TADOQuery;
procedure cxButton3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FileNameClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
procedure CreThumb(Width, Height: Integer);
procedure Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
private
procedure InitData();
{ Private declarations }
public
fkeyNO:string;
fType:string;
fId:integer;
fstatus:integer;
QFilePath:string;
QFileName:string;
MyJpeg: TJPEGImage;
fFlileFlag:string;
// fmanage:string;
{ Public declarations }
end;
var
frmFjList_RZ1: TfrmFjList_RZ1;
implementation
uses
U_DataLink,U_Fun10,U_CompressionFun;
{$R *.dfm}
procedure TfrmFjList_RZ1.InitData();
var
ListItem: TListItem;
Flag: Cardinal;
info: SHFILEINFOA;
Icon: TIcon;
begin
ListView1.Items.Clear;
try
with adoqueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
open;
{ if not IsEmpty then
begin
while not eof do
begin
with ListView1 do
begin
LargeImages := ImageList1;
Icon := TIcon.Create;
ListItem := Items.Add;
Listitem.Caption := trim(fieldbyname('fileName').AsString);
// Listitem.SubItems.Add(OpenDiaLog.FileName);
Flag := (SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
SHGetFileInfo(Pchar(trim(fieldbyname('fileName').AsString)), 0, info, Sizeof(info), Flag);
Icon.Handle := info.hIcon;
ImageList1.AddIcon(Icon);
ListItem.ImageIndex := ImageList1.Count - 1;
end;
next;
end;
end; }
end;
except
end;
end;
procedure TfrmFjList_RZ1.cxButton3Click(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Items.Free;
ModalResult:=-1;
end;
procedure TfrmFjList_RZ1.FormDestroy(Sender: TObject);
begin
MyJpeg.Free;
frmFjList_RZ1:=nil;
end;
procedure TfrmFjList_RZ1.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));
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);
finally
Bitmap.Free;
end;
end;
procedure TfrmFjList_RZ1.FileNameClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName:string;
fFilePath:string;
maxNo:string;
// myStream: TADOBlobStream;
FJStream : TMemoryStream;
mfileSize:integer;
mCreationTime:TdateTime;
mWriteTime:TdateTime;
myStream: TADOBlobStream;
begin
try
{OpenDiaLog := TOpenDialog.Create(Self);
if OpenDiaLog.Execute then
begin
fFilePath:=OpenDiaLog.FileName;
fFileName:=ExtractFileName(OpenDiaLog.FileName);
Panel2.Caption:='<27><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD><CFB4><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD>Ե<EFBFBD>...';
Panel2.Visible:=true;
application.ProcessMessages;
if GetLSNo(ADOQueryCmd,maxNo,'FJ','TP_File',4,1)=False then
begin
Application.MessageBox('ȡ<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>','<27><>ʾ',0);
Exit;
end;
//<2F><>ȡ<EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>Ϣ
GetFileInfo(fFilePath,mfileSize,mCreationTime,mWriteTime);}
if OpenPictureDialog1.Execute then
begin
{Image1.Top := 0;
Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);}
QFilePath:=OpenPictureDialog1.FileName;
QFileName:=ExtractFileName(QFilePath);
CreThumb(240, 180);
//Image1.Visible:=false;
end;
adoqueryCmd.Connection.BeginTrans;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where TFID='+quotedstr(trim(maxNO)));
execsql;
end;
try
FJStream:=TMemoryStream.Create;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where TFID='+quotedstr(trim(maxNO)));
open;
append;
fieldbyname('TFID').Value:=trim(maxNO);
fieldbyname('WBID').Value:=trim(fkeyNO);
fieldbyname('TFType').Value:=trim(fType);
fieldbyname('Filler').Value:=trim(DName);
FieldByName('filltime').Value:=Now;
fieldbyname('FileName').Value:=trim(formatdatetime('yyyyMMddhhnnsszzz',now())+ExtractFileExt(QFilePath));
//fieldbyname('TFDate').Value:=mWriteTime;
myStream := TADOBlobStream.Create(TBlobField(FieldByName('Filesother')), bmWrite);
MyJpeg.Assign(Image2.Picture.Graphic);
MyJpeg.SaveToStream(myStream);
myStream.Free;
post;
end;
{if fFilePath <> '' then
begin
try
IdFTP1.Host := PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
IdFTP1.Put(fFilePath, 'FJ\' + Trim(fFileName));
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;}
Panel2.Visible:=false;
initdata();
finally
FJStream.Free;
end;
adoqueryCmd.Connection.CommitTrans;
except
adoqueryCmd.Connection.RollbackTrans;
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>','<27><>ʾ<EFBFBD><CABE>Ϣ',0);
end;
end;
procedure TfrmFjList_RZ1.FormCreate(Sender: TObject);
begin
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='';
Connected:=true;
end;
MyJpeg := TJpegImage.Create;
cxGrid1.Align:=alclient;
fstatus:=0;
end;
procedure TfrmFjList_RZ1.FormShow(Sender: TObject);
begin
IF fstatus=0 then Panel1.Visible:=true
else Panel1.Visible:=false;
initdata();
end;
procedure TfrmFjList_RZ1.ListView1DblClick(Sender: TObject);
var
sFieldName:string;
fileName:string;
begin
if ListView1.Items.Count<1 THEN EXIT;
if listView1.SelCount<1 then exit;
sFieldName:='D:\ͼƬ<CDBC>鿴';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil);
fileName:=ListView1.Selected.Caption;
sFieldName:=sFieldName+'\'+trim(fileName);
try
IdFTP1.Host := PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
if IdFTP1.Connected then
begin
Panel2.Caption:='<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD>Ե<EFBFBD>...';
Panel2.Visible:=true;
application.ProcessMessages;
try
IdFTP1.Get('FJ\'+ Trim(fileName), sFieldName,false, true);
except
Panel2.Visible:=false;
Application.MessageBox('<27>ͻ<EFBFBD>ͼ<EFBFBD><CDBC><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Panel2.Visible:=false;
Application.MessageBox('<27>޷<EFBFBD><DEB7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
Panel2.Visible:=false;
if IdFTP1.Connected then IdFTP1.Quit;
ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
end;
procedure TfrmFjList_RZ1.cxButton1Click(Sender: TObject);
var
fFileName:string;
fFilePath:string;
begin
// if listView1.SelCount<1 then exit;
IF ADOQueryTmp.IsEmpty then exit;
try
// fFileName:=ListView1.Selected.Caption;
// ADOQueryTmp.Locate('fileName',fFileName,[]);
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where TFID='+quotedstr(trim(ADOQueryTmp.fieldbyname('TFID').AsString)));
// sql.Add('and TFType='+quotedstr(trim(fType)));
// sql.Add('and FileName='+quotedstr(trim(fFileName)));
execsql;
end;
initData();
except
end;
end;
procedure TfrmFjList_RZ1.cxButton2Click(Sender: TObject);
var
SaveDialog: TSaveDialog;
fFileName:string;
fFilePath:string;
ff: TADOBlobStream;
FJStream : TMemoryStream;
begin
if adoqueryTmp.IsEmpty then exit;
try
fFileName:=adoqueryTmp.fieldbyname('FileName').AsString;
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.FileName:=fFileName;
if SaveDialog.Execute then
begin
Panel2.Caption:='<27><><EFBFBD>ڱ<EFBFBD><DAB1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD>Ե<EFBFBD>...';
Panel2.Visible:=true;
application.ProcessMessages;
fFilePath:=SaveDialog.FileName;
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
fjStream:= TMemoryStream.Create ;
ff.SaveToStream(fjStream);
UnCompressionStream(fjStream);
fjStream.SaveToFile(fFilePath);
// ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
finally
fjStream.free;
ff.Free;
end;
Panel2.Visible:=false;
// if IdFTP1.Connected then IdFTP1.Quit;
end;
except
Panel2.Visible:=false;
end;
end;
procedure TfrmFjList_RZ1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId=10 then Action:=cafree
else
Action:=cahide;
end;
procedure TfrmFjList_RZ1.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible:=false;
end;
procedure TfrmFjList_RZ1.Tv1DblClick(Sender: TObject);
var
sFieldName:string;
fileName:string;
ff: TADOBlobStream;
FJStream : TMemoryStream;
jpg:TJpegImage;
myStream: TADOBlobStream;
begin
IF adoqueryTmp.IsEmpty then exit;
sFieldName:='D:\ͼƬ<CDBC>鿴';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil);
fileName:=adoqueryTmp.fieldbyname('FileName').AsString;
sFieldName:=sFieldName+'\'+trim(fileName);
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
jpg:=TJpegImage.Create();
jpg.LoadFromStream(ff);
jpg.SaveToFile(sFieldName);
{myStream := TADOBlobStream.Create(TBlobField(adoqueryTmp.FieldByName('Filesother')), bmWrite);
MyJpeg.Assign(ADOQueryTmp.FieldByName('Filesother'));
MyJpeg.SaveToStream(myStream);
MyJpeg.SaveToFile(sFieldName);
myStream.Free;}
ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
finally
fjStream.free;
ff.Free;
end;
{IF Picture4.Picture.Height=0 then exit;
sFieldName:=leftbstr(ExtractFilePath(Application.ExeName),1)+':\ͼƬ<CDBC>鿴';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil);
fileName:=adoqueryTmp.fieldbyname('FileName').AsString;
sFieldName:=sFieldName+'\'+trim(fileName);
//ShowMessage(sFieldName);
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;
if IdFTP1.Connected then
begin
application.ProcessMessages;
try
IdFTP1.Get(fFlileFlag+'\'+ Trim(fileName), sFieldName,true, false);
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;
ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);}
end;
procedure TfrmFjList_RZ1.Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
var
PicStream: TMemoryStream;
begin
if not ADOQueryTmp.FieldByName('filesother').IsNull then
begin
try
PicStream := TMemoryStream.Create;
TBlobField(ADOQueryTmp.FieldByName('filesother')).SaveToStream(PicStream);
PicStream.Position := 0;
Picture4.Picture.Bitmap.LoadFromStream(PicStream);
PicStream.Free;
except
ShowMessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD>ͼƬ<CDBC><C6AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.');
end;
end;
end;
end.