Group_99/D10xhGemei
7
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

改了些小问题

Browse Source
This commit is contained in:
“ddf” 2025-02-20 14:17:49 +08:00
parent 88e76133e3
commit 551a1d77a0
155 changed files with 84258 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
A01基础公司管理/U_CustInput.dfm
View File

@ -3,13 +3,13 @@ inherited frmCustInput: TfrmCustInput
Top = 149
Caption = #23458#25143#36164#26009#24405#20837
ClientHeight = 673
ClientWidth = 1210
ClientWidth = 1600
Font.Charset = GB2312_CHARSET
Font.Height = -16
OldCreateOrder = True
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 1226
ExplicitWidth = 1616
ExplicitHeight = 712
PixelsPerInch = 96
TextHeight = 21
@ -17,7 +17,7 @@ inherited frmCustInput: TfrmCustInput
Tag = 1
Left = 0
Top = 0
Width = 1210
Width = 1600
Height = 30
AutoSize = True
ButtonHeight = 30
@ -30,6 +30,7 @@ inherited frmCustInput: TfrmCustInput
ParentColor = False
ShowCaptions = True
TabOrder = 0
ExplicitWidth = 1210
object ToolButton3: TToolButton
Left = 0
Top = 0
@ -58,7 +59,7 @@ inherited frmCustInput: TfrmCustInput
object ScrollBox1: TScrollBox [1]
Left = 0
Top = 30
Width = 1210
Width = 1600
Height = 255
Align = alTop
BevelInner = bvNone
@ -67,7 +68,7 @@ inherited frmCustInput: TfrmCustInput
Ctl3D = False
ParentCtl3D = False
TabOrder = 1
ExplicitTop = 31
ExplicitWidth = 1210
object Label2: TLabel
Left = 40
Top = 12
@ -374,24 +375,26 @@ inherited frmCustInput: TfrmCustInput
object Panel1: TPanel [2]
Left = 0
Top = 285
Width = 1210
Width = 1600
Height = 388
Align = alClient
Caption = 'Panel1'
TabOrder = 2
ExplicitWidth = 1210
object Panel3: TPanel
Left = 1
Top = 1
Width = 748
Width = 1138
Height = 386
Align = alClient
Caption = 'Panel1'
TabOrder = 0
ExplicitWidth = 748
object ToolBar3: TToolBar
Tag = 1
Left = 1
Top = 1
Width = 746
Width = 1136
Height = 30
AutoSize = True
ButtonHeight = 30
@ -404,6 +407,7 @@ inherited frmCustInput: TfrmCustInput
ParentColor = False
ShowCaptions = True
TabOrder = 0
ExplicitWidth = 746
object ToolButton2: TToolButton
Left = 0
Top = 0
@ -432,11 +436,12 @@ inherited frmCustInput: TfrmCustInput
object cxGrid2: TcxGrid
Left = 1
Top = 31
Width = 746
Width = 1136
Height = 354
Align = alClient
BorderStyle = cxcbsNone
TabOrder = 1
ExplicitWidth = 746
object TV2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
@ -543,13 +548,14 @@ inherited frmCustInput: TfrmCustInput
end
end
object Panel2: TPanel
Left = 749
Left = 1139
Top = 1
Width = 460
Height = 386
Align = alRight
Caption = 'Panel1'
TabOrder = 1
ExplicitLeft = 749
object cxGrid1: TcxGrid
Left = 1
Top = 31

53
A01基础公司管理/U_Customer.dfm
View File

@ -3,13 +3,13 @@ inherited frmCustomer: TfrmCustomer
Top = 169
Caption = #23458#25143#36164#26009#31649#29702
ClientHeight = 537
ClientWidth = 1167
ClientWidth = 1583
Color = clBtnFace
Font.Height = -16
FormStyle = fsMDIChild
Position = poScreenCenter
Visible = True
ExplicitWidth = 1183
ExplicitWidth = 1599
ExplicitHeight = 576
PixelsPerInch = 96
TextHeight = 21
@ -17,7 +17,7 @@ inherited frmCustomer: TfrmCustomer
Tag = 1
Left = 0
Top = 0
Width = 1167
Width = 1583
Height = 30
AutoSize = True
ButtonHeight = 30
@ -31,6 +31,7 @@ inherited frmCustomer: TfrmCustomer
ParentColor = False
ShowCaptions = True
TabOrder = 5
ExplicitWidth = 1167
object TBRafresh: TToolButton
Left = 0
Top = 0
@ -131,7 +132,7 @@ inherited frmCustomer: TfrmCustomer
object Panel1: TPanel [1]
Left = 0
Top = 30
Width = 1167
Width = 1583
Height = 62
Align = alTop
BevelInner = bvRaised
@ -139,6 +140,7 @@ inherited frmCustomer: TfrmCustomer
ParentBackground = False
ParentColor = True
TabOrder = 6
ExplicitWidth = 1167
object Label3: TLabel
Left = 182
Top = 20
@ -223,11 +225,12 @@ inherited frmCustomer: TfrmCustomer
object cxGrid1: TcxGrid [2]
Left = 0
Top = 120
Width = 1167
Width = 1583
Height = 214
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 2
ExplicitWidth = 1167
object Tv1: TcxGridDBTableView
PopupMenu = PopupMenu1
Navigator.Buttons.CustomButtons = <>
@ -392,18 +395,20 @@ inherited frmCustomer: TfrmCustomer
object Panel2: TPanel [3]
Left = 0
Top = 334
Width = 1167
Width = 1583
Height = 203
Align = alBottom
Caption = 'Panel2'
TabOrder = 3
ExplicitWidth = 1167
object cxGrid2: TcxGrid
Left = 1
Top = 1
Width = 598
Width = 1014
Height = 201
Align = alClient
TabOrder = 0
ExplicitWidth = 598
object Tv2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
@ -436,6 +441,20 @@ inherited frmCustomer: TfrmCustomer
Options.Editing = False
Width = 76
end
object Tv2Column2: TcxGridDBColumn
Caption = #22320#22336
DataBinding.FieldName = 'mxaddress'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 111
end
object Tv2Column3: TcxGridDBColumn
Caption = #21306#22495
DataBinding.FieldName = 'mxarea'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 112
end
object cxGridDBColumn1: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'Contacts'
@ -493,32 +512,19 @@ inherited frmCustomer: TfrmCustomer
Options.Editing = False
Width = 169
end
object Tv2Column2: TcxGridDBColumn
Caption = #22320#22336
DataBinding.FieldName = 'mxaddress'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 77
end
object Tv2Column3: TcxGridDBColumn
Caption = #21306#22495
DataBinding.FieldName = 'mxarea'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 74
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv2
end
end
object cxGrid3: TcxGrid
Left = 599
Left = 1015
Top = 1
Width = 567
Height = 201
Align = alRight
TabOrder = 1
ExplicitLeft = 599
object Tv3: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
@ -559,7 +565,7 @@ inherited frmCustomer: TfrmCustomer
object cxTabControl1: TcxTabControl [4]
Left = 0
Top = 92
Width = 1167
Width = 1583
Height = 28
Align = alTop
TabOrder = 4
@ -572,6 +578,7 @@ inherited frmCustomer: TfrmCustomer
#20840#37096)
LookAndFeel.Kind = lfUltraFlat
OnChange = cxTabControl1Change
ExplicitWidth = 1167
ClientRectRight = 0
ClientRectTop = 0
end

3
A05基础资料管理/BaseInfo.dpr
View File

@ -31,7 +31,8 @@ uses
U_globalVar in '..\..\..\public10\design\U_globalVar.pas',
U_WindowFormdesign in '..\..\..\public10\design\U_WindowFormdesign.pas',
uSZHN_JSON in '..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas',
U_printPdf in '..\..\..\public10\ThreeFun\Fun\U_printPdf.pas';
U_printPdf in '..\..\..\public10\ThreeFun\Fun\U_printPdf.pas',
U_EmployeeSel in '..\A00通用窗体\U_EmployeeSel.pas' {frmEmployeeSel};
{$R *.res}

4
A05基础资料管理/BaseInfo.dproj
View File

@ -198,6 +198,10 @@
<DCCReference Include="..\..\..\public10\design\U_WindowFormdesign.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_printPdf.pas"/>
<DCCReference Include="..\A00通用窗体\U_EmployeeSel.pas">
<Form>frmEmployeeSel</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

10
A05基础资料管理/U_MachineInPut.dfm
View File

@ -18,9 +18,6 @@ inherited frmMachineInPut: TfrmMachineInPut
Height = 303
Align = alClient
TabOrder = 0
ExplicitLeft = -8
ExplicitTop = 71
ExplicitHeight = 262
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
@ -63,6 +60,13 @@ inherited frmMachineInPut: TfrmMachineInPut
Caption = #21496#26426
DataBinding.FieldName = 'Driver'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.OnButtonClick = Tv1Column2PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Width = 226
end

31
A05基础资料管理/U_MachineInPut.pas
View File

@ -40,6 +40,7 @@ type
procedure TBSaveClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure Tv1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
private
{ Private declarations }
function SaveCKData(): Boolean;
@ -54,7 +55,7 @@ var
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp;
U_DataLink, U_RTFun, U_ZDYHelp, U_EmployeeSel;
{$R *.dfm}
@ -231,5 +232,33 @@ begin
WriteCxGrid(trim(self.Caption), Tv1, 'ȾɫÅ÷²¼²Ö¿â');
end;
procedure TfrmMachineInPut.Tv1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
inherited;
try
frmEmployeeSel := TfrmEmployeeSel.Create(Application);
with frmEmployeeSel do
begin
FPost := '˾»ú';
if ShowModal = 1 then
begin
// FRCode := Trim(TSpeedButton(Sender).Hint);
// FRName := Trim(TSpeedButton(Sender).Caption);
with self.CDS_Sub do
begin
Edit;
FieldByName('Driver').Value := FRName;
Post;
end;
end;
end;
finally
frmEmployeeSel.Free;
end;
end;
end.

22
A05基础资料管理/U_MachineManage.dfm
View File

@ -18,7 +18,7 @@ inherited frmMachineManage: TfrmMachineManage
Height = 30
AutoSize = True
ButtonHeight = 30
ButtonWidth = 67
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_BaseInfo.cxImageList_bar
@ -36,7 +36,7 @@ inherited frmMachineManage: TfrmMachineManage
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 71
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
@ -44,15 +44,15 @@ inherited frmMachineManage: TfrmMachineManage
Visible = False
end
object ToolButton4: TToolButton
Left = 142
Left = 126
Top = 0
AutoSize = True
Caption = #22686#34892
Caption = #26032#22686
ImageIndex = 9
OnClick = ToolButton4Click
end
object ToolButton6: TToolButton
Left = 213
Left = 189
Top = 0
AutoSize = True
Caption = #20462#25913
@ -60,7 +60,7 @@ inherited frmMachineManage: TfrmMachineManage
OnClick = ToolButton6Click
end
object ToolButton5: TToolButton
Left = 284
Left = 252
Top = 0
AutoSize = True
Caption = #21024#34892
@ -68,7 +68,7 @@ inherited frmMachineManage: TfrmMachineManage
OnClick = ToolButton5Click
end
object ToolButton3: TToolButton
Left = 355
Left = 315
Top = 0
AutoSize = True
Caption = #25171#21360
@ -76,7 +76,7 @@ inherited frmMachineManage: TfrmMachineManage
OnClick = ToolButton3Click
end
object ToolButton1: TToolButton
Left = 426
Left = 378
Top = 0
AutoSize = True
Caption = #23548#20986
@ -84,7 +84,7 @@ inherited frmMachineManage: TfrmMachineManage
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 497
Left = 441
Top = 0
AutoSize = True
Caption = #20851#38381
@ -167,6 +167,7 @@ inherited frmMachineManage: TfrmMachineManage
Caption = #21496#26426
DataBinding.FieldName = 'Driver'
DataBinding.IsNullValueType = True
Options.Editing = False
end
end
object cxGridLevel1: TcxGridLevel
@ -202,6 +203,9 @@ inherited frmMachineManage: TfrmMachineManage
Width = 158
end
end
inherited cxProgressBar2: TcxProgressBar
ExplicitHeight = 29
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_BaseInfo.ADOLink
Left = 113

15
A05基础资料管理/U_MachineManage.pas
View File

@ -233,20 +233,7 @@ begin
finally
frmMachineInPut.Free;
end;
// VNO.SetFocus;
// if GetLSNo(ADOQueryCmd, maxId, 'M', 'Bs_Vehicle', 4, 1) = False then
// begin
// Application.MessageBox('取最大号失败！', '提示', 0);
// Exit;
// end;
// with ADOQueryCmd do
// begin
// Close;
// sql.Clear;
// sql.Add('insert into Bs_Vehicle(Filler) values(' + quotedstr(Trim(dname)) + ')');
// ExecSQL;
// end;
// InitGrid();
end;
procedure TfrmMachineManage.ToolButton5Click(Sender: TObject);

317
T03贸易布匹检验/AES.pas Normal file
View File

@ -0,0 +1,317 @@
(**************************************************)
unit AES;
interface
uses
SysUtils, Classes, Math, ElAES;
type
TKeyBit = (kb128, kb192, kb256);
function StrToHex(Value: string): string;
function HexToStr(Value: string): string;
function EncryptString(Value: string; Key: string;
KeyBit: TKeyBit = kb128): string;
function DecryptString(Value: string; Key: string;
KeyBit: TKeyBit = kb128): string;
function EncryptStream(Stream: TStream; Key: string;
KeyBit: TKeyBit = kb128): TStream;
function DecryptStream(Stream: TStream; Key: string;
KeyBit: TKeyBit = kb128): TStream;
procedure EncryptFile(SourceFile, DestFile: string;
Key: string; KeyBit: TKeyBit = kb128);
procedure DecryptFile(SourceFile, DestFile: string;
Key: string; KeyBit: TKeyBit = kb128);
implementation
function StrToHex(Value: string): string;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(Value) do
Result := Result + IntToHex(Ord(Value[I]), 2);
end;
function HexToStr(Value: string): string;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(Value) do
begin
if ((I mod 2) = 1) then
Result := Result + Chr(StrToInt('0x'+ Copy(Value, I, 2)));
end;
end;
{ -- 字符串加密函数 默认按照 128 位密匙加密 -- }
function EncryptString(Value: string; Key: string;
KeyBit: TKeyBit = kb128): string;
var
SS, DS: TStringStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
Result := '';
SS := TStringStream.Create(Value);
DS := TStringStream.Create('');
try
Size := SS.Size;
DS.WriteBuffer(Size, SizeOf(Size));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey128, DS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey192, DS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey256, DS);
end;
Result := StrToHex(DS.DataString);
finally
SS.Free;
DS.Free;
end;
end;
{ -- 字符串解密函数 默认按照 128 位密匙解密 -- }
function DecryptString(Value: string; Key: string;
KeyBit: TKeyBit = kb128): string;
var
SS, DS: TStringStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
Result := '';
SS := TStringStream.Create(HexToStr(Value));
DS := TStringStream.Create('');
try
Size := SS.Size;
SS.ReadBuffer(Size, SizeOf(Size));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
DecryptAESStreamECB(SS, SS.Size - SS.Position, AESKey128, DS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
DecryptAESStreamECB(SS, SS.Size - SS.Position, AESKey192, DS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
DecryptAESStreamECB(SS, SS.Size - SS.Position, AESKey256, DS);
end;
Result := DS.DataString;
finally
SS.Free;
DS.Free;
end;
end;
{ -- 流加密函数 默认按照 128 位密匙解密 -- }
function EncryptStream(Stream: TStream; Key: string;
KeyBit: TKeyBit = kb128): TStream;
var
Count: Int64;
OutStrm: TStream;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
OutStrm := TStream.Create;
Stream.Position := 0;
Count := Stream.Size;
OutStrm.Write(Count, SizeOf(Count));
try
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(Stream, 0, AESKey128, OutStrm);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(Stream, 0, AESKey192, OutStrm);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(Stream, 0, AESKey256, OutStrm);
end;
Result := OutStrm;
finally
OutStrm.Free;
end;
end;
{ -- 流解密函数 默认按照 128 位密匙解密 -- }
function DecryptStream(Stream: TStream; Key: string;
KeyBit: TKeyBit = kb128): TStream;
var
Count, OutPos: Int64;
OutStrm: TStream;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
OutStrm := TStream.Create;
Stream.Position := 0;
OutPos :=OutStrm.Position;
Stream.ReadBuffer(Count, SizeOf(Count));
try
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
DecryptAESStreamECB(Stream, Stream.Size - Stream.Position,
AESKey128, OutStrm);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
DecryptAESStreamECB(Stream, Stream.Size - Stream.Position,
AESKey192, OutStrm);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
DecryptAESStreamECB(Stream, Stream.Size - Stream.Position,
AESKey256, OutStrm);
end;
OutStrm.Size := OutPos + Count;
OutStrm.Position := OutPos;
Result := OutStrm;
finally
OutStrm.Free;
end;
end;
{ -- 文件加密函数 默认按照 128 位密匙解密 -- }
procedure EncryptFile(SourceFile, DestFile: string;
Key: string; KeyBit: TKeyBit = kb128);
var
SFS, DFS: TFileStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
SFS := TFileStream.Create(SourceFile, fmOpenRead);
try
DFS := TFileStream.Create(DestFile, fmCreate);
try
Size := SFS.Size;
DFS.WriteBuffer(Size, SizeOf(Size));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(SFS, 0, AESKey128, DFS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(SFS, 0, AESKey192, DFS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(SFS, 0, AESKey256, DFS);
end;
finally
DFS.Free;
end;
finally
SFS.Free;
end;
end;
{ -- 文件解密函数 默认按照 128 位密匙解密 -- }
procedure DecryptFile(SourceFile, DestFile: string;
Key: string; KeyBit: TKeyBit = kb128);
var
SFS, DFS: TFileStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
SFS := TFileStream.Create(SourceFile, fmOpenRead);
try
SFS.ReadBuffer(Size, SizeOf(Size));
DFS := TFileStream.Create(DestFile, fmCreate);
try
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
DecryptAESStreamECB(SFS, SFS.Size - SFS.Position, AESKey128, DFS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
DecryptAESStreamECB(SFS, SFS.Size - SFS.Position, AESKey192, DFS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
DecryptAESStreamECB(SFS, SFS.Size - SFS.Position, AESKey256, DFS);
end;
DFS.Size := Size;
finally
DFS.Free;
end;
finally
SFS.Free;
end;
end;
end.

BIN
T03贸易布匹检验/AllSkins.skinres Normal file
View File

Binary file not shown.

538
T03贸易布匹检验/DbPanel/.svn/entries Normal file
View File

@ -0,0 +1,538 @@
10
dir
4312
svn://192.168.71.68/ftsource/mgg/%E9%A9%AC%E5%9B%BD%E9%92%A2%E5%BC%80%E5%8F%91%E4%BB%A3%E7%A0%81/%E9%A1%B9%E7%9B%AE%E4%BB%A3%E7%A0%81/%E5%AF%8C%E5%BC%BA%E7%9A%AE%E5%A1%91/%E4%BA%BA%E4%BA%8B/KQEnter(%E8%80%83%E5%8B%A4EXE)/DbPanel
svn://192.168.71.68/ftsource
2011-09-05T04:33:21.203125Z
4312
mgg
ef2f1445-a04c-0b43-b547-5002d5acc4ff
dbpanel.dcu
file
2005-06-29T10:14:56.000000Z
8b826c9850c49392add3d17d2a732535
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
17512
L_DBDateTime.dcr
file
1999-12-04T03:57:56.000000Z
8e404868006b2df037d388cd91c03f5b
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
2164
JKFootpanel.dcu
file
2006-02-07T01:38:42.000000Z
3dfed577d2b0cbe7a26ce0543bb78500
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
12497
Dbpanel.pas
file
2005-06-29T10:14:26.000000Z
f90d83413145b739d30cdf376104bf2d
2011-09-05T04:33:21.203125Z
4312
mgg
12415
L_DBDateTime.dcu
file
2006-07-20T13:00:32.000000Z
209b4061eeeb5526ddf939cdde0f62c0
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
6578
JKFootpanel.pas
file
2005-12-31T09:01:50.000000Z
3cedd12399fd69e1f190208ae53a85e8
2011-09-05T04:33:21.203125Z
4312
mgg
10303
JkPanel.dcu
file
2006-02-07T01:38:42.000000Z
31c43b5168a7049bf83acd8bd7f45548
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
42037
L_DBDateTime.pas
file
2000-02-16T08:06:06.000000Z
d74c282fada89437bf2713438c9d511a
2011-09-05T04:33:21.203125Z
4312
mgg
3629
MovePanel.dcu
file
2006-07-20T13:00:32.000000Z
24189494b4f07ee2147946e7a732a8e8
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
4292
AutoPanel.dcu
file
2006-07-19T07:05:22.000000Z
f2a4b17861f738dd07402899b1fba98b
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
33997
dsr.dcu
file
2011-01-10T08:00:04.700500Z
7dc76d775b292ca12e4e18bd2cf82a62
2011-09-05T04:33:21.203125Z
4312
mgg
has-props
6467
JkPanel.pas
file
2006-02-07T01:35:12.000000Z
895ae606414168977b3a1d3fb99a0a87
2011-09-05T04:33:21.203125Z
4312
mgg
39429
MovePanel.pas
file
2005-07-01T01:00:14.000000Z
a7c721193dc82acd02386489752554fd
2011-09-05T04:33:21.203125Z
4312
mgg
1998
AutoPanel.pas
file
2005-10-19T01:47:14.000000Z
ccea78917a93c0ff2f549dd98ae9e101
2011-09-05T04:33:21.203125Z
4312
mgg
24603
dsr.pas
file
2006-02-06T07:55:00.000000Z
a2af085bce0f5fd3cbf187eb65d5e17d
2011-09-05T04:33:21.203125Z
4312
mgg
9279

5
T03贸易布匹检验/DbPanel/.svn/prop-base/AutoPanel.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/JKFootpanel.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/JkPanel.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/L_DBDateTime.dcr.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/L_DBDateTime.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/MovePanel.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/dbpanel.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

5
T03贸易布匹检验/DbPanel/.svn/prop-base/dsr.dcu.svn-base Normal file
View File

@ -0,0 +1,5 @@
K 13
svn:mime-type
V 24
application/octet-stream
END

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/AutoPanel.dcu.svn-base Normal file
View File

Binary file not shown.

707
T03贸易布匹检验/DbPanel/.svn/text-base/AutoPanel.pas.svn-base Normal file
View File

@ -0,0 +1,707 @@
unit AutoPanel;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
ExtCtrls,dbctrls,stdctrls,db,ADODB,ComCtrls,Variants,Gauges,
SqlExpr,DBGrids,MovePanel;
type
TEditorstyle = (TsMemo,Tscombox,Tsedit);
type
TAutoPanel = class(TPanel)
private
{ Private declarations }
FEditorstyle:Teditorstyle;
FLeft :Integer;
FTop :Integer;
maxTextLen :Integer;
maxLabelLen :Integer;
FTitleVisible :Boolean;
FDataReadOnly :Boolean;
FPageCount :Integer;
FPass_Grid :TDBGrid;
FP_Move :TMovePanel;
FP_Parent :TPanel;
FPageControl: TPageControl; {分页控件}
FTabSheets :array of TTabSheet;
FScrollBox :array of TScrollBox; {滚动控件}
FLineHeight :Integer;
//数据数组控件，动态生成
MemoEditors :array of TMemo;
comEditors :array of TCombobox;
edEditors :array of Tedit;
ProgressEditor :array of Tedit;
Labels :array of TLabel; //字段标题，动态生成
ProgressBars :array of TGauge;
Shapes :array of TShape;
FDataSource :TDataSource; // 数据源
FDataField_A :String; // DataField
FDataField_B :String; // DataField
FDataField_C :String; // DataField
FDataField_D :String; // DataField
FDataField_E :String; // DataField
FDataField_F :String; // DataField
FStore :String;
Fcnnstr :String;
FListSql :String;
FBerthFieldName :String;
FStoreFieldName :String;
FBerthTableName :String;
FColumns :Integer; //显示列数
tmpado :TadoDataset;
tmpDs :TDataSource;
procedure FreeEditors; //释放数据输入控件的内存
procedure AKeyDown(Sender:TObject; var Key :Word; Shift:TShiftState);
procedure AKeyPress(Sender:TObject; var Key :Char);
procedure AProgressEditorChange(Sender :TObject);
procedure inti_Grid(sender :TObject);
procedure LabelsClick(Sender: TObject);
procedure FP_MovePanelDblClick(Sender: TObject);
function comEditor(Index :Integer):TComboBox;
function edEditor(Index :Integer):Tedit;
function MemoEditor(Index :Integer) :TMemo;
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Setedit(Value :TEditorstyle);
procedure CreateEditors(var DS :TDataSource; cnnstr :String); //创建各字段的数据输入控件
procedure ClearHits(ItemIndex :Integer);
procedure AddHits(ItemIndex:Integer; Hits :array of string);
{ Public declarations }
published
property LimitLeft :Integer read FLeft write FLeft default 10;
property LimitTop :Integer read FTop write FTop default 10;
property Editorstyle :TEditorstyle read FEditorstyle write Setedit default TsMemo;
property EditorWidth :Integer read maxTextLen write maxTextLen default 100;
property TitleWidth :Integer read maxLabelLen write maxLabelLen default 100;
property TitleVisible :Boolean read FTitleVisible write FTitleVisible default True;
property DataReadOnly :Boolean read FDataReadOnly write FDataReadOnly; //default True;
property LineHeight :Integer read FLineHeight write FLineHeight default 15;
property DataSource :TDataSource read FDataSource write FDataSource; //数据源
property DataField_Editor :String read FDataField_A write FDataField_A;
property DataField_Title :String read FDataField_B write FDataField_B;
property DataField_Progress :String read FDataField_C write FDataField_C;
property DataField_BerthArea :String read FDataField_D write FDataField_D;
property DataField_IconLeft :String read FDataField_E write FDataField_E;
property DataField_IconTop :String read FDataField_F write FDataField_F;
property Data_BerthListSql :String read FListSql write FListSql;
property Data_BerthField :String read FBerthFieldName write FBerthFieldName;
property Data_StoreField :String read FStoreFieldName write FStoreFieldName;
property Data_BerthTable :String read FBerthTableName write FBerthTableName;
property Store_Name :String read FStore write FStore;
property Columns :Integer read FColumns write FColumns default 4;//表列数
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TAutoPanel]);
end;
procedure TAutoPanel.Setedit(Value :TEditorstyle);
begin
if FEditorstyle <> Value then
begin
FEditorstyle := Value;
Invalidate;
end;
end;
{ 为第I字段增加提示信息的方法}
procedure TAutoPanel.AddHits(ItemIndex :Integer; Hits :array of string);
var
m,n,i :Integer;
begin
if FEditorstyle = Tscombox then
begin
n := Length(comEditors);
m := Length(Hits);
if ItemIndex< n then
for i:= 0 to m - 1 do
comEditors[ItemIndex].Items.Add(Hits[i]);
end
else if FEditorstyle = Tsedit then
begin
n := Length(edEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
edEditors[ItemIndex].Hint:= Hits[i];
end
else if FEditorstyle = TsMemo then
begin
n := Length(memoEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
memoEditors[ItemIndex].Hint:= Hits[i];
end;
end;
procedure TAutoPanel.AKeyDown(Sender :TObject; var Key :Word; Shift :TShiftState);
begin
//
end;
procedure TAutoPanel.AProgressEditorChange(Sender :TObject);
begin
//
end;
procedure TAutoPanel.AKeyPress(Sender :TObject; var Key :Char);
begin
if (Sender is TComboBox) or (Sender is Tedit) or (Sender is TMemo) then
if Key=#13 then
(Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TAutoPanel.ClearHits(ItemIndex :Integer);
var
n :Integer;
begin
if FEditorstyle = Tscombox then
begin
n := Length(comEditors);
if ItemIndex< n then comEditors[ItemIndex].Items.Clear;
end
else if FEditorstyle = Tsedit then
begin
n := Length(edEditors);
if ItemIndex< n then edEditors[ItemIndex].Hint:='';;
end
else if FEditorstyle = TsMemo then
begin
n := Length(MemoEditors);
if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';;
end;
end;
constructor TAutoPanel.Create(AOwner :TComponent);
begin
Inherited Create(AOWner);
FLeft := 20;
FTop := 20;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
FTitleVisible := True;
FDataReadOnly := True;
end;
{ 创建各字段的数据输入控件的方法}
procedure TAutoPanel.CreateEditors(var DS :TDataSource; cnnstr :String);
var
i,j,n,This_Index,TextHeight :Integer;
tmp_col0,Tmp_Row0,tmp_col1,Tmp_Row1 :Integer;
XXX :TStringList;
tmpFlag :Boolean;
begin
if (Store_Name = '')
or (Data_BerthTable = '')
or (DataField_BerthArea = '') then
exit;
{ 释放全部控件内存}
FreeEditors;
if DS = nil then exit;
if DataSource = nil then FDataSource := Ds;
if not DataSource.DataSet.Active then exit;
if (DataSource.DataSet is TAdoDataSet) = False then exit;
FPageCount := 0;
tmp_col1 := -1;
Tmp_Row1 := 0;
n := DataSource.DataSet.RecordCount;
if n <= 0 then exit;
DataSource.DataSet.DisableControls;
if maxLabelLen < maxTextLen then
maxTextLen := maxLabelLen;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 分配内存}
SetLength(Labels,n);
SetLength(ProgressBars,n);
SetLength(ProgressEditor,n);
SetLength(Shapes,n);
if Columns = 0 then Columns := 6;
try
tmpado := TadoDataset.Create(Owner);
tmpDs := TDatasource.Create(Owner);
tmpDs.DataSet := tmpado;
with tmpado do
begin
Active := False;
Fcnnstr := cnnstr;
tmpado.ConnectionString := Fcnnstr;
//tmpado.Connection := (DataSource.DataSet as TAdoDataset).Connection;
tmpado.CommandText := ' Select '+DataField_BerthArea+' '
+ ' from '+Data_BerthTable+' where '+DataField_BerthArea+' is not null'
+ ' and '+Data_StoreField+' = '''+Store_Name+''''
+ ' Group by '+DataField_BerthArea+' order by '+DataField_BerthArea+'';
Active := True;
FPageCount := RecordCount;
if FPageCount = 0 then exit;
first;
// 创建PageControl
FPageControl := TPageControl.Create(Owner);
FPageControl.Parent := Self;
FPageControl.Font.Name := '宋体';
FPageControl.Font.Size := 9;
FPageControl.Align := alClient;
FPageControl.Visible := False;
{ 分配载体内存}
setlength(FTabSheets,FPageCount+1);
setlength(FScrollBox,FPageCount+1);
XXX := TStringList.Create();
for j := 0 to FPageCount do
begin
{ FPageControl分页}
FTabSheets[j] := TTabSheet.Create(Owner);
FTabSheets[j].Parent := FPageControl;
FTabSheets[j].ParentFont := True;
FTabSheets[j].PageControl := FPageControl;
FTabSheets[j].Visible := True;
FTabSheets[j].PageIndex := j;
if j < FPageCount then
begin
FTabSheets[j].Caption := '库区：' + trim(fieldByName(DataField_BerthArea).AsString);
FTabSheets[j].Hint := trim(fieldByName(DataField_BerthArea).AsString);
XXX.Append(trim(fieldByName(DataField_BerthArea).AsString));
end
else
begin
FTabSheets[j].Caption := '未指定库区';
FTabSheets[j].Hint := '';
XXX.Append('未指定库区');
end;
FTabSheets[j].ShowHint := False;
FTabSheets[j].Visible := True;
FTabSheets[j].Align := alClient;
//创建滚动盒
FScrollBox[j] := TScrollBox.Create(Owner);
FScrollBox[j].Visible := True;
FScrollBox[j].Parent := FTabSheets[j];
FScrollBox[j].Color := ClBlack;//clTeal;
FScrollBox[j].Align := alClient;
FScrollBox[j].Hint := FTabSheets[j].Hint;
FScrollBox[j].ShowHint := False;
next;
end;
end;
if FEditorstyle = Tscombox then
SetLength(comEditors,n)
else if FEditorstyle = Tsedit then
SetLength(edEditors,n)
else
SetLength(MemoEditors,n);
{ 创建编辑}
for i := 0 to n - 1 do
begin
//DataField_BerthArea
if DataSource.DataSet.Fieldbyname(DataField_BerthArea).AsVariant = null then
This_Index := FPageCount
else
This_Index := XXX.IndexOf(trim(DataSource.DataSet.Fieldbyname(DataField_BerthArea).Asstring));
tmpFlag := False;
if DataSource.DataSet.Fieldbyname(DataField_IconLeft).AsVariant <> null then
tmp_col0 := DataSource.DataSet.Fieldbyname(DataField_IconLeft).Asinteger -1
else
begin
tmpFlag := True;
if tmp_col1 = Columns -1 then
begin
tmp_col1 := 0;
tmp_Row1 := tmp_Row1 +1;
end
else
tmp_col1 := tmp_col1 + 1;
tmp_col0 := tmp_col1;
This_Index := FPageCount;
end;
if DataSource.DataSet.Fieldbyname(DataField_IconTop).AsVariant <> null then
tmp_Row0 := DataSource.DataSet.Fieldbyname(DataField_IconTop).Asinteger - 1
else
begin
if not tmpFlag then
begin
if tmp_col1 = Columns - 1 then
begin
tmp_col1 := 0;
tmp_Row1 := tmp_Row1 +1;
end
else
tmp_col1 := tmp_col1 + 1;
end;
tmp_Row0 := tmp_Row1;
This_Index := FPageCount;
end;
{ 创建标题}
Labels[i] := TLabel.Create(owner);
Labels[i].visible := FTitleVisible;
Labels[i].Parent := (FScrollBox[This_Index] as TScrollBox); // FScrollBox[This_Index];
Labels[i].Font.Name := '宋体';
Labels[i].Font.Size := 9;
Labels[i].Font.Color := ClBlue;
Labels[i].OnClick := LabelsClick;
//Labels[i].Font.Style := [FsBold];
Labels[i].Transparent := True;
if DataSource.DataSet.Fieldbyname(DataField_Title).AsVariant <> null then
Labels[i].caption := DataSource.DataSet.Fieldbyname(DataField_Title).AsString
else
Labels[i].caption := '';
Labels[i].Hint := '库位：[' + Labels[i].caption + ']';
Labels[i].ShowHint := True;
if FEditorstyle = TsMemo then
begin
Labels[i].Top := FTop + tmp_Row0 * (TextHeight*3+30) + 2;
Labels[i].Left := FLeft + (maxLabelLen + 40) * tmp_Col0 + 10;
Labels[i].Width := maxLabelLen;
end
else
begin
Labels[i].Top := FTop + tmp_Row0 * (TextHeight*2+30) + 2;
Labels[i].Left := FLeft + (maxLabelLen + 30) * tmp_Col0 + 10;
Labels[i].Width := maxLabelLen;
end;
{ 创建进度条数据对象}
ProgressEditor[i] := Tedit.Create(Owner);
ProgressEditor[i].visible := False;
ProgressEditor[i].Parent := FScrollBox[This_Index];
if DataSource.DataSet.Fieldbyname(DataField_Progress).AsVariant <> null then
ProgressEditor[i].Text := DataSource.DataSet.Fieldbyname(DataField_Progress).AsString
else
ProgressEditor[i].Text := '0';
ProgressEditor[i].OnChange := AProgressEditorChange;
{ 创建信息显示数据对象}
if FEditorstyle = Tscombox then
begin
comEditors[i] := TComboBox.Create(Owner);
comEditors[i].Parent := FScrollBox[This_Index]; //Self;
comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
comEditors[i].Width := maxTextLen;
comEditors[i].Top := Labels[i].Top+20;
if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then
comEditors[i].Text := DataSource.DataSet.Fieldbyname(DataField_Editor).AsString;
comEditors[i].OnKeyPress := AKeyPress;
comEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TGauge.Create(Owner);
ProgressBars[i].Parent := FScrollBox[This_Index];
ProgressBars[i].Font.name := '宋体';
ProgressBars[i].Font.Size := 9;
ProgressBars[i].ShowText := True;
ProgressBars[i].Font.Color := ClWindow;
ProgressBars[i].Kind := gkHorizontalBar;
ProgressBars[i].Left := comEditors[i].Left;
ProgressBars[i].Width := comEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := comEditors[i].Top+comEditors[i].height+2;
ProgressBars[i].Progress := Round((DataSource.DataSet
.Fieldbyname(DataField_Progress).Ascurrency)*100);
end
else if FEditorstyle = Tsedit then
begin
edEditors[i] := Tedit.Create(Owner);
edEditors[i].Parent := FScrollBox[This_Index];
edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
edEditors[i].Width := maxTextLen;
edEditors[i].Top := Labels[i].Top+20;
edEditors[i].ReadOnly := DataReadOnly;
if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then
edEditors[i].Text := DataSource.DataSet.Fieldbyname(DataField_Editor).AsString;
edEditors[i].OnKeyPress := AKeyPress;
edEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TGauge.Create(Owner);
ProgressBars[i].Parent := FScrollBox[This_Index];
ProgressBars[i].Font.name := '宋体';
ProgressBars[i].Font.Size := 9;
ProgressBars[i].ShowText := True;
ProgressBars[i].Font.Color := ClWindow;
ProgressBars[i].Kind := gkHorizontalBar;
ProgressBars[i].Left := edEditors[i].Left;
ProgressBars[i].Width := edEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := edEditors[i].Top+edEditors[i].height+2;;
ProgressBars[i].Progress := Round((DataSource.DataSet
.Fieldbyname(DataField_Progress).Ascurrency)*100);
end
else
begin
MemoEditors[i] := Tmemo.Create(Owner);
MemoEditors[i].Parent := FScrollBox[This_Index];
MemoEditors[i].Left := Labels[i].Left;
MemoEditors[i].Width := maxTextLen;
MemoEditors[i].Top := Labels[i].Top+20;
MemoEditors[i].Height := 60;
MemoEditors[i].ReadOnly := DataReadOnly;
if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then
MemoEditors[i].Lines.Add(DataSource.DataSet.Fieldbyname(DataField_Editor).AsString);
MemoEditors[i].OnKeyPress := AKeyPress;
MemoEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TGauge.Create(Owner);
ProgressBars[i].Parent := FScrollBox[This_Index];
ProgressBars[i].Font.name := '宋体';
ProgressBars[i].Font.Size := 9;
ProgressBars[i].ShowText := False;
ProgressBars[i].Font.Color := ClWindow;
ProgressBars[i].Kind := gkVerticalBar;
ProgressBars[i].Left := MemoEditors[i].Left + MemoEditors[i].Width +1;
ProgressBars[i].Width := 10;
ProgressBars[i].Height := MemoEditors[i].Height;
ProgressBars[i].Top := MemoEditors[i].Top;
ProgressBars[i].Progress := Round((DataSource.DataSet
.Fieldbyname(DataField_Progress).Ascurrency)*100);
end;
if ProgressBars[i].Progress <= 20 then
ProgressBars[i].ForeColor := RGB(48,48,96)
else if (ProgressBars[i].Progress > 20) and (ProgressBars[i].Progress <= 40) then
ProgressBars[i].ForeColor := RGB(48,48,144)
else if (ProgressBars[i].Progress > 40) and (ProgressBars[i].Progress <= 60) then
ProgressBars[i].ForeColor := RGB(96,48,144)
else if (ProgressBars[i].Progress > 60) and (ProgressBars[i].Progress <= 80) then
ProgressBars[i].ForeColor := RGB(144,48,144)
else if ProgressBars[i].Progress > 80 then
ProgressBars[i].ForeColor := RGB(200,48,48);
Shapes[i] := TShape.Create(Owner);
Shapes[i].Parent := FScrollBox[This_Index];
Shapes[i].Left := Labels[i].Left - 10;
Shapes[i].top := Labels[i].Top - 10;
if FEditorstyle = TsMemo then
begin
Shapes[i].height := ProgressBars[i].height + Labels[i].height +20 +10;
Shapes[i].Width := (ProgressBars[i].left - Labels[i].left) + ProgressBars[i].Width + 20;
end
else
begin
Shapes[i].height := (ProgressBars[i].Top - Labels[i].Top) + ProgressBars[i].Height + 20;
Shapes[i].Width := Labels[i].Width +20;
end;
Shapes[i].Brush.Color := clSkyBlue;
Shapes[i].Visible := True;
Shapes[i].SendToBack;
if not DataSource.DataSet.Eof then
DataSource.DataSet.next;
end;
DataSource.DataSet.EnableControls;
tmpado.Close;
XXX.Free;
if FPageControl.PageCount > 0 then
begin
FPageControl.ActivePageIndex := FPageControl.PageCount-1;
FPageControl.ActivePageIndex := 0;
end;
Finally
FPageControl.Visible := True;
end;
end;
destructor TAutoPanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;
function TAutoPanel.comEditor(Index :Integer) :TComboBox;
begin
if Index< Length(comEditors) then Result := comEditors[Index]
else Result := nil;
end;
function TAutoPanel.edEditor(Index :Integer) :Tedit;
begin
if Index < Length(edEditors) then Result := edEditors[Index]
else Result := nil;
end;
function TAutoPanel.MemoEditor(Index :Integer) :TMemo;
begin
if Index< Length(MemoEditors) then Result := MemoEditors[Index]
else Result := nil;
end;
procedure TAutoPanel.inti_Grid(sender :TObject);
begin
try
// 创建FP_Parent
FP_Parent := TPanel.Create(Owner);
with FP_Parent Do
begin
Parent := Self;
Visible := False;
Font.Name := '宋体';
Font.Size := 9;
Font.Style:= [fsBold];
Align := AlNone;
BevelInner := bvLowered;
BevelOuter := bvRaised;
Width := 380;
Height := 250;
try
Left := round(((Sender as Tlabel).Parent.Width-380)/2);
Top := round(((Sender as Tlabel).Parent.height-250)/2);
except
Left := 0;
Top := 0;
end;
end;
FP_Move := TMovePanel.Create(Owner);
with FP_Move do
begin
Parent := FP_Parent;
ParentFont := true;
BevelInner := bvLowered;
BevelOuter := bvRaised;
Height := 26;
Align := AlTop;
Color := clSkyBlue;
Caption := '';
OnDblClick := FP_MovePanelDblClick;
Visible := True;
end;
FPass_Grid := TDBGrid.Create(Owner);
with FPass_Grid do
begin
Parent := FP_Parent;
ParentFont := true;
Font.Style:= [];
Align := AlClient;
Visible := True;
DataSource := TmpDs;
end;
except
FPass_Grid := Nil;
FP_Move := Nil;
FP_Parent := Nil;
end;
end;
//响应Labels[i]的Click事件
procedure TAutoPanel.LabelsClick(Sender: TObject);
var
i :integer;
Tmp_Area,Tmp_Berth :String;
begin
try
if FP_Parent = nil then inti_Grid(Sender);
if FP_Parent = nil then exit;
Tmp_Berth := trim((Sender as Tlabel).Caption);
Tmp_Area := trim(((Sender as Tlabel).Parent as TScrollBox).Hint);
if tmpado.Active then
begin
if tmpado.FieldValues['库位'] <> null then
if tmpado.FieldByName('库位').AsString = Tmp_Berth then
exit;
end;
screen.Cursor := crSQLWait;
//FP_Parent.Visible := False;
//FP_Parent.Left := FPageControl.Left + (Sender as Tlabel).Left + (Sender as Tlabel).Width + 28;
//FP_Parent.Top := FPageControl.Top + (Sender as Tlabel).top + (Sender as Tlabel).Height +4;
FP_Move.Caption := trim((Sender as Tlabel).Hint) + '明细列表';
with tmpado do
begin
DisableConTrols;
Active := False;
ConnectionString := Fcnnstr;
tmpado.CursorType := ctStatic;
tmpado.LockType := ltReadOnly;
CommandText := 'Exec '+Data_BerthListSql+' '''+Store_Name+''','''+Tmp_Area+''','''+Tmp_Berth+'''';
Active := True;
First;
EnableConTrols;
for i := 0 to Fields.Count -1 do
begin
Fields[i].Alignment := taCenter;
if i = 0 then
fields[i].DisplayWidth := 20
else
fields[i].DisplayWidth := 8;
Fpass_Grid.Columns[i].Title.Alignment := taCenter;
Fpass_Grid.Columns[i].Title.Font.Style:= [];
end;
end;
screen.Cursor := crDefault;
FP_Parent.Visible := True;
except
screen.Cursor := crDefault;
end;
end;
procedure TAutoPanel.FP_MovePanelDblClick(Sender: TObject);
begin
FP_Parent.Visible := False;
end;
// 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时
procedure TAutoPanel.FreeEditors;
begin
if FPageControl <> nil then
begin
if FP_Parent <> nil then
begin
try
FPass_Grid.Free;
FP_Move.Free;
FP_Parent.Free;
except
//
end;
end;
FPass_Grid := nil;
FP_Move := nil;
FP_Parent := nil;
Shapes := nil;
ProgressBars := nil;
comEditors := nil;
edEditors := nil;
MemoEditors := nil;
FScrollBox := nil;
tmpDs.Free;
tmpado.Free;
FPageControl.Free;
end;
end;
end.

380
T03贸易布匹检验/DbPanel/.svn/text-base/Dbpanel.pas.svn-base Normal file
View File

@ -0,0 +1,380 @@
unit Dbpanel;
interface
uses
Windows, Messages, SysUtils, Classes,Graphics, Controls, Forms, Dialogs,
ExtCtrls, dbctrls, stdctrls, db, ADODB, ComCtrls;
type
TEditorstyle = (TsDbMemo,TsDBcombox,Tsdbedit);
type
TDBPanel = class(TPanel)
private
{ Private declarations }
FEditorstyle:Teditorstyle;
FLeft: Integer;
FTop: Integer;
maxTextLen: Integer;
maxLabelLen: Integer;
FTitleVisible :Boolean;
FScrollBox: TScrollBox; {滚动控件}
FLineHeight: Integer;
//数据数组控件，动态生成
MemoEditors: array of TDBMemo;
comEditors: array of TDBCombobox;
edEditors: array of TDBedit;
ProgressEditor :array of TDBedit;
Labels: array of TDBText; //字段标题，动态生成
ProgressBars: array of TProgressBar;
FDataSource: TDataSource; // 数据源
FDataField_A: String; // DataField
FDataField_B: String; // DataField
FDataField_C: String; // DataField
FColumns: Integer; //显示列数
procedure FreeEditors; //释放数据输入控件的内存
procedure AKeyDown(Sender:TObject; var Key: Word; Shift:TShiftState);
procedure AKeyPress(Sender:TObject; var Key: Char);
procedure AProgressEditorChange(Sender: TObject);
function comEditor(Index: Integer):TDBComboBox;
function edEditor(Index: Integer):TDBedit;
function MemoEditor(Index: Integer): TDBMemo;
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
function Get_TitleVisible() :Boolean;
procedure Set_TitleVisible(Value : Boolean);
procedure Setedit(Value : TEditorstyle);
procedure CreateEditors(DS: TDataSource; ColCount: Integer); //创建各字段的数据输入控件
procedure ClearHits(ItemIndex: Integer);
procedure AddHits(ItemIndex:Integer; Hits: array of string);
{ Public declarations }
published
property LimitLeft: Integer read FLeft write FLeft default 10;
property LimitTop: Integer read FTop write FTop default 10;
property Editorstyle : TEditorstyle read FEditorstyle write Setedit default tsdbMemo;
property EditorWidth: Integer read maxTextLen write maxTextLen default 100;
property TitleWidth: Integer read maxLabelLen write maxLabelLen default 100;
property TitleVisible : Boolean read Get_TitleVisible write Set_TitleVisible default True;
property LineHeight: Integer read FLineHeight write FLineHeight default 15;
//property OnOkClick: TNotifyEvent read FClick write FClick;
property DataSource: TDataSource read FDataSource write FDataSource; //数据源
property DataField_Editor: String read FDataField_A write FDataField_A;
property DataField_Title: String read FDataField_B write FDataField_B;
property DataField_Progress: String read FDataField_C write FDataField_C;
property Columns: Integer read FColumns write FColumns default 4;//表列数
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TDBPanel]);
end;
function TDBPanel.Get_TitleVisible() :Boolean;
begin
Result := FTitleVisible;
end;
procedure TDBPanel.Set_TitleVisible(Value : Boolean);
begin
FTitleVisible := Value;
end;
procedure TDBPanel.Setedit(Value : TEditorstyle);
begin
if FEditorstyle <> Value then
begin
FEditorstyle := Value;
Invalidate;
end;
end;
{ 为第I字段增加提示信息的方法}
procedure TDBPanel.AddHits(ItemIndex:
Integer; Hits: array of string);
var
m,n,i: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
comEditors[ItemIndex].Items.Add(Hits[i]);
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
edEditors[ItemIndex].Hint:= Hits[i];
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(memoEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
memoEditors[ItemIndex].Hint:= Hits[i];
end;
end;
procedure TDBPanel.AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Sender is TDBComboBox) then
begin
case Key of
VK_Next: (Sender as TDBComboBox).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBComboBox).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBedit) then
begin
case Key of
VK_Next: (Sender as TDBedit).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBedit).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBMemo) then
begin
case Key of
VK_Next: (Sender as TDBMemo).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBMemo).DataSource.DataSet.Prior;
end;
end;
end;
procedure TDBPanel.AProgressEditorChange(Sender: TObject);
begin
//
end;
procedure TDBPanel.AKeyPress(Sender: TObject; var Key: Char);
begin
if (Sender is TDBComboBox) or (Sender is TDBedit) or (Sender is TDBMemo) then
if Key=#13 then
(Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TDBPanel.ClearHits(ItemIndex: Integer);
var
n: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
if ItemIndex< n then comEditors[ItemIndex].Items.Clear;
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
if ItemIndex< n then edEditors[ItemIndex].Hint:='';;
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(MemoEditors);
if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';;
end;
end;
constructor TDBPanel.Create(AOwner: TComponent);
begin
Inherited Create(AOWner);
FLeft :=10;
FTop := 10;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
end;
{ 创建各字段的数据输入控件的方法}
procedure TDBPanel.CreateEditors(DS: TDataSource; ColCount: Integer);
var
i, n, RowCount: Integer;
TextHeight: Integer;
begin
if DataSource = nil then exit;
if not DataSource.DataSet.Active then exit;
n := DataSource.DataSet.RecordCount;
if n > 0 then
begin
DataSource.DataSet.DisableControls;
if maxLabelLen < maxTextLen then
maxTextLen := maxLabelLen;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 计算行列数}
if (FColumns = 0) or (FColumns <> ColCount) then FColumns := ColCount;
RowCount := n div Columns;
if n mod Columns <> 0 then inc(RowCount);
{ 分配内存}
FreeEditors;
SetLength(Labels,n);
SetLength(ProgressBars,n);
SetLength(ProgressEditor,n);
if FEditorstyle = TsDBcombox then
SetLength(comEditors,n)
else if FEditorstyle = TsDBEdit then
SetLength(edEditors,n)
else
SetLength(MemoEditors,n);
{ 创建滚动盒}
FScrollBox := TScrollBox.Create(Owner);
FScrollBox.Visible := False;
FScrollBox.Parent := Self;
FScrollBox.Align := alClient;
{ 创建编辑}
for i := 0 to n - 1 do
begin
{ 创建标题}
Labels[i] := TDBText.Create(Owner);
Labels[i].visible := FTitleVisible;
Labels[i].Parent := FScrollBox;
Labels[i].DataField := DataField_Title;
Labels[i].DataSource := DataSource;
Labels[i].Left := FLeft + (maxLabelLen + 36) * (i div RowCount)+16; //+maxTextLen
if FEditorstyle = TsDBMemo then
begin
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*4+10) + 2;
end
else
begin
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*2+10) + 2;
Labels[i].Width := maxLabelLen;
end;
{ 创建进度条数据对象}
ProgressEditor[i] := TDBedit.Create(Owner);
ProgressEditor[i].visible := False;
ProgressEditor[i].Parent := FScrollBox;
ProgressEditor[i].DataField := DataField_Progress;
ProgressEditor[i].DataSource := DataSource;
ProgressEditor[i].OnChange := AProgressEditorChange;
{ 创建信息显示数据对象}
if FEditorstyle = TsDBcombox then
begin
comEditors[i] := TDBComboBox.Create(Owner);
comEditors[i].Parent := FScrollBox; //Self;
comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
comEditors[i].Width := maxTextLen;
comEditors[i].Top := Labels[i].Top+20;
comEditors[i].DataSource := DataSource;
comEditors[i].DataField := DataField_Editor;
comEditors[i].OnKeyPress := AKeyPress;
comEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TProgressBar.Create(Owner);
ProgressBars[i].Parent := FScrollBox;
ProgressBars[i].Orientation := pbHorizontal;
ProgressBars[i].Left := comEditors[i].Left;
ProgressBars[i].Width := comEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := comEditors[i].Top+comEditors[i].height+2;
ProgressBars[i].Position := i*4
end
else if FEditorstyle = TsDBEdit then
begin
edEditors[i] := TDBedit.Create(Owner);
edEditors[i].Parent := FScrollBox;
edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
edEditors[i].Width := maxTextLen;
edEditors[i].Top := Labels[i].Top+20;
edEditors[i].DataSource := DataSource;
edEditors[i].DataField := DataField_Editor;
edEditors[i].OnKeyPress := AKeyPress;
edEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TProgressBar.Create(Owner);
ProgressBars[i].Parent := FScrollBox;
ProgressBars[i].Orientation := pbHorizontal;
ProgressBars[i].Left := edEditors[i].Left;
ProgressBars[i].Width := edEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := edEditors[i].Top+edEditors[i].height+2;;
ProgressBars[i].Position := i*4
end
else
begin
MemoEditors[i] := TDBmemo.Create(Owner);
MemoEditors[i].Parent := FScrollBox;
MemoEditors[i].Left := Labels[i].Left;
MemoEditors[i].Width := maxTextLen;
MemoEditors[i].Top := Labels[i].Top+20;
MemoEditors[i].DataSource := DataSource;
MemoEditors[i].DataField := DataField_Editor;
MemoEditors[i].OnKeyPress := AKeyPress;
MemoEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TProgressBar.Create(Owner);
ProgressBars[i].Parent := FScrollBox;
ProgressBars[i].Orientation := pbVertical;
ProgressBars[i].Left := MemoEditors[i].Left + MemoEditors[i].Width +1;
ProgressBars[i].Width := 10;
ProgressBars[i].Height := MemoEditors[i].Height;
ProgressBars[i].Top := MemoEditors[i].Top;
ProgressBars[i].Position := i*4
end;
if not DataSource.DataSet.Eof then
DataSource.DataSet.next;
end;
DataSource.DataSet.EnableControls;
FScrollBox.Visible := True;
end;
end;
destructor TDBPanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;
function TDBPanel.comEditor(Index: Integer): TDBComboBox;
begin
if Index< Length(comEditors) then Result := comEditors[Index]
else Result := nil;
end;
function TDBPanel.edEditor(Index: Integer): TDBedit;
begin
if Index < Length(edEditors) then Result := edEditors[Index]
else Result := nil;
end;
function TDBPanel.MemoEditor(Index: Integer): TDBMemo;
begin
if Index< Length(MemoEditors) then Result := MemoEditors[Index]
else Result := nil;
end;
// 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时
procedure TDBPanel.FreeEditors;
begin
if FScrollBox <> nil then
begin
comEditors := nil;
edEditors := nil;
MemoEditors := nil;
FScrollBox.Free;
FScrollBox := nil;
end;
end;
end.

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/JKFootpanel.dcu.svn-base Normal file
View File

Binary file not shown.

339
T03贸易布匹检验/DbPanel/.svn/text-base/JKFootpanel.pas.svn-base Normal file
View File

@ -0,0 +1,339 @@
unit JKFootpanel;
interface
uses
Windows, Messages, SysUtils, Classes,Graphics, Controls, Forms, Dialogs,
ExtCtrls, dbctrls, stdctrls, db, ADODB, ComCtrls;
type
TEditorstyle = (TsDbMemo,TsDBcombox,Tsdbedit);
type
TJKFootpanel = class(TPanel)
private
{ Private declarations }
FLeft: Integer;
FTop: Integer;
maxTextLen: Integer;
maxLabelLen: Integer;
FScrollBox: TScrollBox; {滚动控件}
FLineHeight: Integer;
FEditorstyle:Teditorstyle;
FTitleVisible :Boolean;
//数据数组控件，动态生成
MemoEditors :array of TDBMemo;
comEditors :array of TDBCombobox;
edEditors :array of TDBedit;
Labels :array of TLAbel; //字段标题，动态生成
FDataSource :TDataSource; // 数据源
FColumns :Integer; //显示列数
procedure FreeEditors; //释放数据输入控件的内存
procedure AKeyDown(Sender :TObject; var Key: Word; Shift:TShiftState);
procedure AKeyPress(Sender :TObject; var Key: Char);
function comEditor(Index :Integer):TDBComboBox;
function edEditor(Index :Integer):TDBedit;
function MemoEditor(Index :Integer): TDBMemo;
protected
{ Protected declarations }
public
constructor Create(AOwner :TComponent); override;
destructor Destroy; override;
procedure Setedit(Value :TEditorstyle);
procedure ClearHits(ItemIndex :Integer);
procedure AddHits(ItemIndex :Integer; Hits :array of string);
Function CreateEditors(DS :TDataSource; ColCount :Integer) :integer; //创建各字段的数据输入控件
{ Public declarations }
published
property LimitLeft :Integer read FLeft write FLeft default 10;
property LimitTop :Integer read FTop write FTop default 10;
property Editorstyle :TEditorstyle read FEditorstyle write FEditorstyle default Tsdbedit;
property EditorWidth :Integer read maxTextLen write maxTextLen default 100;
property TitleWidth :Integer read maxLabelLen write maxLabelLen default 100;
property LineHeight :Integer read FLineHeight write FLineHeight default 15;
property TitleVisible :Boolean read FTitleVisible write FTitleVisible default True;
property DataSource :TDataSource read FDataSource write FDataSource; //数据源
property Columns :Integer read FColumns write FColumns default 4;//表列数
{ Published declarations }
end;
procedure Register;
implementation
constructor TJKFootpanel.Create(AOwner: TComponent);
begin
Inherited Create(AOWner);
FLeft :=16;
FTop := 10;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
FTitleVisible := True;
Editorstyle := Tsdbedit;
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TJKFootpanel]);
end;
procedure TJKFootpanel.Setedit(Value : TEditorstyle);
begin
if FEditorstyle <> Value then
begin
FEditorstyle := Value;
Invalidate;
end;
end;
{ 为第I字段增加提示信息的方法}
procedure TJKFootpanel.AddHits(ItemIndex:
Integer; Hits: array of string);
var
m,n,i: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
comEditors[ItemIndex].Items.Add(Hits[i]);
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
edEditors[ItemIndex].Hint:= Hits[i];
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(memoEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
memoEditors[ItemIndex].Hint:= Hits[i];
end;
end;
procedure TJKFootpanel.AKeyPress(Sender: TObject; var Key: Char);
begin
if (Sender is TDBComboBox) or (Sender is TDBedit) or (Sender is TDBMemo) then
if Key=#13 then
(Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TJKFootpanel.ClearHits(ItemIndex: Integer);
var
n: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
if ItemIndex< n then comEditors[ItemIndex].Items.Clear;
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
if ItemIndex< n then edEditors[ItemIndex].Hint:='';;
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(MemoEditors);
if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';;
end;
end;
{ 创建各字段的数据输入控件的方法}
Function TJKFootpanel.CreateEditors(DS: TDataSource; ColCount: Integer):Integer ;
var
i, n, RowCount: Integer;
TextHeight: Integer;
begin
result := 120;
if DataSource = nil then exit;
if not DataSource.DataSet.Active then exit;
Columns := ColCount;
if Columns = 0 then exit;
n := DataSource.DataSet.fieldCount;
if n > 0 then
begin
DataSource.DataSet.DisableControls;
if maxLabelLen < maxTextLen then
maxTextLen := maxLabelLen;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 计算行列数}
if Columns > n then
Columns := n
else
Columns := ColCount;
RowCount := n div Columns;
if n mod Columns <> 0 then inc(RowCount);
{ 分配内存}
FreeEditors;
SetLength(Labels,n);
if FEditorstyle = TsDBcombox then
SetLength(comEditors,n)
else if FEditorstyle = TsDBEdit then
SetLength(edEditors,n)
else
SetLength(MemoEditors,n);
{ 创建滚动盒}
FScrollBox := TScrollBox.Create(Owner);
FScrollBox.Visible := False;
FScrollBox.Parent := Self;
FScrollBox.Align := alClient;
//FScrollBox.Color := clSkyBlue;
FScrollBox.OnDblClick := OnDblClick;
{ 创建编辑}
for i := 0 to n - 1 do
begin
{ 创建标题}
Labels[i] := TLabel.Create(Owner);
Labels[i].visible := TitleVisible;
Labels[i].Parent := FScrollBox;
Labels[i].Caption := DataSource.DataSet.Fields[i].FieldName;
Labels[i].Left := FLeft + (maxLabelLen + 16) * (i div RowCount)+ 2; //+maxTextLen
if FEditorstyle = TsDBMemo then
begin
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*2+4) + 12;
end
else
begin
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*1 +12)
end;
{ 创建信息显示数据对象}
if FEditorstyle = TsDBcombox then
begin
comEditors[i] := TDBComboBox.Create(Owner);
comEditors[i].Parent := FScrollBox; //Self;
comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
comEditors[i].Width := maxTextLen;
comEditors[i].Top := Labels[i].Top+15;
comEditors[i].DataSource := DataSource;
comEditors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
comEditors[i].OnKeyPress := AKeyPress;
comEditors[i].OnKeyDown := AKeyDown;
comEditors[i].Font.Color := ClBlue;
end
else if FEditorstyle = TsDBEdit then
begin
edEditors[i] := TDBedit.Create(Owner);
edEditors[i].Parent := FScrollBox;
edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
edEditors[i].Width := maxTextLen;
edEditors[i].Top := Labels[i].Top+15;
edEditors[i].DataSource := DataSource;
edEditors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
edEditors[i].OnKeyPress := AKeyPress;
edEditors[i].OnKeyDown := AKeyDown;
edEditors[i].Font.Color := ClBlue;
end
else
begin
MemoEditors[i] := TDBmemo.Create(Owner);
MemoEditors[i].Parent := FScrollBox;
MemoEditors[i].Left := Labels[i].Left;
MemoEditors[i].Width := maxTextLen;
MemoEditors[i].Top := Labels[i].Top+15;
MemoEditors[i].DataSource := DataSource;
MemoEditors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
MemoEditors[i].OnKeyPress := AKeyPress;
MemoEditors[i].OnKeyDown := AKeyDown;
MemoEditors[i].Font.Color := ClBlue;
end;
end;
if FEditorstyle = TsDBMemo then
result := RowCount*TextHeight*4 +20
else
result := RowCount*TextHeight*2 +20;
DataSource.DataSet.EnableControls;
FScrollBox.Visible := True;
end;
end;
destructor TJKFootpanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;
function TJKFootpanel.comEditor(Index: Integer): TDBComboBox;
begin
if Index< Length(comEditors) then Result := comEditors[Index]
else Result := nil;
end;
function TJKFootpanel.edEditor(Index: Integer): TDBedit;
begin
if Index < Length(edEditors) then Result := edEditors[Index]
else Result := nil;
end;
function TJKFootpanel.MemoEditor(Index: Integer): TDBMemo;
begin
if Index< Length(MemoEditors) then Result := MemoEditors[Index]
else Result := nil;
end;
// 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时
procedure TJKFootpanel.FreeEditors;
begin
if FScrollBox <> nil then
begin
comEditors := nil;
edEditors := nil;
MemoEditors := nil;
FScrollBox.Free;
FScrollBox := nil;
end;
end;
procedure TJKFootpanel.AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
{
if (Sender is TDBComboBox) then
begin
case Key of
VK_Next: (Sender as TDBComboBox).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBComboBox).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBedit) then
begin
case Key of
VK_Next: (Sender as TDBedit).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBedit).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBMemo) then
begin
case Key of
VK_Next: (Sender as TDBMemo).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBMemo).DataSource.DataSet.Prior;
end;
end;
}
end;
end.

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/JkPanel.dcu.svn-base Normal file
View File

Binary file not shown.

1123
T03贸易布匹检验/DbPanel/.svn/text-base/JkPanel.pas.svn-base Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/L_DBDateTime.dcr.svn-base Normal file
View File

Binary file not shown.

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/L_DBDateTime.dcu.svn-base Normal file
View File

Binary file not shown.

143
T03贸易布匹检验/DbPanel/.svn/text-base/L_DBDateTime.pas.svn-base Normal file
View File

@ -0,0 +1,143 @@
unit L_DBDateTime;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,db,dbtables,dbctrls,Dialogs,
ComCtrls;
type
TDBDateTime = class(TDateTimePicker)
private
FDataLink:TFieldDataLink;
//TFieldDataLink是TDataLink的派生类，
// 处理单个字段与DataSource的交互
procedure DataChange(sender:Tobject);
//当DataSet的记录改变（如浏览记录）
// 时触发OnDataChange
// 事件，DataChange将作为该事件的事件处理句柄
procedure UpdateData(sender:Tobject);
//更新DataSet前触发OnUpdateData事件，
// UpdateData将作为该事件的事件处理句柄
function GetDataSource:TDataSource;
procedure SetdataSource(value:TDataSource);
Function GetDataField:String;
procedure SetdataField(Value:String);
procedure CMexit(var Message:TCMExit);
message CM_EXIT;//当控件失去焦点时触发CM_EXIT消息
protected
procedure Change;override;//控件中日期、
// 时间改变时触发OnChange事件
procedure Notification(AComponent:TComponent;
Operation:Toperation);override;
//当某一控件从FORM上移走时DELPHI的
// IDE调用该方法通知其它控件
public
constructor Create(AOwner:Tcomponent);override;
destructor Destroy;override;
published
property DataSource:TDataSource read GetDataSource
write SetDataSource;//为控件增加DataSource属性，
// 使它能与DataSource构件连接
property DataField:String read GetDataField
write SetDataField;
end;//为控件增加DataField属性，
// 使它指向代表某一字段的TField对象
procedure Register;//注册构件
implementation
procedure TDBDateTime.CMExit;
begin
try
FDataLink.UpdateRecord;
//控件失去焦点时更新DataSet，
// 这将触发OnUpdateData事件
except
Setfocus;
raise;
end;
DoExit;
end;
constructor TDBDateTime.Create(Aowner:Tcomponent);
begin
inherited Create(Aowner);
//创建DataLink对象，挂接OnDataChange、
//OnUpdateData事件处理句柄
FDataLink:=TFieldDataLInk.Create;
FDataLink.OnDataChange:=DataChange;
FDataLink.OnUpdateData:=Updatedata;
end;
Destructor TDBDateTime.Destroy;
begin
FDataLink.OnDataChange:=nil;
FDataLink.OnUpdateData:=nil;
FDataLink.Free;
inherited Destroy;
end;
function TDBDateTime.GetdataSource:TdataSource;
begin
result:=FDataLink.DataSource;
end;
Procedure TDBDateTime.SetDataSource
(Value:TDataSource);
begin
FDataLink.DataSource:=Value;
end;
function TDBDateTime.GetDatafield:String;
begin
result:=FDataLink.FieldName;
end;
procedure TDBDateTime.SetDataField(value:String);
begin
FdataLink.FieldName:=value;
end;
procedure TDBDateTime.DataChange(Sender:Tobject);
begin
DateTime:=now;
//若控件连了活动的DataSet则数据集变动时
//控件显示当前记录的相应字段值
if FDataLink.Field<>nil then
if FDataLink.Field.Text<>'' then
DateTime:=FDatalink.Field.AsDateTime;
end;
Procedure TDBDateTime.UpdateData(sender:Tobject);
begin
FDatalink.Field.AsDateTime:=DateTime;
//用控件中的日期、时间更新相应字段
end;
procedure TDBDateTime.Change;
begin
//当用户改变了控件中的内容时将DataSet置为编辑状态
FDataLink.Modified;
if not FDataLink.Editing then
FdataLink.Edit;
inherited Change;
end;
procedure TDBDateTime.Notification
(AComponent:TComponent;Operation:TOperation);
begin
inherited Notification(Acomponent,Operation);
//当与控件相连的TdataSource
// 被删除时将控件的DataSource属性置为空
if (Operation=opRemove) and (FDataLink<>nil)
and (AComponent=Datasource) then
DataSource:=nil;
end;
procedure Register;
begin
RegisterComponents('Data Controls',[TDBDateTime]);
end;
end.

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/MovePanel.dcu.svn-base Normal file
View File

Binary file not shown.

84
T03贸易布匹检验/DbPanel/.svn/text-base/MovePanel.pas.svn-base Normal file
View File

@ -0,0 +1,84 @@
unit MovePanel;
interface
uses
Windows, Classes, Controls,ExtCtrls;
type
TMovePanel = class(TPanel) //这个控件是继承Tpanel类的
private
PrePoint:TPoint;
Down:Boolean;
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent);
override;
//重载鼠标事件，抢先处理消息
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure MouseMove(Shift: TShiftState;
X, Y: Integer);override;
{ Public declarations }
published
{ Published declarations }
end;
procedure Register;
implementation
constructor TMovePanel.Create(AOwner:TComponent);
begin
inherited Create(AOwner); //继承父类的Create方法
end;
procedure TMovePanel.MouseDown(Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button=MBLeft) then
begin
Down:=true;
GetCursorPos(PrePoint);
end;
//如果方法已存在，就触发相应事件去调用它，若不加此语句会造成访存异常
if assigned(OnMouseDown) then
OnMouseDown(self,Button,shift,x,y);
end;
procedure TMovePanel.MouseUp(Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button=MBLeft) and Down then
Down:=False;
if assigned(OnMouseUp) then
OnMouseUp(Self,Button,shift,X,y);
end;
procedure TMovePanel.MouseMove(Shift:
TShiftState; X, Y: Integer);
Var
NowPoint:TPoint;
begin
if down then
begin
GetCursorPos(nowPoint);
//self.Parent在Form中就是MovePanel所在的窗体，或是MovePanel所在的容器像Panel
self.Parent.Left:=self.Parent.left
+NowPoint.x-PrePoint.x;
self.parent.Top:=self.Parent.Top
+NowPoint.y-PrePoint.y;
PrePoint:=NowPoint;
end;
if Assigned(OnMouseMove) then
OnMouseMove(self,Shift,X,y);
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TMovePanel]);
end;
end.

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/dbpanel.dcu.svn-base Normal file
View File

Binary file not shown.

BIN
T03贸易布匹检验/DbPanel/.svn/text-base/dsr.dcu.svn-base Normal file
View File

Binary file not shown.

330
T03贸易布匹检验/DbPanel/.svn/text-base/dsr.pas.svn-base Normal file
View File

@ -0,0 +1,330 @@
unit dsr;
interface
uses
SysUtils, StrUtils, Forms, Classes, DB, ADODB, Grids, DBGrids, Messages;
var
CanLCCL :Boolean;
V_User,V_UserID :string;
TmpHandle :THandle;
cnn_Base :TAdoConnection;
function SplitString(STR_Source :string; STR_Split:string):TStringList;
procedure DoAbnormalC(H: THandle;AConn: TADOConnection;UID: String;
UName: String;TRCarNo: String);stdcall;external 'frabnml.dll';
{
procedure DoRinseprt(H: THandle;//调用窗口句柄
AConn: TADOConnection;//ADO连接
UID: String;//操作员号
UName: String;//操作员名
Machine: String;//机台编号
Task: String//任务序次
);stdcall;
}
procedure DoRinseprt(H: THandle;AConn: TADOConnection;UID:String;
UName :String; Machine:String; Task:String); stdcall; external 'rinsepf.dll';
procedure Set_NextControl( Pass_Form: TCustomForm;var Key:Char);
function checkfunc(handle: Integer; DogFlag: String): Integer; stdcall; external 'FUTONG.DLL';
//检查硬件狗函数
// handle为主窗口句柄
// DogFlag为从数据库中查询到的硬件狗信息
// DLL自动检查硬件狗和DogFlag的信息是否相符，不符时将在3分钟左右自动重启计算机
function GetParm(flag: Integer; out len: Integer; outHex: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//硬件狗中获取特定信息，如IP地址，数据库名称，用户名、口令等
//自定义参数flag取值范围为0--4，存储空间一共为20个字节，为连续的地址空间
//也即：参数0，最大可用长度为20，这时其他参数，将覆盖这个区域
// 参数4，最大可用长度为4
//DogFlag为字符串信息
function SetParm(flag, len: Integer; inHex: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//flag=5IP,=6User,=7Pass,=8DB
//硬件狗中设置参数，传入IP时，须设置为 “C8A00164”等形式传入（192.168.1.100）
//自定义参数用法同上
function InfoFunc(order: Integer; info: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//读取本机硬件信息，返回值为机器网卡个数
//考虑到某些可移动的网卡，要查询固定的网卡信息
//软件安装时要求移除可移动网卡
//order为第几块网卡，从0开始
function GetHostIpAddr(DogParm, HostName, IPAddr: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//获取硬件狗标识,本机IP地址（仅参考，因为机器有多个IP地址，获取的只是其中之一）
//以及机器名称
function PBEncode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
function PBEncode1(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
function PBDecode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
implementation
function SplitString(STR_Source :string; STR_Split:string):TStringList;
var
temp:String;
i:Integer;
begin
Result:=TStringList.Create;
//如果是空自符串则返回空列表
if trim(STR_Source) = '' then exit;
temp:=STR_Source;
i:=pos(STR_Split,STR_Source);
while i <> 0 do
begin
Result.add(copy(temp,0,i-1));
Delete(temp,1,i+length(STR_Split)-1); //如果STR_Split长度大于1的话,原来的只删除STR_Split字符的第一个.
i:=pos(STR_Split,temp);
end;
Result.add(temp);
end;
procedure Set_NextControl( Pass_Form: TCustomForm;var Key:Char);
label
labe_A;
begin
if key=#13 then
if not (Pass_Form.ActiveControl is TDbgrid) Then
Begin
key:=#0;
Pass_Form.perform(WM_NEXTDLGCTL,0,0);
end
else
if (Pass_Form.ActiveControl is TDbgrid) Then
begin
With TDbgrid(Pass_Form.ActiveControl) Do
begin
labe_A:
if Selectedindex<(FieldCount-1) then
Selectedindex:=Selectedindex+1
else Selectedindex:=0;
if not Columns[Selectedindex].Visible then
goto labe_A;
end;
end;
end;
function PBEncode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
table: array[0..63] of AnsiChar;
c80, c81, c82, c6: AnsiChar;
i, k, len: Integer;
Tmpbuf: array[0..255] of AnsiChar;
begin
table := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
if (nInLen*4)>(nOutLen*3+3) then Result := 1;
k := nInLen div 3;
len := k*4;
for i:=0 to k-1 do
begin
c80 := Inbuf[i*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[i*4] := table[Integer(c6) and $3f];
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[i*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[i*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
c82 := Inbuf[i*3+2];
c6 := Char((Integer(c82) shr 6) and $03);
Tmpbuf[i*4+2] := table[Integer(c81) or Integer(c6)];
Tmpbuf[i*4+3] := table[Integer(c82) and $3f];
end;
i := nInLen mod 3;
k := nInLen div 3;
if i<>0 then
begin
len := len+4;
c80 := Inbuf[k*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[k*4] := table[Integer(c6) and $3f];
if k=1 then
begin
c80 := Char((Integer(c80) shl 4) and $30);
Tmpbuf[k*4+1] := table[Integer(c80)];
Tmpbuf[k*4+2] := '=';
end
else
begin
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[k*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[k*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
Tmpbuf[k*4+2] := table[Integer(c81)];
end;
Tmpbuf[k*4+3] := '=';
end;
Tmpbuf[len] := #0;
Outbuf := Tmpbuf;
Result := len;
end;
function PBEncode1(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
table: array[0..63] of AnsiChar;
c80, c81, c82, c6: AnsiChar;
i, k, len: Integer;
Tmpbuf: array[0..255] of AnsiChar;
begin
table := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
if (nInLen*4)>(nOutLen*3+3) then Result := 1;
k := nInLen div 3;
len := k*4;
for i:=0 to k-1 do
begin
c80 := Inbuf[i*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[i*4] := table[Integer(c6) and $3f];
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[i*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[i*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
c82 := Inbuf[i*3+2];
c6 := Char((Integer(c82) shr 6) and $03);
Tmpbuf[i*4+2] := table[Integer(c81) or Integer(c6)];
Tmpbuf[i*4+3] := table[Integer(c82) and $3f];
end;
i := nInLen mod 3;
k := nInLen div 3;
if i<>0 then
begin
len := len+4;
c80 := Inbuf[k*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[k*4] := table[Integer(c6) and $3f];
if i=1 then
begin
c80 := Char((Integer(c80) shl 4) and $30);
Tmpbuf[k*4+1] := table[Integer(c80)];
Tmpbuf[k*4+2] := '=';
end
else
begin
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[k*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[k*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
Tmpbuf[k*4+2] := table[Integer(c81)];
end;
Tmpbuf[k*4+3] := '=';
end;
Tmpbuf[len] := #0;
Outbuf := Tmpbuf;
Result := len;
end;
function PBDecode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
pBufIn: PAnsiChar;
szBufTmp: array[0..255] of AnsiChar;
i, dwCoded, nprbytes, nbytesdecoded: Integer;
pszCoded: PAnsiChar;
szBufout: array[0..255] of AnsiChar;
pszBufout: PAnsiChar;
pr2six: array[0..255] of Word;
begin
for i := 0 to 42 do
pr2six[i] := 64;
pr2six[43] := 62;
for i := 44 to 46 do
pr2six[i] := 64;
pr2six[47] := 63;
for i := 48 to 57 do
pr2six[i] := i+4;
for i := 58 to 64 do
pr2six[i] := 64;
for i := 65 to 90 do
pr2six[i] := i-65;
for i := 91 to 96 do
pr2six[i] := 64;
for i := 97 to 122 do
pr2six[i] := i-71;
for i := 123 to 255 do
pr2six[i] := 64;
dwCoded := nInlen;
pszCoded := Inbuf;
while (dwCoded>0) and (pszCoded=' ') do
begin
Inc(pszCoded);
Dec(dwCoded);
end;
if dwCoded>(350-4) then result := 1;
StrLCopy(szBufTmp, pszCoded, dwCoded);
szBufTmp[dwCoded] := #0;
szBufTmp[dwCoded+1] := #0;
szBufTmp[dwCoded+2] := #0;
szBufTmp[dwCoded+3] := #0;
pBufIn := szBufTmp;
repeat
i := pr2six[Integer(pBufIn^)];
Inc(pBufIn);
until i>63;
nprbytes := pBufin-szBufTmp-1;
nbytesdecoded := ((nprbytes+3) div 4)*3;
if nOutLen<nbytesdecoded then result := 2;
if nbytesdecoded>(256-4) then result := 2;
pszBufout := szBufout;
pBufin := szBufTmp;
while nprbytes>0 do
begin
pszBufout^ := Char((pr2six[Integer(pBufin[0])] shl 2) or ((pr2six[Integer(pBufin[1])] shr 4)));
Inc(pszBufout);
pszBufout^ := Char((pr2six[Integer(pBufin[1])] shl 4) or ((pr2six[Integer(pBufin[2])] shr 2)));
Inc(pszBufout);
pszBufout^ := Char((pr2six[Integer(pBufin[2])] shl 6) or (pr2six[Integer(pBufin[3])]));
Inc(pszBufout);
Inc(pBufin, 4);
Dec(nprbytes, 4);
end;
if (nprbytes and $03) <> 0 then
begin
if pr2six[Integer(pBufin[-2])]>63 then Dec(nbytesdecoded, 2)
else Dec(nbytesdecoded);
end;
szBufout[nbytesdecoded] := #0;
Outbuf := szBufout;
result := nbytesdecoded;
end;
end.

707
T03贸易布匹检验/DbPanel/AutoPanel.pas Normal file
View File

@ -0,0 +1,707 @@
unit AutoPanel;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
ExtCtrls,dbctrls,stdctrls,db,ADODB,ComCtrls,Variants,Gauges,
SqlExpr,DBGrids,MovePanel;
type
TEditorstyle = (TsMemo,Tscombox,Tsedit);
type
TAutoPanel = class(TPanel)
private
{ Private declarations }
FEditorstyle:Teditorstyle;
FLeft :Integer;
FTop :Integer;
maxTextLen :Integer;
maxLabelLen :Integer;
FTitleVisible :Boolean;
FDataReadOnly :Boolean;
FPageCount :Integer;
FPass_Grid :TDBGrid;
FP_Move :TMovePanel;
FP_Parent :TPanel;
FPageControl: TPageControl; {分页控件}
FTabSheets :array of TTabSheet;
FScrollBox :array of TScrollBox; {滚动控件}
FLineHeight :Integer;
//数据数组控件，动态生成
MemoEditors :array of TMemo;
comEditors :array of TCombobox;
edEditors :array of Tedit;
ProgressEditor :array of Tedit;
Labels :array of TLabel; //字段标题，动态生成
ProgressBars :array of TGauge;
Shapes :array of TShape;
FDataSource :TDataSource; // 数据源
FDataField_A :String; // DataField
FDataField_B :String; // DataField
FDataField_C :String; // DataField
FDataField_D :String; // DataField
FDataField_E :String; // DataField
FDataField_F :String; // DataField
FStore :String;
Fcnnstr :String;
FListSql :String;
FBerthFieldName :String;
FStoreFieldName :String;
FBerthTableName :String;
FColumns :Integer; //显示列数
tmpado :TadoDataset;
tmpDs :TDataSource;
procedure FreeEditors; //释放数据输入控件的内存
procedure AKeyDown(Sender:TObject; var Key :Word; Shift:TShiftState);
procedure AKeyPress(Sender:TObject; var Key :Char);
procedure AProgressEditorChange(Sender :TObject);
procedure inti_Grid(sender :TObject);
procedure LabelsClick(Sender: TObject);
procedure FP_MovePanelDblClick(Sender: TObject);
function comEditor(Index :Integer):TComboBox;
function edEditor(Index :Integer):Tedit;
function MemoEditor(Index :Integer) :TMemo;
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Setedit(Value :TEditorstyle);
procedure CreateEditors(var DS :TDataSource; cnnstr :String); //创建各字段的数据输入控件
procedure ClearHits(ItemIndex :Integer);
procedure AddHits(ItemIndex:Integer; Hits :array of string);
{ Public declarations }
published
property LimitLeft :Integer read FLeft write FLeft default 10;
property LimitTop :Integer read FTop write FTop default 10;
property Editorstyle :TEditorstyle read FEditorstyle write Setedit default TsMemo;
property EditorWidth :Integer read maxTextLen write maxTextLen default 100;
property TitleWidth :Integer read maxLabelLen write maxLabelLen default 100;
property TitleVisible :Boolean read FTitleVisible write FTitleVisible default True;
property DataReadOnly :Boolean read FDataReadOnly write FDataReadOnly; //default True;
property LineHeight :Integer read FLineHeight write FLineHeight default 15;
property DataSource :TDataSource read FDataSource write FDataSource; //数据源
property DataField_Editor :String read FDataField_A write FDataField_A;
property DataField_Title :String read FDataField_B write FDataField_B;
property DataField_Progress :String read FDataField_C write FDataField_C;
property DataField_BerthArea :String read FDataField_D write FDataField_D;
property DataField_IconLeft :String read FDataField_E write FDataField_E;
property DataField_IconTop :String read FDataField_F write FDataField_F;
property Data_BerthListSql :String read FListSql write FListSql;
property Data_BerthField :String read FBerthFieldName write FBerthFieldName;
property Data_StoreField :String read FStoreFieldName write FStoreFieldName;
property Data_BerthTable :String read FBerthTableName write FBerthTableName;
property Store_Name :String read FStore write FStore;
property Columns :Integer read FColumns write FColumns default 4;//表列数
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TAutoPanel]);
end;
procedure TAutoPanel.Setedit(Value :TEditorstyle);
begin
if FEditorstyle <> Value then
begin
FEditorstyle := Value;
Invalidate;
end;
end;
{ 为第I字段增加提示信息的方法}
procedure TAutoPanel.AddHits(ItemIndex :Integer; Hits :array of string);
var
m,n,i :Integer;
begin
if FEditorstyle = Tscombox then
begin
n := Length(comEditors);
m := Length(Hits);
if ItemIndex< n then
for i:= 0 to m - 1 do
comEditors[ItemIndex].Items.Add(Hits[i]);
end
else if FEditorstyle = Tsedit then
begin
n := Length(edEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
edEditors[ItemIndex].Hint:= Hits[i];
end
else if FEditorstyle = TsMemo then
begin
n := Length(memoEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
memoEditors[ItemIndex].Hint:= Hits[i];
end;
end;
procedure TAutoPanel.AKeyDown(Sender :TObject; var Key :Word; Shift :TShiftState);
begin
//
end;
procedure TAutoPanel.AProgressEditorChange(Sender :TObject);
begin
//
end;
procedure TAutoPanel.AKeyPress(Sender :TObject; var Key :Char);
begin
if (Sender is TComboBox) or (Sender is Tedit) or (Sender is TMemo) then
if Key=#13 then
(Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TAutoPanel.ClearHits(ItemIndex :Integer);
var
n :Integer;
begin
if FEditorstyle = Tscombox then
begin
n := Length(comEditors);
if ItemIndex< n then comEditors[ItemIndex].Items.Clear;
end
else if FEditorstyle = Tsedit then
begin
n := Length(edEditors);
if ItemIndex< n then edEditors[ItemIndex].Hint:='';;
end
else if FEditorstyle = TsMemo then
begin
n := Length(MemoEditors);
if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';;
end;
end;
constructor TAutoPanel.Create(AOwner :TComponent);
begin
Inherited Create(AOWner);
FLeft := 20;
FTop := 20;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
FTitleVisible := True;
FDataReadOnly := True;
end;
{ 创建各字段的数据输入控件的方法}
procedure TAutoPanel.CreateEditors(var DS :TDataSource; cnnstr :String);
var
i,j,n,This_Index,TextHeight :Integer;
tmp_col0,Tmp_Row0,tmp_col1,Tmp_Row1 :Integer;
XXX :TStringList;
tmpFlag :Boolean;
begin
if (Store_Name = '')
or (Data_BerthTable = '')
or (DataField_BerthArea = '') then
exit;
{ 释放全部控件内存}
FreeEditors;
if DS = nil then exit;
if DataSource = nil then FDataSource := Ds;
if not DataSource.DataSet.Active then exit;
if (DataSource.DataSet is TAdoDataSet) = False then exit;
FPageCount := 0;
tmp_col1 := -1;
Tmp_Row1 := 0;
n := DataSource.DataSet.RecordCount;
if n <= 0 then exit;
DataSource.DataSet.DisableControls;
if maxLabelLen < maxTextLen then
maxTextLen := maxLabelLen;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 分配内存}
SetLength(Labels,n);
SetLength(ProgressBars,n);
SetLength(ProgressEditor,n);
SetLength(Shapes,n);
if Columns = 0 then Columns := 6;
try
tmpado := TadoDataset.Create(Owner);
tmpDs := TDatasource.Create(Owner);
tmpDs.DataSet := tmpado;
with tmpado do
begin
Active := False;
Fcnnstr := cnnstr;
tmpado.ConnectionString := Fcnnstr;
//tmpado.Connection := (DataSource.DataSet as TAdoDataset).Connection;
tmpado.CommandText := ' Select '+DataField_BerthArea+' '
+ ' from '+Data_BerthTable+' where '+DataField_BerthArea+' is not null'
+ ' and '+Data_StoreField+' = '''+Store_Name+''''
+ ' Group by '+DataField_BerthArea+' order by '+DataField_BerthArea+'';
Active := True;
FPageCount := RecordCount;
if FPageCount = 0 then exit;
first;
// 创建PageControl
FPageControl := TPageControl.Create(Owner);
FPageControl.Parent := Self;
FPageControl.Font.Name := '宋体';
FPageControl.Font.Size := 9;
FPageControl.Align := alClient;
FPageControl.Visible := False;
{ 分配载体内存}
setlength(FTabSheets,FPageCount+1);
setlength(FScrollBox,FPageCount+1);
XXX := TStringList.Create();
for j := 0 to FPageCount do
begin
{ FPageControl分页}
FTabSheets[j] := TTabSheet.Create(Owner);
FTabSheets[j].Parent := FPageControl;
FTabSheets[j].ParentFont := True;
FTabSheets[j].PageControl := FPageControl;
FTabSheets[j].Visible := True;
FTabSheets[j].PageIndex := j;
if j < FPageCount then
begin
FTabSheets[j].Caption := '库区：' + trim(fieldByName(DataField_BerthArea).AsString);
FTabSheets[j].Hint := trim(fieldByName(DataField_BerthArea).AsString);
XXX.Append(trim(fieldByName(DataField_BerthArea).AsString));
end
else
begin
FTabSheets[j].Caption := '未指定库区';
FTabSheets[j].Hint := '';
XXX.Append('未指定库区');
end;
FTabSheets[j].ShowHint := False;
FTabSheets[j].Visible := True;
FTabSheets[j].Align := alClient;
//创建滚动盒
FScrollBox[j] := TScrollBox.Create(Owner);
FScrollBox[j].Visible := True;
FScrollBox[j].Parent := FTabSheets[j];
FScrollBox[j].Color := ClBlack;//clTeal;
FScrollBox[j].Align := alClient;
FScrollBox[j].Hint := FTabSheets[j].Hint;
FScrollBox[j].ShowHint := False;
next;
end;
end;
if FEditorstyle = Tscombox then
SetLength(comEditors,n)
else if FEditorstyle = Tsedit then
SetLength(edEditors,n)
else
SetLength(MemoEditors,n);
{ 创建编辑}
for i := 0 to n - 1 do
begin
//DataField_BerthArea
if DataSource.DataSet.Fieldbyname(DataField_BerthArea).AsVariant = null then
This_Index := FPageCount
else
This_Index := XXX.IndexOf(trim(DataSource.DataSet.Fieldbyname(DataField_BerthArea).Asstring));
tmpFlag := False;
if DataSource.DataSet.Fieldbyname(DataField_IconLeft).AsVariant <> null then
tmp_col0 := DataSource.DataSet.Fieldbyname(DataField_IconLeft).Asinteger -1
else
begin
tmpFlag := True;
if tmp_col1 = Columns -1 then
begin
tmp_col1 := 0;
tmp_Row1 := tmp_Row1 +1;
end
else
tmp_col1 := tmp_col1 + 1;
tmp_col0 := tmp_col1;
This_Index := FPageCount;
end;
if DataSource.DataSet.Fieldbyname(DataField_IconTop).AsVariant <> null then
tmp_Row0 := DataSource.DataSet.Fieldbyname(DataField_IconTop).Asinteger - 1
else
begin
if not tmpFlag then
begin
if tmp_col1 = Columns - 1 then
begin
tmp_col1 := 0;
tmp_Row1 := tmp_Row1 +1;
end
else
tmp_col1 := tmp_col1 + 1;
end;
tmp_Row0 := tmp_Row1;
This_Index := FPageCount;
end;
{ 创建标题}
Labels[i] := TLabel.Create(owner);
Labels[i].visible := FTitleVisible;
Labels[i].Parent := (FScrollBox[This_Index] as TScrollBox); // FScrollBox[This_Index];
Labels[i].Font.Name := '宋体';
Labels[i].Font.Size := 9;
Labels[i].Font.Color := ClBlue;
Labels[i].OnClick := LabelsClick;
//Labels[i].Font.Style := [FsBold];
Labels[i].Transparent := True;
if DataSource.DataSet.Fieldbyname(DataField_Title).AsVariant <> null then
Labels[i].caption := DataSource.DataSet.Fieldbyname(DataField_Title).AsString
else
Labels[i].caption := '';
Labels[i].Hint := '库位：[' + Labels[i].caption + ']';
Labels[i].ShowHint := True;
if FEditorstyle = TsMemo then
begin
Labels[i].Top := FTop + tmp_Row0 * (TextHeight*3+30) + 2;
Labels[i].Left := FLeft + (maxLabelLen + 40) * tmp_Col0 + 10;
Labels[i].Width := maxLabelLen;
end
else
begin
Labels[i].Top := FTop + tmp_Row0 * (TextHeight*2+30) + 2;
Labels[i].Left := FLeft + (maxLabelLen + 30) * tmp_Col0 + 10;
Labels[i].Width := maxLabelLen;
end;
{ 创建进度条数据对象}
ProgressEditor[i] := Tedit.Create(Owner);
ProgressEditor[i].visible := False;
ProgressEditor[i].Parent := FScrollBox[This_Index];
if DataSource.DataSet.Fieldbyname(DataField_Progress).AsVariant <> null then
ProgressEditor[i].Text := DataSource.DataSet.Fieldbyname(DataField_Progress).AsString
else
ProgressEditor[i].Text := '0';
ProgressEditor[i].OnChange := AProgressEditorChange;
{ 创建信息显示数据对象}
if FEditorstyle = Tscombox then
begin
comEditors[i] := TComboBox.Create(Owner);
comEditors[i].Parent := FScrollBox[This_Index]; //Self;
comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
comEditors[i].Width := maxTextLen;
comEditors[i].Top := Labels[i].Top+20;
if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then
comEditors[i].Text := DataSource.DataSet.Fieldbyname(DataField_Editor).AsString;
comEditors[i].OnKeyPress := AKeyPress;
comEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TGauge.Create(Owner);
ProgressBars[i].Parent := FScrollBox[This_Index];
ProgressBars[i].Font.name := '宋体';
ProgressBars[i].Font.Size := 9;
ProgressBars[i].ShowText := True;
ProgressBars[i].Font.Color := ClWindow;
ProgressBars[i].Kind := gkHorizontalBar;
ProgressBars[i].Left := comEditors[i].Left;
ProgressBars[i].Width := comEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := comEditors[i].Top+comEditors[i].height+2;
ProgressBars[i].Progress := Round((DataSource.DataSet
.Fieldbyname(DataField_Progress).Ascurrency)*100);
end
else if FEditorstyle = Tsedit then
begin
edEditors[i] := Tedit.Create(Owner);
edEditors[i].Parent := FScrollBox[This_Index];
edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
edEditors[i].Width := maxTextLen;
edEditors[i].Top := Labels[i].Top+20;
edEditors[i].ReadOnly := DataReadOnly;
if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then
edEditors[i].Text := DataSource.DataSet.Fieldbyname(DataField_Editor).AsString;
edEditors[i].OnKeyPress := AKeyPress;
edEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TGauge.Create(Owner);
ProgressBars[i].Parent := FScrollBox[This_Index];
ProgressBars[i].Font.name := '宋体';
ProgressBars[i].Font.Size := 9;
ProgressBars[i].ShowText := True;
ProgressBars[i].Font.Color := ClWindow;
ProgressBars[i].Kind := gkHorizontalBar;
ProgressBars[i].Left := edEditors[i].Left;
ProgressBars[i].Width := edEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := edEditors[i].Top+edEditors[i].height+2;;
ProgressBars[i].Progress := Round((DataSource.DataSet
.Fieldbyname(DataField_Progress).Ascurrency)*100);
end
else
begin
MemoEditors[i] := Tmemo.Create(Owner);
MemoEditors[i].Parent := FScrollBox[This_Index];
MemoEditors[i].Left := Labels[i].Left;
MemoEditors[i].Width := maxTextLen;
MemoEditors[i].Top := Labels[i].Top+20;
MemoEditors[i].Height := 60;
MemoEditors[i].ReadOnly := DataReadOnly;
if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then
MemoEditors[i].Lines.Add(DataSource.DataSet.Fieldbyname(DataField_Editor).AsString);
MemoEditors[i].OnKeyPress := AKeyPress;
MemoEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TGauge.Create(Owner);
ProgressBars[i].Parent := FScrollBox[This_Index];
ProgressBars[i].Font.name := '宋体';
ProgressBars[i].Font.Size := 9;
ProgressBars[i].ShowText := False;
ProgressBars[i].Font.Color := ClWindow;
ProgressBars[i].Kind := gkVerticalBar;
ProgressBars[i].Left := MemoEditors[i].Left + MemoEditors[i].Width +1;
ProgressBars[i].Width := 10;
ProgressBars[i].Height := MemoEditors[i].Height;
ProgressBars[i].Top := MemoEditors[i].Top;
ProgressBars[i].Progress := Round((DataSource.DataSet
.Fieldbyname(DataField_Progress).Ascurrency)*100);
end;
if ProgressBars[i].Progress <= 20 then
ProgressBars[i].ForeColor := RGB(48,48,96)
else if (ProgressBars[i].Progress > 20) and (ProgressBars[i].Progress <= 40) then
ProgressBars[i].ForeColor := RGB(48,48,144)
else if (ProgressBars[i].Progress > 40) and (ProgressBars[i].Progress <= 60) then
ProgressBars[i].ForeColor := RGB(96,48,144)
else if (ProgressBars[i].Progress > 60) and (ProgressBars[i].Progress <= 80) then
ProgressBars[i].ForeColor := RGB(144,48,144)
else if ProgressBars[i].Progress > 80 then
ProgressBars[i].ForeColor := RGB(200,48,48);
Shapes[i] := TShape.Create(Owner);
Shapes[i].Parent := FScrollBox[This_Index];
Shapes[i].Left := Labels[i].Left - 10;
Shapes[i].top := Labels[i].Top - 10;
if FEditorstyle = TsMemo then
begin
Shapes[i].height := ProgressBars[i].height + Labels[i].height +20 +10;
Shapes[i].Width := (ProgressBars[i].left - Labels[i].left) + ProgressBars[i].Width + 20;
end
else
begin
Shapes[i].height := (ProgressBars[i].Top - Labels[i].Top) + ProgressBars[i].Height + 20;
Shapes[i].Width := Labels[i].Width +20;
end;
Shapes[i].Brush.Color := clSkyBlue;
Shapes[i].Visible := True;
Shapes[i].SendToBack;
if not DataSource.DataSet.Eof then
DataSource.DataSet.next;
end;
DataSource.DataSet.EnableControls;
tmpado.Close;
XXX.Free;
if FPageControl.PageCount > 0 then
begin
FPageControl.ActivePageIndex := FPageControl.PageCount-1;
FPageControl.ActivePageIndex := 0;
end;
Finally
FPageControl.Visible := True;
end;
end;
destructor TAutoPanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;
function TAutoPanel.comEditor(Index :Integer) :TComboBox;
begin
if Index< Length(comEditors) then Result := comEditors[Index]
else Result := nil;
end;
function TAutoPanel.edEditor(Index :Integer) :Tedit;
begin
if Index < Length(edEditors) then Result := edEditors[Index]
else Result := nil;
end;
function TAutoPanel.MemoEditor(Index :Integer) :TMemo;
begin
if Index< Length(MemoEditors) then Result := MemoEditors[Index]
else Result := nil;
end;
procedure TAutoPanel.inti_Grid(sender :TObject);
begin
try
// 创建FP_Parent
FP_Parent := TPanel.Create(Owner);
with FP_Parent Do
begin
Parent := Self;
Visible := False;
Font.Name := '宋体';
Font.Size := 9;
Font.Style:= [fsBold];
Align := AlNone;
BevelInner := bvLowered;
BevelOuter := bvRaised;
Width := 380;
Height := 250;
try
Left := round(((Sender as Tlabel).Parent.Width-380)/2);
Top := round(((Sender as Tlabel).Parent.height-250)/2);
except
Left := 0;
Top := 0;
end;
end;
FP_Move := TMovePanel.Create(Owner);
with FP_Move do
begin
Parent := FP_Parent;
ParentFont := true;
BevelInner := bvLowered;
BevelOuter := bvRaised;
Height := 26;
Align := AlTop;
Color := clSkyBlue;
Caption := '';
OnDblClick := FP_MovePanelDblClick;
Visible := True;
end;
FPass_Grid := TDBGrid.Create(Owner);
with FPass_Grid do
begin
Parent := FP_Parent;
ParentFont := true;
Font.Style:= [];
Align := AlClient;
Visible := True;
DataSource := TmpDs;
end;
except
FPass_Grid := Nil;
FP_Move := Nil;
FP_Parent := Nil;
end;
end;
//响应Labels[i]的Click事件
procedure TAutoPanel.LabelsClick(Sender: TObject);
var
i :integer;
Tmp_Area,Tmp_Berth :String;
begin
try
if FP_Parent = nil then inti_Grid(Sender);
if FP_Parent = nil then exit;
Tmp_Berth := trim((Sender as Tlabel).Caption);
Tmp_Area := trim(((Sender as Tlabel).Parent as TScrollBox).Hint);
if tmpado.Active then
begin
if tmpado.FieldValues['库位'] <> null then
if tmpado.FieldByName('库位').AsString = Tmp_Berth then
exit;
end;
screen.Cursor := crSQLWait;
//FP_Parent.Visible := False;
//FP_Parent.Left := FPageControl.Left + (Sender as Tlabel).Left + (Sender as Tlabel).Width + 28;
//FP_Parent.Top := FPageControl.Top + (Sender as Tlabel).top + (Sender as Tlabel).Height +4;
FP_Move.Caption := trim((Sender as Tlabel).Hint) + '明细列表';
with tmpado do
begin
DisableConTrols;
Active := False;
ConnectionString := Fcnnstr;
tmpado.CursorType := ctStatic;
tmpado.LockType := ltReadOnly;
CommandText := 'Exec '+Data_BerthListSql+' '''+Store_Name+''','''+Tmp_Area+''','''+Tmp_Berth+'''';
Active := True;
First;
EnableConTrols;
for i := 0 to Fields.Count -1 do
begin
Fields[i].Alignment := taCenter;
if i = 0 then
fields[i].DisplayWidth := 20
else
fields[i].DisplayWidth := 8;
Fpass_Grid.Columns[i].Title.Alignment := taCenter;
Fpass_Grid.Columns[i].Title.Font.Style:= [];
end;
end;
screen.Cursor := crDefault;
FP_Parent.Visible := True;
except
screen.Cursor := crDefault;
end;
end;
procedure TAutoPanel.FP_MovePanelDblClick(Sender: TObject);
begin
FP_Parent.Visible := False;
end;
// 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时
procedure TAutoPanel.FreeEditors;
begin
if FPageControl <> nil then
begin
if FP_Parent <> nil then
begin
try
FPass_Grid.Free;
FP_Move.Free;
FP_Parent.Free;
except
//
end;
end;
FPass_Grid := nil;
FP_Move := nil;
FP_Parent := nil;
Shapes := nil;
ProgressBars := nil;
comEditors := nil;
edEditors := nil;
MemoEditors := nil;
FScrollBox := nil;
tmpDs.Free;
tmpado.Free;
FPageControl.Free;
end;
end;
end.

380
T03贸易布匹检验/DbPanel/Dbpanel.pas Normal file
View File

@ -0,0 +1,380 @@
unit Dbpanel;
interface
uses
Windows, Messages, SysUtils, Classes,Graphics, Controls, Forms, Dialogs,
ExtCtrls, dbctrls, stdctrls, db, ADODB, ComCtrls;
type
TEditorstyle = (TsDbMemo,TsDBcombox,Tsdbedit);
type
TDBPanel = class(TPanel)
private
{ Private declarations }
FEditorstyle:Teditorstyle;
FLeft: Integer;
FTop: Integer;
maxTextLen: Integer;
maxLabelLen: Integer;
FTitleVisible :Boolean;
FScrollBox: TScrollBox; {滚动控件}
FLineHeight: Integer;
//数据数组控件，动态生成
MemoEditors: array of TDBMemo;
comEditors: array of TDBCombobox;
edEditors: array of TDBedit;
ProgressEditor :array of TDBedit;
Labels: array of TDBText; //字段标题，动态生成
ProgressBars: array of TProgressBar;
FDataSource: TDataSource; // 数据源
FDataField_A: String; // DataField
FDataField_B: String; // DataField
FDataField_C: String; // DataField
FColumns: Integer; //显示列数
procedure FreeEditors; //释放数据输入控件的内存
procedure AKeyDown(Sender:TObject; var Key: Word; Shift:TShiftState);
procedure AKeyPress(Sender:TObject; var Key: Char);
procedure AProgressEditorChange(Sender: TObject);
function comEditor(Index: Integer):TDBComboBox;
function edEditor(Index: Integer):TDBedit;
function MemoEditor(Index: Integer): TDBMemo;
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
function Get_TitleVisible() :Boolean;
procedure Set_TitleVisible(Value : Boolean);
procedure Setedit(Value : TEditorstyle);
procedure CreateEditors(DS: TDataSource; ColCount: Integer); //创建各字段的数据输入控件
procedure ClearHits(ItemIndex: Integer);
procedure AddHits(ItemIndex:Integer; Hits: array of string);
{ Public declarations }
published
property LimitLeft: Integer read FLeft write FLeft default 10;
property LimitTop: Integer read FTop write FTop default 10;
property Editorstyle : TEditorstyle read FEditorstyle write Setedit default tsdbMemo;
property EditorWidth: Integer read maxTextLen write maxTextLen default 100;
property TitleWidth: Integer read maxLabelLen write maxLabelLen default 100;
property TitleVisible : Boolean read Get_TitleVisible write Set_TitleVisible default True;
property LineHeight: Integer read FLineHeight write FLineHeight default 15;
//property OnOkClick: TNotifyEvent read FClick write FClick;
property DataSource: TDataSource read FDataSource write FDataSource; //数据源
property DataField_Editor: String read FDataField_A write FDataField_A;
property DataField_Title: String read FDataField_B write FDataField_B;
property DataField_Progress: String read FDataField_C write FDataField_C;
property Columns: Integer read FColumns write FColumns default 4;//表列数
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TDBPanel]);
end;
function TDBPanel.Get_TitleVisible() :Boolean;
begin
Result := FTitleVisible;
end;
procedure TDBPanel.Set_TitleVisible(Value : Boolean);
begin
FTitleVisible := Value;
end;
procedure TDBPanel.Setedit(Value : TEditorstyle);
begin
if FEditorstyle <> Value then
begin
FEditorstyle := Value;
Invalidate;
end;
end;
{ 为第I字段增加提示信息的方法}
procedure TDBPanel.AddHits(ItemIndex:
Integer; Hits: array of string);
var
m,n,i: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
comEditors[ItemIndex].Items.Add(Hits[i]);
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
edEditors[ItemIndex].Hint:= Hits[i];
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(memoEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
memoEditors[ItemIndex].Hint:= Hits[i];
end;
end;
procedure TDBPanel.AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Sender is TDBComboBox) then
begin
case Key of
VK_Next: (Sender as TDBComboBox).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBComboBox).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBedit) then
begin
case Key of
VK_Next: (Sender as TDBedit).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBedit).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBMemo) then
begin
case Key of
VK_Next: (Sender as TDBMemo).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBMemo).DataSource.DataSet.Prior;
end;
end;
end;
procedure TDBPanel.AProgressEditorChange(Sender: TObject);
begin
//
end;
procedure TDBPanel.AKeyPress(Sender: TObject; var Key: Char);
begin
if (Sender is TDBComboBox) or (Sender is TDBedit) or (Sender is TDBMemo) then
if Key=#13 then
(Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TDBPanel.ClearHits(ItemIndex: Integer);
var
n: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
if ItemIndex< n then comEditors[ItemIndex].Items.Clear;
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
if ItemIndex< n then edEditors[ItemIndex].Hint:='';;
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(MemoEditors);
if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';;
end;
end;
constructor TDBPanel.Create(AOwner: TComponent);
begin
Inherited Create(AOWner);
FLeft :=10;
FTop := 10;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
end;
{ 创建各字段的数据输入控件的方法}
procedure TDBPanel.CreateEditors(DS: TDataSource; ColCount: Integer);
var
i, n, RowCount: Integer;
TextHeight: Integer;
begin
if DataSource = nil then exit;
if not DataSource.DataSet.Active then exit;
n := DataSource.DataSet.RecordCount;
if n > 0 then
begin
DataSource.DataSet.DisableControls;
if maxLabelLen < maxTextLen then
maxTextLen := maxLabelLen;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 计算行列数}
if (FColumns = 0) or (FColumns <> ColCount) then FColumns := ColCount;
RowCount := n div Columns;
if n mod Columns <> 0 then inc(RowCount);
{ 分配内存}
FreeEditors;
SetLength(Labels,n);
SetLength(ProgressBars,n);
SetLength(ProgressEditor,n);
if FEditorstyle = TsDBcombox then
SetLength(comEditors,n)
else if FEditorstyle = TsDBEdit then
SetLength(edEditors,n)
else
SetLength(MemoEditors,n);
{ 创建滚动盒}
FScrollBox := TScrollBox.Create(Owner);
FScrollBox.Visible := False;
FScrollBox.Parent := Self;
FScrollBox.Align := alClient;
{ 创建编辑}
for i := 0 to n - 1 do
begin
{ 创建标题}
Labels[i] := TDBText.Create(Owner);
Labels[i].visible := FTitleVisible;
Labels[i].Parent := FScrollBox;
Labels[i].DataField := DataField_Title;
Labels[i].DataSource := DataSource;
Labels[i].Left := FLeft + (maxLabelLen + 36) * (i div RowCount)+16; //+maxTextLen
if FEditorstyle = TsDBMemo then
begin
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*4+10) + 2;
end
else
begin
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*2+10) + 2;
Labels[i].Width := maxLabelLen;
end;
{ 创建进度条数据对象}
ProgressEditor[i] := TDBedit.Create(Owner);
ProgressEditor[i].visible := False;
ProgressEditor[i].Parent := FScrollBox;
ProgressEditor[i].DataField := DataField_Progress;
ProgressEditor[i].DataSource := DataSource;
ProgressEditor[i].OnChange := AProgressEditorChange;
{ 创建信息显示数据对象}
if FEditorstyle = TsDBcombox then
begin
comEditors[i] := TDBComboBox.Create(Owner);
comEditors[i].Parent := FScrollBox; //Self;
comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
comEditors[i].Width := maxTextLen;
comEditors[i].Top := Labels[i].Top+20;
comEditors[i].DataSource := DataSource;
comEditors[i].DataField := DataField_Editor;
comEditors[i].OnKeyPress := AKeyPress;
comEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TProgressBar.Create(Owner);
ProgressBars[i].Parent := FScrollBox;
ProgressBars[i].Orientation := pbHorizontal;
ProgressBars[i].Left := comEditors[i].Left;
ProgressBars[i].Width := comEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := comEditors[i].Top+comEditors[i].height+2;
ProgressBars[i].Position := i*4
end
else if FEditorstyle = TsDBEdit then
begin
edEditors[i] := TDBedit.Create(Owner);
edEditors[i].Parent := FScrollBox;
edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
edEditors[i].Width := maxTextLen;
edEditors[i].Top := Labels[i].Top+20;
edEditors[i].DataSource := DataSource;
edEditors[i].DataField := DataField_Editor;
edEditors[i].OnKeyPress := AKeyPress;
edEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TProgressBar.Create(Owner);
ProgressBars[i].Parent := FScrollBox;
ProgressBars[i].Orientation := pbHorizontal;
ProgressBars[i].Left := edEditors[i].Left;
ProgressBars[i].Width := edEditors[i].Width;
ProgressBars[i].Height := 10;
ProgressBars[i].Top := edEditors[i].Top+edEditors[i].height+2;;
ProgressBars[i].Position := i*4
end
else
begin
MemoEditors[i] := TDBmemo.Create(Owner);
MemoEditors[i].Parent := FScrollBox;
MemoEditors[i].Left := Labels[i].Left;
MemoEditors[i].Width := maxTextLen;
MemoEditors[i].Top := Labels[i].Top+20;
MemoEditors[i].DataSource := DataSource;
MemoEditors[i].DataField := DataField_Editor;
MemoEditors[i].OnKeyPress := AKeyPress;
MemoEditors[i].OnKeyDown := AKeyDown;
ProgressBars[i] := TProgressBar.Create(Owner);
ProgressBars[i].Parent := FScrollBox;
ProgressBars[i].Orientation := pbVertical;
ProgressBars[i].Left := MemoEditors[i].Left + MemoEditors[i].Width +1;
ProgressBars[i].Width := 10;
ProgressBars[i].Height := MemoEditors[i].Height;
ProgressBars[i].Top := MemoEditors[i].Top;
ProgressBars[i].Position := i*4
end;
if not DataSource.DataSet.Eof then
DataSource.DataSet.next;
end;
DataSource.DataSet.EnableControls;
FScrollBox.Visible := True;
end;
end;
destructor TDBPanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;
function TDBPanel.comEditor(Index: Integer): TDBComboBox;
begin
if Index< Length(comEditors) then Result := comEditors[Index]
else Result := nil;
end;
function TDBPanel.edEditor(Index: Integer): TDBedit;
begin
if Index < Length(edEditors) then Result := edEditors[Index]
else Result := nil;
end;
function TDBPanel.MemoEditor(Index: Integer): TDBMemo;
begin
if Index< Length(MemoEditors) then Result := MemoEditors[Index]
else Result := nil;
end;
// 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时
procedure TDBPanel.FreeEditors;
begin
if FScrollBox <> nil then
begin
comEditors := nil;
edEditors := nil;
MemoEditors := nil;
FScrollBox.Free;
FScrollBox := nil;
end;
end;
end.

339
T03贸易布匹检验/DbPanel/JKFootpanel.pas Normal file
View File

@ -0,0 +1,339 @@
unit JKFootpanel;
interface
uses
Windows, Messages, SysUtils, Classes,Graphics, Controls, Forms, Dialogs,
ExtCtrls, dbctrls, stdctrls, db, ADODB, ComCtrls;
type
TEditorstyle = (TsDbMemo,TsDBcombox,Tsdbedit);
type
TJKFootpanel = class(TPanel)
private
{ Private declarations }
FLeft: Integer;
FTop: Integer;
maxTextLen: Integer;
maxLabelLen: Integer;
FScrollBox: TScrollBox; {滚动控件}
FLineHeight: Integer;
FEditorstyle:Teditorstyle;
FTitleVisible :Boolean;
//数据数组控件，动态生成
MemoEditors :array of TDBMemo;
comEditors :array of TDBCombobox;
edEditors :array of TDBedit;
Labels :array of TLAbel; //字段标题，动态生成
FDataSource :TDataSource; // 数据源
FColumns :Integer; //显示列数
procedure FreeEditors; //释放数据输入控件的内存
procedure AKeyDown(Sender :TObject; var Key: Word; Shift:TShiftState);
procedure AKeyPress(Sender :TObject; var Key: Char);
function comEditor(Index :Integer):TDBComboBox;
function edEditor(Index :Integer):TDBedit;
function MemoEditor(Index :Integer): TDBMemo;
protected
{ Protected declarations }
public
constructor Create(AOwner :TComponent); override;
destructor Destroy; override;
procedure Setedit(Value :TEditorstyle);
procedure ClearHits(ItemIndex :Integer);
procedure AddHits(ItemIndex :Integer; Hits :array of string);
Function CreateEditors(DS :TDataSource; ColCount :Integer) :integer; //创建各字段的数据输入控件
{ Public declarations }
published
property LimitLeft :Integer read FLeft write FLeft default 10;
property LimitTop :Integer read FTop write FTop default 10;
property Editorstyle :TEditorstyle read FEditorstyle write FEditorstyle default Tsdbedit;
property EditorWidth :Integer read maxTextLen write maxTextLen default 100;
property TitleWidth :Integer read maxLabelLen write maxLabelLen default 100;
property LineHeight :Integer read FLineHeight write FLineHeight default 15;
property TitleVisible :Boolean read FTitleVisible write FTitleVisible default True;
property DataSource :TDataSource read FDataSource write FDataSource; //数据源
property Columns :Integer read FColumns write FColumns default 4;//表列数
{ Published declarations }
end;
procedure Register;
implementation
constructor TJKFootpanel.Create(AOwner: TComponent);
begin
Inherited Create(AOWner);
FLeft :=16;
FTop := 10;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
FTitleVisible := True;
Editorstyle := Tsdbedit;
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TJKFootpanel]);
end;
procedure TJKFootpanel.Setedit(Value : TEditorstyle);
begin
if FEditorstyle <> Value then
begin
FEditorstyle := Value;
Invalidate;
end;
end;
{ 为第I字段增加提示信息的方法}
procedure TJKFootpanel.AddHits(ItemIndex:
Integer; Hits: array of string);
var
m,n,i: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
comEditors[ItemIndex].Items.Add(Hits[i]);
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
edEditors[ItemIndex].Hint:= Hits[i];
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(memoEditors);
m := Length(Hits);
if ItemIndex< n then
for i:=0 to m-1 do
memoEditors[ItemIndex].Hint:= Hits[i];
end;
end;
procedure TJKFootpanel.AKeyPress(Sender: TObject; var Key: Char);
begin
if (Sender is TDBComboBox) or (Sender is TDBedit) or (Sender is TDBMemo) then
if Key=#13 then
(Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TJKFootpanel.ClearHits(ItemIndex: Integer);
var
n: Integer;
begin
if FEditorstyle = TsDBcombox then
begin
n := Length(comEditors);
if ItemIndex< n then comEditors[ItemIndex].Items.Clear;
end
else if FEditorstyle = TsDBEdit then
begin
n := Length(edEditors);
if ItemIndex< n then edEditors[ItemIndex].Hint:='';;
end
else if FEditorstyle = TsDBMemo then
begin
n := Length(MemoEditors);
if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';;
end;
end;
{ 创建各字段的数据输入控件的方法}
Function TJKFootpanel.CreateEditors(DS: TDataSource; ColCount: Integer):Integer ;
var
i, n, RowCount: Integer;
TextHeight: Integer;
begin
result := 120;
if DataSource = nil then exit;
if not DataSource.DataSet.Active then exit;
Columns := ColCount;
if Columns = 0 then exit;
n := DataSource.DataSet.fieldCount;
if n > 0 then
begin
DataSource.DataSet.DisableControls;
if maxLabelLen < maxTextLen then
maxTextLen := maxLabelLen;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 计算行列数}
if Columns > n then
Columns := n
else
Columns := ColCount;
RowCount := n div Columns;
if n mod Columns <> 0 then inc(RowCount);
{ 分配内存}
FreeEditors;
SetLength(Labels,n);
if FEditorstyle = TsDBcombox then
SetLength(comEditors,n)
else if FEditorstyle = TsDBEdit then
SetLength(edEditors,n)
else
SetLength(MemoEditors,n);
{ 创建滚动盒}
FScrollBox := TScrollBox.Create(Owner);
FScrollBox.Visible := False;
FScrollBox.Parent := Self;
FScrollBox.Align := alClient;
//FScrollBox.Color := clSkyBlue;
FScrollBox.OnDblClick := OnDblClick;
{ 创建编辑}
for i := 0 to n - 1 do
begin
{ 创建标题}
Labels[i] := TLabel.Create(Owner);
Labels[i].visible := TitleVisible;
Labels[i].Parent := FScrollBox;
Labels[i].Caption := DataSource.DataSet.Fields[i].FieldName;
Labels[i].Left := FLeft + (maxLabelLen + 16) * (i div RowCount)+ 2; //+maxTextLen
if FEditorstyle = TsDBMemo then
begin
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*2+4) + 12;
end
else
begin
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * (TextHeight*1 +12)
end;
{ 创建信息显示数据对象}
if FEditorstyle = TsDBcombox then
begin
comEditors[i] := TDBComboBox.Create(Owner);
comEditors[i].Parent := FScrollBox; //Self;
comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
comEditors[i].Width := maxTextLen;
comEditors[i].Top := Labels[i].Top+15;
comEditors[i].DataSource := DataSource;
comEditors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
comEditors[i].OnKeyPress := AKeyPress;
comEditors[i].OnKeyDown := AKeyDown;
comEditors[i].Font.Color := ClBlue;
end
else if FEditorstyle = TsDBEdit then
begin
edEditors[i] := TDBedit.Create(Owner);
edEditors[i].Parent := FScrollBox;
edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width;
edEditors[i].Width := maxTextLen;
edEditors[i].Top := Labels[i].Top+15;
edEditors[i].DataSource := DataSource;
edEditors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
edEditors[i].OnKeyPress := AKeyPress;
edEditors[i].OnKeyDown := AKeyDown;
edEditors[i].Font.Color := ClBlue;
end
else
begin
MemoEditors[i] := TDBmemo.Create(Owner);
MemoEditors[i].Parent := FScrollBox;
MemoEditors[i].Left := Labels[i].Left;
MemoEditors[i].Width := maxTextLen;
MemoEditors[i].Top := Labels[i].Top+15;
MemoEditors[i].DataSource := DataSource;
MemoEditors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
MemoEditors[i].OnKeyPress := AKeyPress;
MemoEditors[i].OnKeyDown := AKeyDown;
MemoEditors[i].Font.Color := ClBlue;
end;
end;
if FEditorstyle = TsDBMemo then
result := RowCount*TextHeight*4 +20
else
result := RowCount*TextHeight*2 +20;
DataSource.DataSet.EnableControls;
FScrollBox.Visible := True;
end;
end;
destructor TJKFootpanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;
function TJKFootpanel.comEditor(Index: Integer): TDBComboBox;
begin
if Index< Length(comEditors) then Result := comEditors[Index]
else Result := nil;
end;
function TJKFootpanel.edEditor(Index: Integer): TDBedit;
begin
if Index < Length(edEditors) then Result := edEditors[Index]
else Result := nil;
end;
function TJKFootpanel.MemoEditor(Index: Integer): TDBMemo;
begin
if Index< Length(MemoEditors) then Result := MemoEditors[Index]
else Result := nil;
end;
// 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时
procedure TJKFootpanel.FreeEditors;
begin
if FScrollBox <> nil then
begin
comEditors := nil;
edEditors := nil;
MemoEditors := nil;
FScrollBox.Free;
FScrollBox := nil;
end;
end;
procedure TJKFootpanel.AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
{
if (Sender is TDBComboBox) then
begin
case Key of
VK_Next: (Sender as TDBComboBox).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBComboBox).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBedit) then
begin
case Key of
VK_Next: (Sender as TDBedit).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBedit).DataSource.DataSet.Prior;
end;
end
else if (Sender is TDBMemo) then
begin
case Key of
VK_Next: (Sender as TDBMemo).DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBMemo).DataSource.DataSet.Prior;
end;
end;
}
end;
end.

1123
T03贸易布匹检验/DbPanel/JkPanel.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
T03贸易布匹检验/DbPanel/L_DBDateTime.dcr Normal file
View File

Binary file not shown.

143
T03贸易布匹检验/DbPanel/L_DBDateTime.pas Normal file
View File

@ -0,0 +1,143 @@
unit L_DBDateTime;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,db,dbtables,dbctrls,Dialogs,
ComCtrls;
type
TDBDateTime = class(TDateTimePicker)
private
FDataLink:TFieldDataLink;
//TFieldDataLink是TDataLink的派生类，
// 处理单个字段与DataSource的交互
procedure DataChange(sender:Tobject);
//当DataSet的记录改变（如浏览记录）
// 时触发OnDataChange
// 事件，DataChange将作为该事件的事件处理句柄
procedure UpdateData(sender:Tobject);
//更新DataSet前触发OnUpdateData事件，
// UpdateData将作为该事件的事件处理句柄
function GetDataSource:TDataSource;
procedure SetdataSource(value:TDataSource);
Function GetDataField:String;
procedure SetdataField(Value:String);
procedure CMexit(var Message:TCMExit);
message CM_EXIT;//当控件失去焦点时触发CM_EXIT消息
protected
procedure Change;override;//控件中日期、
// 时间改变时触发OnChange事件
procedure Notification(AComponent:TComponent;
Operation:Toperation);override;
//当某一控件从FORM上移走时DELPHI的
// IDE调用该方法通知其它控件
public
constructor Create(AOwner:Tcomponent);override;
destructor Destroy;override;
published
property DataSource:TDataSource read GetDataSource
write SetDataSource;//为控件增加DataSource属性，
// 使它能与DataSource构件连接
property DataField:String read GetDataField
write SetDataField;
end;//为控件增加DataField属性，
// 使它指向代表某一字段的TField对象
procedure Register;//注册构件
implementation
procedure TDBDateTime.CMExit;
begin
try
FDataLink.UpdateRecord;
//控件失去焦点时更新DataSet，
// 这将触发OnUpdateData事件
except
Setfocus;
raise;
end;
DoExit;
end;
constructor TDBDateTime.Create(Aowner:Tcomponent);
begin
inherited Create(Aowner);
//创建DataLink对象，挂接OnDataChange、
//OnUpdateData事件处理句柄
FDataLink:=TFieldDataLInk.Create;
FDataLink.OnDataChange:=DataChange;
FDataLink.OnUpdateData:=Updatedata;
end;
Destructor TDBDateTime.Destroy;
begin
FDataLink.OnDataChange:=nil;
FDataLink.OnUpdateData:=nil;
FDataLink.Free;
inherited Destroy;
end;
function TDBDateTime.GetdataSource:TdataSource;
begin
result:=FDataLink.DataSource;
end;
Procedure TDBDateTime.SetDataSource
(Value:TDataSource);
begin
FDataLink.DataSource:=Value;
end;
function TDBDateTime.GetDatafield:String;
begin
result:=FDataLink.FieldName;
end;
procedure TDBDateTime.SetDataField(value:String);
begin
FdataLink.FieldName:=value;
end;
procedure TDBDateTime.DataChange(Sender:Tobject);
begin
DateTime:=now;
//若控件连了活动的DataSet则数据集变动时
//控件显示当前记录的相应字段值
if FDataLink.Field<>nil then
if FDataLink.Field.Text<>'' then
DateTime:=FDatalink.Field.AsDateTime;
end;
Procedure TDBDateTime.UpdateData(sender:Tobject);
begin
FDatalink.Field.AsDateTime:=DateTime;
//用控件中的日期、时间更新相应字段
end;
procedure TDBDateTime.Change;
begin
//当用户改变了控件中的内容时将DataSet置为编辑状态
FDataLink.Modified;
if not FDataLink.Editing then
FdataLink.Edit;
inherited Change;
end;
procedure TDBDateTime.Notification
(AComponent:TComponent;Operation:TOperation);
begin
inherited Notification(Acomponent,Operation);
//当与控件相连的TdataSource
// 被删除时将控件的DataSource属性置为空
if (Operation=opRemove) and (FDataLink<>nil)
and (AComponent=Datasource) then
DataSource:=nil;
end;
procedure Register;
begin
RegisterComponents('Data Controls',[TDBDateTime]);
end;
end.

84
T03贸易布匹检验/DbPanel/MovePanel.pas Normal file
View File

@ -0,0 +1,84 @@
unit MovePanel;
interface
uses
Windows, Classes, Controls,ExtCtrls;
type
TMovePanel = class(TPanel) //这个控件是继承Tpanel类的
private
PrePoint:TPoint;
Down:Boolean;
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent);
override;
//重载鼠标事件，抢先处理消息
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure MouseMove(Shift: TShiftState;
X, Y: Integer);override;
{ Public declarations }
published
{ Published declarations }
end;
procedure Register;
implementation
constructor TMovePanel.Create(AOwner:TComponent);
begin
inherited Create(AOwner); //继承父类的Create方法
end;
procedure TMovePanel.MouseDown(Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button=MBLeft) then
begin
Down:=true;
GetCursorPos(PrePoint);
end;
//如果方法已存在，就触发相应事件去调用它，若不加此语句会造成访存异常
if assigned(OnMouseDown) then
OnMouseDown(self,Button,shift,x,y);
end;
procedure TMovePanel.MouseUp(Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button=MBLeft) and Down then
Down:=False;
if assigned(OnMouseUp) then
OnMouseUp(Self,Button,shift,X,y);
end;
procedure TMovePanel.MouseMove(Shift:
TShiftState; X, Y: Integer);
Var
NowPoint:TPoint;
begin
if down then
begin
GetCursorPos(nowPoint);
//self.Parent在Form中就是MovePanel所在的窗体，或是MovePanel所在的容器像Panel
self.Parent.Left:=self.Parent.left
+NowPoint.x-PrePoint.x;
self.parent.Top:=self.Parent.Top
+NowPoint.y-PrePoint.y;
PrePoint:=NowPoint;
end;
if Assigned(OnMouseMove) then
OnMouseMove(self,Shift,X,y);
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TMovePanel]);
end;
end.

330
T03贸易布匹检验/DbPanel/dsr.pas Normal file
View File

@ -0,0 +1,330 @@
unit dsr;
interface
uses
SysUtils, StrUtils, Forms, Classes, DB, ADODB, Grids, DBGrids, Messages;
var
CanLCCL :Boolean;
V_User,V_UserID :string;
TmpHandle :THandle;
cnn_Base :TAdoConnection;
function SplitString(STR_Source :string; STR_Split:string):TStringList;
procedure DoAbnormalC(H: THandle;AConn: TADOConnection;UID: String;
UName: String;TRCarNo: String);stdcall;external 'frabnml.dll';
{
procedure DoRinseprt(H: THandle;//调用窗口句柄
AConn: TADOConnection;//ADO连接
UID: String;//操作员号
UName: String;//操作员名
Machine: String;//机台编号
Task: String//任务序次
);stdcall;
}
procedure DoRinseprt(H: THandle;AConn: TADOConnection;UID:String;
UName :String; Machine:String; Task:String); stdcall; external 'rinsepf.dll';
procedure Set_NextControl( Pass_Form: TCustomForm;var Key:Char);
function checkfunc(handle: Integer; DogFlag: String): Integer; stdcall; external 'FUTONG.DLL';
//检查硬件狗函数
// handle为主窗口句柄
// DogFlag为从数据库中查询到的硬件狗信息
// DLL自动检查硬件狗和DogFlag的信息是否相符，不符时将在3分钟左右自动重启计算机
function GetParm(flag: Integer; out len: Integer; outHex: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//硬件狗中获取特定信息，如IP地址，数据库名称，用户名、口令等
//自定义参数flag取值范围为0--4，存储空间一共为20个字节，为连续的地址空间
//也即：参数0，最大可用长度为20，这时其他参数，将覆盖这个区域
// 参数4，最大可用长度为4
//DogFlag为字符串信息
function SetParm(flag, len: Integer; inHex: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//flag=5IP,=6User,=7Pass,=8DB
//硬件狗中设置参数，传入IP时，须设置为 “C8A00164”等形式传入（192.168.1.100）
//自定义参数用法同上
function InfoFunc(order: Integer; info: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//读取本机硬件信息，返回值为机器网卡个数
//考虑到某些可移动的网卡，要查询固定的网卡信息
//软件安装时要求移除可移动网卡
//order为第几块网卡，从0开始
function GetHostIpAddr(DogParm, HostName, IPAddr: PAnsiChar): Integer; stdcall; external 'FUTONG.DLL';
//获取硬件狗标识,本机IP地址（仅参考，因为机器有多个IP地址，获取的只是其中之一）
//以及机器名称
function PBEncode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
function PBEncode1(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
function PBDecode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
implementation
function SplitString(STR_Source :string; STR_Split:string):TStringList;
var
temp:String;
i:Integer;
begin
Result:=TStringList.Create;
//如果是空自符串则返回空列表
if trim(STR_Source) = '' then exit;
temp:=STR_Source;
i:=pos(STR_Split,STR_Source);
while i <> 0 do
begin
Result.add(copy(temp,0,i-1));
Delete(temp,1,i+length(STR_Split)-1); //如果STR_Split长度大于1的话,原来的只删除STR_Split字符的第一个.
i:=pos(STR_Split,temp);
end;
Result.add(temp);
end;
procedure Set_NextControl( Pass_Form: TCustomForm;var Key:Char);
label
labe_A;
begin
if key=#13 then
if not (Pass_Form.ActiveControl is TDbgrid) Then
Begin
key:=#0;
Pass_Form.perform(WM_NEXTDLGCTL,0,0);
end
else
if (Pass_Form.ActiveControl is TDbgrid) Then
begin
With TDbgrid(Pass_Form.ActiveControl) Do
begin
labe_A:
if Selectedindex<(FieldCount-1) then
Selectedindex:=Selectedindex+1
else Selectedindex:=0;
if not Columns[Selectedindex].Visible then
goto labe_A;
end;
end;
end;
function PBEncode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
table: array[0..63] of AnsiChar;
c80, c81, c82, c6: AnsiChar;
i, k, len: Integer;
Tmpbuf: array[0..255] of AnsiChar;
begin
table := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
if (nInLen*4)>(nOutLen*3+3) then Result := 1;
k := nInLen div 3;
len := k*4;
for i:=0 to k-1 do
begin
c80 := Inbuf[i*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[i*4] := table[Integer(c6) and $3f];
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[i*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[i*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
c82 := Inbuf[i*3+2];
c6 := Char((Integer(c82) shr 6) and $03);
Tmpbuf[i*4+2] := table[Integer(c81) or Integer(c6)];
Tmpbuf[i*4+3] := table[Integer(c82) and $3f];
end;
i := nInLen mod 3;
k := nInLen div 3;
if i<>0 then
begin
len := len+4;
c80 := Inbuf[k*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[k*4] := table[Integer(c6) and $3f];
if k=1 then
begin
c80 := Char((Integer(c80) shl 4) and $30);
Tmpbuf[k*4+1] := table[Integer(c80)];
Tmpbuf[k*4+2] := '=';
end
else
begin
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[k*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[k*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
Tmpbuf[k*4+2] := table[Integer(c81)];
end;
Tmpbuf[k*4+3] := '=';
end;
Tmpbuf[len] := #0;
Outbuf := Tmpbuf;
Result := len;
end;
function PBEncode1(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
table: array[0..63] of AnsiChar;
c80, c81, c82, c6: AnsiChar;
i, k, len: Integer;
Tmpbuf: array[0..255] of AnsiChar;
begin
table := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
if (nInLen*4)>(nOutLen*3+3) then Result := 1;
k := nInLen div 3;
len := k*4;
for i:=0 to k-1 do
begin
c80 := Inbuf[i*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[i*4] := table[Integer(c6) and $3f];
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[i*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[i*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
c82 := Inbuf[i*3+2];
c6 := Char((Integer(c82) shr 6) and $03);
Tmpbuf[i*4+2] := table[Integer(c81) or Integer(c6)];
Tmpbuf[i*4+3] := table[Integer(c82) and $3f];
end;
i := nInLen mod 3;
k := nInLen div 3;
if i<>0 then
begin
len := len+4;
c80 := Inbuf[k*3];
c6 := Char(Integer(c80) shr 2);
Tmpbuf[k*4] := table[Integer(c6) and $3f];
if i=1 then
begin
c80 := Char((Integer(c80) shl 4) and $30);
Tmpbuf[k*4+1] := table[Integer(c80)];
Tmpbuf[k*4+2] := '=';
end
else
begin
c80 := Char((Integer(c80) shl 4) and $30);
c81 := Inbuf[k*3+1];
c6 := Char((Integer(c81) shr 4) and $0f);
Tmpbuf[k*4+1] := table[Integer(c80) or Integer(c6)];
c81 := Char((Integer(c81) shl 2) and $3c);
Tmpbuf[k*4+2] := table[Integer(c81)];
end;
Tmpbuf[k*4+3] := '=';
end;
Tmpbuf[len] := #0;
Outbuf := Tmpbuf;
Result := len;
end;
function PBDecode(Inbuf: PAnsiChar; out Outbuf: AnsiString; nInLen: Word; nOutLen: Word): Integer;
var
pBufIn: PAnsiChar;
szBufTmp: array[0..255] of AnsiChar;
i, dwCoded, nprbytes, nbytesdecoded: Integer;
pszCoded: PAnsiChar;
szBufout: array[0..255] of AnsiChar;
pszBufout: PAnsiChar;
pr2six: array[0..255] of Word;
begin
for i := 0 to 42 do
pr2six[i] := 64;
pr2six[43] := 62;
for i := 44 to 46 do
pr2six[i] := 64;
pr2six[47] := 63;
for i := 48 to 57 do
pr2six[i] := i+4;
for i := 58 to 64 do
pr2six[i] := 64;
for i := 65 to 90 do
pr2six[i] := i-65;
for i := 91 to 96 do
pr2six[i] := 64;
for i := 97 to 122 do
pr2six[i] := i-71;
for i := 123 to 255 do
pr2six[i] := 64;
dwCoded := nInlen;
pszCoded := Inbuf;
while (dwCoded>0) and (pszCoded=' ') do
begin
Inc(pszCoded);
Dec(dwCoded);
end;
if dwCoded>(350-4) then result := 1;
StrLCopy(szBufTmp, pszCoded, dwCoded);
szBufTmp[dwCoded] := #0;
szBufTmp[dwCoded+1] := #0;
szBufTmp[dwCoded+2] := #0;
szBufTmp[dwCoded+3] := #0;
pBufIn := szBufTmp;
repeat
i := pr2six[Integer(pBufIn^)];
Inc(pBufIn);
until i>63;
nprbytes := pBufin-szBufTmp-1;
nbytesdecoded := ((nprbytes+3) div 4)*3;
if nOutLen<nbytesdecoded then result := 2;
if nbytesdecoded>(256-4) then result := 2;
pszBufout := szBufout;
pBufin := szBufTmp;
while nprbytes>0 do
begin
pszBufout^ := Char((pr2six[Integer(pBufin[0])] shl 2) or ((pr2six[Integer(pBufin[1])] shr 4)));
Inc(pszBufout);
pszBufout^ := Char((pr2six[Integer(pBufin[1])] shl 4) or ((pr2six[Integer(pBufin[2])] shr 2)));
Inc(pszBufout);
pszBufout^ := Char((pr2six[Integer(pBufin[2])] shl 6) or (pr2six[Integer(pBufin[3])]));
Inc(pszBufout);
Inc(pBufin, 4);
Dec(nprbytes, 4);
end;
if (nprbytes and $03) <> 0 then
begin
if pr2six[Integer(pBufin[-2])]>63 then Dec(nbytesdecoded, 2)
else Dec(nbytesdecoded);
end;
szBufout[nbytesdecoded] := #0;
Outbuf := szBufout;
result := nbytesdecoded;
end;
end.

80
T03贸易布匹检验/DjdMachineInsp.dpr Normal file
View File

@ -0,0 +1,80 @@
library DjdMachineInsp;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
midaslib,
U_GetDllForm in 'U_GetDllForm.pas',
U_DataLink in 'U_DataLink.pas' {DataLink_TradeInsp: TDataModule},
U_iniParam in 'U_iniParam.pas',
U_BaseHelp in '..\..\..\public10\design\U_BaseHelp.pas' {frmBaseHelp},
U_BaseInput in '..\..\..\public10\design\U_BaseInput.pas' {frmBaseInput},
U_BaseList in '..\..\..\public10\design\U_BaseList.pas' {frmBaseList},
U_cxGridCustomCss in '..\..\..\public10\design\U_cxGridCustomCss.pas',
U_globalVar in '..\..\..\public10\design\U_globalVar.pas',
U_WindowFormdesign in '..\..\..\public10\design\U_WindowFormdesign.pas',
U_CompressionFun in '..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas',
U_RTFun in '..\..\..\public10\ThreeFun\Fun\U_RTFun.pas',
U_ZDYHelp in '..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas' {frmZDYHelp},
U_AttachmentUpload in '..\A00通用窗体\U_AttachmentUpload.pas' {frmFjList_RZ},
U_CompanySel in '..\A00通用窗体\U_CompanySel.pas' {frmCompanySel},
U_EmployeeSel in '..\A00通用窗体\U_EmployeeSel.pas' {frmEmployeeSel},
U_TradeMachInsp in 'U_TradeMachInsp.pas' {frmTradeMachInsp},
U_FormLayOutDesign in '..\..\..\public10\design\U_FormLayOutDesign.pas',
U_cxGridCustomSet in '..\..\..\public10\design\U_cxGridCustomSet.pas',
U_LabelMapSet in '..\A00通用窗体\U_LabelMapSet.pas' {frmLabelMapSet},
U_BaseDataLink in '..\..\..\public10\design\U_BaseDataLink.pas' {BaseDataLink: TDataModule},
U_MachRollMain in 'U_MachRollMain.pas' {frmMachRollMain},
U_frameBads in 'U_frameBads.pas' {frameBads: TFrame},
U_frameParam in 'U_frameParam.pas' {FrameParam: TFrame},
U_ParamSet in 'U_ParamSet.pas' {frmParamSet},
U_SysLogList in 'U_SysLogList.pas' {frmSysLogList},
U_KeyBoard in 'U_KeyBoard.pas' {FrameKeyBoard: TFrame},
U_ProductListHelp in 'U_ProductListHelp.pas' {frmProductListHelp},
U_ProductJYHZList in 'U_ProductJYHZList.pas' {frmProductJYHZList},
U_TradePack in 'U_TradePack.pas' {frmTradePack},
U_TradeClothWaitPack in 'U_TradeClothWaitPack.pas' {frmTradeClothWaitPack},
U_TradeClothInspList in 'U_TradeClothInspList.pas' {frmTradeClothInspList},
U_DjdDjClList in 'U_DjdDjClList.pas' {frmDjdDjClList},
U_ControlData in '..\..\..\public10\ThreeFun\Fun\U_ControlData.pas',
U_LabelPrint in '..\A00通用窗体\U_LabelPrint.pas' {frmLabelPrint},
U_DeviceJkTest in 'U_DeviceJkTest.pas' {frmDeviceJkTest},
U_DeviceJkDll in 'U_DeviceJkDll.pas',
U_BatchMdyData in 'U_BatchMdyData.pas' {frmBatchMdyData},
U_AdoFunc in '..\..\..\public10\ThreeFun\Fun\U_AdoFunc.pas',
FrameDateSel in '..\A00通用组件\FrameDateSel.pas' {frmFrameDateSel: TFrame},
U_BillPrintList in 'U_BillPrintList.pas' {frmBillPrintList},
U_printPdf in '..\..\..\public10\ThreeFun\Fun\U_printPdf.pas',
U_TradeClothTotalOutSel in 'U_TradeClothTotalOutSel.pas' {frmTradeClothTotalOutSel},
U_CustomFun in '..\A00通用方法\U_CustomFun.pas',
uSZHN_JSON in '..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas';
{$R *.res}
procedure DllEnterPoint(dwReason: DWORD); far; stdcall;
begin
DLLProc := @DLLEnterPoint;
DllEnterPoint(DLL_PROCESS_ATTACH);
end;
procedure DLLUnloadProc(Reason: Integer); register;
begin
// if (Reason = DLL_PROCESS_DETACH) or (Reason = DLL_THREAD_DETACH) then
// Application := NewDllApp;
end;
exports
GetDllForm;
begin
try
NewDllApp := Application;
DLLProc := @DLLUnloadProc;
except
end;
end.

1042
T03贸易布匹检验/DjdMachineInsp.dproj Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
T03贸易布匹检验/DjdMachineInsp.res Normal file
View File

Binary file not shown.

62
T03贸易布匹检验/DjdMachineInsp.skincfg Normal file
View File

@ -0,0 +1,62 @@
[ExpressSkins]
Default=0
ShowNotifications=0
Enabled=1
dxSkinBasic=0
dxSkinBlack=0
dxSkinBlue=0
dxSkinBlueprint=0
dxSkinCaramel=0
dxSkinCoffee=0
dxSkinDarkroom=0
dxSkinDarkSide=0
dxSkinDevExpressDarkStyle=0
dxSkinDevExpressStyle=0
dxSkinFoggy=0
dxSkinGlassOceans=0
dxSkinHighContrast=0
dxSkiniMaginary=0
dxSkinLilian=0
dxSkinLiquidSky=0
dxSkinLondonLiquidSky=0
dxSkinMcSkin=0
dxSkinMetropolis=0
dxSkinMetropolisDark=0
dxSkinMoneyTwins=0
dxSkinOffice2007Black=0
dxSkinOffice2007Blue=0
dxSkinOffice2007Green=0
dxSkinOffice2007Pink=0
dxSkinOffice2007Silver=0
dxSkinOffice2010Black=0
dxSkinOffice2010Blue=0
dxSkinOffice2010Silver=0
dxSkinOffice2013DarkGray=0
dxSkinOffice2013LightGray=0
dxSkinOffice2013White=0
dxSkinOffice2016Colorful=0
dxSkinOffice2016Dark=0
dxSkinOffice2019Black=0
dxSkinOffice2019Colorful=0
dxSkinOffice2019DarkGray=0
dxSkinOffice2019White=0
dxSkinPumpkin=0
dxSkinSeven=0
dxSkinSevenClassic=0
dxSkinSharp=0
dxSkinSharpPlus=0
dxSkinSilver=0
dxSkinSpringtime=0
dxSkinStardust=0
dxSkinSummer2008=0
dxSkinTheAsphaltWorld=0
dxSkinTheBezier=0
dxSkinsDefaultPainters=0
dxSkinValentine=0
dxSkinVisualStudio2013Blue=0
dxSkinVisualStudio2013Dark=0
dxSkinVisualStudio2013Light=0
dxSkinVS2010=0
dxSkinWhiteprint=0
dxSkinWXI=1
dxSkinXmas2008Blue=0

2488
T03贸易布匹检验/ElAES.pas Normal file
View File

File diff suppressed because it is too large Load Diff

5
T03贸易布匹检验/File.INI Normal file
View File

@ -0,0 +1,5 @@
[生产车间配置]
机台标志=1
成品DLL文件=TradeManagePB.dll
成品DLL调用号=3
员工编号=select distinct UserID from SY_Purview where ModuleId='15' and ModuleSubId='04'

15
T03贸易布匹检验/FileCar.INI Normal file
View File

@ -0,0 +1,15 @@
[生产车间配置]
DLL文件1=TradeManage.dll
卷条码机台标志=1
DLL调用号1=5
模块名称1=机台刷卡
模块显示1=1
DLL文件2=TradeManage.dll
模块显示2=1
DLL调用号2=51
模块名称2=员工上班
码表调用Dll文件=JCYData.dll
电子秤调用Dll文件=APORT232D.dll
员工编号=select distinct bzname as userid,bzid from OA_YG_BZ order by bzid

7
T03贸易布匹检验/FileHelp.ini Normal file
View File

@ -0,0 +1,7 @@
[FILEPATH]
FileClass=YP,AA,BB,HT
YP=D:\YP
AA=D:\AA
BB=D:\BB
HT=D:\HT
OTHER=D:\OTHER

12
T03贸易布匹检验/FileKPZ.INI Normal file
View File

@ -0,0 +1,12 @@
[生产车间配置]
DLL文件1=TradeInsp.dll
DLL调用号1=112
DLL文件2=TradeInsp.dll
DLL调用号2=112
模块名称1=坯布称重
模块显示1=1
模块名称2=扫描检验
模块显示2=1
电子秤调用Dll文件=JZCRS232D.dll
码表调用Dll文件=
员工编号=select * from SY_PurView where ModuleId='19' and ModuleSubId in('04','21')

2
T03贸易布匹检验/FileUpdate.INI Normal file
View File

@ -0,0 +1,2 @@
[系统设置]
自动更新文件服务器=

BIN
T03贸易布匹检验/InformationBase_Icon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 766 B

7
T03贸易布匹检验/JCYData10.INI Normal file
View File

@ -0,0 +1,7 @@
[系统配置]
串口号=com1
波特率=19200
校验位=0
数据位=8
停止位=1
频率=100

7
T03贸易布匹检验/JCYData_Ts.INI Normal file
View File

@ -0,0 +1,7 @@
[系统配置]
串口号=com3
波特率=9600
校验位=0
数据位=8
停止位=0
频率=100

295
T03贸易布匹检验/JDAESExtend.pas Normal file
View File

@ -0,0 +1,295 @@
(**************************************************)
(* *)
(* Advanced Encryption Standard (AES) Extend *)
(* *)
(* Copyright (c) 2005-2016 *)
(* aisino, qiaobu@139.com qiaohaidong@aisino.com *)
(* *)
(**************************************************)
unit JDAESExtend;
interface
{$WARN IMPLICIT_STRING_CAST OFF} // 关闭警告
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
uses
SysUtils, Classes, Math, ElAES, System.Generics.Collections, Soap.EncdDecd;
type
TPaddingType = (PKCS5Padding { , PKCS7Padding } );
TKeyBit = (kb128, kb192, kb256);
TalgoMode = (amECB, amCBC { , amCFB, amOFB, amCTR } );
TCipherType = (ctBase64, ctHex);
TArrayPadding = array of Byte;
TArrayByte = array of Byte;
var
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
InitVector: TAESBuffer;
function EncryptString(Value: AnsiString; Key: AnsiString; KeyBit: TKeyBit = kb128; algoMode: TalgoMode = amECB; padding: TPaddingType = PKCS5Padding; sInitVector: AnsiString = '0000000000000000';
CipherType: TCipherType = ctHex): AnsiString;
function DecryptString(Value: AnsiString; Key: AnsiString; KeyBit: TKeyBit = kb128; algoMode: TalgoMode = amECB; padding: TPaddingType = PKCS5Padding; sInitVector: AnsiString = '0000000000000000';
CipherType: TCipherType = ctHex): AnsiString;
implementation
//字符串转16进制（字符串）
function StrToHex(Value: AnsiString): string;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(Value) do
Result := Result + IntToHex(Ord(Value[i]), 2);
end;
//16进制（字符串）转字符串
function HexToStr(Value: AnsiString): AnsiString;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(Value) do
begin
if ((i mod 2) = 1) then
Result := Result + ansichar(StrToInt('0x' + Copy(Value, i, 2)));
end;
end;
//PKCS5规则补码
function PKCS5_Padding(Value: AnsiString; out arrayValue: TArrayByte): Int64;
var
Valueutf8: UTF8String;
BytesValue: array of Byte;
intMod: Byte;
valueLen: Integer;
i: Integer;
begin
Valueutf8 := Value;
SetLength(BytesValue, Length(Valueutf8));
Move(Valueutf8[1], BytesValue[0], Length(Valueutf8));
intMod := 16 - Length(BytesValue) mod 16;
valueLen := Length(BytesValue);
SetLength(BytesValue, valueLen + intMod);
for i := 0 to intMod - 1 do
begin
BytesValue[valueLen + i] := intMod;
end;
SetLength(arrayValue, Length(BytesValue));
Move(BytesValue[0], arrayValue[0], Length(BytesValue));
Result := Length(BytesValue);
end;
//PKCS5规则去补码
function PKCS5_DePadding(bytes: TBytes): string;
var
Encoding: TEncoding;
size: Integer;
paddingByte: Byte;
tmpBytes: TBytes;
begin
paddingByte := bytes[Length(bytes) - 1];
SetLength(tmpBytes, Length(bytes) - paddingByte);
Move(bytes[0], tmpBytes[0], Length(tmpBytes));
Encoding := TEncoding.UTF8;
size := TEncoding.GetBufferEncoding(tmpBytes, Encoding);
Result := Encoding.GetString(tmpBytes, size, Length(tmpBytes) - size)
end;
//密钥不足位数0补码
procedure ZeroPadding(KeyBit: TKeyBit);
begin
case KeyBit of
kb128:
FillChar(AESKey128, SizeOf(AESKey128), 0);
kb192:
FillChar(AESKey192, SizeOf(AESKey192), 0);
kb256:
FillChar(AESKey256, SizeOf(AESKey256), 0);
end;
end;
function EncryptString(Value: AnsiString; Key: AnsiString; KeyBit: TKeyBit = kb128; algoMode: TalgoMode = amECB; padding: TPaddingType = PKCS5Padding; sInitVector: AnsiString = '0000000000000000';
CipherType: TCipherType = ctHex): AnsiString;
var
SS, DS: TMemoryStream;
str: AnsiString;
byteContent: TArrayByte;
begin
Result := '';
PKCS5_Padding(Value, byteContent);
SS := TMemoryStream.Create;
SS.WriteBuffer(byteContent[0], Length(byteContent));
SS.Position := SS.size;
DS := TMemoryStream.Create;
try
case KeyBit of
kb128:
begin
ZeroPadding(kb128);
Move(PAnsiChar(Key)^, AESKey128, Length(Key));
case algoMode of
amECB:
begin
EncryptAESStreamECB(SS, 0, AESKey128, DS);
end;
amCBC:
begin
// 不足16位用0补齐
FillChar(InitVector, SizeOf(InitVector), 0);
Move(PAnsiChar(sInitVector)^, InitVector, Length(sInitVector));
EncryptAESStreamCBC(SS, 0, AESKey128, InitVector, DS);
end;
end;
end;
kb192:
begin
ZeroPadding(kb192);
Move(PAnsiChar(Key)^, AESKey192, Length(Key));
case algoMode of
amECB:
begin
EncryptAESStreamECB(SS, 0, AESKey192, DS);
end;
amCBC:
begin
FillChar(InitVector, SizeOf(InitVector), 0);
Move(PAnsiChar(sInitVector)^, InitVector, Length(sInitVector));
EncryptAESStreamCBC(SS, 0, AESKey192, InitVector, DS);
end;
end;
end;
kb256:
begin
ZeroPadding(kb256);
Move(PAnsiChar(Key)^, AESKey256, Length(Key));
case algoMode of
amECB:
begin
EncryptAESStreamECB(SS, 0, AESKey256, DS);
end;
amCBC:
begin
FillChar(InitVector, SizeOf(InitVector), 0);
Move(PAnsiChar(sInitVector)^, InitVector, Length(sInitVector));
EncryptAESStreamCBC(SS, 0, AESKey256, InitVector, DS);
end;
end;
end;
end;
SetLength(str, DS.size);
DS.Position := 0;
DS.ReadBuffer(PAnsiChar(str)^, DS.size);
if CipherType = ctHex then
Result := StrToHex(str)
else
Result := EncodeBase64(PChar(str),Length(str));
finally
SS.Free;
DS.Free;
end;
end;
function DecryptString(Value: AnsiString; Key: AnsiString; KeyBit: TKeyBit = kb128; algoMode: TalgoMode = amECB; padding: TPaddingType = PKCS5Padding; sInitVector: AnsiString = '0000000000000000';
CipherType: TCipherType = ctHex): AnsiString;
var
SS,DS: TMemoryStream;
str: AnsiString;
byteContent: TBytes;
BytesValue: TBytes;
begin
Result := '';
// pcharValue := pchar(Value);
if CipherType = ctHex then
begin
str := HexToStr(Value);
SetLength(byteContent, Length(str));
Move(str[1], byteContent[0], Length(str));
end
else
byteContent:= DecodeBase64(Value);
SS := TMemoryStream.Create;
SS.WriteBuffer(byteContent[0], Length(byteContent));
DS := TMemoryStream.Create;
try
case KeyBit of
kb128:
begin
ZeroPadding(kb128);
Move(PAnsiChar(Key)^, AESKey128, Length(Key));
case algoMode of
amECB:
begin
DecryptAESStreamECB(SS, 0, AESKey128, DS);
end;
amCBC:
begin
// 不足16位用0补齐
FillChar(InitVector, SizeOf(InitVector), 0);
Move(PAnsiChar(sInitVector)^, InitVector, Length(sInitVector));
DecryptAESStreamCBC(SS, 0, AESKey128, InitVector, DS);
end;
end;
end;
kb192:
begin
ZeroPadding(kb192);
Move(PAnsiChar(Key)^, AESKey192, Length(Key));
case algoMode of
amECB:
begin
DecryptAESStreamECB(SS, 0, AESKey192, DS);
end;
amCBC:
begin
FillChar(InitVector, SizeOf(InitVector), 0);
Move(PAnsiChar(sInitVector)^, InitVector, Length(sInitVector));
DecryptAESStreamCBC(SS, 0, AESKey192, InitVector, DS);
end;
end;
end;
kb256:
begin
ZeroPadding(kb256);
Move(PAnsiChar(Key)^, AESKey256, Length(Key));
case algoMode of
amECB:
begin
DecryptAESStreamECB(SS, 0, AESKey256, DS);
end;
amCBC:
begin
FillChar(InitVector, SizeOf(InitVector), 0);
Move(PAnsiChar(sInitVector)^, InitVector, Length(sInitVector));
DecryptAESStreamCBC(SS, 0, AESKey256, InitVector, DS);
end;
end;
end;
end;
DS.Position := 0;
SetLength(BytesValue, DS.size);
DS.ReadBuffer(BytesValue[0], DS.size);
Result := PKCS5_DePadding(BytesValue);
finally
SS.Free;
DS.Free;
end;
end;
END.

33
T03贸易布匹检验/NapInspFile.INI Normal file
View File

@ -0,0 +1,33 @@
[生产车间配置]
卷条码机台标志=1
机台个数=
端口号=
电子秤调用Dll文件=
启用电子秤Dll文件=0
码表调用Dll文件=
启用码表Dll文件=1
启用码表单位=1
DLL文件1=NappingInsp.dll
DLL调用号1=111
模块名称1=机台检验
模块显示1=1
DLL文件2=NapProcess.dll
模块显示2=1
DLL调用号2=211
模块名称2=员工刷卡
卷条码机台标志=1
员工编号=select userid='ADMIN'
标签份数=2
米数下限=0
米数上限=100
重量下限=0
重量上限=50
米数小数位=1
码数小数位=1
重量小数位=1

23
T03贸易布匹检验/ProjectGroup1.bpg Normal file
View File

@ -0,0 +1,23 @@
#------------------------------------------------------------------------------
VERSION = BWS.01
#------------------------------------------------------------------------------
!ifndef ROOT
ROOT = $(MAKEDIR)\..
!endif
#------------------------------------------------------------------------------
MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
DCC = $(ROOT)\bin\dcc32.exe $**
BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------
PROJECTS = testDll.exe ProductPrice.dll
#------------------------------------------------------------------------------
default: $(PROJECTS)
#------------------------------------------------------------------------------
testDll.exe: testDll.dpr
$(DCC)
ProductPrice.dll: ProductPrice.dpr
$(DCC)

48
T03贸易布匹检验/ProjectGroup1.groupproj Normal file
View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{4ACFE47E-6D57-4F14-B3CC-D7658A0D65E3}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="testDll.dproj">
<Dependencies/>
</Projects>
<Projects Include="DjdMachineInsp.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="testDll">
<MSBuild Projects="testDll.dproj"/>
</Target>
<Target Name="testDll:Clean">
<MSBuild Projects="testDll.dproj" Targets="Clean"/>
</Target>
<Target Name="testDll:Make">
<MSBuild Projects="testDll.dproj" Targets="Make"/>
</Target>
<Target Name="DjdMachineInsp">
<MSBuild Projects="DjdMachineInsp.dproj"/>
</Target>
<Target Name="DjdMachineInsp:Clean">
<MSBuild Projects="DjdMachineInsp.dproj" Targets="Clean"/>
</Target>
<Target Name="DjdMachineInsp:Make">
<MSBuild Projects="DjdMachineInsp.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="testDll;DjdMachineInsp"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="testDll:Clean;DjdMachineInsp:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="testDll:Make;DjdMachineInsp:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

2
T03贸易布匹检验/ProjectGroup1_prjgroup.tvsconfig Normal file
View File

@ -0,0 +1,2 @@
<?xml version="1.0"?>
<TgConfig Version="3" SubLevelDisabled="False" />

10
T03贸易布匹检验/SYSTEMSET.ini Normal file
View File

@ -0,0 +1,10 @@
[SERVER]
服务器地址=101.132.143.144
服务器地址类型=2002
是否自动更新=1
软件名称=睿特版本库
登陆标题=sss
[窗口设置]
字体大小=9
design=1
skin=1

11
T03贸易布匹检验/TiShi.INI Normal file
View File

@ -0,0 +1,11 @@
[系统配置]
dllName=MessageAlert.dll
dllId=111
[Image1]
左边距离=1360
高度距离=365
[配置参数]
登陆用户=admin
显示主菜单=1
窗口模式=导航模式
登陆标题=傲唐软件

BIN
T03贸易布匹检验/TradeInsp.res Normal file
View File

Binary file not shown.

62
T03贸易布匹检验/TradeInsp.skincfg Normal file
View File

@ -0,0 +1,62 @@
[ExpressSkins]
Default=0
ShowNotifications=0
Enabled=1
dxSkinBasic=0
dxSkinBlack=0
dxSkinBlue=0
dxSkinBlueprint=0
dxSkinCaramel=0
dxSkinCoffee=0
dxSkinDarkroom=0
dxSkinDarkSide=0
dxSkinDevExpressDarkStyle=0
dxSkinDevExpressStyle=0
dxSkinFoggy=0
dxSkinGlassOceans=0
dxSkinHighContrast=0
dxSkiniMaginary=0
dxSkinLilian=0
dxSkinLiquidSky=0
dxSkinLondonLiquidSky=0
dxSkinMcSkin=0
dxSkinMetropolis=0
dxSkinMetropolisDark=0
dxSkinMoneyTwins=0
dxSkinOffice2007Black=0
dxSkinOffice2007Blue=0
dxSkinOffice2007Green=0
dxSkinOffice2007Pink=0
dxSkinOffice2007Silver=0
dxSkinOffice2010Black=0
dxSkinOffice2010Blue=0
dxSkinOffice2010Silver=0
dxSkinOffice2013DarkGray=0
dxSkinOffice2013LightGray=0
dxSkinOffice2013White=0
dxSkinOffice2016Colorful=0
dxSkinOffice2016Dark=0
dxSkinOffice2019Black=0
dxSkinOffice2019Colorful=0
dxSkinOffice2019DarkGray=0
dxSkinOffice2019White=0
dxSkinPumpkin=0
dxSkinSeven=0
dxSkinSevenClassic=0
dxSkinSharp=0
dxSkinSharpPlus=0
dxSkinSilver=0
dxSkinSpringtime=0
dxSkinStardust=0
dxSkinSummer2008=0
dxSkinTheAsphaltWorld=0
dxSkinTheBezier=0
dxSkinsDefaultPainters=0
dxSkinValentine=0
dxSkinVisualStudio2013Blue=0
dxSkinVisualStudio2013Dark=0
dxSkinVisualStudio2013Light=0
dxSkinVS2010=0
dxSkinWhiteprint=0
dxSkinWXI=1
dxSkinXmas2008Blue=0

21
T03贸易布匹检验/TradeInspFile.INI Normal file
View File

@ -0,0 +1,21 @@
[生产车间配置]
卷条码机台标志=
机台个数=
端口号=
电子秤调用Dll文件=
启用电子秤Dll文件=1
码表调用Dll文件=
启用码表Dll文件=1
启用码表单位=1
标签份数=2
米数下限=0
米数上限=100
重量下限=0
重量上限=222
米数小数位=1
码数小数位=1
重量小数位=1
自定义字母键1=A
自定义字母键2=B
赠送数计算规则=1

BIN
T03贸易布匹检验/TradeInspLogin.res Normal file
View File

Binary file not shown.

BIN
T03贸易布匹检验/TradeMachineInsp.res Normal file
View File

Binary file not shown.

62
T03贸易布匹检验/TradeMachineInsp.skincfg Normal file
View File

@ -0,0 +1,62 @@
[ExpressSkins]
Default=0
ShowNotifications=0
Enabled=1
dxSkinBasic=0
dxSkinBlack=0
dxSkinBlue=0
dxSkinBlueprint=0
dxSkinCaramel=0
dxSkinCoffee=0
dxSkinDarkroom=0
dxSkinDarkSide=0
dxSkinDevExpressDarkStyle=0
dxSkinDevExpressStyle=0
dxSkinFoggy=0
dxSkinGlassOceans=0
dxSkinHighContrast=0
dxSkiniMaginary=0
dxSkinLilian=0
dxSkinLiquidSky=0
dxSkinLondonLiquidSky=0
dxSkinMcSkin=0
dxSkinMetropolis=0
dxSkinMetropolisDark=0
dxSkinMoneyTwins=0
dxSkinOffice2007Black=0
dxSkinOffice2007Blue=0
dxSkinOffice2007Green=0
dxSkinOffice2007Pink=0
dxSkinOffice2007Silver=0
dxSkinOffice2010Black=0
dxSkinOffice2010Blue=0
dxSkinOffice2010Silver=0
dxSkinOffice2013DarkGray=0
dxSkinOffice2013LightGray=0
dxSkinOffice2013White=0
dxSkinOffice2016Colorful=0
dxSkinOffice2016Dark=0
dxSkinOffice2019Black=0
dxSkinOffice2019Colorful=0
dxSkinOffice2019DarkGray=0
dxSkinOffice2019White=0
dxSkinPumpkin=0
dxSkinSeven=0
dxSkinSevenClassic=0
dxSkinSharp=0
dxSkinSharpPlus=0
dxSkinSilver=0
dxSkinSpringtime=0
dxSkinStardust=0
dxSkinSummer2008=0
dxSkinTheAsphaltWorld=0
dxSkinTheBezier=0
dxSkinsDefaultPainters=0
dxSkinValentine=0
dxSkinVisualStudio2013Blue=0
dxSkinVisualStudio2013Dark=0
dxSkinVisualStudio2013Light=0
dxSkinVS2010=0
dxSkinWhiteprint=0
dxSkinWXI=1
dxSkinXmas2008Blue=0

193
T03贸易布匹检验/U_BatchMdyData.dfm Normal file
View File

@ -0,0 +1,193 @@
object frmBatchMdyData: TfrmBatchMdyData
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #25209#37327#20462#25913#25968#25454
ClientHeight = 274
ClientWidth = 424
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = #24494#36719#38597#40657
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 19
object cxPageControl1: TcxPageControl
Left = 8
Top = 8
Width = 393
Height = 248
TabOrder = 0
Properties.ActivePage = cxTabSheet2
Properties.CustomButtons.Buttons = <>
ClientRectBottom = 247
ClientRectLeft = 1
ClientRectRight = 392
ClientRectTop = 27
object cxTabSheet1: TcxTabSheet
Caption = #35843#25972#31859#25968
ImageIndex = 0
object Label17: TLabel
Left = 24
Top = 20
Width = 52
Height = 19
Caption = #35843#25972#26041#24335
end
object Label18: TLabel
Left = 24
Top = 64
Width = 52
Height = 19
Caption = #35843#25972#25968#37327
end
object tzfs: TcxComboBox
Left = 96
Top = 15
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
''
#22686#21152
#20943#23569)
TabOrder = 0
Width = 137
end
object tzsl: TcxTextEdit
Left = 96
Top = 59
TabOrder = 1
Width = 137
end
object cxOk1: TcxButton
Left = 80
Top = 160
Width = 75
Height = 32
Caption = #30830#23450
TabOrder = 2
OnClick = cxOk1Click
end
object cxclose: TcxButton
Left = 248
Top = 160
Width = 75
Height = 30
Caption = #20851#38381
TabOrder = 3
OnClick = cxcloseClick
end
end
object cxTabSheet2: TcxTabSheet
Caption = #20462#25913#38271#24230#21333#20301
ImageIndex = 1
ExplicitLeft = 0
object lenUnit: TcxComboBox
Left = 88
Top = 40
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
''
'M'
'Y')
TabOrder = 0
Width = 161
end
object cxButton1: TcxButton
Left = 72
Top = 159
Width = 75
Height = 32
Caption = #30830#23450
TabOrder = 1
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 232
Top = 159
Width = 75
Height = 30
Caption = #20851#38381
TabOrder = 2
OnClick = cxcloseClick
end
end
object cxTabSheet3: TcxTabSheet
Caption = #29420#31435#35843#25972#37325#37327
ImageIndex = 2
object Label1: TLabel
Left = 32
Top = 112
Width = 52
Height = 19
Caption = #35843#25972#25968#37327
end
object Label2: TLabel
Left = 32
Top = 63
Width = 52
Height = 19
Caption = #35843#25972#26041#24335
end
object Label3: TLabel
Left = 32
Top = 20
Width = 52
Height = 19
Caption = #35843#25972#23383#27573
end
object tzsl1: TcxTextEdit
Left = 104
Top = 107
TabOrder = 0
Width = 196
end
object tzfs1: TcxComboBox
Left = 104
Top = 58
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
''
#22686#21152
#20943#23569)
TabOrder = 1
Width = 196
end
object tzfield: TcxComboBox
Left = 104
Top = 15
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
''
#27611#37325
#20928#37325
#30382#37325)
TabOrder = 2
Width = 196
end
object cxButton3: TcxButton
Left = 88
Top = 168
Width = 75
Height = 32
Caption = #30830#23450
TabOrder = 3
OnClick = cxButton3Click
end
object cxButton4: TcxButton
Left = 256
Top = 168
Width = 75
Height = 30
Caption = #20851#38381
TabOrder = 4
OnClick = cxcloseClick
end
end
end
end

128
T03贸易布匹检验/U_BatchMdyData.pas Normal file
View File

@ -0,0 +1,128 @@
unit U_BatchMdyData;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, dxBarBuiltInMenu, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters,
cxPC, cxContainer, cxEdit, Vcl.Menus, Vcl.StdCtrls, cxButtons, cxTextEdit,
cxMaskEdit, cxDropDownEdit, dxSkinsCore;
type
TfrmBatchMdyData = class(TForm)
cxPageControl1: TcxPageControl;
cxTabSheet1: TcxTabSheet;
Label17: TLabel;
Label18: TLabel;
tzfs: TcxComboBox;
tzsl: TcxTextEdit;
cxOk1: TcxButton;
cxclose: TcxButton;
cxTabSheet2: TcxTabSheet;
lenUnit: TcxComboBox;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxTabSheet3: TcxTabSheet;
Label1: TLabel;
tzsl1: TcxTextEdit;
tzfs1: TcxComboBox;
Label2: TLabel;
Label3: TLabel;
tzfield: TcxComboBox;
cxButton3: TcxButton;
cxButton4: TcxButton;
procedure FormCreate(Sender: TObject);
procedure cxcloseClick(Sender: TObject);
procedure cxOk1Click(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cxButton3Click(Sender: TObject);
private
{ Private declarations }
public
fTabCaption:String;
end;
var
frmBatchMdyData: TfrmBatchMdyData;
implementation
{$R *.dfm}
procedure TfrmBatchMdyData.cxButton1Click(Sender: TObject);
begin
if trim(lenunit.Text) = '' then
begin
Application.MessageBox('请先选择单位!', '提示', 0);
Exit;
end;
ModalResult:=1;
end;
procedure TfrmBatchMdyData.cxButton3Click(Sender: TObject);
begin
if trim(tzfield.Text) = '' then
begin
Application.MessageBox('调整字段不能为空!', '提示', 0);
Exit;
end;
if trim(TZFS1.Text) = '' then
begin
Application.MessageBox('调整方式不能为空!', '提示', 0);
Exit;
end;
if trim(TZSL1.Text) = '' then
begin
Application.MessageBox('调整数量不能为空!', '提示', 0);
Exit;
end;
ModalResult:=1;
end;
procedure TfrmBatchMdyData.cxcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmBatchMdyData.cxOk1Click(Sender: TObject);
begin
if trim(TZFS.Text) = '' then
begin
Application.MessageBox('调整方式不能为空!', '提示', 0);
Exit;
end;
if trim(TZSL.Text) = '' then
begin
Application.MessageBox('调整数量不能为空!', '提示', 0);
Exit;
end;
ModalResult:=1;
end;
procedure TfrmBatchMdyData.FormCreate(Sender: TObject);
begin
cxPageControl1.Align:=alClient;
end;
procedure TfrmBatchMdyData.FormShow(Sender: TObject);
var
i:integer;
begin
for i:=0 to cxPageControl1.PageCount -1 do
begin
if fTabCaption= cxPageControl1.Pages[i].Caption then
begin
cxPageControl1.Pages[i].TabVisible:=True;
end
else
begin
cxPageControl1.Pages[i].TabVisible:=false;
end;
end;
end;
end.

338
T03贸易布匹检验/U_BillPrintList.dfm Normal file
View File

@ -0,0 +1,338 @@
inherited frmBillPrintList: TfrmBillPrintList
Caption = #30721#21333#26684#24335#31649#29702
ClientHeight = 572
ClientWidth = 999
Color = clBtnFace
ExplicitWidth = 1015
ExplicitHeight = 611
PixelsPerInch = 96
TextHeight = 17
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 999
Height = 30
AutoSize = True
ButtonHeight = 30
ButtonWidth = 131
Caption = 'ToolBar1'
Color = clBtnFace
DisabledImages = DataLink_TradeInsp.cxImageList_bar
EdgeInner = esNone
EdgeOuter = esNone
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ParentColor = True
ParentFont = True
ShowCaptions = True
TabOrder = 4
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TgroupAdd: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 2
OnClick = TgroupAddClick
end
object TgroupMdy: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #20462#25913
ImageIndex = 3
Visible = False
end
object TBDel: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 5
Visible = False
OnClick = TBDelClick
end
object ToolButton1: TToolButton
Left = 284
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 37
OnClick = ToolButton1Click
end
object Tgetresult: TToolButton
Left = 355
Top = 0
Caption = #33719#21462#26126#32454#32467#26524
ImageIndex = 9
OnClick = TgetresultClick
end
object ToolButton3: TToolButton
Left = 486
Top = 0
Caption = #33719#21462#27719#24635#32467#26524
ImageIndex = 13
OnClick = ToolButton3Click
end
object Tmdgs: TToolButton
Left = 617
Top = 0
AutoSize = True
Caption = #30721#21333#26684#24335
ImageIndex = 8
OnClick = TmdgsClick
end
object ToolButton2: TToolButton
Left = 720
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 823
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid [1]
Left = 8
Top = 75
Width = 826
Height = 173
BorderStyle = cxcbsNone
TabOrder = 1
LookAndFeel.Kind = lfFlat
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
object Tv1billName: TcxGridDBColumn
Caption = #30721#21333#21517#31216
DataBinding.FieldName = 'billName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 101
end
object tv1direction: TcxGridDBColumn
Caption = #26041#21521
DataBinding.FieldName = 'direction'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsEditFixedList
Properties.ImmediatePost = True
Properties.Items.Strings = (
#27178
#31446)
HeaderAlignmentHorz = taCenter
Width = 49
end
object tv1billType: TcxGridDBColumn
Caption = #31867#22411
DataBinding.FieldName = 'billType'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
#20837#24211#30721#21333
#20986#24211#30721#21333)
HeaderAlignmentHorz = taCenter
Width = 59
end
object tv1pageRow: TcxGridDBColumn
Caption = #30721#21333#34892#25968
DataBinding.FieldName = 'pageRow'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 68
end
object Tv1PageCol: TcxGridDBColumn
Caption = #30721#21333#21015#25968
DataBinding.FieldName = 'PageCol'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 65
end
object tv1billLayoutPageField: TcxGridDBColumn
Caption = #30721#21333#20998#39029#23383#27573
DataBinding.FieldName = 'billLayoutPageField'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
#21697#21517','#38376#24133','#20811#37325
#21697#21517','#38376#24133','#20811#37325','#33457#22411','#27454#21495
#21697#21517','#38376#24133','#20811#37325','#33457#22411','#27454#21495','#39068#33394','#33394#21495
#21697#21517','#38376#24133','#20811#37325','#33457#22411','#27454#21495','#39068#33394','#33394#21495','#32568#21495)
HeaderAlignmentHorz = taCenter
Width = 121
end
object tv1procedureName: TcxGridDBColumn
Caption = #26126#32454#23384#20648#36807#31243
DataBinding.FieldName = 'procedureName'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.Items.Strings = (
'P_Trade_Cloth_in_djd_Prt1')
HeaderAlignmentHorz = taCenter
Width = 111
end
object Tv1procedureName2: TcxGridDBColumn
Caption = #27719#24635#23384#20648#36807#31243
DataBinding.FieldName = 'procedureName2'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 105
end
object tv1isValid: TcxGridDBColumn
Caption = #21551#29992
DataBinding.FieldName = 'valid'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
Properties.NullStyle = nssUnchecked
HeaderAlignmentHorz = taCenter
Width = 61
end
object Tv1note: TcxGridDBColumn
Caption = #35828#26126
DataBinding.FieldName = 'note'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv1
end
end
object cxGrid2: TcxGrid [2]
Left = 0
Top = 372
Width = 999
Height = 200
Align = alBottom
TabOrder = 2
object tv2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource2
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.BestFitMaxRecordCount = 1
OptionsData.Deleting = False
OptionsData.Editing = False
OptionsData.Inserting = False
OptionsView.GroupByBox = False
end
object cxGrid2Level1: TcxGridLevel
GridView = tv2
end
end
object RzGroupBox1: TcxGroupBox [3]
Left = 0
Top = 30
Align = alTop
Alignment = alCenterCenter
ParentFont = True
TabOrder = 3
Height = 43
Width = 999
object cxRadioGroup1: TcxRadioGroup
Left = 4
Top = 4
Align = alLeft
Alignment = alLeftCenter
ParentFont = True
Properties.Columns = 3
Properties.Items = <
item
Caption = #24050#21551#29992
end
item
Caption = #26410#21551#29992
end
item
Caption = #20840#37096
end>
ItemIndex = 0
Style.LookAndFeel.SkinName = 'WXI'
StyleDisabled.LookAndFeel.SkinName = 'WXI'
TabOrder = 0
OnClick = cxRadioGroup1Click
Height = 35
Width = 290
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltBatchOptimistic
Parameters = <>
Left = 157
Top = 241
end
object DataSource1: TDataSource
DataSet = ADOQueryMain
Left = 288
Top = 248
end
object DataSource2: TDataSource
DataSet = ADOQueryResult
Left = 472
Top = 224
end
object ADOQueryResult: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 405
Top = 225
end
end

330
T03贸易布匹检验/U_BillPrintList.pas Normal file
View File

@ -0,0 +1,330 @@
unit U_BillPrintList;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ComCtrls, Vcl.ToolWin, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters,
cxStyles, cxCustomData, cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator,
dxDateRanges, dxScrollbarAnnotations, Data.DB, cxDBData, cxTextEdit,
cxCheckBox, cxGridLevel, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxClasses, cxGridCustomView, U_BaseList, cxGrid,
Data.Win.ADODB, cxDropDownEdit, Vcl.StdCtrls, Vcl.ExtCtrls, cxContainer,
cxGroupBox, cxRadioGroup, cxProgressBar;
type
TfrmBillPrintList = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TgroupAdd: TToolButton;
TgroupMdy: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
tv1direction: TcxGridDBColumn;
tv1billType: TcxGridDBColumn;
tv1procedureName: TcxGridDBColumn;
tv1pageRow: TcxGridDBColumn;
Tv1PageCol: TcxGridDBColumn;
tv1billLayoutPageField: TcxGridDBColumn;
Tv1note: TcxGridDBColumn;
tv1isValid: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
ToolButton1: TToolButton;
ADOQueryMain: TADOQuery;
DataSource1: TDataSource;
ToolButton2: TToolButton;
Tv1billName: TcxGridDBColumn;
Tgetresult: TToolButton;
tv2: TcxGridDBTableView;
cxGrid2Level1: TcxGridLevel;
cxGrid2: TcxGrid;
DataSource2: TDataSource;
ADOQueryResult: TADOQuery;
Tv1procedureName2: TcxGridDBColumn;
ToolButton3: TToolButton;
Tmdgs: TToolButton;
RzGroupBox1: TcxGroupBox;
cxRadioGroup1: TcxRadioGroup;
procedure TBCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TgroupAddClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TgetresultClick(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure TmdgsClick(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure cxRadioGroup1Click(Sender: TObject);
private
procedure DoQuery();
public
fuseSystem: string;
FLMType: string;
FFiltration1, FFiltration2, FFiltration3: string;
end;
var
frmBillPrintList: TfrmBillPrintList;
implementation
uses
U_DataLink, U_RTfun, U_globalVar, U_LabelPrint;
{$R *.dfm}
procedure TfrmBillPrintList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmBillPrintList.FormCreate(Sender: TObject);
begin
inherited;
cxGrid1.Align := alClient;
fuseSystem := fParameters1;
end;
procedure TfrmBillPrintList.FormDestroy(Sender: TObject);
begin
inherited;
frmBillPrintList := nil;
end;
procedure TfrmBillPrintList.FormShow(Sender: TObject);
begin
inherited;
DoQuery();
readCxGrid('码单格式管理列表T1', Tv1, gDllFileName);
end;
procedure TfrmBillPrintList.RadioGroup1Click(Sender: TObject);
begin
TBRafresh.Click;
end;
procedure TfrmBillPrintList.TBCloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmBillPrintList.TBDelClick(Sender: TObject);
begin
inherited;
ADOQueryMain.Delete;
end;
procedure TfrmBillPrintList.TBRafreshClick(Sender: TObject);
begin
inherited;
DoQuery();
end;
procedure TfrmBillPrintList.TgetresultClick(Sender: TObject);
begin
if trim(ADOQueryMain.FieldByName('procedureName').AsString) = '' then
begin
Application.MessageBox('明细存储过程名称不能为空!', '提示信息', 0);
exit;
end;
try
with ADOQueryBaseTemp do
begin
close;
Filtered := False;
Sql.Clear;
sql.Add('select max(ciid) as ciid from Trade_Cloth_Inspect');
// if Pos('<27><><EFBFBD>',trim(ADOQueryMain.FieldByName('billType').AsString),1)>=0 then
// sql.Add('where ioflag='+QuotedStr('<27><><EFBFBD>') )
// else
// sql.Add('where ioflag='+QuotedStr(' <20><><EFBFBD><EFBFBD>'));
open;
end;
TV2.BeginUpdate();
ADOQueryResult.DisableControls;
with ADOQueryResult do
begin
Close;
Filtered := False;
SQL.Clear;
sql.Add('exec ' + trim(ADOQueryMain.FieldByName('procedureName').AsString));
if not ADOQueryBaseTemp.IsEmpty then
sql.Add('@Filtration=' + quotedstr(Trim(ADOQueryBaseTemp.FieldByName('ciid').AsString)))
else
sql.Add('@Filtration=' + quotedstr('92405270001'));
Open;
end;
TV2.ClearItems; //<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //ɾ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ<EFBFBD>е<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
finally
ADOQueryResult.EnableControls;
TV2.EndUpdate;
TV2.BeginBestFitUpdate;
TV2.ApplyBestFit; //<EFBFBD><EFBFBD><EFBFBD>п<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӧ .BestFitMaxWidth;
TV2.EndBestFitUpdate;
end;
end;
procedure TfrmBillPrintList.TgroupAddClick(Sender: TObject);
begin
inherited;
ADOQueryMain.Append;
ADOQueryMain.FieldByName('billType').Value := '<27><><EFBFBD><EFBFBD>뵥';
ADOQueryMain.FieldByName('billName').Value := '';
ADOQueryMain.FieldByName('direction').Value := '<27><>';
ADOQueryMain.FieldByName('procedureName').Value := '';
ADOQueryMain.FieldByName('pageRow').Value := 10;
ADOQueryMain.FieldByName('PageCol').Value := 10;
ADOQueryMain.FieldByName('useSystem').Value := fuseSystem;
ADOQueryMain.FieldByName('valid').Value := 1;
end;
procedure TfrmBillPrintList.TmdgsClick(Sender: TObject);
begin
inherited;
with ADOQueryBaseTemp do
begin
close;
Filtered := False;
Sql.Clear;
sql.Add('select max(ciid) as ciid from Trade_Cloth_Inspect');
open;
end;
try
frmLabelPrint := TfrmLabelPrint.Create(Application);
with frmLabelPrint do
begin
FLMType := '入库码单';
FFiltration1 := Trim(self.ADOQueryBaseTemp.FieldByName('ciid').AsString);
FFiltration2 := Trim(self.ADOQueryBaseTemp.FieldByName('ciid').AsString);
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmLabelPrint.Free;
end;
end;
procedure TfrmBillPrintList.ToolButton1Click(Sender: TObject);
begin
inherited;
try
if ADOQueryMain.Locate('billName', '', []) then
begin
Application.MessageBox('码单名称不能为空!', '提示信息', 0);
exit;
end;
if ADOQueryMain.Locate('procedureName', '', []) then
begin
Application.MessageBox('存储过程名称不能为空!', '提示信息', 0);
exit;
end;
ADOQueryMain.UpdateBatch();
Application.MessageBox('保存成功!', '提示信息', 0);
except
Application.MessageBox('保存失败!', '警告信息', 0);
end;
end;
procedure TfrmBillPrintList.ToolButton2Click(Sender: TObject);
begin
inherited;
WriteCxGrid('码单格式管理列表T1', Tv1, gDllFileName);
end;
procedure TfrmBillPrintList.ToolButton3Click(Sender: TObject);
begin
if trim(ADOQueryMain.FieldByName('procedureName2').AsString) = '' then
begin
Application.MessageBox('汇总存储过程名称不能为空!', '提示信息', 0);
exit;
end;
try
with ADOQueryBaseTemp do
begin
close;
Filtered := False;
Sql.Clear;
sql.Add('select max(ciid) as ciid from Trade_Cloth_Inspect');
//if Pos('<27><><EFBFBD>',trim(ADOQueryMain.FieldByName('billType').AsString),1)>=0 then
// sql.Add('where ioflag='+QuotedStr('<27><><EFBFBD>') )
//else
//sql.Add('where ioflag='+QuotedStr(' <20><><EFBFBD><EFBFBD>'));
open;
end;
TV2.BeginUpdate();
ADOQueryResult.DisableControls;
with ADOQueryResult do
begin
Close;
Filtered := False;
SQL.Clear;
sql.Add('exec ' + trim(ADOQueryMain.FieldByName('procedureName2').AsString));
if not ADOQueryBaseTemp.IsEmpty then
sql.Add('@Filtration=' + quotedstr(Trim(ADOQueryBaseTemp.FieldByName('ciid').AsString)))
else
sql.Add('@Filtration=' + quotedstr('92405270001'));
Open;
end;
TV2.ClearItems; //<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //ɾ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դ<EFBFBD>е<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
finally
ADOQueryResult.EnableControls;
TV2.EndUpdate;
TV2.BeginBestFitUpdate;
TV2.ApplyBestFit; //<EFBFBD><EFBFBD><EFBFBD>п<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ӧ .BestFitMaxWidth;
TV2.EndBestFitUpdate;
end;
end;
procedure TfrmBillPrintList.cxRadioGroup1Click(Sender: TObject);
begin
TBRafresh.click;
end;
procedure TfrmBillPrintList.DoQuery();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add('select * from SD_BillPrint ');
if cxRadioGroup1.ItemIndex = 0 then
sql.Add('where valid=1 ')
else if cxRadioGroup1.ItemIndex = 1 then
sql.Add('where valid=0');
// if FLMType<>'' then
sql.Add('and billtype=' + QuotedStr(TRIM(FLMType)));
sql.Add('order by recid');
Open;
end;
finally
ADOQueryMain.EnableControls;
end;
end;
end.

10453
T03贸易布匹检验/U_DataLink.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

113
T03贸易布匹检验/U_DataLink.pas Normal file
View File

@ -0,0 +1,113 @@
unit U_DataLink;
interface
uses
SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels,
Windows, Messages, forms, OleCtnrs, DateUtils, ExtCtrls, SyncObjs, cxClasses,
System.ImageList,U_BaseDataLink,
dxCore, cxLocalization, dxLayoutLookAndFeels, cxImageList, cxGraphics, cxEdit,
cxContainer, dxSkinsForm, dxSkinsCore;
type
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
var
DConString: string; {全局连接字符串}
server, dtbase, user, pswd: string; {数据库连接参数}
DCurHandle: hwnd; //当前窗体句柄
DName: string; //#用户名#//
DCode: string; //#用户编号#//
Ddatabase: string; //#数据库名称#//
DTitCaption: string; //#主窗体名称#//
PicSvr: string;
fDllFileName:string;
DParameters1, DParameters2, DParameters3, DParameters4, DParameters5: string; // 外部参数；
DParameters6, DParameters7, DParameters8, DParameters9, DParameters10: string; //外部参数；
OldDllApp: Tapplication; //保存原有句柄
NewDllApp: Tapplication; //当前句柄
MainApplication: Tapplication;
DFormCode: integer; //当前窗口号
IsDelphiLanguage: integer;
DServerDate: TdateTime; //服务器时间
DCompany: string; //公司
IpCall: Integer;
IpWLDZStr: string;
UserDataFlag: string;
type
TDataLink_TradeInsp = class(TBaseDataLink)
AdoDataLink: TADOQuery;
ADOLink: TADOConnection;
ThreeImgList: TImageList;
Timer_link: TTimer;
procedure DataModuleDestroy(Sender: TObject);
procedure Timer_linkTimer(Sender: TObject);
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMakebar = procedure(ucData: pchar; nDataLen: integer; nErrLevel: integer; nMask: integer; nBarEdition: integer; szBmpFileName: pchar; nScale: integer); stdcall;
TMixtext = procedure(szSrcBmpFileName: PChar; szDstBmpFileName: PChar; sztext: PChar; fontsize, txtheight, hmargin, vmargin, txtcntoneline: integer); stdcall;
var
DataLink_TradeInsp: TDataLink_TradeInsp;
CriticalSection: TCriticalSection; {声明临界}
implementation
{$R *.dfm}
procedure TMyThread.Execute;
begin
FreeOnTerminate := True;
CriticalSection.Enter;
try
with DataLink_TradeInsp.AdoDataLink do
begin
close;
sql.Clear;
sql.Add('select getdate()');
open;
end;
except
try
with DataLink_TradeInsp.ADOLink do
begin
Connected := false;
ConnectionString := DConString;
LoginPrompt := false;
Connected := true;
end;
except
end;
end;
CriticalSection.Leave;
end;
procedure TDataLink_TradeInsp.DataModuleDestroy(Sender: TObject);
begin
CriticalSection.Free;
DataLink_TradeInsp := nil;
end;
procedure TDataLink_TradeInsp.Timer_linkTimer(Sender: TObject);
begin
TMyThread.Create(False);
end;
procedure TDataLink_TradeInsp.DataModuleCreate(Sender: TObject);
begin
inherited ;
CriticalSection := TCriticalSection.Create;
end;
end.

100
T03贸易布匹检验/U_DeviceJkDll.pas Normal file
View File

@ -0,0 +1,100 @@
unit U_DeviceJkDll;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, cxClasses, dxLayoutContainer,
dxLayoutControl, dxLayoutcxEditAdapters, cxContainer, cxEdit, Vcl.StdCtrls,
cxTextEdit, Vcl.ExtCtrls, dxLayoutControlAdapters, U_BaseList, Data.DB,
Data.Win.ADODB, Vcl.Buttons, Vcl.ComCtrls, Vcl.ToolWin, cxImage, cxDBEdit,
cxStyles, cxCustomData, cxData, cxDataStorage, cxNavigator,
dxDateRanges, dxScrollbarAnnotations, cxDBData, dxBarBuiltInMenu, cxPC,
cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
cxGridCustomView, cxGrid, cxMemo, cxRichEdit, U_frameBads,
Datasnap.DBClient, RM_Common, RM_Class, RM_GridReport,
cxCheckBox, cxMaskEdit, cxDropDownEdit, Vcl.Menus, cxButtonEdit, RM_Dataset,
cxGeometry, dxFramedControl, dxPanel, U_KeyBoard, cxGroupBox,
cxGridCustomPopupMenu, cxGridPopupMenu, MovePanel;
procedure OpenCom(mHandle:Thandle;DllName: string;var fIsCommopen:boolean);
procedure CloseCom(DllName: string);
implementation
procedure OpenCom(mHandle:Thandle;DllName: string;var fIsCommopen:boolean);
type
TMyFunc = function(fhandle: hwnd; sCommName: PAnsiChar; IntTime: Integer;
IsMessage: Integer): hwnd; stdcall;
var
Tf: TMyFunc;
Tp: TFarProc;
Th: Thandle;
newh: hwnd;
begin
Th := LoadLibrary(pchar(trim(DllName)));
if Th > 0 then
begin
try
Tp := GetProcAddress(Th, 'CommOpen');
if Tp <> nil then
begin
Tf := TMyFunc(Tp);
newh := Tf(mHandle, 'Comm1', 500, 1);
if newh < 1 then
begin
Application.MessageBox(pchar('打开串口失败！'), '提示');
end
else
fIsCommopen := true;
end
else
begin
fIsCommopen := false;
end;
finally
// FreeLibrary(Th);
end;
end
else
begin
fIsCommopen := false;
Application.MessageBox(pchar('找不到 ' + trim(DllName) + ' 文件！'), '提示');
end;
end;
procedure CloseCom(DllName: string);
type
TMyFunc = function(sCommName: PAnsiChar): hwnd; stdcall;
var
Tf1: TMyFunc;
Tp1: TFarProc;
Th1: Thandle;
newh1: hwnd;
begin
Th1 := LoadLibrary(pchar(trim(DllName)));
if Th1 > 0 then
begin
try
Tp1 := GetProcAddress(Th1, 'CommClose');
if Tp1 <> nil then
begin
Tf1 := TMyFunc(Tp1);
newh1 := Tf1('Comm1');
end
else
begin
end;
finally
// FreeLibrary(Th1);
end;
end
else
begin
Application.MessageBox(pchar('找不到 ' + trim(DllName) + ' 文件！'), '提示');
end;
end;
end.

255
T03贸易布匹检验/U_DeviceJkTest.dfm Normal file
View File

@ -0,0 +1,255 @@
inherited frmDeviceJkTest: TfrmDeviceJkTest
Caption = #27979#35797#36890#35759#25509#21475
ClientHeight = 449
ClientWidth = 831
Color = clBtnFace
FormStyle = fsMDIChild
Visible = True
ExplicitWidth = 847
ExplicitHeight = 488
PixelsPerInch = 96
TextHeight = 17
object SpeedButton1: TSpeedButton [0]
Left = 296
Top = 240
Width = 23
Height = 22
end
object cxGroupBox1: TcxGroupBox [1]
Left = 0
Top = 33
Align = alTop
Caption = #25509#25910#25968#25454
TabOrder = 4
Height = 87
Width = 831
object InputLen: TcxTextEdit
Tag = 999
Left = 280
Top = 23
AutoSize = False
Properties.ReadOnly = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 0
TextHint = #26174#31034#25509#25910#25968#25454
Height = 38
Width = 193
end
object cxButton1: TcxButton
Left = 528
Top = 23
Width = 89
Height = 42
Caption = #24320#22987#27979#35797
TabOrder = 1
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 639
Top = 23
Width = 89
Height = 42
Caption = #20572#27490#27979#35797
TabOrder = 2
OnClick = cxButton2Click
end
object fileType: TcxComboBox
Left = 3
Top = 25
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
#30721#34920
#30005#23376#31216)
Properties.OnChange = cxComboBox1PropertiesChange
TabOrder = 3
Width = 87
end
end
object cxGrid1: TcxGrid [2]
Left = -8
Top = 144
Width = 793
Height = 207
TabOrder = 5
LookAndFeel.NativeStyle = False
LookAndFeel.SkinName = 'WXI'
object tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsData.Deleting = False
OptionsData.Editing = False
OptionsData.Inserting = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
object tv1FtFileName: TcxGridDBColumn
Caption = #25991#20214#21517#31216
DataBinding.FieldName = 'FileName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 123
end
object tv1FileType: TcxGridDBColumn
Caption = #25991#20214#31867#22411
DataBinding.FieldName = 'FileType'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
#19968#33324
#20844#29992)
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 77
end
object tv1factory: TcxGridDBColumn
Caption = #29983#20135#21378#23478
DataBinding.FieldName = 'factory'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 100
end
object tv1remark: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'remark'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 115
end
object tv1fileCreatedate: TcxGridDBColumn
Caption = #21019#24314#26085#26399
DataBinding.FieldName = 'fileCreatedate'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 105
end
object tv1FileEditDate: TcxGridDBColumn
Caption = #20462#25913#26085#26399
DataBinding.FieldName = 'FileEditDate'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 115
end
object tv1fillTime: TcxGridDBColumn
Caption = #19978#20256#26085#26399
DataBinding.FieldName = 'fillTime'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 91
end
object tv1FileSize: TcxGridDBColumn
Caption = #25991#20214#22823#23567
DataBinding.FieldName = 'FileSize'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 69
end
end
object cxGrid1Level1: TcxGridLevel
GridView = tv1
end
end
object ToolBar1: TToolBar [3]
Tag = 1
Left = 0
Top = 0
Width = 831
Height = 33
ButtonHeight = 30
ButtonWidth = 96
Caption = 'ToolBar1'
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ShowCaptions = True
TabOrder = 2
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object ToolButton1: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #25171#24320'ini'#25991#20214
ImageIndex = 9
OnClick = ToolButton1Click
end
object ToolButton2: TToolButton
Left = 163
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
Visible = False
end
object TBClose: TToolButton
Left = 250
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object edt_dllName: TcxTextEdit [4]
Left = 96
Top = 69
AutoSize = False
Properties.ReadOnly = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 3
Height = 30
Width = 162
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 577
Top = 241
end
object DataSource1: TDataSource
DataSet = cds_list
Left = 136
Top = 192
end
object ADOQueryList: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 208
Top = 200
end
object cds_list: TClientDataSet
Aggregates = <>
Params = <>
Left = 296
Top = 224
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 432
Top = 120
end
end

377
T03贸易布匹检验/U_DeviceJkTest.pas Normal file
View File

@ -0,0 +1,377 @@
unit U_DeviceJkTest;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, cxContainer, cxEdit, Vcl.Menus,
Vcl.StdCtrls, cxButtons, cxTextEdit, cxGroupBox, cxStyles, cxCustomData,
cxFilter, cxData, cxDataStorage, cxNavigator, dxDateRanges, ShellAPI,
dxScrollbarAnnotations, Data.DB, cxDBData, Data.Win.ADODB, cxGridLevel,
cxClasses, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, cxDropDownEdit, Vcl.ComCtrls, Vcl.ToolWin,
Datasnap.DBClient, cxMaskEdit, Vcl.Buttons, U_BaseList, cxProgressBar,
dxSkinsCore, Vcl.ExtCtrls;
type
TfrmDeviceJkTest = class(TfrmBaseList)
cxGroupBox1: TcxGroupBox;
InputLen: TcxTextEdit;
cxButton1: TcxButton;
DataSource1: TDataSource;
ADOQueryList: TADOQuery;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1FtFileName: TcxGridDBColumn;
tv1FileType: TcxGridDBColumn;
tv1factory: TcxGridDBColumn;
tv1remark: TcxGridDBColumn;
tv1fileCreatedate: TcxGridDBColumn;
tv1FileEditDate: TcxGridDBColumn;
tv1fillTime: TcxGridDBColumn;
tv1FileSize: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ToolBar1: TToolBar;
TBRafresh: TToolButton;
ToolButton2: TToolButton;
TBClose: TToolButton;
edt_dllName: TcxTextEdit;
cds_list: TClientDataSet;
cxButton2: TcxButton;
ADOQueryTmp: TADOQuery;
fileType: TcxComboBox;
ToolButton1: TToolButton;
SpeedButton1: TSpeedButton;
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxComboBox1PropertiesChange(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private
fIsCommopen: Boolean;
fDllName:string;
procedure InitGrid();
procedure testCom();
function ExportFtErpFile(recid,mFileName:string;ADORead:TADOQuery):boolean;
procedure On1201(var Message: Tmessage); message 1201; // 电子称
procedure On1301(var Message: Tmessage); message 1301; // 码表
public
fFormID:Integer;
end;
var
frmDeviceJkTest: TfrmDeviceJkTest;
implementation
uses
U_DataLink,U_globalVar,U_DeviceJkDll,U_RTFun;
{$R *.dfm}
procedure TfrmDeviceJkTest.cxButton1Click(Sender: TObject);
begin
if cds_list.IsEmpty then
begin
exit;
end;
testCom();
end;
procedure TfrmDeviceJkTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
if fIsCommopen then
begin
CloseCom(fDllName);
end;
Action:=caFree;
end;
procedure TfrmDeviceJkTest.FormCreate(Sender: TObject);
begin
inherited;
cxGrid1.Align:=alClient;
end;
procedure TfrmDeviceJkTest.FormDestroy(Sender: TObject);
begin
inherited;
frmDeviceJkTest:=nil;
end;
procedure TfrmDeviceJkTest.FormShow(Sender: TObject);
begin
// inherited;
InitGrid();
end;
procedure TfrmDeviceJkTest.InitGrid();
begin
try
ADOQueryList.DisableControls ;
with ADOQueryList do
begin
close;
sql.clear;
sql.Add('select recid, FileName,FileType,FileEditDate,fileCreateDate,FileSize,filltime,');
sql.Add('FilePath,remark,factory');
sql.Add('from RT_deviceDllFile');
if Trim(fileType.Text)<>'' then
sql.Add('where filetype='+QuotedStr(Trim(fileType.Text)));
sql.Add('order by fillTime desc');
Open;
SCreateCDS(ADOQueryList, cds_list);
SInitCDSData(ADOQueryList, cds_list);
end;
finally
ADOQueryList.EnableControls ;
tv1.ApplyBestFit() ;
end;
end;
procedure TfrmDeviceJkTest.TBCloseClick(Sender: TObject);
begin
inherited;
close;
end;
procedure TfrmDeviceJkTest.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmDeviceJkTest.testCom();
var
iniFileName:string;
filePath:string;
begin
try
// while True do
// begin
fDllName:=Trim(cds_list.FieldByName('FileName').AsString) ;
edt_dllName.Text:=fDllName ;
if Trim(cds_list.FieldByName('FileType').AsString)<>'' then
ExportFtErpFile(Trim(cds_list.FieldByName('recid').AsString),fDllName,ADOQueryTmp);
iniFileName:= StringReplace(fDllName,'.dll','.ini',[rfIgnoreCase]);
filePath:= ExtractFilePath(Paramstr(0))+iniFileName ;
if not FileExists(filePath) then
begin
ExportFtErpFile('',iniFileName,ADOQueryTmp);
end;
if not FileExists(ExtractFilePath(Paramstr(0))+iniFileName) then
begin
application.MessageBox(PChar(iniFileName+'文件不存在!'),'警告信息',0);
Exit;
end;
OpenCom(self.handle,fDllName,fIsCommopen);
// Close;
// end;
finally
end;
end;
procedure TfrmDeviceJkTest.ToolButton1Click(Sender: TObject);
var
iniFileName:String;
filePath:string;
begin
if cds_list.IsEmpty then exit;
iniFileName :=Trim( cds_list.FieldByName('fileName').AsString );
iniFileName:= StringReplace(iniFileName,'.dll','.ini',[rfIgnoreCase]);
filePath:= ExtractFilePath(Paramstr(0))+iniFileName ;
if not FileExists(filePath) then
begin
ExportFtErpFile('',iniFileName,ADOQueryTmp);
end;
if not FileExists(filePath) then
begin
application.MessageBox(PChar(iniFileName+'文件不存在!'),'警告信息',0);
Exit;
end;
//
ShellExecute(0, 'open', PChar('notepad.exe'), PChar(filePath), nil, SW_SHOWNORMAL);
end;
///////////////////////////////////////////////////////
//函数功能：从服务器下载文件；
///////////////////////////////////////////////////////
procedure TfrmDeviceJkTest.cxButton2Click(Sender: TObject);
begin
if fDllName<>'' then
CloseCom(fDllName);
end;
procedure TfrmDeviceJkTest.cxComboBox1PropertiesChange(Sender: TObject);
begin
TBRafresh.Click;
end;
function TfrmDeviceJkTest.ExportFtErpFile(recid,mFileName:string;ADORead:TADOQuery):boolean;
var
Stream : TMemoryStream;
ff:TADOBlobstream;
mfileSize:integer;
mCreationTime:TdateTime;
mWriteTime:TdateTime;
IsFileHas:boolean;
mChildPath:string;
mFilePath:string;
begin
try
result:=false;
mChildPath:=''; //test\
///////////////////////////////////////////////
//如果产品存在
mFilePath:= ExtractFilePath(Paramstr(0))+mChildPath;
IsFileHas:= FileExists(mFilePath+fDllName);
if IsFileHas then
begin
//////////////////////////
//获取文件信息
GetFileInfo(mFilePath+mFileName,mfileSize,mCreationTime,mWriteTime);
//eleteFile(mFilePath+fDllName);
end;
//////////////////////////////////////////
//存在文件
if IsFileHas then
begin
with ADORead do
begin
close;
sql.Clear ;
sql.Add('select count(FileName) as cnt ');
sql.Add('from RT_deviceDllFile');
if recid<>'' then
sql.Add('where recid='+quotedStr(recid))
else
sql.Add('where FileName='+quotedStr(mFileName));
sql.Add(' and DATEDIFF(minute,'+ quotedStr(formatDateTime('yyyy-MM-dd hh:mm',mWriteTime))+',fileEditDate)>0');
Open;
//是否存在新的文件
if fieldByName('cnt').AsInteger>0 then
begin
close;
sql.Clear ;
sql.Add('select * ');
sql.Add('from RT_deviceDllFile');
if recid<>'' then
sql.Add('where recid='+quotedStr(recid))
else
sql.Add('where FileName='+quotedStr(mFileName));
Open;
ff := TADOBlobstream.Create(fieldByName('Files') as TblobField, bmRead);
end
else
begin
exit;
end;
if trim(fieldByName('FilePath').AsString)<>'' then
mChildPath:=trim(fieldByName('FilePath').AsString)+'\';
end;
end
//////////////////////////////////////
//不存在
else
begin
with ADORead do
begin
close;
sql.Clear ;
sql.Add('select * ');
sql.Add('from RT_deviceDllFile');
if recid<>'' then
sql.Add('where recid='+quotedStr(recid))
else
sql.Add('where FileName='+quotedStr(mFileName));
Open;
if recordCount>0 then
begin
ff := TADOBlobstream.Create(fieldByName('Files') as TblobField, bmRead);
end
else
begin
application.MessageBox(pchar('未找到文件'+mfileName+'!'),'提示信息',0);
exit;
end;
if trim(fieldByName('FilePath').AsString)<>'' then
mChildPath:=trim(fieldByName('FilePath').AsString)+'\';
end;
end;
if ff<>nil then
begin
try
mfileName:=trim(ADORead.fieldByName('FileName').asString);
if not DirectoryExists(ExtractFileDir(mFilePath+mfileName)) then
ForceDirectories(ExtractFileDir(mFilePath+mfileName));
Stream:= TMemoryStream.Create ;
ff.SaveToStream(Stream);
Stream.SaveToFile(mFilePath+mfileName); //+'\tmpFile\'
finally
Stream.Free ;
ff.free;
end;
end;
UpdateFileTime(mFilePath+mfileName,ADORead.fieldByName('FileCreateDate').AsDateTime,ADORead.fieldByName('FileEditDate').AsDateTime,ADORead.fieldByName('FileEditDate').AsDateTime);
Result:=true;
except
application.MessageBox(pchar('读取文件'+mfileName+'失败!'),'提示信息',0);
end;
end;
procedure TfrmDeviceJkTest.On1301(var Message: Tmessage);
var
i1, i2: Integer;
unitname: string;
fdata: double;
begin
i1 := Message.WParam;
i2 := Message.LParam;
// if trim(cds_list.fieldbyName('filetype').AsString) = '码表' then
// begin
InputLen.Text := format('%.2f', [i1 / 100000]);
//end;
end;
procedure TfrmDeviceJkTest.On1201(var Message: Tmessage);
var
i1, i2: Integer;
unitname: string;
fdata: double;
begin
i1 := Message.WParam;
i2 := Message.LParam;
// if trim(cds_list.fieldbyName('filetype').AsString) = '电子称' then
// begin
InputLen.Text := format('%.2f', [i1 / 100000]);
// end;
end;
end.

474
T03贸易布匹检验/U_DjdDjClList.dfm Normal file
View File

@ -0,0 +1,474 @@
inherited frmDjdDjClList: TfrmDjdDjClList
Caption = #25171#21367#20135#37327#32479#35745#27719#24635
ClientHeight = 422
ClientWidth = 1061
Color = clBtnFace
Font.Height = -16
FormStyle = fsMDIChild
Visible = True
ExplicitWidth = 1077
ExplicitHeight = 461
PixelsPerInch = 96
TextHeight = 21
object toolbar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1061
Height = 33
ButtonHeight = 30
ButtonWidth = 99
Caption = 'toolbar1'
Color = clBtnFace
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ParentColor = True
ShowCaptions = True
TabOrder = 3
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
Visible = False
OnClick = TBFindClick
end
object TBExport: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 28
OnClick = TBExportClick
end
object Tbcgs: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = TbcgsClick
end
object TBClose: TToolButton
Left = 316
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid [1]
Left = 20
Top = 184
Width = 1005
Height = 230
BorderStyle = cxcbsNone
TabOrder = 1
object TV1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Filter.AutoDataSetFilter = True
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
Column = cxGridDBColumn9
end
item
Kind = skSum
end
item
Kind = skCount
end
item
Kind = skSum
Column = cxGridDBColumn11
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
Column = cxGridDBColumn10
end
item
Kind = skSum
end
item
Format = #26816#39564#31995#25968'=#.##'
Kind = skAverage
end
item
Format = #25442#31639#31995#25968'=#.##'
Kind = skAverage
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skCount
end
item
Kind = skSum
Column = cxGridDBColumn12
end
item
Kind = skSum
Column = cxGridDBColumn8
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.IndicatorWidth = 30
object cxGridDBColumn3: TcxGridDBColumn
Tag = 11
Caption = #35746#21333#21495
DataBinding.FieldName = 'OrderNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 112
end
object TV1ConNo: TcxGridDBColumn
Caption = #21512#21516#21495
DataBinding.FieldName = 'ConNo'
DataBinding.IsNullValueType = True
end
object TV1CustName: TcxGridDBColumn
Caption = #23458#25143
DataBinding.FieldName = 'CustName'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
end
object cxGridDBColumn4: TcxGridDBColumn
Caption = #20135#21697#21517#31216
DataBinding.FieldName = 'C_Name'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 101
end
object TV1Column1: TcxGridDBColumn
Caption = #25171#30721#20154
DataBinding.FieldName = 'Filler'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 70
end
object cxGridDBColumn7: TcxGridDBColumn
Caption = #25171#21367#26085#26399
DataBinding.FieldName = 'Filltime'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 84
end
object cxGridDBColumn8: TcxGridDBColumn
Caption = #21367#25968
DataBinding.FieldName = 'SumPieceNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 94
end
object cxGridDBColumn9: TcxGridDBColumn
Caption = #27611#37325
DataBinding.FieldName = 'GrossWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 88
end
object cxGridDBColumn10: TcxGridDBColumn
Caption = #20928#37325
DataBinding.FieldName = 'NetWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 93
end
object cxGridDBColumn11: TcxGridDBColumn
Caption = #31859#25968
DataBinding.FieldName = 'Meter'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 91
end
object cxGridDBColumn12: TcxGridDBColumn
Caption = #30721#25968
DataBinding.FieldName = 'Yardage'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 99
end
end
object cxGridLevel1: TcxGridLevel
GridView = TV1
end
end
object dxLayoutControl_query: TdxLayoutControl [2]
Left = 0
Top = 33
Width = 1061
Height = 83
Align = alTop
BorderWidth = 2
TabOrder = 2
LayoutLookAndFeel = DataLink_TradeInsp.dxLayoutSkinLookAndFeel1
OptionsItem.SizableHorz = True
OptionsItem.SizableVert = True
object Filler: TcxTextEdit
Tag = 2
Left = 306
Top = 33
Hint = 'Filler'
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 4
Width = 136
end
object begdate: TcxDateEdit
Left = 88
Top = 8
ParentFont = True
Properties.ImmediatePost = True
Properties.SaveTime = False
Properties.ShowTime = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 0
Width = 155
end
object enddate: TcxDateEdit
Left = 88
Top = 33
AutoSize = False
ParentFont = True
Properties.ImmediatePost = True
Properties.SaveTime = False
Properties.ShowTime = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 3
Height = 29
Width = 153
end
object C_name: TcxTextEdit
Tag = 2
Left = 523
Top = 33
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 5
Width = 160
end
object orderNo: TcxTextEdit
Tag = 2
Left = 308
Top = 8
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 1
Width = 134
end
object C_color: TcxTextEdit
Tag = 2
Left = 10000
Top = 10000
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 6
Visible = False
Width = 105
end
object conNo: TcxTextEdit
Tag = 2
Left = 523
Top = 8
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 2
Width = 161
end
object dxLayoutControl_queryGroup_Root: TdxLayoutGroup
AlignHorz = ahParentManaged
AlignVert = avParentManaged
CaptionOptions.AlignVert = tavCenter
CaptionOptions.Text = #26597#35810#32452
CaptionOptions.Visible = False
SizeOptions.AssignedValues = [sovSizableHorz, sovSizableVert]
SizeOptions.SizableHorz = True
SizeOptions.SizableVert = True
Hidden = True
ItemIndex = 1
Padding.Top = -8
Padding.AssignedValues = [lpavBottom, lpavTop]
ShowBorder = False
UseIndent = False
Index = -1
end
object dxLayoutItem2: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 190
AllowRemove = False
CaptionOptions.Text = #35746#21333#21495
Control = orderNo
ControlOptions.OriginalHeight = 25
ControlOptions.OriginalWidth = 134
ControlOptions.ShowBorder = False
Index = 1
end
object dxLayoutItem_color: TdxLayoutItem
SizeOptions.Width = 136
CaptionOptions.Text = #39068#33394
Control = C_color
ControlOptions.OriginalHeight = 25
ControlOptions.OriginalWidth = 105
ControlOptions.ShowBorder = False
Index = -1
end
object dxLayoutItem_pm: TdxLayoutItem
Parent = dxLayoutGroup2
SizeOptions.Width = 232
CaptionOptions.Text = #20013#25991#21517#31216
Control = C_name
ControlOptions.OriginalHeight = 25
ControlOptions.OriginalWidth = 160
ControlOptions.ShowBorder = False
Index = 2
end
object dxLayoutItem_hth: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 233
CaptionOptions.Text = #21512#21516#21495
Control = conNo
ControlOptions.OriginalHeight = 25
ControlOptions.OriginalWidth = 161
ControlOptions.ShowBorder = False
Index = 2
end
object dxLayoutGroup1: TdxLayoutGroup
Parent = dxLayoutControl_queryGroup_Root
CaptionOptions.Text = #32452'1'
Hidden = True
LayoutDirection = ldHorizontal
ShowBorder = False
Index = 0
end
object dxLayoutGroup2: TdxLayoutGroup
Parent = dxLayoutControl_queryGroup_Root
CaptionOptions.Text = #32452'2'
Hidden = True
ItemIndex = 2
LayoutDirection = ldHorizontal
ShowBorder = False
Index = 1
end
object dxLayoutItem_beg: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 227
CaptionOptions.Text = #26816#39564#26102#38388
Control = begdate
ControlOptions.OriginalHeight = 25
ControlOptions.OriginalWidth = 155
ControlOptions.ShowBorder = False
Index = 0
end
object dxLayoutItem_end: TdxLayoutItem
Parent = dxLayoutGroup2
AlignVert = avClient
SizeOptions.Width = 225
CaptionOptions.Text = #33267
Control = enddate
ControlOptions.OriginalHeight = 29
ControlOptions.OriginalWidth = 153
ControlOptions.ShowBorder = False
Index = 0
end
object dxLayoutItem1: TdxLayoutItem
Parent = dxLayoutGroup2
SizeOptions.Width = 192
CaptionOptions.Text = #25171#30721#20154
Control = Filler
ControlOptions.OriginalHeight = 25
ControlOptions.OriginalWidth = 136
ControlOptions.ShowBorder = False
Index = 1
end
end
inherited cxProgressBar2: TcxProgressBar
Left = 291
Top = 136
ExplicitLeft = 291
ExplicitTop = 136
ExplicitHeight = 26
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 265
Top = 232
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 185
Top = 241
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
CommandTimeout = 60
Parameters = <>
Left = 584
Top = 224
end
object DataSource1: TDataSource
DataSet = ADOQueryMain
Left = 632
Top = 152
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 552
Top = 160
end
end

165
T03贸易布匹检验/U_DjdDjClList.pas Normal file
View File

@ -0,0 +1,165 @@
unit U_DjdDjClList;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, cxStyles, cxCustomData,
cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator, dxDateRanges,
dxScrollbarAnnotations, Data.DB, cxDBData, cxGridLevel, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid,
Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.ToolWin,U_BaseList,
Data.Win.ADODB, Data.FMTBcd, dxBarBuiltInMenu, cxGridCustomPopupMenu,
cxGridPopupMenu, Data.SqlExpr, cxContainer, dxCore, cxDateUtils, cxTextEdit,
cxMaskEdit, cxDropDownEdit, cxCalendar, dxLayoutcxEditAdapters,
dxLayoutContainer, dxLayoutControl,
cxProgressBar;
type
TfrmDjdDjClList = class(TFrmBaseList)
toolbar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBExport: TToolButton;
Tbcgs: TToolButton;
TBClose: TToolButton;
Filler: TcxTextEdit;
cxGrid1: TcxGrid;
TV1: TcxGridDBTableView;
cxGridDBColumn3: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
TV1Column1: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
cxGridDBColumn9: TcxGridDBColumn;
cxGridDBColumn10: TcxGridDBColumn;
cxGridDBColumn11: TcxGridDBColumn;
cxGridDBColumn12: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
ADOQueryMain: TADOQuery;
DataSource1: TDataSource;
cxGridPopupMenu1: TcxGridPopupMenu;
begdate: TcxDateEdit;
enddate: TcxDateEdit;
TV1ConNo: TcxGridDBColumn;
dxLayoutControl_query: TdxLayoutControl;
C_name: TcxTextEdit;
orderNo: TcxTextEdit;
C_color: TcxTextEdit;
conNo: TcxTextEdit;
dxLayoutControl_queryGroup_Root: TdxLayoutGroup;
dxLayoutItem2: TdxLayoutItem;
dxLayoutItem_color: TdxLayoutItem;
dxLayoutItem_pm: TdxLayoutItem;
dxLayoutItem_hth: TdxLayoutItem;
dxLayoutGroup1: TdxLayoutGroup;
dxLayoutGroup2: TdxLayoutGroup;
dxLayoutItem_beg: TdxLayoutItem;
dxLayoutItem_end: TdxLayoutItem;
dxLayoutItem1: TdxLayoutItem;
TV1CustName: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBFindClick(Sender: TObject);
procedure TbcgsClick(Sender: TObject);
private
procedure InitGrid();
public
{ Public declarations }
end;
var
frmDjdDjClList: TfrmDjdDjClList;
implementation
uses
U_RTFun,U_DataLink,U_globalVar,U_FormLayOutDesign;
{$R *.dfm}
procedure TfrmDjdDjClList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmDjdDjClList.FormCreate(Sender: TObject);
begin
inherited ;
cxGrid1.Align:=alClient;
BegDate.Date:=SGetServerDateTime(ADOQueryBaseTemp);
EndDate.Date:=SGetServerDateTime(ADOQueryBaseTemp)
end;
procedure TfrmDjdDjClList.FormShow(Sender: TObject);
begin
inherited;
TBRafresh.Click;
ReadCxGrid(Trim(self.Caption) + 'Tv1', Tv1, gDllFileCaption);
end;
procedure TfrmDjdDjClList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
Filtered:=False;
sql.Add('exec p_select_djcl_list');
sql.Add('@begdate='+ quotedstr(FormatDateTime('yyyy-MM-dd', BegDate.Date)));
sql.Add(',@enddate='+ quotedstr(FormatDateTime('yyyy-MM-dd', endDate.Date+1)));
sql.Add(',@djMan='+ quotedstr(gUserName));
sql.Add(',@cltype='+ quotedstr('´ò¾í²úÁ¿'));
Open;
end;
finally
ADOQueryMain.EnableControls;
end
end;
procedure TfrmDjdDjClList.TbcgsClick(Sender: TObject);
begin
inherited;
WriteCxGrid(Trim(self.Caption) + 'Tv1', Tv1, gDllFileCaption);
if gIsCanDesign then
begin
saveLayOut(application, dxLayoutControl_query, ADOQueryBaseCmd, PWideChar( fDllFileName + '|' + Self.Name + '|' + dxLayoutControl_query.Name + '.ini'));
end;
end;
procedure TfrmDjdDjClList.TBCloseClick(Sender: TObject);
begin
inherited;
close;
end;
procedure TfrmDjdDjClList.TBExportClick(Sender: TObject);
begin
inherited;
if ADOQueryMain.IsEmpty then exit;
TcxGridToExcel(self.Caption,cxGrid1);
end;
procedure TfrmDjdDjClList.TBFindClick(Sender: TObject);
begin
inherited;
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SLGetFilters(dxLayoutControl_query,1,2));
end;
end;
procedure TfrmDjdDjClList.TBRafreshClick(Sender: TObject);
begin
inherited;
InitGrid();
end;
end.

308
T03贸易布匹检验/U_GetDllForm.pas Normal file
View File

@ -0,0 +1,308 @@
unit U_GetDllForm;
interface
uses
Windows, Messages, forms, OleCtnrs, DateUtils, SysUtils, ADODB, dxCore,
ActiveX, IniFiles;
function GetDllForm(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; export; stdcall;
function ConnData(): Boolean;
function GetsysParam(muserId: pchar; fparam1: pchar): Boolean;
implementation
uses
U_DataLink, U_globalVar, U_iniParam, U_TradeMachInsp, U_ProductJYHZList,
U_DeviceJkTest, U_TradeClothInspList, U_MachRollMain, U_TradePack,
U_DjdDjClList, U_TradeClothTotalCXJYOutList;
/////////////////////////////////////////////////////////////////
// 功能说明:取Dll中得窗体 //
// 参数说明：App>>调用应用程序； //
// FormH>>调用窗口句柄 ； //
// FormID>>窗口号; //
// Language>>语言种类; //
// WinStyle>>窗口类型； //
/////////////////////////////////////////////////////////////////
function GetDllForm(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd;
var
i: Integer;
bFound: Boolean;
mnewHandle: hwnd;
mstyle: TFormStyle; // 0:子窗口; 1：普通窗口
mstate: TWindowState;
mborderstyle: TFormBorderStyle;
begin
mnewHandle := 0;
DName := PChar(GName);
DCode := PChar(GCode);
DdataBase := DataBase;
DTitCaption := Title;
DParameters1 := Parameters1;
DParameters2 := Parameters2;
DParameters3 := Parameters3;
DParameters4 := Parameters4;
DParameters5 := Parameters5;
DParameters6 := Parameters6;
DParameters7 := Parameters7;
DParameters8 := Parameters8;
DParameters9 := Parameters9;
DParameters10 := Parameters10;
gScanBarcodeMaxLen := 0;
SetLength(fDllFileName, 255);
GetModuleFileName(HInstance, PChar(fDllFileName), Length(fDllFileName));
fDllFileName := ExtractFileName(PChar(fDllFileName));
gDllFileCaption := '指示单打卷包装';
MainApplication := App;
DCurHandle := FormH;
IsDelphiLanguage := Language;
Application := TApplication(App);
DCurHandle := 0;
//赋值链接字符串
SetLength(server, 255);
SetLength(dtbase, 255);
SetLength(user, 255);
SetLength(pswd, 255);
if trim(DataBaseStr) = '' then
begin
server := '101.132.143.144,7781';
dtbase := 'gemeiData';
user := 'rtsa';
pswd := 'rightsoft@5740';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
// DParameters1:='高权限';
end
else
begin
DConString := DataBaseStr;
end;
if not ConnData() then
begin
result := 0;
exit;
end;
// application.MessageBox('44','',0);
gConString := DConString;
if IsINIFile() then
ReadINIFile()
else
WriteINIFile;
GetsysParam('', '');
// 定义窗口类型 、状态
// if WinStyle = 0 then
// begin
mstyle := fsMDIChild;
mstate := wsMaximized;
mborderstyle := bsSizeable;
// end
// else
// begin
// mstyle := fsNormal;
// mstate := wsNormal;
// mborderstyle := bsSizeable;
// end;
bFound := False;
if FormID <> 10000 then
begin
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
if Application.MainForm.MDIChildren[i].Caption = Title then
begin
mnewHandle := Application.MainForm.MDIChildren[i].Handle;
Application.MainForm.MDIChildren[i].BringToFront;
bFound := True;
Result := mnewHandle;
exit;
end;
end;
end;
/////////////////////
//调用子模块窗口
case FormID of
2: //测试
begin
with TfrmDeviceJkTest.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
// 111: //机台检验
// begin
// with TfrmTradeMachInsp.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
// begin
// fFormID := FormID;
// // FormStyle := mstyle;
// WindowState := mstate;
// BorderStyle := mborderstyle;
// mnewHandle := Handle;
// end;
// end;
1: //机台检验
begin
with TfrmMachRollMain.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
// FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
121: //布匹打包
begin
with TfrmTradePack.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10), FormID) do //
begin
fFormID := FormID;
// FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
211: //检验信息管理
begin
with TfrmTradeClothInspList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10), FormID) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
221: //重检信息管理
begin
with TfrmTradeClothTotalCXJYOutList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10), FormID) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
212: //检验信息管理
begin
with TfrmProductJYHZList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10), FormID) do //
begin
fFormID := FormID;
// FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
213: //打卷和打包产量
begin
with TfrmDjdDjClList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10), FormID) do //
begin
fFormID := FormID;
// FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
10000:
begin
for i := 0 to application.MainForm.MDIChildCount - 1 do
begin
if application.MainForm.MDIChildren[i].Caption = Title then
begin
application.MainForm.MDIChildren[i].Close;
end;
end;
end;
end;
Result := mnewHandle;
end;
function GetsysParam(muserId: pchar; fparam1: pchar): Boolean;
begin
result := true;
//////////////////////////////
// shortDateFormat := 'yyyy-MM-dd';
//服务器日期
with DataLink_TradeInsp.AdoDataLink do
begin
close;
sql.Clear;
sql.Add('select getDate()as dt');
open;
DServerDate := fieldByName('dt').AsDatetime;
end;
result := true;
end;
//===========================================================
//建立数据库连接池
//===========================================================
function ConnData(): Boolean;
var
IniFile: TIniFile;
begin
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'SYSTEMSET.INI');
PicSvr := IniFile.ReadString('SERVER', '服务器地址', '127.0.0.1');
UserDataFlag := IniFile.ReadString('SERVER', '服务器地址类型', '-1');
finally
IniFile.Free;
end;
if not Assigned(DataLink_TradeInsp) then
DataLink_TradeInsp := TDataLink_TradeInsp.Create(Application);
try
with DataLink_TradeInsp.ADOLink do
begin
if not Connected then
begin
Connected := false;
ConnectionString := DConString;
LoginPrompt := false;
Connected := true;
end;
end;
Result := true;
except
Result := false;
application.MessageBox('数据库连接失败！', '错误', mb_Ok + MB_ICONERROR);
end;
end;
initialization
CoInitialize(nil);
dxUnitsLoader.Initialize;
finalization
DataLink_TradeInsp.Free;
application := NewDllApp;
dxUnitsLoader.Finalize;
end.

133
T03贸易布匹检验/U_KeyBoard.dfm Normal file
View File

@ -0,0 +1,133 @@
object FrameKeyBoard: TFrameKeyBoard
Left = 0
Top = 0
Width = 314
Height = 235
TabOrder = 0
object dxPanel1: TdxPanel
Left = 0
Top = 0
Width = 314
Height = 235
Align = alClient
Frame.Visible = False
TabOrder = 0
ExplicitHeight = 192
object SpeedButton1: TSpeedButton
Left = 1
Top = 2
Width = 60
Height = 60
Caption = '1'
end
object SpeedButton4: TSpeedButton
Left = 1
Top = 63
Width = 60
Height = 60
Caption = '4'
end
object SpeedButton7: TSpeedButton
Left = 1
Top = 125
Width = 60
Height = 60
Caption = '7'
end
object SpeedButton2: TSpeedButton
Left = 62
Top = 2
Width = 60
Height = 60
Caption = '2'
end
object SpeedButton5: TSpeedButton
Left = 62
Top = 63
Width = 60
Height = 60
Caption = '5'
end
object SpeedButton8: TSpeedButton
Left = 62
Top = 125
Width = 60
Height = 60
Caption = '8'
end
object SpeedButton3: TSpeedButton
Left = 124
Top = 2
Width = 60
Height = 60
Caption = '3'
end
object SpeedButton6: TSpeedButton
Left = 124
Top = 63
Width = 60
Height = 60
Caption = '6'
end
object SpeedButton9: TSpeedButton
Tag = 9
Left = 124
Top = 125
Width = 60
Height = 60
Caption = '9'
end
object SpeedButton_back: TSpeedButton
Left = 186
Top = 2
Width = 60
Height = 60
Caption = #8592
end
object SpeedButton0: TSpeedButton
Left = 186
Top = 63
Width = 60
Height = 60
Caption = '0'
end
object SpeedButton_dot: TSpeedButton
Left = 186
Top = 125
Width = 60
Height = 60
Caption = '.'
end
object SpeedButton_yc: TSpeedButton
Tag = 9
Left = 248
Top = 2
Width = 60
Height = 60
Caption = #38544#34255
end
object SpeedButton_zdykey2: TSpeedButton
Tag = 9
Left = 248
Top = 63
Width = 60
Height = 60
Caption = 'C'
end
object SpeedButton_zdykey1: TSpeedButton
Tag = 9
Left = 248
Top = 125
Width = 60
Height = 60
Caption = 'A'
end
object SpeedButton10: TSpeedButton
Left = 2
Top = 187
Width = 60
Height = 44
Caption = '-'
end
end
end

41
T03贸易布匹检验/U_KeyBoard.pas Normal file
View File

@ -0,0 +1,41 @@
unit U_KeyBoard;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls,
cxLookAndFeels, cxLookAndFeelPainters,
dxLayoutContainer, cxClasses, Vcl.Buttons, dxLayoutControl, cxGeometry,
dxFramedControl, dxPanel, dxSkinsCore;
type
TFrameKeyBoard = class(TFrame)
dxPanel1: TdxPanel;
SpeedButton1: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton_back: TSpeedButton;
SpeedButton0: TSpeedButton;
SpeedButton_dot: TSpeedButton;
SpeedButton_yc: TSpeedButton;
SpeedButton_zdykey2: TSpeedButton;
SpeedButton_zdykey1: TSpeedButton;
SpeedButton10: TSpeedButton;
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.dfm}
end.

46
T03贸易布匹检验/U_Link.dfm Normal file
View File

@ -0,0 +1,46 @@
object frmLink: TfrmLink
Left = 294
Top = 244
BorderIcons = []
BorderStyle = bsNone
ClientHeight = 114
ClientWidth = 246
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object AADs: TPanel
Left = 36
Top = 32
Width = 185
Height = 41
Caption = #27491#22312#36830#25509#26381#21153#22120'...'
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = True
TabOrder = 0
Visible = False
end
object CSocket: TClientSocket
Active = False
ClientType = ctNonBlocking
Port = 0
OnConnect = CSocketConnect
OnRead = CSocketRead
OnError = CSocketError
Left = 12
Top = 84
end
end

115
T03贸易布匹检验/U_Link.pas Normal file
View File

@ -0,0 +1,115 @@
unit U_Link;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
IniFiles,Dialogs, ScktComp, ExtCtrls;
type
TCommBlock = record
workFlag:integer; //0:开始接受字符串，
linkString:string[255];
// buf:array [0..Buffersize] of char;
end;
TfrmLink = class(TForm)
CSocket: TClientSocket;
AADs: TPanel;
procedure CSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure FormDestroy(Sender: TObject);
procedure CSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
fADOConnString:string;
LinkFlag:string;
function LinkTxServer():Boolean;
{ Public declarations }
end;
var
frmLink: TfrmLink;
implementation
//uses U_Main;
{$R *.dfm}
function TfrmLink.LinkTxServer():Boolean;
var
CommBlock : TCommBlock;
begin
result:=false;
try
CommBlock.workFlag:=strtointdef(LinkFlag,-1);
CommBlock.linkString:='';
CSocket.Socket.SendBuf(CommBlock,SizeOf(CommBlock));
Result:=true;
except
Application.MessageBox('连接通讯服务器失败！','错误信息',MB_ICONERROR);
end;
end;
procedure TfrmLink.CSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
CommBlock1: TCommBlock;
begin
try
CSocket.Socket.ReceiveBuf(CommBlock1,SizeOf(CommBlock1));
fADOConnString:=trim(CommBlock1.linkString);
ModalResult:=1;
except
ModalResult:=-1;
end;
end;
procedure TfrmLink.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=cahide;
end;
procedure TfrmLink.CSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
if not LinkTxServer() then ModalResult:=-1;
end;
procedure TfrmLink.FormDestroy(Sender: TObject);
begin
frmLink:=nil;
end;
procedure TfrmLink.CSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Application.MessageBox('连接通讯服务器失败！','错误信息',MB_ICONERROR);
application.Terminate;
end;
procedure TfrmLink.FormCreate(Sender: TObject);
var
IniFile: TIniFile;
LinkServer:string;
begin
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'SYSTEMSET.INI');
LinkServer := IniFile.ReadString('SERVER', '服务器地址','127.0.0.1');
LinkFlag:= IniFile.ReadString('SERVER', '服务器地址类型','0');
finally
IniFile.Free;
end;
try
CSocket.Host:=trim(LinkServer);
CSocket.Port:=47936;
CSocket.Open;
except
ModalResult:=-1;
end;
end;
end.

1545
T03贸易布匹检验/U_MachRollMain.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

2526
T03贸易布匹检验/U_MachRollMain.pas Normal file
View File

File diff suppressed because it is too large Load Diff

231
T03贸易布匹检验/U_ParamSet.dfm Normal file
View File

@ -0,0 +1,231 @@
object frmParamSet: TfrmParamSet
Left = 0
Top = 0
BorderIcons = [biSystemMenu, biMinimize]
Caption = #21442#25968#35774#32622
ClientHeight = 593
ClientWidth = 775
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 21
object Label33: TLabel
Left = 13
Top = 69
Width = 60
Height = 20
Caption = #37325#37327#20445#30041
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -15
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = True
end
inline FrameParam1: TFrameParam
Left = 0
Top = 50
Width = 775
Height = 519
Align = alTop
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = True
TabOrder = 0
ExplicitTop = 50
ExplicitWidth = 775
ExplicitHeight = 519
inherited pnlSet: TPanel
Width = 775
Height = 519
ExplicitWidth = 775
ExplicitHeight = 519
inherited cxGroupBox1: TcxGroupBox
Style.Font.Charset = GB2312_CHARSET
Style.IsFontAssigned = True
ExplicitTop = 2
ExplicitWidth = 771
Width = 771
inherited Label34: TLabel
Visible = True
end
inherited edtMaBiao: TcxTextEdit
ExplicitHeight = 38
end
inherited edtMBDW: TcxTextEdit
ExplicitHeight = 38
end
inherited edtChen: TcxTextEdit
ExplicitHeight = 38
end
inherited outPage: TcxTextEdit
ExplicitHeight = 38
end
inherited AddwetPresent: TcxTextEdit
ExplicitHeight = 31
end
inherited AddLenPresent: TcxTextEdit
ExplicitHeight = 31
end
inherited presentNumFlag: TcxComboBox
ExplicitHeight = 31
end
end
inherited cxGroupBox2: TcxGroupBox
Style.Font.Charset = GB2312_CHARSET
Style.IsFontAssigned = True
ExplicitWidth = 771
Width = 771
inherited MinLen: TcxTextEdit
Left = 53
Top = 27
Touch.ParentTabletOptions = False
Touch.TabletOptions = []
ExplicitLeft = 53
ExplicitTop = 27
ExplicitHeight = 31
end
inherited MaxLen: TcxTextEdit
ExplicitHeight = 31
end
inherited MinWeight: TcxTextEdit
ExplicitHeight = 31
end
inherited MaxWeight: TcxTextEdit
ExplicitHeight = 31
end
inherited BeginPieceNo: TcxTextEdit
Top = 64
Properties.OnChange = FrameParam1BeginPieceNoPropertiesChange
ExplicitTop = 64
ExplicitHeight = 31
end
inherited EndPieceNo: TcxTextEdit
Properties.OnChange = FrameParam1EndPieceNoPropertiesChange
ExplicitHeight = 31
end
end
inherited cxGroupBox3: TcxGroupBox
ExplicitWidth = 771
Width = 771
inherited MPlace: TcxTextEdit
ExplicitHeight = 31
end
inherited YPlace: TcxTextEdit
ExplicitHeight = 31
end
inherited KgPlace: TcxTextEdit
ExplicitHeight = 31
end
end
inherited cxGroupBox4: TcxGroupBox
ExplicitWidth = 771
ExplicitHeight = 133
Height = 133
Width = 771
inherited edtdabao: TcxTextEdit
Style.Font.Height = -16
Style.IsFontAssigned = True
ExplicitHeight = 34
end
inherited packRolls: TcxTextEdit
ExplicitHeight = 31
end
inherited rollnoMake: TcxComboBox
Properties.DropDownListStyle = lsEditFixedList
Style.Font.Charset = GB2312_CHARSET
Style.IsFontAssigned = True
ExplicitHeight = 31
end
inherited packNoMake: TcxComboBox
ExplicitHeight = 31
end
inherited packPrintPreview: TCheckBox
Top = 74
Width = 128
ExplicitTop = 74
ExplicitWidth = 128
end
inherited packlabNumber: TcxComboBox
Style.Font.Charset = GB2312_CHARSET
Style.IsFontAssigned = True
ExplicitHeight = 25
end
inherited packPrintAction: TcxComboBox
ExplicitHeight = 31
end
end
end
inherited weightRule: TcxComboBox
ExplicitHeight = 34
end
end
object dxPanel1: TdxPanel
Left = 0
Top = 0
Width = 775
Height = 50
Align = alTop
TabOrder = 1
object cxButton1: TcxButton
Left = 14
Top = 3
Width = 87
Height = 38
Caption = #30830#23450
TabOrder = 0
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = [fsBold]
ParentFont = True
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 107
Top = 3
Width = 83
Height = 38
Caption = #20851#38381
TabOrder = 1
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = [fsBold]
ParentFont = True
OnClick = cxButton2Click
end
end
object TouchKeyboard1: TTouchKeyboard
Left = 504
Top = 135
Width = 200
Height = 218
Color = clBtnFace
DrawingStyle = dsGradient
GradientEnd = clSilver
GradientStart = clGray
Layout = 'NumPad'
ParentColor = True
end
object cds_params: TClientDataSet
Aggregates = <>
Params = <>
Left = 280
Top = 8
end
end

231
T03贸易布匹检验/U_ParamSet.pas Normal file
View File

@ -0,0 +1,231 @@
unit U_ParamSet;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, U_frameParam, cxGraphics, cxControls,
cxLookAndFeels, cxLookAndFeelPainters, cxGeometry,
dxFramedControl, Vcl.Menus, Vcl.StdCtrls, cxButtons, dxPanel,
Vcl.Touch.Keyboard, Vcl.ExtCtrls, Data.DB, Datasnap.DBClient;
type
TfrmParamSet = class(TForm)
FrameParam1: TFrameParam;
dxPanel1: TdxPanel;
cxButton1: TcxButton;
cxButton2: TcxButton;
TouchKeyboard1: TTouchKeyboard;
cds_params: TClientDataSet;
Label33: TLabel;
procedure FormCreate(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FrameParam1BeginPieceNoPropertiesChange(Sender: TObject);
procedure FrameParam1EndPieceNoPropertiesChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmParamSet: TfrmParamSet;
implementation
uses
U_iniparam;
{$R *.dfm}
procedure TfrmParamSet.cxButton1Click(Sender: TObject);
begin
if not cds_params.IsEmpty then
begin
cds_params.Edit;
with FrameParam1 do
begin
if Trim(edtChen.Text) = '￡' then
cds_params.fieldByName('chen').Value:='1'
else
cds_params.fieldByName('chen').Value:='0';
if Trim(edtMaBiao.Text) = '￡' then
cds_params.fieldByName('mabiao').Value:='1'
else
cds_params.fieldByName('mabiao').Value:='0';
if Trim(edtMBDW.Text) = '￡' then
cds_params.fieldByName('mbunit').Value:='1'
else
cds_params.fieldByName('mbunit').Value:='0';
//
cds_params.fieldByName('weightRule').Value:=weightRule.ItemIndex ;
// 놔笭
cds_params.fieldByName('outPage').Value:=outPage.Text ;
cds_params.fieldByName('labNumber').Value:=StrToIntDef(labNumber.Text ,1);
//
cds_params.fieldByName('MinLen').Value:=StrToIntDef(Trim(MinLen.Text) ,0);
cds_params.fieldByName('MaxLen').Value:=StrToIntDef(Trim(MaxLen.Text) ,100);
cds_params.fieldByName('MinWeight').Value:=StrToIntDef(Trim(MinWeight.Text) ,0);
cds_params.fieldByName('MaxWeight').Value:=StrToIntDef(Trim(MaxWeight.Text) ,100);
cds_params.fieldByName('MPlace').Value:=StrToIntDef(Trim(MPlace.Text) ,1);
cds_params.fieldByName('YPlace').Value:=StrToIntDef(Trim(YPlace.Text) ,1);
cds_params.fieldByName('KgPlace').Value:=StrToIntDef(Trim(KgPlace.Text) ,1);
cds_params.fieldByName('BeginPieceNo').Value:=StrToIntDef(Trim(BeginPieceNo.Text) ,1);
cds_params.fieldByName('EndPieceNo').Value:=StrToIntDef(Trim(EndPieceNo.Text) ,1);
// 댔관
cds_params.fieldByName('dabao').Value:= trim(edtdabao.Text);
cds_params.fieldByName('packRolls').Value:=StrToIntDef(Trim(packRolls.Text) ,2);
cds_params.fieldByName('packnoMake').Value:= packnoMake.Text;
cds_params.fieldByName('packPostAction').Value:=trim( packPrintAction.Text);
cds_params.fieldByName('packlabNumber').Value:=StrToIntDef(packlabNumber.Text ,0);
cds_params.fieldByName('packPrintPreview').value:=packPrintPreview.checked;
//
cds_params.fieldByName('rollnoMake').Value:= rollnoMake.Text;
cds_params.fieldByName('AddwetPresent').Value:=StrToFloatDef(Trim(AddwetPresent.Text) ,0);
cds_params.fieldByName('AddLenPresent').Value:=StrToFloatDef(Trim(AddLenPresent.Text) ,0);
gPresentNumFlag:=presentNumFlag.itemIndex;
end;
cds_params.Post;
end;
ModalResult := 1;
end;
procedure TfrmParamSet.cxButton2Click(Sender: TObject);
begin
close;
end;
procedure TfrmParamSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
procedure TfrmParamSet.FormCreate(Sender: TObject);
begin
FrameParam1.Align := alClient;
end;
procedure TfrmParamSet.FormShow(Sender: TObject);
begin
if not cds_params.IsEmpty then
begin
with FrameParam1 do
begin
if Trim(cds_params.fieldByName('chen').AsString) = '1' then
edtChen.Text := '￡'
else
edtChen.Text := '';
if Trim(cds_params.fieldByName('mabiao').AsString) = '1' then
edtMaBiao.Text := '￡'
else
edtMaBiao.Text := '';
if Trim(cds_params.fieldByName('mbunit').AsString) = '1' then
edtMBDW.Text := '￡'
else
edtMBDW.Text := '';
//
weightRule.ItemIndex :=cds_params.fieldByName('weightRule').AsInteger;
// 놔笭
outPage.Text := Trim(cds_params.fieldByName('outPage').AsString);
labNumber.ItemIndex := labNumber.Items.IndexOf
(cds_params.fieldByName('labNumber').AsString);
//
MinLen.Text := cds_params.fieldByName('MinLen').AsString;
MaxLen.Text := cds_params.fieldByName('MaxLen').AsString;
MinWeight.Text := cds_params.fieldByName('MinWeight').AsString;
MaxWeight.Text := cds_params.fieldByName('MaxWeight').AsString;
if cds_params.fieldByName('BeginPieceNo').AsString<>'0' then
BeginPieceNo.Text := cds_params.fieldByName('BeginPieceNo').AsString;
if cds_params.fieldByName('EndPieceNo').AsString<>'0' then
EndPieceNo.Text := cds_params.fieldByName('EndPieceNo').AsString;
MPlace.Text := cds_params.fieldByName('MPlace').AsString;
YPlace.Text := cds_params.fieldByName('YPlace').AsString;
KgPlace.Text := cds_params.fieldByName('KgPlace').AsString;
AddwetPresent.Text :='';// cds_params.fieldByName('AddwetPresent').AsString;
AddLenPresent.Text :='';// cds_params.fieldByName('AddLenPresent').AsString;
// 댔관
edtdabao.Text := cds_params.fieldByName('dabao').AsString;
if cds_params.fieldByName('packRolls').AsInteger>0 then
packRolls.Text := cds_params.fieldByName('packRolls').AsString;
packPrintPreview.checked:= cds_params.fieldByName('packPrintPreview').AsBoolean;
packlabNumber.ItemIndex := packlabNumber.Properties.Items.IndexOf
(cds_params.fieldByName('packlabNumber').AsString);
//
packnoMake.ItemIndex := packnoMake.Properties.Items.IndexOf
(cds_params.fieldByName('packnoMake').AsString);
//댔丹관뵀
packPrintAction.ItemIndex := packPrintAction.Properties.Items.IndexOf
(cds_params.fieldByName('packPostAction').AsString);
if packPrintAction.ItemIndex=-1 then
packPrintAction.ItemIndex:=1;
if packnoMake.ItemIndex =-1 then
packnoMake.ItemIndex :=0;
//
rollnoMake.ItemIndex := rollnoMake.Properties.Items.IndexOf
(cds_params.fieldByName('rollnoMake').AsString);
if rollnoMake.ItemIndex =-1 then
rollnoMake.ItemIndex :=0;
//
presentNumFlag.itemIndex:=gPresentNumFlag;
end;
end;
FrameParam1.MinLen.SetFocus;
end;
procedure TfrmParamSet.FrameParam1BeginPieceNoPropertiesChange(Sender: TObject);
begin
if (StrToIntDef(Trim(FrameParam1.BeginPieceNo.Text),0)>0) OR (StrToIntDef(Trim(FrameParam1.EndPieceNo.Text),0)>0) then
begin
FrameParam1.rollnoMake.ItemIndex:=1;
end
else
begin
FrameParam1.rollnoMake.ItemIndex:=0;
end;
end;
procedure TfrmParamSet.FrameParam1EndPieceNoPropertiesChange(Sender: TObject);
begin
if ( StrToIntDef(Trim(FrameParam1.EndPieceNo.Text),0)>0) or (StrToIntDef(Trim(FrameParam1.BeginPieceNo.Text),0)>0) then
begin
FrameParam1.rollnoMake.ItemIndex:=1;
end
else
begin
FrameParam1.rollnoMake.ItemIndex:=0;
end;
end;
end.

663
T03贸易布匹检验/U_ProductJYHZList.dfm Normal file
View File

@ -0,0 +1,663 @@
inherited frmProductJYHZList: TfrmProductJYHZList
Caption = #25104#21697#26816#39564#27719#24635#20449#24687
ClientHeight = 449
ClientWidth = 1112
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Height = -16
FormStyle = fsMDIChild
Visible = True
ExplicitWidth = 1128
ExplicitHeight = 488
PixelsPerInch = 96
TextHeight = 21
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1112
Height = 33
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar1'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ParentColor = True
ParentFont = True
ShowCaptions = True
TabOrder = 3
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
Visible = False
OnClick = TBFindClick
end
object Tmx: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #26597#30475#26126#32454
ImageIndex = 30
OnClick = TmxClick
end
object TBExport: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 28
OnClick = TBExportClick
end
object ToolButton2: TToolButton
Left = 276
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 363
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid [1]
Left = 8
Top = 210
Width = 833
Height = 174
TabOrder = 1
object Tv1: TcxGridDBTableView
OnDblClick = Tv1DblClick
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
Column = v1Column6
end
item
Kind = skSum
Column = v2grossWeight
end
item
Kind = skSum
end
item
Kind = skSum
Column = v1netWeight
end
item
Kind = skSum
Column = v1meter
end
item
Kind = skSum
Column = Tv1kcMeter
end
item
Kind = skSum
Column = Tv1KCROLL
end
item
Kind = skSum
Column = Tv1CKMeter
end
item
Kind = skSum
Column = Tv1CKROLL
end
item
Kind = skSum
Column = Tv1AddLenPresent
end
item
Kind = skSum
Column = Tv1AddwetPresent
end
item
Kind = skSum
Column = Tv1kcnetWeight
end
item
Kind = skSum
Column = Tv1kcgrossWeight
end
item
Kind = skSum
Column = Tv1kcyardage
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
object v1CRTime: TcxGridDBColumn
Caption = #20837#24211#26085#26399
DataBinding.FieldName = 'CRTime'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxDateEditProperties'
Properties.ShowTime = False
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 89
end
object v1orderNo: TcxGridDBColumn
Caption = #35746#21333#21495
DataBinding.FieldName = 'orderNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 72
end
object v1conNo: TcxGridDBColumn
Caption = #21512#21516#21495
DataBinding.FieldName = 'conNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 80
end
object v1buyconNo: TcxGridDBColumn
Caption = #23458#25143#21333#21495
DataBinding.FieldName = 'buyconNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 80
end
object v2C_Name: TcxGridDBColumn
Caption = #20013#25991#21517#31216
DataBinding.FieldName = 'C_Name'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 125
end
object v1C_color: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'C_color'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 70
end
object v1C_ecolor: TcxGridDBColumn
Caption = #39068#33394'('#33521#25991')'
DataBinding.FieldName = 'C_ecolor'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 85
end
object Tv1C_StyleNo: TcxGridDBColumn
Caption = #27454#21495
DataBinding.FieldName = 'C_StyleNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Options.Editing = False
end
object v1C_pattern: TcxGridDBColumn
Caption = #33457#22411
DataBinding.FieldName = 'C_pattern'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 70
end
object v1batchno: TcxGridDBColumn
Caption = #26412#21378#32568#21495
DataBinding.FieldName = 'batchno'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 70
end
object v1ordUnit: TcxGridDBColumn
Caption = #25968#37327#21333#20301
DataBinding.FieldName = 'ordUnit'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Width = 72
end
object v1Column6: TcxGridDBColumn
Caption = #26816#39564#21367#25968
DataBinding.FieldName = 'JQty'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 70
end
object v1meter: TcxGridDBColumn
Caption = #26816#39564#31859#25968
DataBinding.FieldName = 'meter'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 80
end
object Tv1yardage: TcxGridDBColumn
Caption = #30721#25968
DataBinding.FieldName = 'yardage'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 56
end
object v2grossWeight: TcxGridDBColumn
Caption = #27611#37325
DataBinding.FieldName = 'grossWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 80
end
object v1netWeight: TcxGridDBColumn
Caption = #20928#37325
DataBinding.FieldName = 'netWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 80
end
object Tv1CKROLL: TcxGridDBColumn
Caption = #20986#24211#21305#25968
DataBinding.FieldName = 'CKROLL'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 74
end
object Tv1CKMeter: TcxGridDBColumn
Caption = #20986#24211#31859#25968
DataBinding.FieldName = 'CKMeter'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 70
end
object Tv1KCROLL: TcxGridDBColumn
Caption = #24211#23384#21305#25968
DataBinding.FieldName = 'KCROLL'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 67
end
object Tv1kcMeter: TcxGridDBColumn
Caption = #24211#23384#31859#25968
DataBinding.FieldName = 'kcMeter'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 60
end
object Tv1kcyardage: TcxGridDBColumn
Caption = #24211#23384#30721#25968
DataBinding.FieldName = 'kcyardage'
DataBinding.IsNullValueType = True
Options.Editing = False
Width = 66
end
object Tv1kcgrossWeight: TcxGridDBColumn
Caption = #24211#23384#27611#37325
DataBinding.FieldName = 'kcgrossWeight'
DataBinding.IsNullValueType = True
Options.Editing = False
end
object Tv1kcnetWeight: TcxGridDBColumn
Caption = #24211#23384#20928#37325
DataBinding.FieldName = 'kcnetWeight'
DataBinding.IsNullValueType = True
Options.Editing = False
end
object Tv1AddwetPresent: TcxGridDBColumn
Caption = #36192#36865#37325#37327
DataBinding.FieldName = 'AddwetPresent'
DataBinding.IsNullValueType = True
Options.Editing = False
end
object Tv1AddLenPresent: TcxGridDBColumn
Caption = #36192#36865#38271#24230
DataBinding.FieldName = 'AddLenPresent'
DataBinding.IsNullValueType = True
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
object dxLayoutControl_query: TdxLayoutControl [2]
Left = 0
Top = 33
Width = 1112
Height = 80
Align = alTop
TabOrder = 2
AutoSize = True
LayoutLookAndFeel = DataLink_TradeInsp.dxLayoutSkinLookAndFeel1
OptionsItem.SizableHorz = True
OptionsItem.SizableVert = True
object C_name: TcxTextEdit
Tag = 2
Left = 846
Top = 11
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 4
Width = 108
end
object orderNo: TcxTextEdit
Tag = 2
Left = 462
Top = 11
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 2
Width = 124
end
object C_color: TcxTextEdit
Tag = 2
Left = 88
Top = 44
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 5
Width = 155
end
object batchNo: TcxTextEdit
Tag = 1
Left = 848
Top = 44
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 9
Width = 108
end
object conNo: TcxTextEdit
Tag = 2
Left = 651
Top = 11
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 3
Width = 114
end
object buyconNo: TcxTextEdit
Tag = 2
Left = 480
Top = 44
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 7
Width = 108
end
object C_styleNo: TcxTextEdit
Tag = 2
Left = 637
Top = 44
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 8
Width = 130
end
object enddate: TcxDateEdit
Left = 276
Top = 11
ParentFont = True
Properties.ImmediatePost = True
Properties.SaveTime = False
Properties.ShowTime = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 1
Width = 121
end
object begdate: TcxDateEdit
Left = 88
Top = 11
ParentFont = True
Properties.ImmediatePost = True
Properties.InputKind = ikRegExpr
Properties.SaveTime = False
Properties.ShowTime = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 0
Width = 157
end
object C_Pattern: TcxTextEdit
Tag = 2
Left = 292
Top = 44
AutoSize = False
ParentFont = True
Properties.OnChange = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 6
Height = 33
Width = 107
end
object dxLayoutControl_queryGroup_Root: TdxLayoutGroup
AlignHorz = ahParentManaged
AlignVert = avParentManaged
CaptionOptions.AlignVert = tavCenter
CaptionOptions.Text = #26597#35810#32452
CaptionOptions.Visible = False
SizeOptions.AssignedValues = [sovSizableHorz, sovSizableVert]
SizeOptions.SizableHorz = True
SizeOptions.SizableVert = True
Hidden = True
ItemIndex = 1
Padding.Top = -5
Padding.AssignedValues = [lpavTop]
ShowBorder = False
UseIndent = False
Index = -1
end
object dxLayoutItem_begdate: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 229
AllowRemove = False
CaptionOptions.Text = #26597#35810#26102#38388
Control = begdate
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 157
ControlOptions.ShowBorder = False
Index = 0
end
object dxLayoutItem2: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 180
AllowRemove = False
CaptionOptions.Text = #35746#21333#21495
Control = orderNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 124
ControlOptions.ShowBorder = False
Index = 2
end
object dxLayoutItem_color: TdxLayoutItem
Parent = dxLayoutGroup2
SizeOptions.Width = 227
CaptionOptions.Text = #39068#33394
Control = C_color
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 155
ControlOptions.ShowBorder = False
Index = 0
end
object dxLayoutItem_pm: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 180
CaptionOptions.Text = #20013#25991#21517#31216
Control = C_name
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 108
ControlOptions.ShowBorder = False
Index = 4
end
object dxLayoutItem_end: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 143
CaptionOptions.Text = '--'
Control = enddate
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 121
ControlOptions.ShowBorder = False
Index = 1
end
object dxLayoutItem_hth: TdxLayoutItem
Parent = dxLayoutGroup1
SizeOptions.Width = 170
CaptionOptions.Text = #21512#21516#21495
Control = conNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 114
ControlOptions.ShowBorder = False
Index = 3
end
object dxLayoutItem_khdh: TdxLayoutItem
Parent = dxLayoutGroup2
SizeOptions.Width = 180
CaptionOptions.Text = #23458#25143#21333#21495
Control = buyconNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 108
ControlOptions.ShowBorder = False
Index = 2
end
object dxLayoutItem_Pattern: TdxLayoutItem
Parent = dxLayoutGroup2
AlignVert = avClient
SizeOptions.Width = 147
CaptionOptions.Text = #33457#22411
Control = C_Pattern
ControlOptions.OriginalHeight = 29
ControlOptions.OriginalWidth = 107
ControlOptions.ShowBorder = False
Index = 1
end
object dxLayoutGroup1: TdxLayoutGroup
Parent = dxLayoutControl_queryGroup_Root
CaptionOptions.Text = #32452'1'
Hidden = True
LayoutDirection = ldHorizontal
ShowBorder = False
Index = 0
end
object dxLayoutGroup2: TdxLayoutGroup
Parent = dxLayoutControl_queryGroup_Root
CaptionOptions.Text = #32452'2'
Hidden = True
ItemIndex = 4
LayoutDirection = ldHorizontal
ShowBorder = False
Index = 1
end
object dxLayoutItem1: TdxLayoutItem
Parent = dxLayoutGroup2
SizeOptions.Width = 170
CaptionOptions.Text = #27454#21495
Control = C_styleNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 130
ControlOptions.ShowBorder = False
Index = 3
end
object dxLayoutItem3: TdxLayoutItem
Parent = dxLayoutGroup2
SizeOptions.Width = 180
CaptionOptions.Text = #26412#21378#32568#21495
Control = batchNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 108
ControlOptions.ShowBorder = False
Index = 4
end
end
inherited cxProgressBar2: TcxProgressBar
Left = 296
Top = 128
ExplicitLeft = 296
ExplicitTop = 128
ExplicitHeight = 26
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 121
Top = 168
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 73
Top = 169
end
object DataSource1: TDataSource
DataSet = ADOQueryMain
Left = 544
Top = 296
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 200
Top = 192
end
object RMGridReport1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbExport, rmpbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 320
Top = 320
ReportData = {}
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 581
Top = 304
end
end

231
T03贸易布匹检验/U_ProductJYHZList.pas Normal file
View File

@ -0,0 +1,231 @@
unit U_ProductJYHZList;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxStyles, cxCustomData,
cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator, dxDateRanges,
dxScrollbarAnnotations, Data.DB, cxDBData, cxCalendar, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxGridCustomView, cxGrid, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls,
Vcl.ToolWin, U_BaseList, Data.Win.ADODB, dxBarBuiltInMenu,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Common, RM_Class, RM_GridReport,
cxContainer, cxTextEdit, dxCore, cxDateUtils, dxLayoutcxEditAdapters,
dxLayoutContainer, cxMaskEdit, cxDropDownEdit, dxLayoutControl, cxProgressBar;
type
TfrmProductJYHZList = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
Tmx: TToolButton;
TBExport: TToolButton;
TBClose: TToolButton;
C_name: TcxTextEdit;
orderNo: TcxTextEdit;
C_color: TcxTextEdit;
batchNo: TcxTextEdit;
conNo: TcxTextEdit;
buyconNo: TcxTextEdit;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1CRTime: TcxGridDBColumn;
v1orderNo: TcxGridDBColumn;
v1conNo: TcxGridDBColumn;
v1buyconNo: TcxGridDBColumn;
v2C_Name: TcxGridDBColumn;
v1C_color: TcxGridDBColumn;
v1C_ecolor: TcxGridDBColumn;
v1C_pattern: TcxGridDBColumn;
v1batchno: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1meter: TcxGridDBColumn;
v1ordUnit: TcxGridDBColumn;
v2grossWeight: TcxGridDBColumn;
v1netWeight: TcxGridDBColumn;
Tv1CKROLL: TcxGridDBColumn;
Tv1CKMeter: TcxGridDBColumn;
Tv1KCROLL: TcxGridDBColumn;
Tv1kcMeter: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
DataSource1: TDataSource;
ADOQueryMain: TADOQuery;
RMGridReport1: TRMGridReport;
cxGridPopupMenu1: TcxGridPopupMenu;
Tv1yardage: TcxGridDBColumn;
Tv1kcyardage: TcxGridDBColumn;
Tv1kcgrossWeight: TcxGridDBColumn;
Tv1kcnetWeight: TcxGridDBColumn;
Tv1AddwetPresent: TcxGridDBColumn;
Tv1AddLenPresent: TcxGridDBColumn;
Tv1C_StyleNo: TcxGridDBColumn;
ToolButton2: TToolButton;
dxLayoutControl_query: TdxLayoutControl;
C_styleNo: TcxTextEdit;
enddate: TcxDateEdit;
begdate: TcxDateEdit;
C_Pattern: TcxTextEdit;
dxLayoutControl_queryGroup_Root: TdxLayoutGroup;
dxLayoutItem_begdate: TdxLayoutItem;
dxLayoutItem2: TdxLayoutItem;
dxLayoutItem_color: TdxLayoutItem;
dxLayoutItem_pm: TdxLayoutItem;
dxLayoutItem_end: TdxLayoutItem;
dxLayoutItem_hth: TdxLayoutItem;
dxLayoutItem_khdh: TdxLayoutItem;
dxLayoutItem_Pattern: TdxLayoutItem;
dxLayoutGroup1: TdxLayoutGroup;
dxLayoutGroup2: TdxLayoutGroup;
dxLayoutItem1: TdxLayoutItem;
dxLayoutItem3: TdxLayoutItem;
procedure TBCloseClick(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure TmxClick(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
private
procedure InitGrid();
public
{ Public declarations }
end;
var
frmProductJYHZList: TfrmProductJYHZList;
implementation
uses
U_DataLink, U_RtFun, U_ZDYHelp, U_globalVar, U_TradeClothInspList,
U_FormLayOutDesign;
{$R *.dfm}
procedure TfrmProductJYHZList.TBCloseClick(Sender: TObject);
begin
inherited;
WriteCxGrid(self.Caption + tv1.Name, Tv1, '³ÉÆ·²Ö¿â');
Close;
end;
procedure TfrmProductJYHZList.TBExportClick(Sender: TObject);
begin
inherited;
if ADOQueryMain.IsEmpty then
exit;
TcxGridToExcel(self.Caption, cxGrid1);
end;
procedure TfrmProductJYHZList.TBFindClick(Sender: TObject);
begin
inherited;
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SLGetFilters(dxLayoutControl_query, 1, 2));
// SCreateCDS20(ADOQueryMain,CDS_Main);
// SInitCDSData20(ADOQueryMain,CDS_Main);
end;
end;
procedure TfrmProductJYHZList.TBRafreshClick(Sender: TObject);
begin
inherited;
InitGrid();
end;
procedure TfrmProductJYHZList.TmxClick(Sender: TObject);
begin
inherited;
if ADOQueryMain.IsEmpty then
Exit;
//frmTradeClothInspList:=TfrmTradeClothInspList.Create(Application);
with TfrmTradeClothInspList.Create(Application) do
begin
orderno.Text := trim(self.ADOQueryMain.fieldbyname('orderno').asstring);
batchNo.Text := trim(self.ADOQueryMain.fieldbyname('batchNo').asstring);
C_Color.Text := trim(self.ADOQueryMain.fieldbyname('C_Color').asstring);
if ShowModal = 1 then
begin
// InitGrid();
end;
free;
end;
end;
procedure TfrmProductJYHZList.ToolButton2Click(Sender: TObject);
begin
inherited;
WriteCxGrid(self.Caption, Tv1, gDllFileCaption);
if gIsCanDesign then
begin
saveLayOut(application, dxLayoutControl_query, ADOQueryBaseCmd, PWideChar(fDllFileName + '|' + Self.Name + '|' + dxLayoutControl_query.Name + '.ini'));
end;
end;
procedure TfrmProductJYHZList.Tv1DblClick(Sender: TObject);
begin
inherited;
Tmx.Click;
end;
//////////////////////////
procedure TfrmProductJYHZList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmProductJYHZList.FormCreate(Sender: TObject);
begin
inherited;
BegDate.Date := SGetServerDateTime(ADOQueryBaseTemp);
EndDate.Date := BegDate.Date;
cxGrid1.Align := alClient;
end;
procedure TfrmProductJYHZList.FormDestroy(Sender: TObject);
begin
inherited;
frmProductJYHZList := nil;
end;
procedure TfrmProductJYHZList.FormShow(Sender: TObject);
begin
inherited;
readCxGrid(self.Caption + tv1.Name, Tv1, '³ÉÆ·²Ö¿â');
InitGrid();
end;
procedure TfrmProductJYHZList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
Filtered := False;
sql.Add('exec p_select_pieceCheckHz_list');
sql.Add('@begdate=' + QuotedStr(FormatDateTime('yyyy-MM-dd', BegDate.Date)));
sql.Add(',@enddate=' + QuotedStr(FormatDateTime('yyyy-MM-dd', endDate.Date + 1)));
sql.Add(',@orderNo=' + QuotedStr(orderNo.Text));
sql.Add(',@groupBy=''1''');
Open;
//ShowMessage(SQL.Text);
end;
// SCreateCDS(ADOQueryMain,CDS_Main);
// SInitCDSData(ADOQueryMain,CDS_Main);
SDofilter(ADOQueryMain, SLGetFilters(dxLayoutControl_query, 1, 2));
finally
ADOQueryMain.EnableControls;
end;
end;
end.

514
T03贸易布匹检验/U_ProductListHelp.dfm Normal file
View File

@ -0,0 +1,514 @@
inherited frmProductListHelp: TfrmProductListHelp
Caption = #25351#31034#21333#26126#32454#21015#34920
ClientHeight = 540
ClientWidth = 1143
Font.Charset = ANSI_CHARSET
Font.Height = -13
Font.Name = #24494#36719#38597#40657
Position = poDesktopCenter
WindowState = wsMaximized
ExplicitWidth = 1159
ExplicitHeight = 579
PixelsPerInch = 96
TextHeight = 19
object ToolBar1: TToolBar [0]
Tag = 999
Left = 0
Top = 0
Width = 1143
Height = 30
AutoSize = True
ButtonHeight = 30
ButtonWidth = 99
Caption = 'ToolBar1'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = [fsBold]
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ParentColor = True
ParentFont = True
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
OnClick = TBFindClick
end
object TselOk: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #30830#23450
ImageIndex = 12
OnClick = TselOkClick
end
object ToolButton1: TToolButton
Left = 213
Top = 0
Caption = #20445#23384#26684#24335
ImageIndex = 37
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 312
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid2: TcxGrid [1]
Left = 0
Top = 151
Width = 1007
Height = 208
TabOrder = 1
object TV2: TcxGridDBTableView
OnDblClick = TV2DblClick
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Format = '0'
Position = spFooter
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
Column = TV2OrdPiece
end
item
Kind = skSum
Column = V2OrdQty
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
object V2filltime: TcxGridDBColumn
Caption = #21046#21333#26102#38388
DataBinding.FieldName = 'filltime'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxDateEditProperties'
Properties.SaveTime = False
Properties.ShowTime = False
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 79
end
object V2Subid: TcxGridDBColumn
Caption = #35746#21333#26465#30721
DataBinding.FieldName = 'Subid'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 73
end
object V2Column10: TcxGridDBColumn
Caption = #35746#21333#21495
DataBinding.FieldName = 'OrderNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 72
end
object V2CustomerNoName: TcxGridDBColumn
Caption = #23458#25143
DataBinding.FieldName = 'CustName'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 70
end
object V2KHOrderNo: TcxGridDBColumn
Caption = #23458#25143#35746#21333#21495
DataBinding.FieldName = 'KHOrderNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 79
end
object V2Column14: TcxGridDBColumn
Caption = #21512#21516#21495
DataBinding.FieldName = 'conNo'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 70
end
object V2C_Name: TcxGridDBColumn
Caption = #20135#21697#21517#31216
DataBinding.FieldName = 'C_Name'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 80
end
object V2C_Spec: TcxGridDBColumn
Caption = #22411#21495#35268#26684
DataBinding.FieldName = 'C_Spec'
DataBinding.IsNullValueType = True
FixedKind = fkLeftDynamic
HeaderAlignmentHorz = taCenter
Width = 80
end
object V2C_Color: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'C_Color'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 77
end
object V2C_ColorNo: TcxGridDBColumn
Caption = #33394#21495
DataBinding.FieldName = 'C_ColorNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 73
end
object V2C_Pattern: TcxGridDBColumn
Caption = #33457#22411
DataBinding.FieldName = 'C_Pattern'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 71
end
object TV2OrdPiece: TcxGridDBColumn
Caption = #21305#25968
DataBinding.FieldName = 'OrdPiece'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
end
object V2OrdQty: TcxGridDBColumn
Caption = #25968#37327
DataBinding.FieldName = 'OrdQty'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 65
end
object V2OrderUnit: TcxGridDBColumn
Caption = #25968#37327#21333#20301
DataBinding.FieldName = 'OrdUnit'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 65
end
object V2OrdSNote: TcxGridDBColumn
Caption = #25968#37327#35201#27714
DataBinding.FieldName = 'OrdSNote'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 76
end
object V2packNote: TcxGridDBColumn
Caption = #21253#35013#35201#27714
DataBinding.FieldName = 'packNote'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 65
end
object TV2Column1: TcxGridDBColumn
Caption = #26412#21378#32568#21495
DataBinding.FieldName = 'batchno'
DataBinding.IsNullValueType = True
end
end
object cxGridLevel1: TcxGridLevel
GridView = TV2
end
end
object dxLayoutControl_query: TdxLayoutControl [2]
Left = 0
Top = 30
Width = 1143
Height = 59
Align = alTop
TabOrder = 2
LayoutLookAndFeel = DataLink_TradeInsp.dxLayoutSkinLookAndFeel1
OptionsItem.SizableHorz = True
OptionsItem.SizableVert = True
object custName: TcxTextEdit
Tag = 2
Left = 601
Top = 14
ParentFont = True
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 3
Width = 109
end
object conNo: TcxTextEdit
Tag = 2
Left = 764
Top = 14
ParentFont = True
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 4
Width = 105
end
object BuyConNo: TcxTextEdit
Tag = 2
Left = 10000
Top = 10000
ParentFont = True
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 6
Visible = False
Width = 121
end
object OrderNo: TcxTextEdit
Tag = 2
Left = 425
Top = 14
ParentFont = True
Properties.OnEditValueChanged = TBFindClick
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 2
Width = 109
end
object C_Color: TcxTextEdit
Tag = 2
Left = 10000
Top = 10000
ParentFont = True
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 7
Visible = False
Width = 121
end
object C_Name: TcxTextEdit
Tag = 2
Left = 936
Top = 14
AutoSize = False
ParentFont = True
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 5
Height = 29
Width = 109
end
object enddate: TcxDateEdit
Left = 238
Top = 14
ParentFont = True
Properties.ImmediatePost = True
Properties.SaveTime = False
Properties.ShowTime = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 1
Width = 133
end
object begdate: TcxDateEdit
Left = 73
Top = 14
ParentFont = True
Properties.ImmediatePost = True
Properties.InputKind = ikRegExpr
Properties.SaveTime = False
Properties.ShowTime = False
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 0
Width = 138
end
object C_Pattern: TcxTextEdit
Tag = 2
Left = 10000
Top = 10000
ParentFont = True
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 8
Visible = False
Width = 121
end
object dxLayoutControl_queryGroup_Root: TdxLayoutGroup
AlignHorz = ahParentManaged
AlignVert = avParentManaged
CaptionOptions.AlignVert = tavCenter
CaptionOptions.Text = #26597#35810#32452
CaptionOptions.Visible = False
SizeOptions.AssignedValues = [sovSizableHorz, sovSizableVert]
SizeOptions.SizableHorz = True
SizeOptions.SizableVert = True
Hidden = True
ItemIndex = 5
LayoutDirection = ldHorizontal
ShowBorder = False
Index = -1
end
object dxLayoutItem1: TdxLayoutItem
Parent = dxLayoutControl_queryGroup_Root
AllowRemove = False
CaptionOptions.Text = #35746#21333#21495
Control = OrderNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 109
ControlOptions.ShowBorder = False
Index = 2
end
object dxLayoutItem2: TdxLayoutItem
Parent = dxLayoutControl_queryGroup_Root
AllowRemove = False
CaptionOptions.Text = #23458#25143#21517#31216
Control = custName
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 109
ControlOptions.ShowBorder = False
Index = 3
end
object dxLayoutItem_color: TdxLayoutItem
CaptionOptions.Text = #39068#33394
Control = C_Color
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 121
ControlOptions.ShowBorder = False
Index = -1
end
object dxLayoutItem_pm: TdxLayoutItem
Parent = dxLayoutControl_queryGroup_Root
SizeOptions.Width = 168
CaptionOptions.Text = #20135#21697#21517#31216
Control = C_Name
ControlOptions.OriginalHeight = 29
ControlOptions.OriginalWidth = 109
ControlOptions.ShowBorder = False
Index = 5
end
object dxLayoutItem_beg: TdxLayoutItem
Parent = dxLayoutControl_queryGroup_Root
SizeOptions.Width = 197
CaptionOptions.Text = #21046#21333#26085#26399
Control = begdate
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 133
ControlOptions.ShowBorder = False
Index = 0
end
object dxLayoutItem_end: TdxLayoutItem
Parent = dxLayoutControl_queryGroup_Root
SizeOptions.Width = 152
CaptionOptions.Text = '--'
Control = enddate
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 117
ControlOptions.ShowBorder = False
Index = 1
end
object dxLayoutItem_hth: TdxLayoutItem
Parent = dxLayoutControl_queryGroup_Root
CaptionOptions.Text = #21512#21516#21495
Control = conNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 105
ControlOptions.ShowBorder = False
Index = 4
end
object dxLayoutItem_khdh: TdxLayoutItem
CaptionOptions.Text = #23458#25143#21333#21495
Control = BuyConNo
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 121
ControlOptions.ShowBorder = False
Index = -1
end
object dxLayoutItem_Pattern: TdxLayoutItem
CaptionOptions.Text = #33457#22411
Control = C_Pattern
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 121
ControlOptions.ShowBorder = False
Index = -1
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 385
Top = 336
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 289
Top = 345
end
object DataSource1: TDataSource
DataSet = Order_Main
Left = 680
Top = 328
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 616
Top = 328
end
object Order_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 824
Top = 256
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 448
Top = 168
end
end

193
T03贸易布匹检验/U_ProductListHelp.pas Normal file
View File

@ -0,0 +1,193 @@
unit U_ProductListHelp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, cxStyles, cxCustomData,
cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator, dxDateRanges,
dxScrollbarAnnotations, Data.DB, cxDBData, cxCalendar, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxGridCustomView, cxGrid, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls,
Vcl.ToolWin, Data.Win.ADODB, U_BaseHelp, U_BaseList, System.ImageList,
Vcl.ImgList, Datasnap.DBClient, dxBarBuiltInMenu, cxGridCustomPopupMenu,
cxGridPopupMenu, dxLayoutContainer, dxLayoutControl, cxContainer, dxCore,
cxDateUtils, dxLayoutcxEditAdapters, cxMaskEdit, cxDropDownEdit, cxTextEdit;
type
TfrmProductListHelp = class(TfrmBaseHelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBClose: TToolButton;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
V2filltime: TcxGridDBColumn;
V2Subid: TcxGridDBColumn;
V2Column10: TcxGridDBColumn;
V2CustomerNoName: TcxGridDBColumn;
V2KHOrderNo: TcxGridDBColumn;
V2Column14: TcxGridDBColumn;
V2C_Name: TcxGridDBColumn;
V2C_Spec: TcxGridDBColumn;
V2C_Color: TcxGridDBColumn;
V2C_ColorNo: TcxGridDBColumn;
V2C_Pattern: TcxGridDBColumn;
V2OrdSNote: TcxGridDBColumn;
V2packNote: TcxGridDBColumn;
V2OrdQty: TcxGridDBColumn;
V2OrderUnit: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
DataSource1: TDataSource;
ADOQueryMain: TADOQuery;
Order_Main: TClientDataSet;
TV2OrdPiece: TcxGridDBColumn;
cxGridPopupMenu1: TcxGridPopupMenu;
TselOk: TToolButton;
ToolButton1: TToolButton;
dxLayoutControl_query: TdxLayoutControl;
custName: TcxTextEdit;
conNo: TcxTextEdit;
BuyConNo: TcxTextEdit;
OrderNo: TcxTextEdit;
C_Color: TcxTextEdit;
C_Name: TcxTextEdit;
enddate: TcxDateEdit;
begdate: TcxDateEdit;
dxLayoutControl_queryGroup_Root: TdxLayoutGroup;
dxLayoutItem1: TdxLayoutItem;
dxLayoutItem2: TdxLayoutItem;
dxLayoutItem_color: TdxLayoutItem;
dxLayoutItem_pm: TdxLayoutItem;
dxLayoutItem_beg: TdxLayoutItem;
dxLayoutItem_end: TdxLayoutItem;
dxLayoutItem_hth: TdxLayoutItem;
dxLayoutItem_khdh: TdxLayoutItem;
dxLayoutItem_Pattern: TdxLayoutItem;
C_Pattern: TcxTextEdit;
TV2Column1: TcxGridDBColumn;
procedure TBCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure TselOkClick(Sender: TObject);
procedure TV2DblClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBFindClick(Sender: TObject);
private
procedure InitForm();
procedure InitGrid();
public
fType:string;
end;
var
frmProductListHelp: TfrmProductListHelp;
implementation
uses
U_DataLink,U_globalVar,U_RTFun,U_FormLayOutDesign;
{$R *.dfm}
procedure TfrmProductListHelp.FormCreate(Sender: TObject);
begin
inherited;
cxGrid2.Align:=alClient;
BegDate.Date:=SGetServerDateTime(ADOQueryBaseTemp)-3;
endDate.Date:=SGetServerDateTime(ADOQueryBaseTemp)
end;
procedure TfrmProductListHelp.FormShow(Sender: TObject);
begin
inherited;
InitForm();
end;
procedure TfrmProductListHelp.InitForm();
begin
InitGrid();
ReadCxGrid(self.Caption+tv2.Name,Tv2,gDllFileCaption);
end;
procedure TfrmProductListHelp.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain, SLGetFilters(dxLayoutControl_query, 1, 2));
SCreateCDS(ADOQueryMain, Order_Main);
SInitCDSData(ADOQueryMain, Order_Main);
end;
procedure TfrmProductListHelp.TBRafreshClick(Sender: TObject);
begin
OrderNo.SetFocus;
InitGrid();
end;
procedure TfrmProductListHelp.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(trim(Self.Caption)+tv2.Name , Tv2, gDllFileCaption);
if gIsCanDesign then
begin
saveLayOut(application,dxLayoutControl_query, ADOQueryBaseCmd,
PWideChar( fDllFileName + '|' + Self.Name + '|' + dxLayoutControl_query.Name
+ '.ini'));
end;
end;
procedure TfrmProductListHelp.TselOkClick(Sender: TObject);
begin
inherited;
if Order_Main.IsEmpty then exit;
ModalResult:=1;
end;
procedure TfrmProductListHelp.TV2DblClick(Sender: TObject);
begin
inherited;
TselOk.Click;
end;
procedure TfrmProductListHelp.TBCloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmProductListHelp.InitGrid();
var
mBegDate:string;
mendDate:string;
begin
if BegDate.Text<>'' then
mBegDate := FormatDateTime('yyyy-MM-dd', BegDate.Date);
if enddate.Text<>'' then
mendDate := FormatDateTime('yyyy-MM-dd', enddate.Date + 1);
try
Order_Main.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.* ');
// sql.Add(',SumPiece=(select Sum(X.Piece) from BS_Cloth_IO X where X.IOFlag=''Èë¿â'' and X.fromSubID=A.SubID and isnull(X.STKNAME,'''')=' + Quotedstr(Trim(FSTKNAME)) + ')');
//sql.Add(',SumQty=(select Sum(X.Qty) from BS_Cloth_IO X where X.IOFlag=''Èë¿â'' and X.fromSubID=A.SubID and isnull(X.STKNAME,'''')=' + Quotedstr(Trim(FSTKNAME)) + ')');
sql.Add('from V_Trade_Plan_Fty A ');
sql.add('where Status=''9'' ');
if mBegDate<>'' then
sql.Add('and filltime>='+QuotedStr(mBegDate));
if mendDate<>'' then
sql.Add('and filltime<'+QuotedStr(mendDate));
Open;
end;
SDofilter(ADOQueryMain, SLGetFilters(dxLayoutControl_query, 1, 2));
SCreateCDS(ADOQueryMain, Order_Main);
SInitCDSData(ADOQueryMain, Order_Main);
finally
Order_Main.EnableControls;
end;
end;
end.

6110
T03贸易布匹检验/U_SysLogList.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

327
T03贸易布匹检验/U_SysLogList.pas Normal file
View File

@ -0,0 +1,327 @@
unit U_SysLogList;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, cxStyles, cxCustomData,Vcl.Clipbrd,
cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator, dxDateRanges,
dxScrollbarAnnotations, Data.DB, cxDBData, cxGridLevel, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid,
Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.ToolWin, cxContainer, dxCore,
cxDateUtils, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar,System.StrUtils ,
System.ImageList, Vcl.ImgList, cxImageList, Data.Win.ADODB, dxBarBuiltInMenu,
cxGridCustomPopupMenu, cxGridPopupMenu, Datasnap.DBClient, cxCheckBox,
Vcl.Menus;
type
TfrmSysLogList = class(TForm)
Panel1: TPanel;
Label2: TLabel;
Label1: TLabel;
Label4: TLabel;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1UOperator: TcxGridDBColumn;
tv1utime: TcxGridDBColumn;
tv1Utype: TcxGridDBColumn;
tv1UOperation: TcxGridDBColumn;
tv1UDetails: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
begdate: TcxDateEdit;
enddate: TcxDateEdit;
edt_nr: TcxTextEdit;
cxImageList_bar: TcxImageList;
ADOQueryLog: TADOQuery;
DataSource1: TDataSource;
ADOConnection1: TADOConnection;
ToolBar1: TToolBar;
TQry: TToolButton;
Tclose: TToolButton;
tv1orderNo: TcxGridDBColumn;
tv1pieceNo: TcxGridDBColumn;
tv1Meter: TcxGridDBColumn;
tv1GrossWeight: TcxGridDBColumn;
tv1NetWeight: TcxGridDBColumn;
tv1C_name: TcxGridDBColumn;
tv1c_color: TcxGridDBColumn;
tv1FtyPCId: TcxGridDBColumn;
Label3: TLabel;
orderNo: TcxTextEdit;
cxGridPopupMenu1: TcxGridPopupMenu;
ToolButton1: TToolButton;
tv1batchNo: TcxGridDBColumn;
tv1CIID: TcxGridDBColumn;
tv1C_pattern: TcxGridDBColumn;
tv1C_colorNo: TcxGridDBColumn;
Tundo: TToolButton;
cds_loglist: TClientDataSet;
ADOQueryCmd: TADOQuery;
tv1ssel: TcxGridDBColumn;
PM_1: TPopupMenu;
N2: TMenuItem;
N3: TMenuItem;
N1: TMenuItem;
procedure TQryClick(Sender: TObject);
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure edt_nrPropertiesChange(Sender: TObject);
procedure TundoClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N1Click(Sender: TObject);
private
procedure DoQuery();
procedure DoFilter();
function undoDel():Boolean;
public
FMainid:string;
FSubId:string;
fModel:string;
end;
var
frmSysLogList: TfrmSysLogList;
implementation
uses
U_DataLink,U_globalVar,U_RTFun;
{$R *.dfm}
procedure TfrmSysLogList.FormCreate(Sender: TObject);
begin
cxGrid1.Align:=alClient;
begDate.Date :=date-2;
endDate.Date :=date;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
end;
procedure TfrmSysLogList.FormShow(Sender: TObject);
begin
ReadCxGrid('包装日志列表' + 'Tv1', TV1, gDllFileCaption);
if FMainid<>'' then
TQry.Click;
end;
procedure TfrmSysLogList.N1Click(Sender: TObject);
begin
Clipboard.SetTextBuf(PChar(Trim(cds_logList.fieldbyname(TV1.Controller.FocusedColumn.DataBinding.FilterFieldName).AsString)));
end;
procedure TfrmSysLogList.N2Click(Sender: TObject);
begin
SelOKNoFiler(Tv1, True); //全选
end;
procedure TfrmSysLogList.N3Click(Sender: TObject);
begin
SelOKNoFiler(Tv1, false); //全选
end;
procedure TfrmSysLogList.TcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmSysLogList.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(trim('包装日志列表') + 'Tv1', TV1, gDllFileCaption);
end;
procedure TfrmSysLogList.TQryClick(Sender: TObject);
begin
DoQuery();
end;
procedure TfrmSysLogList.TundoClick(Sender: TObject);
begin
try
begdate.SetFocus;
if not gIsCanDesign then
begin
application.MessageBox('没有操作权限!','提示信息',0) ;
exit;
end;
cds_logList.DisableControls;
if not cds_logList.Locate('ssel;Utype',vararrayOf([true,'检验删除']),[]) then
begin
application.MessageBox('请先选择检验删除的记录','提示信息',0) ;
exit;
end;
if undoDel() then
begin
tqry.Click;
end;
finally
cds_logList.EnableControls ;
end;
end;
procedure TfrmSysLogList.DoQuery();
var
mbegdate,menddate:string;
begin
mbegdate:=formatDatetime('yyyy-MM-dd',begDate.Date); //
menddate:=formatDatetime('yyyy-MM-dd',endDate.Date+1);
try
cds_logList.DisableControls;
with ADOQueryLog do
begin
close;
sql.clear;
filtered:=false;
sql.add('select B.*,A.utime,A.Utype,A.UOperation,A.UOperator,A.UDetails');
sql.add(' from Trade_Need_Up A');
sql.add(' inner join Trade_Cloth_Inspect B on A.udataId=B.ciid');
if FMainid<>'' then
begin
sql.Add('where B.mainId='''+Trim(FMainid)+''' ');
end
else
begin
sql.Add('where UTime>='+quotedStr(mbegdate));
sql.Add('and UTime<'+quotedStr(menddate));
end;
if FSubId<>'' then
sql.Add('and B.subId='''+Trim(FSubId)+''' ');
sql.add('union all');
sql.add('select B.*,A.utime,A.Utype,A.UOperation,A.UOperator,A.UDetails');
sql.add(' from Trade_Need_Up A');
sql.add(' inner join Trade_Cloth_Inspect_del B on A.udataId like ''%''+rtrim(B.ciid)+'',%''');
if FMainid<>'' then
begin
sql.Add('where B.mainId='''+Trim(FMainid)+''' ');
end
else
begin
sql.Add('where UTime>='+quotedStr(mbegdate));
sql.Add('and UTime<'+quotedStr(menddate));
end;
if FSubId<>'' then
sql.Add('and B.subId='''+Trim(FSubId)+''' ');
// sql.Add('order by UOperator,UTime');
Open;
end;
SCreateCDS(ADOQueryLog, cds_logList);
SInitCDSData(ADOQueryLog, cds_logList);
finally
cds_logList.EnableControls ;
end;
end;
procedure TfrmSysLogList.edt_nrPropertiesChange(Sender: TObject);
begin
DoFilter();
end;
///////////////////////////////////////////////////////////
//
///////////////////////////////////////////////////////////
procedure TfrmSysLogList.DoFilter();
var
filterStr:string;
begin
if not ADOQueryLog.Active then exit;
filterStr:='';
//
if trim(orderNo.text)<>'' then
begin
filterStr:=' and orderNo like '+quotedStr('%'+trim(orderNo.text)+'%');
end;
if trim(edt_nr.text)<>'' then
begin
filterStr:=' and UDetails like '+quotedStr('%'+trim(edt_nr.text)+'%');
end;
try
cds_logList.DisableControls ;
if trim(filterStr)='' then
begin
ADOQueryLog.Filtered:=false;
exit;
end;
filterStr:=RightBStr(filterStr,length(filterStr)-4);
with ADOQueryLog do
begin
filtered:=false;
filter:=filterStr;
filtered:=true;
end;
cds_logList.EmptyDataSet;
SInitCDSData(ADOQueryLog, cds_logList);
finally
cds_logList.EnableControls;
end;
end;
//////////////////////////////////////////////////////////////////
///
function TfrmSysLogList.undoDel():Boolean;
var
MCIIDS:string;
begin
result:=false;
with cds_loglist do
begin
First;
while not Eof do
begin
if cds_loglist.FieldByName('SSel').AsBoolean = True then
begin
MCIIDS := MCIIDS + Trim(cds_loglist.fieldbyname('CIID').AsString) + ',';
end;
Next;
end;
end;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into Trade_Need_Up(UOperation,UType,UDataId) values(''检验'',''恢复检验删除'',' + quotedstr(MCIIDS) + ') ');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
Sql.Clear;
Sql.Add('exec P_Trade_Insp_Del_undo ');
Sql.Add('@CIIDS=' + quotedstr(Trim(MCIIDS)));
Sql.Add(',@DCode=' + Quotedstr(DCode));
Sql.Add(',@DName=' + Quotedstr(DName));
Open;
end;
if ADOQueryCmd.FieldByName('intReturn').AsInteger = -1 then
begin
raise Exception.Create(pchar(trim(ADOQueryCmd.FieldByName('ShowMsg').AsString)));
end;
ADOQueryCmd.Connection.CommitTrans;
result:=true;
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox('恢复数据删除记录发生错误!','提示信息',0);
end;
end;
end.

1552
T03贸易布匹检验/U_TradeClothInspList.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

1477
T03贸易布匹检验/U_TradeClothInspList.pas Normal file
View File

File diff suppressed because it is too large Load Diff

789
T03贸易布匹检验/U_TradeClothTotalCXJYOutList.dfm Normal file
View File

@ -0,0 +1,789 @@
inherited frmTradeClothTotalCXJYOutList: TfrmTradeClothTotalCXJYOutList
Left = 65
Top = 98
Caption = #26816#39564#20986#24211#21015#34920
ClientHeight = 732
ClientWidth = 1844
Font.Height = -16
FormStyle = fsMDIChild
Position = poScreenCenter
Visible = True
ExplicitWidth = 1860
ExplicitHeight = 771
PixelsPerInch = 96
TextHeight = 21
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1844
Height = 30
AutoSize = True
ButtonHeight = 30
ButtonWidth = 99
Caption = 'ToolBar1'
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ShowCaptions = True
TabOrder = 3
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
Visible = False
OnClick = TBFindClick
end
object btn3: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #29983#25104#36180#27454
ImageIndex = 2
end
object TBExport: TToolButton
Left = 245
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 20
OnClick = TBExportClick
end
object ToolButton1: TToolButton
Left = 316
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 419
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 30
Width = 1844
Height = 118
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
ParentBackground = False
TabOrder = 4
ExplicitTop = 27
ExplicitWidth = 1597
object Label3: TLabel
Left = 261
Top = 46
Width = 32
Height = 21
Caption = #21697#21517
end
object Label5: TLabel
Left = 23
Top = 46
Width = 64
Height = 21
Caption = #20986#24211#21333#21495
end
object Label8: TLabel
Left = 261
Top = 83
Width = 32
Height = 21
Caption = #35268#26684
end
object Label12: TLabel
Left = 24
Top = 83
Width = 64
Height = 21
Caption = #20986#24211#31867#22411
end
object Label4: TLabel
Left = 458
Top = 46
Width = 64
Height = 21
Caption = #26469#33258#21333#20301
end
object Label9: TLabel
Left = 458
Top = 83
Width = 64
Height = 21
Caption = #20986#21040#21333#20301
end
object Label6: TLabel
Left = 681
Top = 83
Width = 80
Height = 21
Caption = #20986#21040#35745#21010#21333
end
object Label7: TLabel
Left = 681
Top = 46
Width = 80
Height = 21
Caption = #26469#33258#35745#21010#21333
end
object Label1: TLabel
Left = 948
Top = 46
Width = 32
Height = 21
Caption = #24067#31181
end
object Label2: TLabel
Left = 932
Top = 83
Width = 48
Height = 21
Caption = #21152#24037#21035
end
object C_NAME: TcxTextEdit
Tag = 2
Left = 302
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 0
Width = 150
end
object BCIONO: TcxTextEdit
Tag = 2
Left = 93
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 1
Width = 150
end
object C_spec: TcxTextEdit
Tag = 2
Left = 302
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 2
Width = 150
end
object FromCoName: TcxTextEdit
Tag = 2
Left = 526
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 3
Width = 150
end
object ToCoName: TcxTextEdit
Tag = 2
Left = 526
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 4
Width = 150
end
object ToOrdNo: TcxTextEdit
Tag = 2
Left = 767
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 5
Width = 150
end
object FromOrdNo: TcxTextEdit
Tag = 2
Left = 767
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 6
Width = 150
end
inline frmFrameDateSel1: TfrmFrameDateSel
Left = 2
Top = 2
Width = 1840
Height = 36
Align = alTop
Color = clWhite
ParentBackground = False
ParentColor = False
TabOrder = 7
ExplicitLeft = 2
ExplicitTop = 2
ExplicitWidth = 1593
inherited lbl2: TLabel
Width = 16
Height = 21
ExplicitWidth = 16
ExplicitHeight = 21
end
end
object IOType: TcxComboBox
Left = 93
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 8
Width = 149
end
object GC_Name: TcxTextEdit
Tag = 2
Left = 984
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 9
Width = 150
end
object CraftCode: TcxTextEdit
Tag = 2
Left = 984
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 10
Width = 150
end
end
object cxGrid1: TcxGrid [2]
Left = 0
Top = 178
Width = 1408
Height = 554
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 2
ExplicitLeft = 8
ExplicitTop = 184
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
OnFocusedRecordChanged = Tv1FocusedRecordChanged
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Kind = skSum
Position = spFooter
end
item
Kind = skSum
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skCount
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
Column = Tv1Column33
end
item
Kind = skSum
Column = Tv1Column34
end
item
Kind = skSum
Column = Tv1Column35
end
item
Kind = skSum
Column = cxgrdbclmnTv1Column1
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.IndicatorWidth = 40
object Tv1Column5: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
HeaderAlignmentHorz = taCenter
Width = 66
end
object v1Column6: TcxGridDBColumn
Caption = #20986#24211#21333#21495
DataBinding.FieldName = 'BCIONO'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 87
end
object v1Column2: TcxGridDBColumn
Tag = 2
Caption = #20986#24211#26102#38388
DataBinding.FieldName = 'IOTime'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxDateEditProperties'
Properties.SaveTime = False
Properties.ShowTime = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 92
end
object v1Column15: TcxGridDBColumn
Tag = 2
Caption = #25152#23646#31867#22411
DataBinding.FieldName = 'SSType'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#33258#24049
#23458#25143)
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 66
end
object v1Column1: TcxGridDBColumn
Caption = #37319#36141#21333#21495
DataBinding.FieldName = 'ConNo'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 66
end
object v1Column14: TcxGridDBColumn
Tag = 2
Caption = #26469#33258#21333#20301
DataBinding.FieldName = 'FromCoName'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Alignment.Horz = taLeftJustify
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 102
end
object Tv1Column8: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'C_Code'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object v2Column1: TcxGridDBColumn
Tag = 2
Caption = #21697#21517
DataBinding.FieldName = 'C_Name'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object v1Column17: TcxGridDBColumn
Caption = #21697#29260
DataBinding.FieldName = 'SXPinPai'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 66
end
object v1Column20: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'SPCode'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 66
end
object v1Column10: TcxGridDBColumn
Caption = #25209#21495
DataBinding.FieldName = 'BatchNo'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 66
end
object Tv1Column4: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'C_Color'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column9: TcxGridDBColumn
Caption = #33457#22411
DataBinding.FieldName = 'C_Pattern'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column6: TcxGridDBColumn
Caption = #33394#21495
DataBinding.FieldName = 'C_ColorNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column7: TcxGridDBColumn
Caption = #32568#21495
DataBinding.FieldName = 'FtyPCId'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object v1Column18: TcxGridDBColumn
Caption = #35745#21010#21333
DataBinding.FieldName = 'ToOrdNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 73
end
object Tv1Column30: TcxGridDBColumn
Caption = #21512#21516#21495
DataBinding.FieldName = 'fromConNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column35: TcxGridDBColumn
Caption = #25277#26816#21305#25968
DataBinding.FieldName = 'Piece2'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 104
end
object Tv1Column33: TcxGridDBColumn
Caption = #25277#26816#25968#37327
DataBinding.FieldName = 'Qty2'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 100
end
object Tv1Column34: TcxGridDBColumn
Caption = #21407#25968#37327
DataBinding.FieldName = 'Qty1'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 94
end
object cxgrdbclmnTv1Column1: TcxGridDBColumn
Caption = #25968#37327#24046
DataBinding.FieldName = 'Qty3'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
end
object cxgrdbclmnTv1Column2: TcxGridDBColumn
Caption = #25968#37327#21333#20301
DataBinding.FieldName = 'QtyUnit'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 113
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
inherited loadProcess: TPanel
Left = 777
Top = 447
ExplicitLeft = 777
ExplicitTop = 447
end
inherited cxProgressBar2: TcxProgressBar
Left = 777
Top = 396
ExplicitLeft = 777
ExplicitTop = 396
ExplicitWidth = 169
ExplicitHeight = 29
Width = 169
end
object cxTabControl1: TcxTabControl [5]
Left = 0
Top = 148
Width = 1844
Height = 30
Align = alTop
TabOrder = 5
Visible = False
Properties.CustomButtons.Buttons = <>
Properties.Style = 9
Properties.TabIndex = 0
Properties.Tabs.Strings = (
' '#24453#26816#39564' '
#13' '#24050#26816#39564' '
#13' '#20840#37096' ')
OnChange = cxTabControl1Change
ExplicitTop = 145
ExplicitWidth = 1597
ClientRectRight = 0
ClientRectTop = 0
end
object pnl1: TPanel [6]
Left = 1408
Top = 178
Width = 436
Height = 554
Align = alRight
Caption = 'pnl1'
TabOrder = 6
object cxGrid2: TcxGrid
Left = 1
Top = 31
Width = 434
Height = 522
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 0
ExplicitLeft = 1286
ExplicitTop = 170
ExplicitWidth = 564
ExplicitHeight = 554
object TV2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DS_2
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Kind = skSum
Position = spFooter
end
item
Kind = skSum
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
Column = cxgrdbclmnTV_2Column1
end
item
Kind = skSum
Column = cxgrdbclmnTV_2Column2
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.IndicatorWidth = 40
object cxgrdbclmn1: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
HeaderAlignmentHorz = taCenter
Width = 66
end
object cxgrdbclmnTV2Column1: TcxGridDBColumn
Caption = #21367#21495
DataBinding.FieldName = 'PieceNo1'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
end
object cxgrdbclmnTV_2Column2: TcxGridDBColumn
Caption = #24403#21069#25968#37327
DataBinding.FieldName = 'Qty1'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 83
end
object cxgrdbclmnTV_2Column1: TcxGridDBColumn
Caption = #21407#25968#37327
DataBinding.FieldName = 'Qty2'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 80
end
end
object cxGridLevel1: TcxGridLevel
GridView = TV2
end
end
object tlb1: TToolBar
Tag = 1
Left = 1
Top = 1
Width = 434
Height = 30
AutoSize = True
ButtonHeight = 30
ButtonWidth = 99
Caption = 'ToolBar1'
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ShowCaptions = True
TabOrder = 1
object btn1: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20462#25913#31859#25968
ImageIndex = 3
OnClick = btn1Click
end
object btn2: TToolButton
Left = 103
Top = 0
AutoSize = True
Caption = #20462#25913#37325#37327
ImageIndex = 4
OnClick = btn2Click
end
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 260
Top = 246
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 92
Top = 230
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Parameters = <>
Left = 560
Top = 300
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 637
Top = 529
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 707
Top = 306
end
object DataSource1: TDataSource
DataSet = CDS_Main
Left = 824
Top = 546
end
object GPM_1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 545
Top = 534
end
object CDS_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 748
Top = 535
end
object PopupMenu1: TPopupMenu
Left = 524
Top = 412
object N1: TMenuItem
Caption = #20840#36873
OnClick = N1Click
end
object N2: TMenuItem
Caption = #20840#24323
OnClick = N2Click
end
object N3: TMenuItem
Caption = #22797#21046
OnClick = N3Click
end
end
object ADOQueryPrint: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Parameters = <>
Left = 655
Top = 444
end
object DS_2: TDataSource
DataSet = CDS_2
Left = 832
Top = 626
end
object CDS_2: TClientDataSet
Aggregates = <>
Params = <>
Left = 756
Top = 615
end
object ADO_2: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 645
Top = 609
end
object GPM_2: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 553
Top = 614
end
end

518
T03贸易布匹检验/U_TradeClothTotalCXJYOutList.pas Normal file
View File

@ -0,0 +1,518 @@
unit U_TradeClothTotalCXJYOutList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Vcl.Printers, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxGridCustomTableView, cxGridTableView,
cxGridBandedTableView, cxGridDBBandedTableView, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridDBTableView, cxGrid, StdCtrls, ComCtrls,
ExtCtrls, ToolWin, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB, DBClient,
cxDropDownEdit, cxCheckBox, RM_Common, RM_Class, RM_e_Xls, RM_Dataset,
RM_System, RM_GridReport, Menus, cxCalendar, cxButtonEdit, cxTextEdit, cxPC,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxDateRanges,
dxBarBuiltInMenu, U_BaseList, Clipbrd, dxScrollbarAnnotations, FrameDateSel,
cxContainer, cxMaskEdit, cxProgressBar, cxButtons, dxSkinsCore,
dxSkinsDefaultPainters;
type
TfrmTradeClothTotalCXJYOutList = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBExport: TToolButton;
TBClose: TToolButton;
Panel1: TPanel;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
GPM_1: TcxGridPopupMenu;
CDS_Main: TClientDataSet;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column6: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
v1Column14: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Label3: TLabel;
Label5: TLabel;
Label8: TLabel;
Label12: TLabel;
C_NAME: TcxTextEdit;
BCIONO: TcxTextEdit;
C_spec: TcxTextEdit;
v1Column20: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column17: TcxGridDBColumn;
v1Column18: TcxGridDBColumn;
ToolButton1: TToolButton;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
N3: TMenuItem;
Label4: TLabel;
Label9: TLabel;
Label6: TLabel;
Label7: TLabel;
FromCoName: TcxTextEdit;
ToCoName: TcxTextEdit;
ToOrdNo: TcxTextEdit;
FromOrdNo: TcxTextEdit;
frmFrameDateSel1: TfrmFrameDateSel;
IOType: TcxComboBox;
Label1: TLabel;
Label2: TLabel;
GC_Name: TcxTextEdit;
CraftCode: TcxTextEdit;
Tv1Column30: TcxGridDBColumn;
ADOQueryPrint: TADOQuery;
cxTabControl1: TcxTabControl;
Tv1Column33: TcxGridDBColumn;
Tv1Column34: TcxGridDBColumn;
Tv1Column35: TcxGridDBColumn;
cxgrdbclmnTv1Column1: TcxGridDBColumn;
DS_2: TDataSource;
CDS_2: TClientDataSet;
ADO_2: TADOQuery;
GPM_2: TcxGridPopupMenu;
pnl1: TPanel;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxgrdbclmn1: TcxGridDBColumn;
cxgrdbclmnTV2Column1: TcxGridDBColumn;
cxgrdbclmnTV_2Column2: TcxGridDBColumn;
cxgrdbclmnTV_2Column1: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
tlb1: TToolBar;
btn1: TToolButton;
btn2: TToolButton;
cxgrdbclmnTv1Column2: TcxGridDBColumn;
btn3: TToolButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ConNoMChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure SPNameChange(Sender: TObject);
procedure BCIOIDChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure C_specChange(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure BCIOIDPropertiesChange(Sender: TObject);
procedure Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
canshu1, FstkName, canshu3: string;
procedure InitGrid();
{ Private declarations }
public
FFSPID, FC_Degree, FC_Pack: string;
{ Public declarations }
end;
//var
// frmPBOutList: TfrmPBOutList;
implementation
uses
U_DataLink, U_RTFun, U_LabelPrint, U_BatchMdyData;
{$R *.dfm}
procedure TfrmTradeClothTotalCXJYOutList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmTradeClothTotalCXJYOutList.FormCreate(Sender: TObject);
begin
inherited;
canshu1 := Trim(self.fParameters1);
FSTKName := Trim(self.fParameters2);
canshu3 := Trim(self.fParameters3);
frmFrameDateSel1.EndDate.Date := SGetServerDate(ADOQueryTemp);
frmFrameDateSel1.BegDate.Date := frmFrameDateSel1.EndDate.Date - 90;
end;
procedure TfrmTradeClothTotalCXJYOutList.InitGrid();
var
SqlStr: string;
begin
SqlStr := ' exec P_Trade_Insp_Recheck_View ';
SqlStr := SqlStr + ' @BegDate=''' + Trim(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.BegDate.Date)) + '''';
SqlStr := SqlStr + ' ,@Enddate=''' + Trim(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.enddate.Date + 1)) + '''';
// case cxTabControl1.TabIndex of
// 0:
// begin
// SqlStr := SqlStr + ' and NOT exists(select ciid from Trade_Cloth_Inspect X where X.BCIOID=A.BCIOID) ';
// end;
// 1:
// begin
// SqlStr := SqlStr + ' and exists(select ciid from Trade_Cloth_Inspect X where X.BCIOID=A.BCIOID) ';
// end;
// end;
InitCDSData(ADOQueryMain, CDS_Main, Tv1, SqlStr, SGetFilters(Panel1, 1, 2), 'BCIOID');
end;
procedure TfrmTradeClothTotalCXJYOutList.TBRafreshClick(Sender: TObject);
begin
frmFrameDateSel1.BegDate.SetFocus;
InitGrid();
end;
procedure TfrmTradeClothTotalCXJYOutList.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(trim(Self.Caption), Tv1, '贸易汇总仓库');
end;
procedure TfrmTradeClothTotalCXJYOutList.Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
var
SqlStr: string;
begin
SqlStr := ' select A.BCIOID,A.MainID,A.CIID,A.GrossWeight,A.Tare,A.NetWeight,A.Meter,A.Yardage,PieceNo1=A.PieceNo,Qty1=A.Qty,Qty2= B.Qty ';
SqlStr := SqlStr + ' from Trade_Cloth_Inspect A left join Trade_Cloth_Inspect_recheck B on A.CIID=B.CIID ';
SqlStr := SqlStr + ' where A.BCIOID=''' + Trim(CDS_Main.FieldByName('BCIOID').AsString) + '''';
InitCDSData(ADO_2, CDS_2, Tv2, SqlStr, '', '');
end;
procedure TfrmTradeClothTotalCXJYOutList.BCIOIDPropertiesChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmTradeClothTotalCXJYOutList.btn1Click(Sender: TObject);
var
isOk: boolean;
mtzfs: string;
mtzsl, mvalue: double;
decimalY: integer;
begin
if CDS_2.IsEmpty then
Exit;
if CDS_2.Locate('SSel', True, []) = False then
begin
Application.MessageBox('请先选择数据记录', '提示', 0);
Exit;
end;
with ADOQueryBaseTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_IO A ');
sql.Add(' where EXISTS(select X.RTValue from [dbo].[F_Tool_SplitString](' + quotedstr(SelCDSKey(CDS_2, ['cIId'])[0]) + ','','') X where X.RTValue=A.StkId ) ');
Open;
if not IsEmpty then
begin
Application.MessageBox('已产生入库数据不能操作!', '提示', 0);
exit;
end;
end;
isOk := false;
frmBatchMdyData := TfrmBatchMdyData.create(self);
with frmBatchMdyData do
begin
fTabCaption := '调整米数';
if ShowModal = 1 then
begin
mtzfs := Trim(tzfs.Text);
mtzsl := strTofloatdef(Trim(tzsl.Text), 0);
isOk := true;
end;
free;
end;
if not isOk then
exit;
with ADOQueryTemp do
begin
Close;
SQL.Clear;
sql.Add(' select * from Trade_Cloth_Inspect_Rule where RuleID=' + quotedstr(Trim(CDS_2.fieldbyname('mainId').AsString)));
Open;
if not IsEmpty then
begin
if fieldByname('decimalY').AsInteger > 0 then
decimalY := fieldByname('decimalY').AsInteger
else
decimalY := 1;
end;
end;
try
CDS_2.DisableControls;
ADOQueryCmd.Connection.BeginTrans;
with CDS_2 do
begin
First;
while not Eof do
begin
if CDS_2.FieldByName('SSel').AsBoolean = True then
begin
if mtzfs = '增加' then
begin
mvalue := CDS_2.fieldbyname('Meter').AsFloat + mtzsl;
end;
if mtzfs = '减少' then
begin
mvalue := CDS_2.fieldbyname('Meter').AsFloat - mtzsl;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update Trade_Cloth_Inspect Set Meter=' + floatTostr(mvalue));
sql.Add('where cIId=''' + Trim(CDS_2.fieldbyname('cIId').AsString) + '''');
sql.Add('Update Trade_Cloth_Inspect Set yardage=round(meter/0.9144,' + inttostr(decimalY) + ')');
sql.Add('where cIId=''' + Trim(CDS_2.fieldbyname('cIId').AsString) + '''');
sql.Add('Update Trade_Cloth_Inspect Set Qty=CASE WHEN QtyUnit=''M'' THEN Meter WHEN QtyUnit=''Y'' THEN Yardage WHEN QtyUnit=''kg'' THEN GrossWeight ELSE 0 END ');
sql.Add('where cIId=''' + Trim(CDS_2.fieldbyname('cIId').AsString) + '''');
ExecSQL;
end;
end;
Next;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
CDS_2.EnableControls;
application.MessageBox('数据操作成功！', '提示信息');
TBRafresh.Click;
except
ADOQueryCmd.Connection.RollbackTrans;
CDS_2.EnableControls;
application.MessageBox('数据操作失败！', '提示信息', 0);
end;
end;
procedure TfrmTradeClothTotalCXJYOutList.btn2Click(Sender: TObject);
var
isOk: boolean;
mtzfs: string;
mtzsl, mvalue: double;
decimalY: integer;
mfield: string;
begin
if CDS_2.IsEmpty then
Exit;
if CDS_2.Locate('SSel', True, []) = False then
begin
Application.MessageBox('请先选择数据记录', '提示', 0);
Exit;
end;
with ADOQueryBaseTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_IO A ');
sql.Add(' where EXISTS(select X.RTValue from [dbo].[F_Tool_SplitString](' + quotedstr(SelCDSKey(CDS_2, ['cIId'])[0]) + ','','') X where X.RTValue=A.StkId ) ');
Open;
if not IsEmpty then
begin
Application.MessageBox('已产生入库数据不能操作!', '提示', 0);
exit;
end;
end;
isOk := false;
frmBatchMdyData := TfrmBatchMdyData.create(self);
with frmBatchMdyData do
begin
fTabCaption := '独立调整重量';
if ShowModal = 1 then
begin
mtzfs := Trim(tzfs1.Text);
if Trim(tzfield.Text) = '毛重' then
begin
mfield := 'grossWeight';
end
else if Trim(tzfield.Text) = '净重' then
begin
mfield := 'netWeight';
end
else if Trim(tzfield.Text) = '皮重' then
begin
mfield := 'tare';
end
else
begin
free;
exit;
end;
mtzsl := strTofloatdef(Trim(tzsl1.Text), 0);
isOk := true;
end;
free;
end;
if not isOk then
exit;
try
CDS_2.DisableControls;
ADOQueryCmd.Connection.BeginTrans;
with CDS_2 do
begin
First;
while not Eof do
begin
if CDS_2.FieldByName('SSel').AsBoolean = True then
begin
if mtzfs = '增加' then
begin
mvalue := CDS_2.fieldbyname(mfield).AsFloat + mtzsl;
end;
if mtzfs = '减少' then
begin
mvalue := CDS_2.fieldbyname(mfield).AsFloat - mtzsl;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update Trade_Cloth_Inspect Set ' + mfield + '=' + floatTostr(mvalue));
sql.Add('where cIId=''' + Trim(CDS_2.fieldbyname('cIId').AsString) + '''');
sql.Add('Update Trade_Cloth_Inspect Set Qty=CASE WHEN QtyUnit=''M'' THEN Meter WHEN QtyUnit=''Y'' THEN Yardage WHEN QtyUnit=''kg'' THEN GrossWeight ELSE 0 END ');
sql.Add('where cIId=''' + Trim(CDS_2.fieldbyname('cIId').AsString) + '''');
ExecSQL;
end;
end;
Next;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
CDS_2.EnableControls;
application.MessageBox('数据操作成功！', '提示信息');
TBRafresh.Click;
except
ADOQueryCmd.Connection.RollbackTrans;
CDS_2.EnableControls;
application.MessageBox('数据操作失败！', '提示信息', 0);
end;
end;
procedure TfrmTradeClothTotalCXJYOutList.ConNoMChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
end;
end;
procedure TfrmTradeClothTotalCXJYOutList.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmTradeClothTotalCXJYOutList.FormShow(Sender: TObject);
var
mSql: string;
begin
inherited;
mSql := 'select distinct name=A.IOType from BS_Cloth_IO A where IOFlag=''出库'' and isnull(STKNAME,'''')=''' + Trim(FSTKNAME) + ''' ';
SInitTcxComBoxBySql(ADOQueryTemp, IOType, false, mSql);
ReadCxGrid(trim(Self.Caption), Tv1, '贸易汇总仓库');
InitGrid();
end;
procedure TfrmTradeClothTotalCXJYOutList.TBExportClick(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then
exit;
TcxGridToExcel(FstkName + '出库列表', cxGrid1);
end;
procedure TfrmTradeClothTotalCXJYOutList.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_Main);
SInitCDSData(ADOQueryMain, CDS_Main);
end;
end;
procedure TfrmTradeClothTotalCXJYOutList.SPNameChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmTradeClothTotalCXJYOutList.BCIOIDChange(Sender: TObject);
begin
if Length(Trim(BCIOno.Text)) < 4 then
begin
if Trim(BCIOno.Text) <> '' then
Exit;
end;
TBFind.Click;
end;
procedure TfrmTradeClothTotalCXJYOutList.N1Click(Sender: TObject);
begin
SelOKNo(CDS_Main, True);
end;
procedure TfrmTradeClothTotalCXJYOutList.N2Click(Sender: TObject);
begin
SelOKNo(CDS_Main, False);
end;
procedure TfrmTradeClothTotalCXJYOutList.N3Click(Sender: TObject);
begin
Clipboard.SetTextBuf(PChar(Trim(CDS_Main.fieldbyname(TV1.Controller.FocusedColumn.DataBinding.FilterFieldName).AsString)));
end;
procedure TfrmTradeClothTotalCXJYOutList.C_specChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmTradeClothTotalCXJYOutList.cxTabControl1Change(Sender: TObject);
begin
InitGrid();
end;
end.

810
T03贸易布匹检验/U_TradeClothTotalOutSel.dfm Normal file
View File

@ -0,0 +1,810 @@
inherited frmTradeClothTotalOutSel: TfrmTradeClothTotalOutSel
Left = 65
Top = 98
Caption = #36152#26131#24067#21305#20986#24211#21015#34920
ClientHeight = 564
ClientWidth = 1597
Font.Charset = ANSI_CHARSET
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 1613
ExplicitHeight = 603
PixelsPerInch = 96
TextHeight = 21
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1597
Height = 30
AutoSize = True
ButtonHeight = 30
ButtonWidth = 99
Caption = 'ToolBar1'
Color = clBtnFace
Images = DataLink_TradeInsp.cxImageList_bar
List = True
ParentColor = True
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
Visible = False
OnClick = TBFindClick
end
object btnOK: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #30830#35748
ImageIndex = 12
OnClick = btnOKClick
end
object ToolButton1: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 316
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 30
Width = 1597
Height = 118
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
ParentBackground = False
ParentColor = True
TabOrder = 1
object Label3: TLabel
Left = 261
Top = 46
Width = 32
Height = 21
Caption = #21697#21517
end
object Label5: TLabel
Left = 23
Top = 46
Width = 64
Height = 21
Caption = #20986#24211#21333#21495
end
object Label8: TLabel
Left = 261
Top = 83
Width = 32
Height = 21
Caption = #35268#26684
end
object Label12: TLabel
Left = 24
Top = 83
Width = 64
Height = 21
Caption = #20986#24211#31867#22411
end
object Label4: TLabel
Left = 458
Top = 46
Width = 64
Height = 21
Caption = #26469#33258#21333#20301
end
object Label9: TLabel
Left = 458
Top = 83
Width = 64
Height = 21
Caption = #20986#21040#21333#20301
end
object Label6: TLabel
Left = 681
Top = 83
Width = 80
Height = 21
Caption = #20986#21040#35745#21010#21333
end
object Label7: TLabel
Left = 681
Top = 46
Width = 80
Height = 21
Caption = #26469#33258#35745#21010#21333
end
object C_NAME: TcxTextEdit
Tag = 2
Left = 302
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 0
Width = 150
end
object BCIONO: TcxTextEdit
Tag = 2
Left = 93
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 1
Width = 150
end
object C_spec: TcxTextEdit
Tag = 2
Left = 302
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 2
Width = 150
end
object FromCoName: TcxTextEdit
Tag = 2
Left = 526
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 3
Width = 150
end
object ToCoName: TcxTextEdit
Tag = 2
Left = 526
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 4
Width = 150
end
object ToOrdNo: TcxTextEdit
Tag = 2
Left = 767
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 5
Width = 150
end
object FromOrdNo: TcxTextEdit
Tag = 2
Left = 767
Top = 40
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 6
Width = 150
end
inline frmFrameDateSel1: TfrmFrameDateSel
Left = 2
Top = 2
Width = 1593
Height = 36
Align = alTop
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentBackground = False
ParentColor = True
ParentFont = True
TabOrder = 7
ExplicitLeft = 2
ExplicitTop = 2
ExplicitWidth = 1593
inherited lbl2: TLabel
Width = 16
Height = 21
ExplicitWidth = 16
ExplicitHeight = 21
end
inherited cxButton2: TcxButton
Left = 611
ExplicitLeft = 611
end
end
object IOType: TcxComboBox
Left = 93
Top = 77
Properties.OnChange = BCIOIDPropertiesChange
TabOrder = 8
Width = 149
end
end
object cxGrid1: TcxGrid [2]
Left = 0
Top = 148
Width = 1597
Height = 416
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 2
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Kind = skSum
Position = spFooter
Column = v1Column19
end
item
Kind = skSum
Column = v1Column19
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skCount
end
item
Kind = skSum
end
item
Kind = skSum
Column = v2Column6
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
Column = v1Column19
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.IndicatorWidth = 40
object v1Column5: TcxGridDBColumn
Caption = #36710#38388
DataBinding.FieldName = 'Workshop'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column6: TcxGridDBColumn
Caption = #20986#24211#21333#21495
DataBinding.FieldName = 'BCIONO'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column2: TcxGridDBColumn
Tag = 2
Caption = #20986#24211#26102#38388
DataBinding.FieldName = 'IOTime'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxDateEditProperties'
Properties.SaveTime = False
Properties.ShowTime = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column4: TcxGridDBColumn
Tag = 2
Caption = #20986#24211#31867#22411
DataBinding.FieldName = 'IOType'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#21152#24037#20986#24211
#24179#31227#20986#24211
#36864#36135)
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column15: TcxGridDBColumn
Tag = 2
Caption = #25152#23646#31867#22411
DataBinding.FieldName = 'SSType'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#33258#24049
#23458#25143)
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 111
end
object v1Column1: TcxGridDBColumn
Caption = #37319#36141#21333#21495
DataBinding.FieldName = 'ConNo'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 111
end
object v1Column14: TcxGridDBColumn
Tag = 2
Caption = #26469#33258#21333#20301
DataBinding.FieldName = 'FromCoName'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Alignment.Horz = taLeftJustify
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column13: TcxGridDBColumn
Caption = #38376#24133
DataBinding.FieldName = 'C_Width'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column16: TcxGridDBColumn
Caption = #20811#37325
DataBinding.FieldName = 'C_GramWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column17: TcxGridDBColumn
Caption = #21697#29260
DataBinding.FieldName = 'SXPinPai'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 111
end
object v2Column1: TcxGridDBColumn
Tag = 2
Caption = #21697#21517
DataBinding.FieldName = 'C_Name'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column20: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'SPCode'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 111
end
object v1Column8: TcxGridDBColumn
Tag = 2
Caption = #35268#26684
DataBinding.FieldName = 'C_Spec'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
HeaderGlyphAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column10: TcxGridDBColumn
Caption = #25209#21495
DataBinding.FieldName = 'BatchNo'
DataBinding.IsNullValueType = True
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
VisibleForCustomization = False
Width = 111
end
object Tv1Column6: TcxGridDBColumn
Caption = #33394#21495
DataBinding.FieldName = 'C_ColorNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 111
end
object Tv1Column7: TcxGridDBColumn
Caption = #32568#21495
DataBinding.FieldName = 'FtyPCId'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 111
end
object v1Column18: TcxGridDBColumn
Caption = #20986#21040#35745#21010#21333
DataBinding.FieldName = 'ToOrdNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column1: TcxGridDBColumn
Caption = #35745#21010#21333#21495
DataBinding.FieldName = 'FromOrdNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column18: TcxGridDBColumn
Caption = #20986#21040#21333#20301
DataBinding.FieldName = 'ToCoName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column19: TcxGridDBColumn
Caption = #23384#25918#21333#20301
DataBinding.FieldName = 'StkCoName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column19: TcxGridDBColumn
Caption = #21305#25968
DataBinding.FieldName = 'Piece'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v2Column6: TcxGridDBColumn
Tag = 2
Caption = #25968#37327
DataBinding.FieldName = 'Qty'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column3: TcxGridDBColumn
Tag = 2
Caption = #21333#20301
DataBinding.FieldName = 'QtyUnit'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column8: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'C_Code'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 111
end
object Tv1Column2: TcxGridDBColumn
Caption = #21305#37325
DataBinding.FieldName = 'PieceWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column4: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'C_Color'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column3: TcxGridDBColumn
Caption = #33394#21035
DataBinding.FieldName = 'C_ColorDepth'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column9: TcxGridDBColumn
Caption = #33457#22411
DataBinding.FieldName = 'C_Pattern'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column30: TcxGridDBColumn
Caption = #21512#21516#21495
DataBinding.FieldName = 'fromConNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 91
end
object Tv1Column31: TcxGridDBColumn
Caption = #20986#21040#21512#21516#21495
DataBinding.FieldName = 'ToConNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 110
end
object Tv1Column10: TcxGridDBColumn
Caption = #25104#20998
DataBinding.FieldName = 'C_Composition'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column11: TcxGridDBColumn
Caption = #27454#21495
DataBinding.FieldName = 'C_StyleNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column21: TcxGridDBColumn
Caption = #33521#25991#39068#33394
DataBinding.FieldName = 'C_EColor'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 111
end
object Tv1Column22: TcxGridDBColumn
Caption = #31867#22411
DataBinding.FieldName = 'C_Degree'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column13: TcxGridDBColumn
Caption = #25209#21495
DataBinding.FieldName = 'BatchNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column12: TcxGridDBColumn
Caption = #38468#20214
DataBinding.FieldName = 'FJFlag'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v1Column12: TcxGridDBColumn
Tag = 2
Caption = #22791#27880
DataBinding.FieldName = 'Note'
DataBinding.IsNullValueType = True
Options.Editing = False
Width = 111
end
object Tv1Column14: TcxGridDBColumn
Caption = #30331#35760#20154
DataBinding.FieldName = 'Filler'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column15: TcxGridDBColumn
Caption = #30331#35760#26102#38388
DataBinding.FieldName = 'Filltime'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column20: TcxGridDBColumn
Caption = #33521#25991#21697#21517
DataBinding.FieldName = 'C_EName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 111
end
object Tv1Column16: TcxGridDBColumn
Caption = #20462#25913#20154
DataBinding.FieldName = 'Editer'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column17: TcxGridDBColumn
Caption = #20462#25913#26102#38388
DataBinding.FieldName = 'Edittime'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column23: TcxGridDBColumn
Caption = #22383#24067#20379#24212#21830
DataBinding.FieldName = 'GCFtyName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column32: TcxGridDBColumn
Caption = #35760#24405#21495
DataBinding.FieldName = 'BCIOID'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 137
end
object Tv1Column24: TcxGridDBColumn
Caption = #21152#24037#21035
DataBinding.FieldName = 'CraftCode'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column25: TcxGridDBColumn
Caption = #24067#31181
DataBinding.FieldName = 'GC_Name'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column26: TcxGridDBColumn
Caption = #21518#21152#24037#33521#25991
DataBinding.FieldName = 'CraftEName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column27: TcxGridDBColumn
Caption = #21518#21152#24037#20013#25991
DataBinding.FieldName = 'CraftName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object Tv1Column33: TcxGridDBColumn
Caption = #27611#37325
DataBinding.FieldName = 'GrossWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 77
end
object Tv1Column34: TcxGridDBColumn
Caption = #20928#37325
DataBinding.FieldName = 'NetWeight'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 82
end
object Tv1Column35: TcxGridDBColumn
Caption = #21367#21495
DataBinding.FieldName = 'PieceNo'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 68
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 260
Top = 246
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Left = 92
Top = 230
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Parameters = <>
Left = 527
Top = 233
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 821
Top = 329
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 523
Top = 314
end
object DataSource1: TDataSource
DataSet = CDS_Main
Left = 792
Top = 234
end
object GPM_1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 425
Top = 254
end
object CDS_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 626
Top = 237
end
object PopupMenu1: TPopupMenu
Left = 524
Top = 412
object N1: TMenuItem
Caption = #20840#36873
OnClick = N1Click
end
object N2: TMenuItem
Caption = #20840#24323
OnClick = N2Click
end
object N3: TMenuItem
Caption = #22797#21046
OnClick = N3Click
end
end
object ADOQueryPrint: TADOQuery
Connection = DataLink_TradeInsp.ADOLink
Parameters = <>
Left = 655
Top = 444
end
end

369
T03贸易布匹检验/U_TradeClothTotalOutSel.pas Normal file
View File

@ -0,0 +1,369 @@
unit U_TradeClothTotalOutSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Vcl.Printers, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxGridCustomTableView, cxGridTableView,
cxGridBandedTableView, cxGridDBBandedTableView, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridDBTableView, cxGrid, StdCtrls, ComCtrls,
ExtCtrls, ToolWin, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB, DBClient,
cxDropDownEdit, cxCheckBox, RM_Common, RM_Class, RM_e_Xls, RM_Dataset,
RM_System, RM_GridReport, Menus, cxCalendar, cxButtonEdit, cxTextEdit, cxPC,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxDateRanges,
dxBarBuiltInMenu, U_Basehelp, Clipbrd, dxScrollbarAnnotations, FrameDateSel,
cxContainer, cxMaskEdit, cxProgressBar, cxButtons, U_BaseList,
System.ImageList, Vcl.ImgList;
type
TfrmTradeClothTotalOutSel = class(TfrmBasehelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBClose: TToolButton;
Panel1: TPanel;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
GPM_1: TcxGridPopupMenu;
CDS_Main: TClientDataSet;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column6: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
v1Column14: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
v2Column6: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Label3: TLabel;
Label5: TLabel;
Label8: TLabel;
Label12: TLabel;
C_NAME: TcxTextEdit;
BCIONO: TcxTextEdit;
C_spec: TcxTextEdit;
v1Column20: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column17: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
v1Column16: TcxGridDBColumn;
v1Column18: TcxGridDBColumn;
v1Column19: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
ToolButton1: TToolButton;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
Tv1Column10: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
N3: TMenuItem;
Tv1Column12: TcxGridDBColumn;
Tv1Column13: TcxGridDBColumn;
Tv1Column14: TcxGridDBColumn;
Tv1Column15: TcxGridDBColumn;
Tv1Column16: TcxGridDBColumn;
Tv1Column17: TcxGridDBColumn;
Label4: TLabel;
Label9: TLabel;
Label6: TLabel;
Label7: TLabel;
FromCoName: TcxTextEdit;
ToCoName: TcxTextEdit;
ToOrdNo: TcxTextEdit;
FromOrdNo: TcxTextEdit;
Tv1Column18: TcxGridDBColumn;
Tv1Column19: TcxGridDBColumn;
Tv1Column20: TcxGridDBColumn;
Tv1Column21: TcxGridDBColumn;
frmFrameDateSel1: TfrmFrameDateSel;
IOType: TcxComboBox;
Tv1Column22: TcxGridDBColumn;
Tv1Column24: TcxGridDBColumn;
Tv1Column25: TcxGridDBColumn;
Tv1Column26: TcxGridDBColumn;
Tv1Column27: TcxGridDBColumn;
Tv1Column23: TcxGridDBColumn;
Tv1Column30: TcxGridDBColumn;
Tv1Column31: TcxGridDBColumn;
Tv1Column32: TcxGridDBColumn;
Tv1Column33: TcxGridDBColumn;
Tv1Column34: TcxGridDBColumn;
ADOQueryPrint: TADOQuery;
Tv1Column35: TcxGridDBColumn;
btnOK: TToolButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ConNoMChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure SPNameChange(Sender: TObject);
procedure BCIOIDChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure C_specChange(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure BCIOIDPropertiesChange(Sender: TObject);
procedure btnOKClick(Sender: TObject);
private
canshu1, canshu2: string;
procedure InitGrid();
{ Private declarations }
public
FFSPID, FstkName, FC_Degree, FC_Pack: string;
{ Public declarations }
end;
var
frmTradeClothTotalOutSel: TfrmTradeClothTotalOutSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmTradeClothTotalOutSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmTradeClothTotalOutSel.FormCreate(Sender: TObject);
begin
inherited;
canshu1 := Trim(DParameters1);
canshu2 := Trim(DParameters2);
frmFrameDateSel1.EndDate.Date := SGetServerDate(ADOQueryTemp);
frmFrameDateSel1.BegDate.Date := frmFrameDateSel1.EndDate.Date;
end;
procedure TfrmTradeClothTotalOutSel.InitGrid();
var
SqlStr: string;
begin
SqlStr := ' select A.* ';
SqlStr := SqlStr + ',FJFlag=CAST((CASE WHEN (SELECT COUNT(X.FileName) FROM FJ_File X where X.TFType=''贸易汇总布'' and X.WBID=A.BCIOID)>0 THEN 1 ELSE 0 END) AS BIT) ';
SqlStr := SqlStr + ' from BS_Cloth_IO A ';
SqlStr := SqlStr + ' where A.IOFlag=''出库'' ';
SqlStr := SqlStr + ' and A.IOTime>=''' + Trim(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.BegDate.Date)) + '''';
SqlStr := SqlStr + ' and A.IOTime<''' + Trim(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.enddate.Date + 1)) + '''';
SqlStr := SqlStr + ' and isnull(stkName,'''')=''贸易布匹''';
SqlStr := SqlStr + ' and IOType = ''检验出库'' ';
SqlStr := SqlStr + ' order by IOTime desc';
InitCDSData(ADOQueryMain, CDS_Main, Tv1, SqlStr, SGetFilters(Panel1, 1, 2), 'BCIOID');
end;
procedure TfrmTradeClothTotalOutSel.TBRafreshClick(Sender: TObject);
begin
frmFrameDateSel1.BegDate.SetFocus;
InitGrid();
end;
procedure TfrmTradeClothTotalOutSel.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(trim(Self.Caption), Tv1, '贸易汇总仓库');
end;
procedure TfrmTradeClothTotalOutSel.BCIOIDPropertiesChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmTradeClothTotalOutSel.btnOKClick(Sender: TObject);
begin
if CDS_Main.IsEmpty then
exit;
ModalResult := 1;
end;
procedure TfrmTradeClothTotalOutSel.ConNoMChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
end;
end;
procedure TfrmTradeClothTotalOutSel.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmTradeClothTotalOutSel.FormShow(Sender: TObject);
var
mSql: string;
begin
inherited;
mSql := 'select distinct name=A.IOType from BS_Cloth_IO A where IOFlag=''出库'' and isnull(STKNAME,'''')=''' + Trim(FSTKNAME) + ''' ';
SInitTcxComBoxBySql(ADOQueryTemp, IOType, false, mSql);
ReadCxGrid(trim(Self.Caption), Tv1, '贸易汇总仓库');
InitGrid();
end;
procedure TfrmTradeClothTotalOutSel.TBExportClick(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then
exit;
TcxGridToExcel(FstkName + '出库列表', cxGrid1);
end;
procedure TfrmTradeClothTotalOutSel.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_Main);
SInitCDSData(ADOQueryMain, CDS_Main);
end;
end;
procedure TfrmTradeClothTotalOutSel.SPNameChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmTradeClothTotalOutSel.BCIOIDChange(Sender: TObject);
begin
if Length(Trim(BCIOno.Text)) < 4 then
begin
if Trim(BCIOno.Text) <> '' then
Exit;
end;
TBFind.Click;
end;
procedure TfrmTradeClothTotalOutSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_Main, True);
end;
procedure TfrmTradeClothTotalOutSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_Main, False);
end;
procedure TfrmTradeClothTotalOutSel.N3Click(Sender: TObject);
begin
Clipboard.SetTextBuf(PChar(Trim(CDS_Main.fieldbyname(TV1.Controller.FocusedColumn.DataBinding.FilterFieldName).AsString)));
end;
procedure TfrmTradeClothTotalOutSel.TBDelClick(Sender: TObject);
var
MBCIOID, MBCIONO: string;
begin
if CDS_Main.IsEmpty then
Exit;
if CDS_Main.Locate('SSel', True, []) = False then
begin
Application.MessageBox('没有选择数据!', '提示', 0);
Exit;
end;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
MBCIOID := SelCDSKey(CDS_Main, ['BCIOID'])[0];
MBCIONO := SelCDSKey(CDS_Main, ['BCIONO'])[0];
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('exec P_Fin_Flow_Judge ');
Sql.Add(' @FFIDS=' + quotedstr(MBCIONO));
Sql.Add(',@DCode=' + quotedstr(Trim(DCode)));
Sql.Add(',@DName=' + quotedstr(Trim(DName)));
Open;
end;
if ADOQueryTemp.FieldByName('intReturn').AsInteger = -1 then
begin
Application.MessageBox(PChar(ADOQueryTemp.fieldbyname('ShowMsg').AsString), '提示', 0);
exit;
end;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
Close;
Sql.Clear;
Sql.Add('exec P_Trade_BSCloth_Judge ');
Sql.Add(' @BCIOIDS=' + quotedstr(MBCIOID));
Sql.Add(',@DCode=' + quotedstr(Trim(DCode)));
Sql.Add(',@DName=' + quotedstr(Trim(DName)));
Open;
end;
if ADOQueryCmd.FieldByName('intReturn').AsInteger = -1 then
raise Exception.Create(pchar(trim(ADOQueryCmd.FieldByName('ShowMsg').AsString)));
with ADOQueryCmd do
begin
Close;
Sql.Clear;
sql.Add('insert into Finance_Need_Up(UType,UDataId,UOperation,UOperator,UModule,UDetails) ');
sql.Add('values(''贸易布坯出库'' ');
sql.Add(',' + quotedstr(MBCIONO));
sql.Add(',''删除'' ');
sql.Add(',' + quotedstr(DName));
sql.Add(',' + quotedstr(trim(self.Caption)));
sql.Add(',' + quotedstr(MBCIOID));
sql.Add(') ');
Sql.Add('exec P_BS_Cloth_Out_Del ');
Sql.Add(' @BCIOIDS=' + quotedstr(MBCIOID));
Sql.Add(',@DCode=' + quotedstr(Trim(DCode)));
Sql.Add(',@DName=' + quotedstr(Trim(DName)));
Open;
end;
if ADOQueryCmd.FieldByName('intReturn').AsInteger = -1 then
raise Exception.Create(pchar(trim(ADOQueryCmd.FieldByName('ShowMsg').AsString)));
ADOQueryCmd.Connection.CommitTrans;
InitGrid();
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
InitGrid();
end;
end;
procedure TfrmTradeClothTotalOutSel.C_specChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmTradeClothTotalOutSel.cxTabControl1Change(Sender: TObject);
begin
InitGrid();
end;
end.

Some files were not shown because too many files have changed in this diff Show More