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

467 lines
13 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_HXKYH;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu,IniFiles,
cxButtonEdit, BtnEdit, cxTL, cxMaskEdit, cxInplaceContainer, cxDBTL,U_SLT_TJ,
cxTLData, cxContainer, cxCurrencyEdit, cxCheckBox, cxSplitter,jpeg,Math, Menus, cxCalendar,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP;
type
TfrmHXKYH = class(TForm)
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
Ord_TJ: TClientDataSet;
ADOConnection1: TADOConnection;
ThreeImgList: TImageList;
DataSource2: TDataSource;
Panel2: TPanel;
Panel4: TPanel;
DataSource4: TDataSource;
ADOQueryTree: TADOQuery;
Order_Tree: TClientDataSet;
cxGridPopupMenu1: TcxGridPopupMenu;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
cxStyleRepository2: TcxStyleRepository;
cxStyle2: TcxStyle;
cxSplitter1: TcxSplitter;
ToolBar2: TToolBar;
TSH: TToolButton;
ToolBar1: TToolBar;
adoqueryPicture: TADOQuery;
ScrollBox2: TScrollBox;
THB: TToolButton;
TGB: TToolButton;
ADOQuery1: TADOQuery;
cxDBTreeList1: TcxDBTreeList;
VColumn2: TcxDBTreeListColumn;
SaveDialog1: TSaveDialog;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
Panel1: TPanel;
Image2: TImage;
Image1: TImage;
Panel16: TPanel;
Panel3: TPanel;
ScrollBox3: TPanel;
BTLP: TButton;
BTNP: TButton;
LBCPAP: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure TSHClick(Sender: TObject);
procedure THBClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TGBClick(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure BTLPClick(Sender: TObject);
procedure BTNPClick(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
private
JS:integer;
lstPat: TStringList;
AJpeg: TJPEGImage;
procedure initTree();
procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
procedure ReadINIFile10();
{ Private declarations }
public
my,mz:integer;
procedure initimageSH(FWBID:String);
{ Public declarations }
end;
var
frmHXKYH: TfrmHXKYH;
Mach1: array of TfrmSLT_TJ;
implementation
uses
U_DataLink,U_RTFun, U_BPZdy_HXK,U_CPTypePB,U_FileUp_TP
,U_FileUp,U_FileUp_PB,U_FileUp_TPSH,U_SLT_BF1;
{$R *.dfm}
procedure TfrmHXKYH.initTree();
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select *');
sql.Add(',JS=(select Max(A.CPlevel) from CP_TypeTJ A)');
sql.Add(', Case when isnull(CPNo,'''')<>'''' and CPlevel=''2'' then RTrim(CPNo)+''/''+CPName else CPName end as CP ');
SQL.Add('from CP_TypeTJ order by CPlevel,CPOrder,CPName');
Open;
end;
SCreateCDS20(ADOQueryTree,Order_Tree);
SInitCDSData20(ADOQueryTree,Order_Tree);
JS:=Order_Tree.fieldbyname('JS').AsInteger;
cxDBTreeList1.Items[0].Expand(true);
end;
procedure TfrmHXKYH.initimageSH(FWBID:String);
var
i,j,p,x:integer;
jpg:TJpegImage;
myStream: TADOBlobStream;
begin
j:=length(Mach1);
if j>0 then
begin
for i:=0 to j-1 do
begin
Mach1[i].free;
end;
end;
SetLength(Mach1, 0);
try
with adoqueryPicture do
begin
close;
sql.Clear;
sql.Add(' exec P_View_Image :WBID,:ImageType,:IFType,:Ye,:YeQty ');
Parameters.ParamByName('WBID').Value:=Trim(FWBID);
Parameters.ParamByName('ImageType').Value:='TJ';
Parameters.ParamByName('IFType').Value:='С';
Parameters.ParamByName('Ye').Value:=my;
Parameters.ParamByName('YeQty').Value:=18;
open;
end;
j:=adoqueryPicture.RecordCount;
if j<1 then exit;
adoqueryPicture.DisableControls;
adoqueryPicture.First;
SetLength(Mach1, j);
with adoqueryPicture do
begin
First;
i:=0;
x:=0; //<2F><>
p:=0; //<2F><>
while not eof do
begin
if (i<18*my) and (i>=18*(my-1)) then
begin
jpg:=TJpegImage.Create();
myStream:=tadoblobstream.Create(tblobfield(adoqueryPicture.fieldbyname('ImageFile')),bmread);
jpg.LoadFromStream(myStream);
if (i-18*(my-1))<6*(p+1) then
begin
end
else
begin
p:=p+1;
end;
Mach1[i]:=TfrmSLT_TJ.Create(Self);
Mach1[i].Name:=trim(adoqueryPicture.fieldbyname('IMID').AsString);
//Mach1[i].CPName.Caption:=trim(adoqueryPicture.fieldbyname('CPName').AsString);
Mach1[i].IMID.Caption:=trim(adoqueryPicture.fieldbyname('IMNO').AsString);
Mach1[i].Parent:=ScrollBox2;
Mach1[I].Left:=0+(x-6*p)*158;
Mach1[I].Top:=p*236;
Mach1[I].FIMID:=trim(adoqueryPicture.fieldbyname('IMID').AsString);
Mach1[I].FIMNO:=trim(adoqueryPicture.fieldbyname('IMNO').AsString);
Mach1[I].FWBID:=Trim(FWBID);
if triM(adoqueryPicture.fieldbyname('IMID').AsString)<>'' then
begin
Mach1[i].Init(adoqueryPicture.fieldbyname('ImageName').AsString,jpg);
end;
Mach1[i].cxImage1.Visible:=True;
Mach1[i].cxImage1.AutoSize:=True;
Mach1[i].cxImage1.Properties.Stretch:=True;
Mach1[i].cxImage1.Align:=alClient;
Mach1[i].Image11.Visible:=False;
x:=x+1;
end;
i:=i+1;
Next;
end;
end;
adoqueryPicture.EnableControls;
finally
jpg.free;
end;
end;
procedure TfrmHXKYH.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
except;
frmHXKYH.Free;
end;
lstPat := TStringList.Create;
end;
procedure TfrmHXKYH.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Finalize(Mach1);
Action:=caFree;
end;
procedure TfrmHXKYH.FormShow(Sender: TObject);
begin
initTree();
ToolBar1.Visible:=false;
TSH.Visible:=false;
end;
procedure TfrmHXKYH.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
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 TfrmHXKYH.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 TfrmHXKYH.TSHClick(Sender: TObject);
var
i,j: Integer;
AJpeg: TJPEGImage;
myStream: TADOBlobStream;
maxnoIMID,maxnoIMNO,maxnoIFID,FWBID,ImageName:String;
imageDate:TDate;
begin
lstPat.Clear;
if ODPat.Execute then
begin
lstPat.AddStrings(ODPat.Files);
end;
if lstPat.Count > 0 then
begin
try
if IdFTP1.Connected then
begin
IdFTP1.Quit;
end;
ReadINIFile10();
server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ','127.0.0.1');
IdFTP1.Host :=server;
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 else
begin
Exit;
end;
Panel16.Visible:=True;
Panel16.Refresh;
FWBID:=Trim(Self.Order_Tree.fieldbyname('CPID').AsString);
imageDate:=SGetServerDate(ADOQueryTemp);
try
ADOQueryCmd.Connection.BeginTrans;
for i := 0 to lstPat.Count - 1 do
begin
ImageName:=ExtractFileName(lstPat[i]);
if GetLSNoHZ(ADOQueryCmd,maxnoIMID,'TJ','Image_Info',4,1,0)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('ȡͼƬIDʧ<44><CAA7>!','<27><>ʾ',0);
Exit;
end;
if GetLSNoHZ(ADOQueryCmd,maxnoIMNO,'','Image_InfoTJ',4,0,0)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('ȡͼƬNOʧ<4F><CAA7>!','<27><>ʾ',0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from Image_Info where 1=2');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('IMID').Value:=Trim(maxnoIMID);
FieldByName('IMNO').Value:=Trim(maxnoIMNO);
FieldByName('WBID').Value:=Trim(FWBID);
FieldByName('ImageType').Value:='TJ';
FieldByName('ImageDate').Value:=imageDate;
FieldByName('ImageName').Value:=Trim(ImageName);
FieldByName('Filler').Value:=Trim(DName);
FieldByName('FillerCode').Value:=Trim(DCode);
FieldByName('Valid').Value:='Y';
Post;
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;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from Image_File where 1=2');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('IMID').Value:=Trim(maxnoIMID);
FieldByName('IFID').Value:=Trim(maxnoIMID)+'X';
FieldByName('IFType').Value:='С';
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite);
AJpeg.Assign(Image1.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
FieldByName('Filler').Value:=Trim(DName);
FieldByName('FillerCode').Value:=Trim(DCode);
FieldByName('Valid').Value:='Y';
Post;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('IMID').Value:=Trim(maxnoIMID);
FieldByName('IFID').Value:=Trim(maxnoIMID)+'D';
FieldByName('IFType').Value:='<27><>';
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite);
AJpeg.Assign(Image2.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
FieldByName('Filler').Value:=Trim(DName);
FieldByName('FillerCode').Value:=Trim(DCode);
FieldByName('Valid').Value:='Y';
Post;
end;
if IdFTP1.Connected then
IdFTP1.Put(lstPat[i], 'TJ'+'\'+Trim(ImageName));
end;
ADOQueryCmd.Connection.CommitTrans;
except
Panel16.Visible:=False;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD>ʧ<EFBFBD><CAA7>!','<27><>ʾ',0);
Exit;
end;
Panel16.Visible:=False;
initimageSH(FWBID);
end;
procedure TfrmHXKYH.THBClick(Sender: TObject);
begin
InitTree();
end;
procedure TfrmHXKYH.FormDestroy(Sender: TObject);
begin
frmHXKYH:=nil;
end;
procedure TfrmHXKYH.TGBClick(Sender: TObject);
begin
Close;
end;
procedure TfrmHXKYH.cxDBTreeList1DblClick(Sender: TObject);
begin
ModalResult:=1;
end;
procedure TfrmHXKYH.BTLPClick(Sender: TObject);
begin
if my<=1 then exit;
my:=my-1;
LBCPAP.Caption:=IntToStr(my)+'/'+inttostr(mz);
initimageSH(Order_Tree.fieldbyname('CPID').AsString);
end;
procedure TfrmHXKYH.BTNPClick(Sender: TObject);
begin
if my>=mz then exit;
my:=my+1;
LBCPAP.Caption:=IntToStr(my)+'/'+inttostr(mz);
initimageSH(Order_Tree.fieldbyname('CPID').AsString);
end;
procedure TfrmHXKYH.cxDBTreeList1Click(Sender: TObject);
var FLevel:integer;
begin
Panel3.Visible:=true;
Panel3.Refresh;
cxDBTreeList1.Enabled:=false;
my:=1;
if Order_Tree.fieldbyname('CPlevel').AsInteger<>3 then
begin
TSH.Visible:=false;
end
else
TSH.Visible:=True;
initimageSH(Trim(Order_Tree.fieldbyname('CPID').AsString));
if adoqueryPicture.IsEmpty=False then
begin
mz:=Ceil(adoqueryPicture.fieldbyname('GS').AsInteger/18);
end else
begin
mz:=1;
end;
LBCPAP.Caption:=IntToStr(my)+'/'+IntToStr(mz);
cxDBTreeList1.Enabled:=True;
Panel3.Visible:=false;
end;
end.