This commit is contained in:
DESKTOP-E401PHE\Administrator 2025-09-30 15:00:54 +08:00
commit 48a82ff3f9
1568 changed files with 1008983 additions and 0 deletions

12
.gitignore vendored Normal file
View File

@ -0,0 +1,12 @@
**/layout
**/report
**/实施文件
**/image
**/doc
**/wav
*.dll
*.ddp
*.dcu
*.~pas
*.~dfm
*.~ddp

View File

@ -0,0 +1,42 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-U"D:\말繫ERP"
-O"D:\말繫ERP"
-I"D:\말繫ERP"
-R"D:\말繫ERP"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,138 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=D:\富通ERP
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOffice2k;Rave50CLX;Rave50VCL
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\朱哲飞开发代码\项目代码\武嘉\合同管理(ContractManagement.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
c:\program files\borland\delphi7\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package

View File

@ -0,0 +1,48 @@
library ContractManagement;
//ÒѸÄ
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
U_GetDllForm in 'U_GetDllForm.pas',
U_RTFun in '..\..\..\RTFunAndForm\Fun\U_RTFun.pas',
U_ModuleNote in 'U_ModuleNote.pas' {frmModuleNote},
U_DataLink in 'U_DataLink.pas' {DataLink_ContractManagement: TDataModule},
U_ZDYHelpSel in 'U_ZDYHelpSel.pas' {frmZDYHelpSel},
U_iniParam in 'U_iniParam.pas',
U_ZDYHelp in 'U_ZDYHelp.pas' {frmZDYHelp},
U_Fun in '..\..\..\ThreeFun\Fun\U_Fun.pas',
U_SelExportField in '..\..\..\ThreeFun\Fun\U_SelExportField.pas' {frmSelExportField},
U_ColumnSet in '..\..\..\ThreeFun\Form\U_ColumnSet.pas' {frmColumnSet},
U_ColumnBandSet in '..\..\..\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet},
U_SelPrintFieldNew in '..\..\..\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew},
U_RTZDYHelp in '..\..\..\RTFunAndForm\Form\U_RTZDYHelp.pas' {frmRTZDYHelp},
U_CompressionFun in '..\..\..\ThreeFun\Fun\U_CompressionFun.pas',
U_ContractListPB in 'U_ContractListPB.pas' {frmContractListPB};
{$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.

View File

@ -0,0 +1,48 @@
library ContractManagement;
//ÒѸÄ
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
U_GetDllForm in 'U_GetDllForm.pas',
U_RTFun in '..\..\..\RTFunAndForm\Fun\U_RTFun.pas',
U_ModuleNote in 'U_ModuleNote.pas' {frmModuleNote},
U_DataLink in 'U_DataLink.pas' {DataLink_ContractManagement: TDataModule},
U_ZDYHelpSel in 'U_ZDYHelpSel.pas' {frmZDYHelpSel},
U_iniParam in 'U_iniParam.pas',
U_ZDYHelp in 'U_ZDYHelp.pas' {frmZDYHelp},
U_Fun in '..\..\..\ThreeFun\Fun\U_Fun.pas',
U_SelExportField in '..\..\..\ThreeFun\Fun\U_SelExportField.pas' {frmSelExportField},
U_ColumnSet in '..\..\..\ThreeFun\Form\U_ColumnSet.pas' {frmColumnSet},
U_ColumnBandSet in '..\..\..\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet},
U_SelPrintFieldNew in '..\..\..\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew},
U_RTZDYHelp in '..\..\..\RTFunAndForm\Form\U_RTZDYHelp.pas' {frmRTZDYHelp},
U_CompressionFun in '..\..\..\ThreeFun\Fun\U_CompressionFun.pas',
U_ContractListPB in 'U_ContractListPB.pas' {frmContractListPB};
{$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.

View File

@ -0,0 +1,4 @@
[生产车间配置]
卷条码机台标志=99
成品DLL文件=CYZZ.dll
成品DLL调用号=11

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

View File

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

View File

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

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)

View File

@ -0,0 +1,3 @@
[SERVER]
服务器地址=172.168.1.246
软件名称=欣戈纺织

Binary file not shown.

View File

@ -0,0 +1,549 @@
object frmCPManageFMSel: TfrmCPManageFMSel
Left = 128
Top = 81
Width = 1382
Height = 754
Align = alClient
Caption = #26679#21697#20449#24687
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1366
Height = 31
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_ContractManagement.ThreeImgList
Flat = True
Images = DataLink_ContractManagement.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = ToolButton2Click
end
object ToolButton4: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #36873#25321
ImageIndex = 31
OnClick = ToolButton4Click
end
object TBClose: TToolButton
Left = 189
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object cxSplitter1: TcxSplitter
Left = 220
Top = 93
Width = 8
Height = 623
HotZoneClassName = 'TcxMediaPlayer9Style'
Control = Panel5
end
object Panel1: TPanel
Left = 0
Top = 31
Width = 1366
Height = 62
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label2: TLabel
Left = 16
Top = 15
Width = 48
Height = 12
Caption = #25195#25551#20837#21475
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label1: TLabel
Left = 364
Top = 15
Width = 48
Height = 12
Caption = #20013#25991#21517#31216
end
object Label3: TLabel
Left = 216
Top = 15
Width = 48
Height = 12
Caption = #20135#21697#32534#21495
end
object Label7: TLabel
Left = 732
Top = 15
Width = 24
Height = 12
Caption = #20811#37325
end
object Label8: TLabel
Left = 611
Top = 15
Width = 48
Height = 12
Caption = #25104' '#20998
end
object Label10: TLabel
Left = 485
Top = 15
Width = 24
Height = 12
Caption = #38376#24133
end
object Label11: TLabel
Left = 1088
Top = 11
Width = 7
Height = 12
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
end
object Label12: TLabel
Left = 1088
Top = 31
Width = 7
Height = 12
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
end
object Label4: TLabel
Left = 840
Top = 15
Width = 48
Height = 12
Caption = #23545#26041#21333#20301
end
object CYID: TEdit
Tag = 3
Left = 72
Top = 11
Width = 121
Height = 20
TabOrder = 0
OnKeyPress = CYIDKeyPress
end
object CYName: TEdit
Tag = 2
Left = 414
Top = 11
Width = 56
Height = 20
TabOrder = 2
OnChange = CYNameChange
end
object CYNO: TEdit
Tag = 2
Left = 265
Top = 11
Width = 89
Height = 20
TabOrder = 1
OnChange = CYNoChange
OnKeyPress = CYNOKeyPress
end
object CYKZ: TEdit
Tag = 2
Left = 758
Top = 11
Width = 76
Height = 20
TabOrder = 5
OnChange = CYMFChange
end
object CYCF: TEdit
Tag = 2
Left = 661
Top = 11
Width = 56
Height = 20
TabOrder = 4
OnChange = CYNameChange
end
object CYMF: TEdit
Tag = 2
Left = 511
Top = 11
Width = 76
Height = 20
TabOrder = 3
OnChange = CYMFChange
end
object ForCustomer: TEdit
Tag = 2
Left = 891
Top = 11
Width = 114
Height = 20
TabOrder = 6
OnChange = CYMFChange
end
end
object Panel2: TPanel
Left = 512
Top = 232
Width = 185
Height = 41
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = #27491#22312#26597#35810#25968#25454#65292#35831#31245#21518#12290#12290#12290
Color = clSkyBlue
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
Visible = False
end
object Panel5: TPanel
Left = 0
Top = 93
Width = 220
Height = 623
Align = alLeft
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 2
object cxDBTreeList1: TcxDBTreeList
Left = 2
Top = 2
Width = 216
Height = 619
Align = alClient
Bands = <
item
end>
BufferedPaint = False
DataController.DataSource = DataSource1
DataController.ParentField = 'CPParent'
DataController.KeyField = 'CPID'
OptionsBehavior.ExpandOnDblClick = False
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_ContractManagement.Red
Styles.Selection = DataLink_ContractManagement.Red
Styles.IncSearch = DataLink_ContractManagement.Red
TabOrder = 0
OnDblClick = cxDBTreeList1DblClick
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'CPName'
Width = 210
Position.ColIndex = 1
Position.RowIndex = 0
Position.BandIndex = 0
end
end
end
object Panel3: TPanel
Left = 230
Top = 104
Width = 1073
Height = 609
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = 'Panel3'
TabOrder = 4
object GroupBox1: TGroupBox
Left = 2
Top = 412
Width = 1069
Height = 195
Align = alBottom
Caption = #26679#21697#32553#30053#22270#65288#21452#20987#22270#29255#26597#30475#21407#22270#65289
TabOrder = 1
object ScrollBox1: TScrollBox
Left = 2
Top = 14
Width = 1065
Height = 179
Align = alClient
BevelInner = bvLowered
BorderStyle = bsNone
TabOrder = 0
end
end
object cxGrid1: TcxGrid
Left = 2
Top = 2
Width = 1069
Height = 410
Align = alClient
TabOrder = 0
object Tv1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
OnCellClick = Tv1CellClick
DataController.DataSource = DataSource2
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
object v1Column19: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
Properties.NullStyle = nssUnchecked
HeaderAlignmentHorz = taCenter
Width = 40
end
object v1Column12: TcxGridDBColumn
Caption = #31867#22411
DataBinding.FieldName = 'CPName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 54
end
object v1CYNo: TcxGridDBColumn
Caption = #20135#21697#32534#21495
DataBinding.FieldName = 'CYNo'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 92
end
object v1Column9: TcxGridDBColumn
Caption = #20135#21697#21517#31216
DataBinding.FieldName = 'CYName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 96
end
object v1Column2: TcxGridDBColumn
Caption = #21407#26009#25104#20998
DataBinding.FieldName = 'CYSpec'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 68
end
object v1Column4: TcxGridDBColumn
Caption = #25104#20998
DataBinding.FieldName = 'CYCF'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 89
end
object v1Column3: TcxGridDBColumn
Caption = #38376#24133
DataBinding.FieldName = 'CYMF'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object v1Column1: TcxGridDBColumn
Caption = #20811#37325
DataBinding.FieldName = 'CYKZ'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 81
end
object v1Column5: TcxGridDBColumn
Caption = #33457#22411
DataBinding.FieldName = 'CYHX'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object v1Column6: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'CYColor'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 77
end
object v1Column39: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'CYNote'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 91
end
object v1Column7: TcxGridDBColumn
Caption = #23545#26041#21333#20301
DataBinding.FieldName = 'ForCustomer'
HeaderAlignmentHorz = taCenter
Width = 149
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
end
object DataSource1: TDataSource
DataSet = ADOQueryTree
Left = 91
Top = 147
end
object ADOQueryTree20: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 61
Top = 145
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 989
Top = 1
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
Parameters = <>
Left = 1029
Top = 1
end
object cxGridPopupMenu1: TcxGridPopupMenu
PopupMenus = <>
Left = 432
Top = 184
end
object DataSource2: TDataSource
DataSet = CDS_Main
Left = 451
Top = 155
end
object ADOQueryMain: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 493
Top = 193
end
object CDS_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 392
Top = 184
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 392
Top = 152
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
DataSet = CDS_Main
Left = 424
Top = 152
end
object ODPat: TOpenDialog
Options = [ofReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Left = 484
Top = 157
end
object IdFTP1: TIdFTP
MaxLineAction = maException
ReadTimeout = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
Left = 461
Top = 188
end
object SaveDialog1: TSaveDialog
Left = 513
Top = 157
end
object DSCYNO: TDataSource
DataSet = CDS_CYNO
Left = 771
Top = 235
end
object CDS_CYNO: TClientDataSet
Aggregates = <>
Params = <>
Left = 712
Top = 264
end
object ADOQueryTree: TClientDataSet
Aggregates = <>
Params = <>
Left = 32
Top = 200
end
object adoqueryPicture: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
Parameters = <>
Left = 479
Top = 256
end
end

View File

@ -0,0 +1,474 @@
unit U_CPManageFMSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP,ShellAPI,IniFiles, cxCheckBox,jpeg,U_SLT;
type
TfrmCPManageFMSel = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
DataSource1: TDataSource;
ADOQueryTree20: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
cxGridPopupMenu1: TcxGridPopupMenu;
cxSplitter1: TcxSplitter;
Panel1: TPanel;
Label2: TLabel;
CYID: TEdit;
ToolButton2: TToolButton;
Label1: TLabel;
CYName: TEdit;
DataSource2: TDataSource;
ADOQueryMain: TADOQuery;
CDS_Main: TClientDataSet;
ToolButton4: TToolButton;
RM1: TRMGridReport;
RMDB_Main: TRMDBDataSet;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
SaveDialog1: TSaveDialog;
Label3: TLabel;
CYNO: TEdit;
Panel2: TPanel;
DSCYNO: TDataSource;
CDS_CYNO: TClientDataSet;
Label7: TLabel;
CYKZ: TEdit;
Label8: TLabel;
CYCF: TEdit;
Label10: TLabel;
CYMF: TEdit;
ADOQueryTree: TClientDataSet;
Panel5: TPanel;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
Label11: TLabel;
Label12: TLabel;
Panel3: TPanel;
GroupBox1: TGroupBox;
ScrollBox1: TScrollBox;
adoqueryPicture: TADOQuery;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column19: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column39: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
v1Column7: TcxGridDBColumn;
Label4: TLabel;
ForCustomer: TEdit;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure CYIDKeyPress(Sender: TObject; var Key: Char);
procedure CYNoChange(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure v1Column19PropertiesChange(Sender: TObject);
procedure CYMFChange(Sender: TObject);
procedure CYNameChange(Sender: TObject);
procedure CYNOKeyPress(Sender: TObject; var Key: Char);
procedure Tv1DblClick(Sender: TObject);
private
{ Private declarations }
CPID:string;
PState:Integer;
FCPID,FTopID:String;
procedure InitTree();
procedure InitGrid();
procedure ReadINIFile();
procedure InitImage();
public
{ Public declarations }
end;
var
frmCPManageFMSel: TfrmCPManageFMSel;
Mach: array of TfrmSlt;
implementation
uses
U_DataLink,U_Fun,U_FileUp;
{$R *.dfm}
procedure TfrmCPManageFMSel.InitTree();
var
i:Integer;
begin
with ADOQueryTree20 do
begin
Close;
SQL.Clear;
SQL.Add('select * from CP_Type order by CPlevel,CPOrder,CPName');
Open;
end;
SCreateCDS20(ADOQueryTree20,ADOQueryTree);
SInitCDSData20(ADOQueryTree20,ADOQueryTree);
cxDBTreeList1.Items[0].Expand(false);
//cxDBTreeList1.Items[1].Expand(False);
end;
procedure TfrmCPManageFMSel.InitGrid();
begin
Panel2.Visible:=True;
Panel2.Refresh;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
SQL.Clear;
SQL.Add('exec P_Select_CP_YDang :Code,:PState,:CYType');
Parameters.ParamByName('Code').Value:='';
Parameters.ParamByName('PState').Value:=0;
Parameters.ParamByName('CYType').Value:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
finally
ADOQueryMain.EnableControls;
end;
Panel2.Visible:=False;
end;
procedure TfrmCPManageFMSel.FormDestroy(Sender: TObject);
begin
frmCPManageFMSel:=nil;
end;
procedure TfrmCPManageFMSel.FormClose(Sender: TObject; var Action: TCloseAction);
var
i,j:integer;
begin
j:=length(Mach);
if j>0 then
begin
for i:=0 to j-1 do
begin
Mach[i].free;
end;
end;
SetLength(Mach, 0);
// writeCxGrid(self.Caption+tv1.Name,tv1);
// Application := mainApplication;
action:=cafree;
end;
procedure TfrmCPManageFMSel.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('样品列表SelLJ',Tv1,'样品管理');
if DirectoryExists(ExtractFileDir('D:\Right1209')) then
winexec('cmd /c rd /s /q D:\Right1209',sw_hide);
Close;
end;
procedure TfrmCPManageFMSel.FormShow(Sender: TObject);
begin
Panel3.Align:=alclient;
InitTree();
ReadCxGrid('样品列表SelLJ',Tv1,'样品管理');
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select CYID='''' ');
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_CYNO);
SInitCDSData20(ADOQueryTemp,CDS_CYNO);
with ADOQueryMain do
begin
Filtered:=False;
Close;
SQL.Clear;
SQL.Add('exec P_Select_CP_YDang :Code,:PState,:CYType');
Parameters.ParamByName('Code').Value:='';
Parameters.ParamByName('PState').Value:=0;
Parameters.ParamByName('CYType').Value:='XXXXXXX';
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
CDS_CYNO.Delete;
end;
procedure TfrmCPManageFMSel.cxDBTreeList1DblClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmCPManageFMSel.TBRafreshClick(Sender: TObject);
begin
InitTree();
InitGrid();
//TJGS();
end;
procedure TfrmCPManageFMSel.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
// TJGS();
end;
end;
procedure TfrmCPManageFMSel.CYIDKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
begin
if Trim(CYID.Text)='' then Exit;
with ADOQueryMain do
begin
Close;
Filtered:=False;
sql.Clear;
sql.Add('exec P_Select_CP_YDang :Code,1,'''' ');
Parameters.ParamByName('Code').Value:=Trim(CYID.Text);
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
CYID.Text:='';
ADOQueryTree.Locate('CPID',CPID,[]);
end;
end;
procedure TfrmCPManageFMSel.CYNoChange(Sender: TObject);
begin
//if Length(Trim(TEdit(Sender).Text))<4 then Exit;
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
//TJGS();
end;
end;
procedure TfrmCPManageFMSel.ToolButton4Click(Sender: TObject);
begin
if CDS_Main.IsEmpty then Exit;
ModalResult:=1;
end;
procedure TfrmCPManageFMSel.ReadINIFile();
var
programIni:Tinifile; //配置文件名
FileName:string;
begin
FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI';
programIni:=Tinifile.create(FileName);
server:=programIni.ReadString('SERVER','服务器地址','127.0.0.1');
programIni.Free;
end;
procedure TfrmCPManageFMSel.Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if CDS_Main.IsEmpty then Exit;
{ with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from CP_YDang where CYID='''+Trim(CDS_Main.fieldbyname('CYID').asstring)+'''');
Open;
end;
CPID:=Trim(ADOQueryTemp.fieldbyname('CYType').AsString);
ADOQueryTree.Locate('CPID',CPID,[]); }
InitImage();
end;
procedure TfrmCPManageFMSel.InitImage();
var
i,j:integer;
jpg:TJpegImage;
myStream: TADOBlobStream;
begin
j:=length(Mach);
if j>0 then
begin
for i:=0 to j-1 do
begin
Mach[i].free;
end;
end;
SetLength(Mach, 0);
IF CDS_Main.IsEmpty then exit;
try
with adoqueryPicture do
begin
close;
sql.Clear;
sql.Add(' select A.TFID,A.WBID,A.FilesOther,B.FileName from TP_File A,XD_File B where A.TFID =B.XFID and A.WBID='+quotedstr(trim(CDS_Main.fieldbyname('CYID').AsString)));
open;
end;
j:=adoqueryPicture.RecordCount;
if j<1 then exit;
adoqueryPicture.DisableControls;
adoqueryPicture.First;
SetLength(Mach, j);
jpg:=TJpegImage.Create();
for i:=0 to j-1 do
begin
if triM(adoqueryPicture.fieldbyname('FilesOther').AsString)<>'' then
begin
myStream:=tadoblobstream.Create(tblobfield(adoqueryPicture.fieldbyname('FilesOther')),bmread);
jpg.LoadFromStream(myStream);
Mach[i] := TfrmSlt.Create(Self);
Mach[i].Name:=trim(adoqueryPicture.fieldbyname('TFID').AsString);
Mach[i].Parent := ScrollBox1;
Mach[I].Left:=0+i*165;
Mach[i].Init(adoqueryPicture.fieldbyname('TFID').AsString,adoqueryPicture.fieldbyname('FileName').AsString,jpg);
end;
adoqueryPicture.Next;
end;
adoqueryPicture.EnableControls;
finally
jpg.free;
application.ProcessMessages;
end;
end;
procedure TfrmCPManageFMSel.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
{if Key= then
begin
if CDS_Main.IsEmpty then Exit;
if Application.MessageBox('确定6666要删除数据吗','提示',32+4)<>IDYES then Exit;
if Trim(CDS_Main.fieldbyname('CYID').AsString)<>'' then
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('delete CP_YDang where CYID='''+Trim(CDS_Main.fieldbyname('CYID').AsString)+'''');
ExecSQL;
end;
end;
CDS_Main.Delete;
end; }
end;
procedure TfrmCPManageFMSel.v1Column19PropertiesChange(Sender: TObject);
var
mvalue:Boolean;
begin
{ mvalue:=TcxCheckBox(Sender).EditingValue;
if mvalue=True then
begin
with CDS_CYNO do
begin
if Locate('CYID',Trim(CDS_Main.fieldbyname('CYID').AsString),[])=False then
begin
Append;
FieldByName('CYID').Value:=Trim(CDS_Main.fieldbyname('CYID').AsString);
Post;
end;
end;
end else
begin
//with CDS_CYNO do
//begin
CDS_CYNO.Locate('CYID',Trim(CDS_Main.fieldbyname('CYID').AsString),[]);
CDS_CYNO.Delete;
//end;
end; }
end;
procedure TfrmCPManageFMSel.CYMFChange(Sender: TObject);
begin
//if Length(Trim(TEdit(Sender).Text))<2 then Exit;
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
//TJGS();
end;
end;
procedure TfrmCPManageFMSel.CYNameChange(Sender: TObject);
begin
//if Length(Trim(TEdit(Sender).Text))<2 then Exit;
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
// TJGS();
end;
end;
procedure TfrmCPManageFMSel.CYNOKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
begin
if Trim(CYNO.Text)='' then Exit;
if Length(Trim(CYNO.Text))<4 then Exit;
with ADOQueryMain do
begin
Close;
Filtered:=False;
sql.Clear;
sql.Add('exec P_Select_CP_YDang :Code,2,'''' ');
Parameters.ParamByName('Code').Value:='%'+Trim(CYNO.Text)+'%';
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
CYID.Text:='';
ADOQueryTree.Locate('CPID',CPID,[]);
// TJGS();
end;
end;
procedure TfrmCPManageFMSel.Tv1DblClick(Sender: TObject);
begin
if CDS_Main.IsEmpty then Exit;
ModalResult:=1;
end;
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,903 @@
object frmConInPutNXKFSH: TfrmConInPutNXKFSH
Left = 348
Top = 70
Width = 1040
Height = 714
Caption = #20869#38144#21512#21516#24320#21457#23457#26680
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1024
Height = 29
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clBtnFace
EdgeInner = esNone
EdgeOuter = esNone
Flat = True
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_ContractManagement.ThreeImgList
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
object TBSave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 5
OnClick = TBSaveClick
end
object TBClose: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object ScrollBox1: TScrollBox
Left = 0
Top = 29
Width = 1024
Height = 300
Align = alTop
BevelInner = bvNone
BevelOuter = bvNone
Color = clBtnFace
Ctl3D = False
ParentColor = False
ParentCtl3D = False
TabOrder = 1
object Label3: TLabel
Left = 247
Top = 39
Width = 65
Height = 12
Caption = #21046#21333#26085#26399#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 675
Top = 39
Width = 65
Height = 12
Caption = #20132#36135#26085#26399#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label7: TLabel
Left = 463
Top = 39
Width = 65
Height = 12
Caption = #31614#35746#22320#28857#65306
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label9: TLabel
Left = 463
Top = 12
Width = 66
Height = 12
Caption = #19994' '#21153' '#21592#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label10: TLabel
Left = 34
Top = 12
Width = 66
Height = 12
Caption = #21512' '#21516' '#21495#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label11: TLabel
Left = 463
Top = 67
Width = 65
Height = 12
Caption = #20132#26399#35828#26126#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label14: TLabel
Left = 247
Top = 12
Width = 67
Height = 12
Caption = #38656' '#26041#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label20: TLabel
Left = 675
Top = 12
Width = 67
Height = 12
Caption = #20379' '#26041#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 247
Top = 67
Width = 66
Height = 12
Caption = #28322' '#30701' '#35013#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label34: TLabel
Left = 34
Top = 93
Width = 65
Height = 12
Caption = #23458#25143#21333#21495#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 34
Top = 65
Width = 67
Height = 12
Caption = #31867' '#22411#65306
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label16: TLabel
Left = 59
Top = 126
Width = 39
Height = 12
Caption = #21333#20301#65306
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label25: TLabel
Left = 34
Top = 39
Width = 65
Height = 12
Caption = #28145#27973#27604#20363#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label29: TLabel
Left = 242
Top = 94
Width = 65
Height = 12
Caption = #26159#21542#21547#31246#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label33: TLabel
Left = 463
Top = 92
Width = 65
Height = 12
Caption = #36136#37327#26631#20934#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label35: TLabel
Left = 146
Top = 126
Width = 60
Height = 12
Caption = #36164' '#28304#65306
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object OrdDate: TDateTimePicker
Tag = 2
Left = 310
Top = 35
Width = 140
Height = 20
BevelInner = bvNone
Date = 40916.670856296290000000
Format = 'yyyy-MM-dd'
Time = 40916.670856296290000000
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 5
end
object DlyDate: TDateTimePicker
Tag = 2
Left = 737
Top = 35
Width = 138
Height = 20
BevelInner = bvNone
Date = 40916.670856296290000000
Format = 'yyyy-MM-dd'
Time = 40916.670856296290000000
ShowCheckbox = True
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 7
end
object ConNo: TEdit
Tag = 9
Left = 97
Top = 9
Width = 136
Height = 18
Enabled = False
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ReadOnly = True
TabOrder = 3
Text = #33258#21160#29983#25104
end
object FromPlace: TBtnEditC
Tag = 2
Left = 526
Top = 35
Width = 136
Height = 20
Hint = 'QianDPlace/'#31614#35746#22320#28857
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ReadOnly = True
TabOrder = 6
OnDblClick = SYRNameBtnUpClick
OnBtnUpClick = SYRNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object CustomerNoName: TBtnEditC
Tag = 2
Left = 310
Top = 8
Width = 140
Height = 20
Hint = 'CustomerNo'
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ReadOnly = True
TabOrder = 0
OnBtnUpClick = CustomerNoNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object SYRName: TBtnEditC
Tag = 2
Left = 737
Top = 8
Width = 136
Height = 20
Hint = 'SYRName/'#20379#26041
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ReadOnly = True
TabOrder = 2
Text = #32461#20852#23665#28023#32442#32455#26377#38480#20844#21496
OnBtnUpClick = SYRNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object QtyNote: TBtnEditC
Tag = 2
Left = 310
Top = 63
Width = 139
Height = 20
Hint = 'QtyNoteZW/'#28322#30701#35013
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 9
OnDblClick = SYRNameBtnUpClick
OnBtnUpClick = SYRNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object DlyNote: TBtnEditC
Tag = 2
Left = 526
Top = 63
Width = 348
Height = 20
Hint = 'DlyNoteZW/'#20132#26399#35828#26126
ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
TabOrder = 10
OnDblClick = SYRNameBtnUpClick
OnBtnUpClick = SYRNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object KHConNo: TEdit
Tag = 2
Left = 95
Top = 90
Width = 136
Height = 18
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 12
end
object Button1: TButton
Left = 36
Top = 185
Width = 41
Height = 25
Caption = #22686#34892
TabOrder = 17
OnClick = Button1Click
end
object Button2: TButton
Left = 36
Top = 233
Width = 41
Height = 25
Caption = #21024#34892
TabOrder = 18
OnClick = Button2Click
end
object cxGrid2: TcxGrid
Left = 97
Top = 154
Width = 778
Height = 129
TabOrder = 16
object Tv2: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource2
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Format = '0'
Position = spFooter
end
item
Format = '0'
Position = spFooter
end
item
Format = '0'
Position = spFooter
end
item
Format = '0'
Position = spFooter
end
item
Format = '0'
Position = spFooter
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.FocusCellOnTab = True
OptionsBehavior.GoToNextCellOnEnter = True
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
Styles.Inactive = DataLink_ContractManagement.SHuangSe
Styles.IncSearch = DataLink_ContractManagement.SHuangSe
Styles.Selection = DataLink_ContractManagement.SHuangSe
Styles.Header = DataLink_ContractManagement.Default
object cxGridDBColumn1: TcxGridDBColumn
Caption = #24207#21495
DataBinding.FieldName = 'XHNo'
HeaderAlignmentHorz = taCenter
Styles.Header = DataLink_ContractManagement.Default
Width = 40
end
object cxGridDBColumn18: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'MNote'
HeaderAlignmentHorz = taCenter
Width = 721
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object XSType: TComboBox
Tag = 2
Left = 97
Top = 62
Width = 139
Height = 20
Style = csDropDownList
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ItemHeight = 12
TabOrder = 8
Items.Strings = (
#32463#38144
#21152#24037
#25171#26679
#24320#21457#26679)
end
object ConQtyUnit: TComboBox
Tag = 2
Left = 93
Top = 123
Width = 37
Height = 20
Style = csDropDownList
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ItemHeight = 12
ItemIndex = 0
TabOrder = 14
Text = 'Kg'
Items.Strings = (
'Kg'
'M')
end
object ConPerson1: TBtnEditC
Tag = 2
Left = 526
Top = 8
Width = 136
Height = 20
Hint = 'ConPerson1/'#19994#21153#21592
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 1
OnDblClick = SYRNameBtnUpClick
OnBtnUpClick = SYRNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object SQRatio: TEdit
Tag = 2
Left = 97
Top = 35
Width = 136
Height = 18
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 4
end
object IsHS: TComboBox
Tag = 2
Left = 305
Top = 91
Width = 139
Height = 20
Style = csDropDownList
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ItemHeight = 12
TabOrder = 13
Items.Strings = (
''
#21547#31246
#19981#21547#31246)
end
object zlbz: TBtnEditC
Tag = 2
Left = 526
Top = 88
Width = 349
Height = 20
Hint = 'zlbz/'#36136#37327#26631#20934
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 11
OnDblClick = SYRNameBtnUpClick
OnBtnUpClick = SYRNameBtnUpClick
OnBtnDnClick = CustomerNoNameBtnDnClick
end
object ZhiYuan: TComboBox
Tag = 2
Left = 209
Top = 123
Width = 139
Height = 20
Style = csDropDownList
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ItemHeight = 12
TabOrder = 15
Items.Strings = (
#22791#36135
#29983#20135
#22791#36135#20860#29983#20135)
end
end
object cxGrid1: TcxGrid
Left = 0
Top = 329
Width = 1024
Height = 347
Align = alClient
TabOrder = 2
object Tv1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Format = '0'
Position = spFooter
end
item
Format = '0'
Position = spFooter
Column = v1PRTOrderQty
end
item
Format = '0'
Position = spFooter
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
Column = v1PRTOrderQty
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
Column = v1Column12
end
item
Kind = skSum
Column = v1Column11
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.FocusCellOnTab = True
OptionsBehavior.GoToNextCellOnEnter = True
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_ContractManagement.SHuangSe
Styles.IncSearch = DataLink_ContractManagement.SHuangSe
Styles.Selection = DataLink_ContractManagement.SHuangSe
Styles.Header = DataLink_ContractManagement.Default
object v1XHNo: TcxGridDBColumn
Tag = 1
Caption = #24207#21495
DataBinding.FieldName = 'XHNo'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Header = DataLink_ContractManagement.Default
Width = 35
end
object v1Column9: TcxGridDBColumn
Tag = 1
Caption = #23458#25143#21333#21495
DataBinding.FieldName = 'MXKHConNo'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 82
end
object v1Column14: TcxGridDBColumn
Tag = 1
Caption = #20135#21697#32534#21495
DataBinding.FieldName = 'PrtCode'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
Properties.OnButtonClick = v1Column14PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 92
end
object v1Column4: TcxGridDBColumn
Tag = 1
Caption = #21697#21517
DataBinding.FieldName = 'PrtCodeName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
Properties.OnButtonClick = v1Column4PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Options.Editing = False
Options.Focusing = False
Styles.Header = DataLink_ContractManagement.Default
Width = 107
end
object v1Column5: TcxGridDBColumn
Tag = 1
Caption = #35268#26684
DataBinding.FieldName = 'prtspec'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Header = DataLink_ContractManagement.Default
Width = 105
end
object v1PRTColor: TcxGridDBColumn
Tag = 1
Caption = #39068#33394
DataBinding.FieldName = 'PRTColor'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = False
Properties.OnButtonClick = v1PRTColorPropertiesButtonClick
HeaderAlignmentHorz = taCenter
Options.Editing = False
Options.Sorting = False
Styles.Header = DataLink_ContractManagement.Default
Width = 92
end
object v1Column6: TcxGridDBColumn
Tag = 1
Caption = #38376#24133'CM'
DataBinding.FieldName = 'prtmf'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Header = DataLink_ContractManagement.Default
Width = 74
end
object v1Column7: TcxGridDBColumn
Tag = 1
Caption = #20811#37325'g/'#13217
DataBinding.FieldName = 'prtkz'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Header = DataLink_ContractManagement.Default
Width = 64
end
object v1PRTOrderQty: TcxGridDBColumn
Tag = 1
Caption = #25968#37327
DataBinding.FieldName = 'PRTOrderQty'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v1PRTOrderQtyPropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Header = DataLink_ContractManagement.Default
Width = 60
end
object v1Column8: TcxGridDBColumn
Tag = 1
Caption = #21305#25968
DataBinding.FieldName = 'PiShu'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v1Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 74
end
object v1Column3: TcxGridDBColumn
Tag = 1
Caption = #21305#37325'(Kg)'
DataBinding.FieldName = 'PiZhong'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v1Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 69
end
object v1Column10: TcxGridDBColumn
Caption = #24320#24133#35201#27714
DataBinding.FieldName = 'KFNote'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.Items.Strings = (
#24320#24133
#36864#21367)
HeaderAlignmentHorz = taCenter
Width = 80
end
object v1Column12: TcxGridDBColumn
Tag = 1
Caption = #29983#20135#21305#25968
DataBinding.FieldName = 'SCPs'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 57
end
object v1Column11: TcxGridDBColumn
Tag = 1
Caption = #29983#20135#25968#37327
DataBinding.FieldName = 'SCQty'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 67
end
object v1Column2: TcxGridDBColumn
Tag = 1
Caption = #22791#27880
DataBinding.FieldName = 'SOrdDefNote1'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 113
end
object v1Column1: TcxGridDBColumn
Caption = #32455#38024#35201#27714
DataBinding.FieldName = 'ZhenZhiNote'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.OnButtonClick = v1Column1PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Width = 66
end
object v1Column13: TcxGridDBColumn
Caption = #32455#36896#25439#32791
DataBinding.FieldName = 'ZZSunHao'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.OnButtonClick = v1Column13PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Width = 66
end
object v1Column15: TcxGridDBColumn
Caption = #36716#36895'/'#20998
DataBinding.FieldName = 'MeiFenZhuanSu'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.OnButtonClick = v1Column15PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Width = 66
end
object v1Column16: TcxGridDBColumn
Caption = #25209#37327#39118#38505#24635#32467
DataBinding.FieldName = 'ZongJieNote'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.OnButtonClick = v1Column16PropertiesButtonClick
HeaderAlignmentHorz = taCenter
Width = 66
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
object ADOTemp: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 448
Top = 149
end
object ADOCmd: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
Parameters = <>
Left = 416
Top = 149
end
object DataSource1: TDataSource
DataSet = Order_Sub
Left = 1016
Top = 368
end
object Order_Sub: TClientDataSet
Aggregates = <>
Params = <>
Left = 976
Top = 288
end
object ADOQuery1: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
Parameters = <>
Left = 384
Top = 149
end
object CDS_Type: TClientDataSet
Aggregates = <>
Params = <>
Left = 632
Top = 480
end
object Order_Note: TClientDataSet
Aggregates = <>
Params = <>
Left = 472
Top = 264
end
object DataSource2: TDataSource
DataSet = Order_Note
Left = 528
Top = 256
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 896
Top = 424
end
end

View File

@ -0,0 +1,956 @@
unit U_ConInPutNXKFSH;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxClasses, cxControls,
cxGridCustomView, cxGrid, cxMemo, cxRichEdit, ComCtrls, cxContainer,
cxTextEdit, cxMaskEdit, cxButtonEdit, StdCtrls, ToolWin, DBClient, ADODB,
ExtCtrls, BtnEdit, cxCalendar,StrUtils, cxDropDownEdit,
cxGridCustomPopupMenu, cxGridPopupMenu;
type
TfrmConInPutNXKFSH = class(TForm)
ToolBar1: TToolBar;
TBSave: TToolButton;
TBClose: TToolButton;
ScrollBox1: TScrollBox;
Label3: TLabel;
OrdDate: TDateTimePicker;
Label4: TLabel;
DlyDate: TDateTimePicker;
Label7: TLabel;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
v1PRTColor: TcxGridDBColumn;
ADOTemp: TADOQuery;
ADOCmd: TADOQuery;
DataSource1: TDataSource;
Order_Sub: TClientDataSet;
ADOQuery1: TADOQuery;
v1PRTOrderQty: TcxGridDBColumn;
Label9: TLabel;
Label10: TLabel;
ConNo: TEdit;
Label11: TLabel;
Label14: TLabel;
Label20: TLabel;
FromPlace: TBtnEditC;
CustomerNoName: TBtnEditC;
v1XHNo: TcxGridDBColumn;
SYRName: TBtnEditC;
Label6: TLabel;
QtyNote: TBtnEditC;
DlyNote: TBtnEditC;
CDS_Type: TClientDataSet;
Label34: TLabel;
KHConNo: TEdit;
v1Column2: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
Button1: TButton;
Button2: TButton;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn18: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
Order_Note: TClientDataSet;
DataSource2: TDataSource;
v1Column14: TcxGridDBColumn;
cxGridPopupMenu2: TcxGridPopupMenu;
Label1: TLabel;
XSType: TComboBox;
Label16: TLabel;
ConQtyUnit: TComboBox;
v1Column3: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
ConPerson1: TBtnEditC;
Label25: TLabel;
SQRatio: TEdit;
Label29: TLabel;
IsHS: TComboBox;
Label33: TLabel;
zlbz: TBtnEditC;
v1Column9: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
Label35: TLabel;
ZhiYuan: TComboBox;
v1Column11: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
v1Column16: TcxGridDBColumn;
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure v1PRTColorPropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure CustomerNoNameBtnUpClick(Sender: TObject);
procedure CustomerNoNameBtnDnClick(Sender: TObject);
procedure v1Column1PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure v1OrderUnitPropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure v1PriceUnitPropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure SYRNameBtnUpClick(Sender: TObject);
procedure CPCFNoDblClick(Sender: TObject);
procedure CPRanHouGYBtnDnClick(Sender: TObject);
procedure v1Column4PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure v1Column14PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure v1Column8PropertiesEditValueChanged(Sender: TObject);
procedure v1PRTOrderQtyPropertiesEditValueChanged(Sender: TObject);
procedure v1Column13PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure v1Column16PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure v1Column15PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
private
fuserName:string;
procedure InitData();
procedure ZDYHelp(FButn:TcxButtonEdit;LType:string);
function SaveData():Boolean;
function SaveDataSubOne():Boolean;
function SaveDataMain():Boolean;
function SaveDataSubMore():Boolean;
{ Private declarations }
public
PState,CopyInt:Integer;
FMainId,FFMainId,ChkStr,ConPriceStr:String;
FXS:Integer;
{ Public declarations }
end;
var
frmConInPutNXKFSH: TfrmConInPutNXKFSH;
newh:hwnd;
implementation
uses
U_DataLink,U_ZDYHelp,U_Fun,U_ZDYHelpSel, U_ZdyAttachment,
U_CPManageFMSel;
{$R *.dfm}
procedure TfrmConInPutNXKFSH.TBCloseClick(Sender: TObject);
begin
Close;
WriteCxGrid('合同录入内销RZ',Tv1,'生产指示单管理');
end;
procedure TfrmConInPutNXKFSH.InitData();
begin
with ADOQuery1 do
begin
Close;
sql.Clear;
sql.Add('select * from KH_Zdy where Type=''MPRTNameType'' ');
Open;
end;
SCreateCDS20(ADOQuery1,CDS_Type);
SInitCDSData20(ADOQuery1,CDS_Type);
with ADOQuery1 do
begin
Close;
SQL.Clear;
sql.Add(' select * from JYOrderCon_Sub_PB ');
if PState=1 then
begin
sql.Add('where MainId='''+Trim(FMainId)+'''');
end;
if PState=0 then
begin
sql.Add(' where 1<>1');
end;
Open;
end;
SCreateCDS20(ADOQuery1,Order_Sub);
SInitCDSData20(ADOQuery1,Order_Sub);
with ADOQuery1 do
begin
Close;
SQL.Clear;
sql.Add(' select * from JYOrderCon_Main_Note_PB ');
if PState=1 then
begin
sql.Add('where MainId='''+Trim(FMainId)+'''');
end;
if PState=0 then
begin
sql.Add(' where 1<>1');
end;
Open;
end;
SCreateCDS20(ADOQuery1,Order_Note);
SInitCDSData20(ADOQuery1,Order_Note);
with ADOQuery1 do
begin
Close;
sql.Clear;
sql.Add('select * from JYOrderCon_Main_PB where MainId='''+Trim(FMainId)+'''');
Open;
end;
SCSHDataNew(ADOQuery1,ScrollBox1,2);
SYRName.TxtCode:=Trim(ADOQuery1.fieldbyname('ConDefStr2').AsString);
ConNo.Text:=Trim(ADOQuery1.fieldbyname('ConNo').AsString);
if Trim(ADOQuery1.fieldbyname('status').AsString)='1' then
begin
ChkStr:='已审核';
end;
if PState=0 then
begin
OrdDate.DateTime:=SGetServerDateTime(ADOTemp);
DlyDate.DateTime:=SGetServerDateTime(ADOTemp);
//ConPerson1.Text:=Trim(DName);
end else
begin
end;
if CopyInt=99 then
begin
PState:=0;
FMainId:='';
//ConPerson1.Text:=Trim(DName);
ConNo.Text:='';
with Order_Sub do
begin
First;
while not Eof do
begin
Edit;
FieldByName('MainId').Value:='';
FieldByName('SubId').Value:='';
Post;
Next;
end;
end;
with Order_Note do
begin
First;
while not Eof do
begin
Edit;
FieldByName('MainId').Value:='';
FieldByName('MNId').Value:='';
Post;
Next;
end;
end;
end;
end;
procedure TfrmConInPutNXKFSH.ZDYHelp(FButn:TcxButtonEdit;LType:string);
var
FType,ZDYName,FText:String;
begin
end;
procedure TfrmConInPutNXKFSH.FormShow(Sender: TObject);
begin
fuserName:=DCode;
readCxGrid('合同录入内销RZ',Tv1,'生产指示单管理');
InitData();
if CopyInt=99 then Exit;
ScrollBox1.Enabled:=False;
end;
function TfrmConInPutNXKFSH.SaveData():Boolean;
var
maxno,maxmnno,MConNo,MConFlag:String;
fconNO,fmxType:string;
begin
try
ADOCmd.Connection.BeginTrans;
///保存主表
maxno:=Trim(FMainId);
with ADOCmd do
begin
Close;
sql.Clear;
SQL.Add('select * from JYOrderCon_Main_PB where MainId='''+Trim(FMainId)+'''');
Open;
end;
with ADOCmd do
begin
Edit;
SSetsaveSqlNew(ADOCmd,'JYOrderCon_Main_PB',ScrollBox1,3);
Post;
end;
FMainId:=Trim(maxno);
///保存子表
with Order_Sub do
begin
First;
while not Eof do
begin
maxno:=Trim(Order_Sub.fieldbyname('SubId').AsString);
with ADOCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from JYOrderCon_Sub_PB where MainId='''+Trim(FMainId)+'''');
sql.Add(' and SubId='''+Trim(maxno)+'''');
Open;
end;
with ADOCmd do
begin
Edit;
RTSetSaveDataCDS(ADOCmd,Tv1,Order_Sub,'JYOrderCon_Sub_PB',0);
Post;
end;
Next;
end;
end;
ADOCmd.Connection.CommitTrans;
Result:=True;
except
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
Result:=False;
end;
end;
function TfrmConInPutNXKFSH.SaveDataMain():Boolean;
var
maxno:String;
begin
try
ADOCmd.Connection.BeginTrans;
///保存主表
with ADOCmd do
begin
Close;
sql.Clear;
SQL.Add('select * from JYOrder_Main where MainId='''+Trim(FMainId)+'''');
Open;
end;
with ADOCmd do
begin
if Trim(FMainId)='' then
begin
Append;
maxno:=Trim(FFMainId);
end
else begin
maxno:=Trim(FMainId);
Edit;
end;
FieldByName('MainId').Value:=Trim(maxno);
SSetsaveSqlNew(ADOCmd,'JYOrder_Main',ScrollBox1,2);
if PState=1 then
begin
FieldByName('OrdUpDate').Value:=SGetServerDateTime(ADOTemp);
end;
if Trim(FMainId)='' then
begin
FieldByName('Filler').Value:=Trim(DName);
end else
begin
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOTemp);
end;
Post;
end;
FMainId:=Trim(maxno);
ADOCmd.Connection.CommitTrans;
Result:=True;
except
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
Result:=False;
end;
end;
function TfrmConInPutNXKFSH.SaveDataSubOne():Boolean;
var
maxno:String;
begin
try
ADOCmd.Connection.BeginTrans;
///保存子表
with Order_Sub do
begin
//First;
//while not Eof do
begin
if Trim(Order_Sub.fieldbyname('SubId').AsString)='' then
begin
if GetLSNo(ADOTemp,maxno,'JS','JYOrder_Sub',4,1)=False then
begin
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('取子流水号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(Order_Sub.fieldbyname('SubId').AsString);
end;
with ADOCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from JYOrder_Sub where MainId='''+Trim(FMainId)+'''');
sql.Add(' and SubId='''+Trim(maxno)+'''');
Open;
end;
with ADOCmd do
begin
if Trim(Order_Sub.fieldbyname('SubId').AsString)='' then
Append
else
Edit;
FieldByName('MainId').Value:=Trim(FMainId);
FieldByName('SubId').Value:=Trim(maxno);
RTSetSaveDataCDS(ADOCmd,Tv1,Order_Sub,'JYOrder_Sub',0);
Post;
end;
Order_Sub.Edit;
Order_Sub.FieldByName('SubId').Value:=Trim(maxno);
//Order_Sub.Post;
//Next;
end;
end;
ADOCmd.Connection.CommitTrans;
Result:=True;
except
Result:=False;
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('操作异常!','提示',0);
end;
end;
function TfrmConInPutNXKFSH.SaveDataSubMore():Boolean;
var
maxno:String;
begin
try
ADOCmd.Connection.BeginTrans;
///保存子表
with Order_Sub do
begin
First;
while not Eof do
begin
if Trim(Order_Sub.fieldbyname('SubId').AsString)='' then
begin
if GetLSNo(ADOTemp,maxno,'JS','JYOrder_Sub',4,1)=False then
begin
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('取子流水号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(Order_Sub.fieldbyname('SubId').AsString);
end;
with ADOCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from JYOrder_Sub where MainId='''+Trim(FMainId)+'''');
sql.Add(' and SubId='''+Trim(maxno)+'''');
Open;
end;
with ADOCmd do
begin
if Trim(Order_Sub.fieldbyname('SubId').AsString)='' then
Append
else
Edit;
FieldByName('MainId').Value:=Trim(FMainId);
FieldByName('SubId').Value:=Trim(maxno);
RTSetSaveDataCDS(ADOCmd,Tv1,Order_Sub,'JYOrder_Sub',0);
Post;
end;
Order_Sub.Edit;
Order_Sub.FieldByName('SubId').Value:=Trim(maxno);
//Order_Sub.Post;
Next;
end;
end;
ADOCmd.Connection.CommitTrans;
Result:=True;
except
Result:=False;
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('操作异常!','提示',0);
end;
end;
procedure TfrmConInPutNXKFSH.TBSaveClick(Sender: TObject);
var
MaxDS,FlagDS:string;
begin
ToolBar1.SetFocus;
if Order_Sub.Locate('KFNote',null,[])=True then
begin
Application.MessageBox('开福要求不能为空!','提示',0);
Exit;
end;
if Order_Sub.Locate('KFNote','',[])=True then
begin
Application.MessageBox('开福要求不能为空!','提示',0);
Exit;
end;
if SaveData() then
begin
Application.MessageBox('保存成功!','提示',0);
end;
end;
procedure TfrmConInPutNXKFSH.v1PRTColorPropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='OrdColor';
flagname:='颜色';
V1Name.Caption:='中文名称';
// V1Note.Caption:='英文名称';
//fnote:=True;
MainType:=Trim(DName);
if ShowModal=1 then
begin
Self.Order_Sub.Edit;
Self.Order_Sub.FieldByName('PRTColor').Value:=Trim(ClientDataSet1.fieldbyname('ZdyName').AsString);
//Self.Order_Sub.FieldByName('SOrdDefStr4').Value:=Trim(ClientDataSet1.fieldbyname('Note').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmConInPutNXKFSH.CustomerNoNameBtnUpClick(Sender: TObject);
begin
with ADOTemp do
begin
Close;
sql.Clear;
sql.Add('select * from FHSQ_Main where ConMainId='''+Trim(FMainId)+'''');
Open;
end;
if ADOTemp.IsEmpty=False then
begin
Application.MessageBox('已做发货申请,不能修改客户!','提示',0);
Exit;
end;
try
frmZdyAttachment:=TfrmZdyAttachment.Create(Application);
with frmZdyAttachment do
begin
if ShowModal=1 then
begin
CustomerNoName.Text:=Trim(CDS_HZ.fieldbyname('CoName').AsString);
CustomerNoName.TxtCode:=Trim(CDS_HZ.fieldbyname('CoCode').AsString);
Self.ConPerson1.Text:=Trim(CDS_HZ.fieldbyname('Salesman').AsString);
with ADOTemp do
begin
Close;
sql.Clear;
sql.Add('select Top 1* from JYOrderCon_Main_PB where CustomerNoName='''+Trim(CDS_HZ.fieldbyname('CoName').AsString)+'''');
sql.Add(' order by FillTime desc');
Open;
if Trim(ADOTemp.fieldbyname('ConPerson1').AsString)<>'' then
Self.ConPerson1.Text:=Trim(ADOTemp.fieldbyname('ConPerson1').AsString);
end;
end;
end;
finally
frmZdyAttachment.Free;
end;
end;
procedure TfrmConInPutNXKFSH.CustomerNoNameBtnDnClick(Sender: TObject);
begin
TBtnEditC(Sender).Text:='';
TBtnEditC(Sender).TxtCode:='';
end;
procedure TfrmConInPutNXKFSH.v1Column1PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='ZhenZhiNote';
flagname:='织针要求';
if ShowModal=1 then
begin
Order_Sub.Edit;
Order_Sub.fieldbyname('ZhenZhiNote').Value:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
Order_Sub.Post;
end;
end;
finally
frmZDYHelp.Free;
end;
tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmConInPutNXKFSH.v1OrderUnitPropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='OrderUnit';
flagname:='数量单位';
if ShowModal=1 then
begin
Self.Order_Sub.Edit;
Self.Order_Sub.FieldByName('OrderUnit').Value:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmConInPutNXKFSH.v1PriceUnitPropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='PriceUnit';
flagname:='价格单位';
if Trim(DParameters1)<>'高权限' then
begin
TBAdd.Visible:=False;
TBEdit.Visible:=False;
TBDel.Visible:=False;
end;
if ShowModal=1 then
begin
Self.Order_Sub.Edit;
Self.Order_Sub.FieldByName('PriceUnit').Value:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmConInPutNXKFSH.SYRNameBtnUpClick(Sender: TObject);
var
fsj:string;
FWZ:Integer;
begin
fsj:=Trim(TEdit(Sender).Hint);
FWZ:=Pos('/',fsj);
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:=Copy(fsj,1,FWZ-1);
flagname:=Copy(fsj,FWZ+1,Length(fsj)-fwz);
if Trim(flag)='SYRName' then
begin
flag:='GSTTPB';
V1Name.Caption:='中文名称';
end;
if Trim(flag)='BankNo' then
begin
fnote:=True;
end;
if ShowModal=1 then
begin
TEdit(Sender).Text:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmConInPutNXKFSH.CPCFNoDblClick(Sender: TObject);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='MPRTNameType';
flagname:='产品类别定义';
V1HelpType.Visible:=True;
V1HelpType.Caption:='缩写名';
fnote:=True;
V1Name.Caption:='中文';
V1Note.Caption:='英文';
if ShowModal=1 then
begin
with ADOQuery1 do
begin
Close;
sql.Clear;
sql.Add('select * from KH_Zdy where Type=''MPRTNameType'' ');
Open;
end;
SCreateCDS20(ADOQuery1,CDS_Type);
SInitCDSData20(ADOQuery1,CDS_Type);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmConInPutNXKFSH.CPRanHouGYBtnDnClick(Sender: TObject);
begin
TBtnEditC(Sender).Text:='';
TBtnEditC(Sender).TxtCode:='';
end;
procedure TfrmConInPutNXKFSH.v1Column4PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='MPRTCodeNameZW';
flagname:='产品名称';
if ShowModal=1 then
begin
Order_Sub.Edit;
Order_Sub.fieldbyname('PRTCodeName').Value:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
//Order_Sub.fieldbyname('PRTCode').Value:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
Order_Sub.Post;
end;
end;
finally
frmZDYHelp.Free;
end;
tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmConInPutNXKFSH.Button1Click(Sender: TObject);
var
i:Integer;
begin
i:=Order_Note.RecordCount;
i:=i+1;
with Order_Note do
begin
Append;
FieldByName('XHNO').Value:=IntToStr(i);
Post;
end;
end;
procedure TfrmConInPutNXKFSH.Button2Click(Sender: TObject);
begin
if Order_Note.IsEmpty then Exit;
if Trim(Order_Note.fieldbyname('MNId').AsString)<>'' then
begin
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
with ADOCmd do
begin
Close;
sql.Clear;
sql.Add('delete JYOrderCon_Main_Note_PB where MNId='''+Trim(Order_Note.fieldbyname('MNId').AsString)+'''');
ExecSQL;
end;
end;
Order_Note.Delete;
end;
procedure TfrmConInPutNXKFSH.v1Column14PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
var
fsj:string;
FWZ:Integer;
begin
with ADOTemp do
begin
Close;
sql.Clear;
sql.Add('select * from Cloth_Main where ConSubId='''+Trim(Order_Sub.fieldbyname('SubId').AsString)+'''');
Open;
end;
if ADOTemp.IsEmpty=False then
begin
Application.MessageBox('已做计划单,不能修改编号!','提示',0);
Exit;
end;
with ADOTemp do
begin
Close;
sql.Clear;
sql.Add('select * from FHSQ_Main where ConSubId='''+Trim(Order_Sub.fieldbyname('SubId').AsString)+'''');
Open;
end;
if ADOTemp.IsEmpty=False then
begin
Application.MessageBox('已做发货申请,不能修改编号!','提示',0);
Exit;
end;
try
frmCPManageFMSel:=TfrmCPManageFMSel.Create(Application);
with frmCPManageFMSel do
begin
if ShowModal=1 then
begin
with Self.Order_Sub do
begin
Edit;
FieldByName('PrtCode').Value:=frmCPManageFMSel.CDS_Main.fieldbyname('CYNo').Value;
FieldByName('PrtCodeName').Value:=frmCPManageFMSel.CDS_Main.fieldbyname('CYName').Value;
FieldByName('PRTspec').Value:=frmCPManageFMSel.CDS_Main.fieldbyname('HZSPEC').Value;
FieldByName('PRTColor').Value:=frmCPManageFMSel.CDS_Main.fieldbyname('CYColor').Value;
FieldByName('PRTMF').Value:=frmCPManageFMSel.CDS_Main.fieldbyname('CYMF').Value;
FieldByName('PRTKZ').Value:=frmCPManageFMSel.CDS_Main.fieldbyname('CYKZ').Value;
end;
end;
end;
finally
frmCPManageFMSel.Free;
end;
end;
procedure TfrmConInPutNXKFSH.v1Column8PropertiesEditValueChanged(
Sender: TObject);
var
mvalue,FFieldName:String;
FPiShu,FPiZhong:double;
begin
mvalue:=TcxTextEdit(Sender).EditingText;
FFieldName:=Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
with Order_Sub do
begin
Edit;
FieldByName(FFieldName).Value:=mvalue;
Post;
FPiShu:=FieldByName('PiShu').AsFloat;
FPiZhong:=FieldByName('PiZhong').AsFloat;
end;
with Order_Sub do
begin
Edit;
FieldByName('PRTOrderQty').Value:=FPiShu*FPiZhong;
Post;
end;
tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmConInPutNXKFSH.v1PRTOrderQtyPropertiesEditValueChanged(
Sender: TObject);
var
mvalue,FFieldName:String;
FPRTOrderQty:double;
begin
mvalue:=TcxTextEdit(Sender).EditingText;
FFieldName:=Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
with Order_Sub do
begin
Edit;
FieldByName(FFieldName).Value:=mvalue;
FieldByName('SCQty').Value:=mvalue;
Post;
end;
end;
procedure TfrmConInPutNXKFSH.v1Column13PropertiesButtonClick(
Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='ZZSunHao';
flagname:='织造损耗';
if ShowModal=1 then
begin
Order_Sub.Edit;
Order_Sub.fieldbyname('ZZSunHao').Value:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
Order_Sub.Post;
end;
end;
finally
frmZDYHelp.Free;
end;
tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmConInPutNXKFSH.v1Column16PropertiesButtonClick(
Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='ZongJieNote';
flagname:='批量风险总结';
if ShowModal=1 then
begin
Order_Sub.Edit;
Order_Sub.fieldbyname('ZongJieNote').Value:=Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
Order_Sub.Post;
end;
end;
finally
frmZDYHelp.Free;
end;
tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmConInPutNXKFSH.v1Column15PropertiesButtonClick(
Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp:=TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag:='MeiFenZhuanSu';
flagname:='转速/分';
if ShowModal=1 then
begin
Order_Sub.Edit;
Order_Sub.fieldbyname('MeiFenZhuanSu').Value:=strtointdef(Trim(ClientDataSet1.fieldbyname('ZDYName').AsString),0);
Order_Sub.Post;
end;
end;
finally
frmZDYHelp.Free;
end;
tv1.Controller.EditingController.ShowEdit();
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,850 @@
unit U_ContractListPB;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, DBClient, cxCheckBox, cxCalendar, cxSplitter,
RM_Dataset, RM_System, RM_Common, RM_Class, RM_GridReport, RM_e_Xls,
Menus, cxPC, cxButtonEdit, RM_E_llPDF, cxDropDownEdit, cxTextEdit,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxBarBuiltInMenu;
type
TfrmContractListPB = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBAdd: TToolButton;
TBEdit: TToolButton;
TBDel: TToolButton;
TBPrint: TToolButton;
TBClose: TToolButton;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
cxGridPopupMenu1: TcxGridPopupMenu;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
TBExport: TToolButton;
v1OrdDate: TcxGridDBColumn;
v1DeliveryDate: TcxGridDBColumn;
v1OrdPerson1: TcxGridDBColumn;
v1ConNo: TcxGridDBColumn;
v1MPRTCF: TcxGridDBColumn;
Order_Main: TClientDataSet;
RMDBDataSet1: TRMDBDataSet;
RMXLSExport1: TRMXLSExport;
v1CustomerNoName: TcxGridDBColumn;
v1PRTOrderQty: TcxGridDBColumn;
ToolButton1: TToolButton;
v1Column1: TcxGridDBColumn;
ToolButton2: TToolButton;
ADOQueryPrint: TADOQuery;
CDS_Print: TClientDataSet;
ToolButton3: TToolButton;
v1Column4: TcxGridDBColumn;
Panel1: TPanel;
Label1: TLabel;
Label4: TLabel;
Label5: TLabel;
Label8: TLabel;
Label9: TLabel;
Label12: TLabel;
Label13: TLabel;
BegDate: TDateTimePicker;
EndDate: TDateTimePicker;
CustomerNoName: TEdit;
ConPerson1: TEdit;
MPRTCodeName: TEdit;
ConNo: TEdit;
MPRTKZ: TEdit;
MPRTMF: TEdit;
v1Column2: TcxGridDBColumn;
cxTabControl1: TcxTabControl;
tchk: TToolButton;
Tnochk: TToolButton;
cxSplitter1: TcxSplitter;
ADOQuerySub: TADOQuery;
DataSource2: TDataSource;
v1Column8: TcxGridDBColumn;
Label2: TLabel;
KHConNO: TEdit;
Label3: TLabel;
Tqx: TToolButton;
Tnoqx: TToolButton;
ToolButton5: TToolButton;
v1Column10: TcxGridDBColumn;
v1Column11: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
//RMllPDFExport1: TRMllPDFExport;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
v1XHNo: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
v1OrderUnit: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn10: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
ClientDataSet2: TClientDataSet;
cxGridPopupMenu2: TcxGridPopupMenu;
v2Column1: TcxGridDBColumn;
CDS_Note: TClientDataSet;
v2Column2: TcxGridDBColumn;
RM1: TRMGridReport;
v1Column22: TcxGridDBColumn;
Label6: TLabel;
XSType: TComboBox;
RMDBDataSet2: TRMDBDataSet;
v2Column3: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
Label7: TLabel;
Label10: TLabel;
PrtCode: TEdit;
PrtCodeName: TEdit;
v1Column14: TcxGridDBColumn;
//RMllPDFExport1: TRMllPDFExport;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBPrintClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure CustomerNoNameChange(Sender: TObject);
procedure tchkClick(Sender: TObject);
procedure TnochkClick(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure TqxClick(Sender: TObject);
procedure TnoqxClick(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure Tv1CustomDrawCell(Sender: TcxCustomGridTableView;
ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo;
var ADone: Boolean);
procedure Tv1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
DQdate:TDateTime;
fuserName,canshu2:string;
procedure InitGrid();
procedure InitForm();
function DelData():Boolean;
procedure SetStatus();
{ Private declarations }
public
FFInt,FCloth:Integer;
canshu1:string;
{ Public declarations }
end;
//var
//frmContractListNX: TfrmContractListNX;
implementation
uses
U_DataLink,U_ConInPutNX,U_Fun,U_ZDYHelp, U_FjList_RZ;
{$R *.dfm}
procedure TfrmContractListPB.SetStatus();
begin
tchk.Visible:=false;
tnochk.Visible:=false;
// tbedit.Visible:=false;
// tbdel.Visible:=false;
Tqx.Visible:=false;
TNoqx.Visible:=false;
if Trim(canshu1)<>'高权限' then
begin
end
else
begin
case cxTabControl1.TabIndex of
0:begin
tchk.Visible:=true;
tbedit.Visible:=true;
tbdel.Visible:=true;
Tqx.Visible:=true;
end;
1:begin
tnochk.Visible:=true;
Tqx.Visible:=true;
end;
2:begin
TNOqx.Visible:=true;
end;
3:begin
end;
end;
end;
end;
procedure TfrmContractListPB.FormDestroy(Sender: TObject);
begin
//frmContractListNX:=nil;
end;
procedure TfrmContractListPB.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmContractListPB.FormCreate(Sender: TObject);
begin
//canshu1:=Trim(DParameters1);
canshu2:=Trim(DParameters2);
cxgrid1.Align:=alClient;
DQdate:=SGetServerDate(ADOQueryTemp);
end;
procedure TfrmContractListPB.TBCloseClick(Sender: TObject);
begin
Close;
WriteCxGrid('内销合同',Tv1,'生产指示单管理');
WriteCxGrid('内销合同11',Tv2,'生产指示单管理');
end;
procedure TfrmContractListPB.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(',Case when isnull((select count(*) from TP_File where WBID=A.MainID and TFType=''合同'' ),0)>0 ');
sql.Add('then Cast(1 as bit) else Cast(0 as bit) end as FJFlag');
sql.Add(',PrtCode=(select Top 1 PrtCode from JYOrderCon_Sub_PB JCS where JCS.MainId=A.MainId)');
sql.Add(',PrtCodeName=(select Top 1 PrtCodeName from JYOrderCon_Sub_PB JCS where JCS.MainId=A.MainId)');
sql.Add(',Case when isnull((select count(*) from Cloth_Main where ConMainId=A.MainID ),0)>0 ');
sql.Add('then Cast(1 as bit) else Cast(0 as bit) end as JHDFlag');
sql.Add(' from JYOrderCon_Main_PB A where 1=1');
sql.Add(' and A.FillTIme>='''+Trim(FormatDateTime('yyyy-MM-dd',BegDate.DateTime))+'''');
sql.Add(' and A.FillTIme<'''+Trim(FormatDateTime('yyyy-MM-dd',EndDate.DateTime+1))+'''');
{ if Trim(canshu1)<>'高权限' then
begin
SQL.Add(' and A.FillerCode='''+Trim(DCode)+'''');
end; }
IF cxTabControl1.TabIndex<3 then
begin
SQL.Add(' and isnull(A.status,''0'')='''+inttostr(cxTabControl1.TabIndex)+'''');
end;
Open;
end;
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmContractListPB.InitForm();
begin
ReadCxGrid('内销合同',Tv1,'生产指示单管理');
ReadCxGrid('内销合同11',Tv2,'生产指示单管理');
EndDate.DateTime:=SGetServerDate10(ADOQueryTemp);
BegDate.DateTime:=EndDate.DateTime;
//InitGrid();
end;
procedure TfrmContractListPB.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
end;
procedure TfrmContractListPB.TBEditClick(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
if Trim(canshu1)<>'高权限' then
begin
if Trim(Order_Main.fieldbyname('Filler').AsString)<>Trim(DName) then
begin
Application.MessageBox('不能操作他人的数据!','提示',0);
Exit;
end;
end;
if Trim(canshu1)<>'高权限' then
begin
if cxTabControl1.TabIndex<>0 then Exit;
end;
try
frmConInPutNX:=TfrmConInPutNX.Create(Application);
with frmConInPutNX do
begin
PState:=1;
FMainId:=Trim(Self.Order_Main.fieldbyname('MainId').AsString);
if ShowModal=1 then
begin
end;
end;
finally
frmConInPutNX.Free;
end;
end;
procedure TfrmContractListPB.TBDelClick(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
if cxTabControl1.TabIndex<>0 then Exit;
// if Trim(Order_Main.fieldbyname('Filler').AsString)<>Trim(DName) then
// begin
// Application.MessageBox('不能操作他人的数据!','提示',0);
// Exit;
// end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from Cloth_Main where ConMainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
Open;
end;
if ADOQueryTemp.IsEmpty=False then
begin
Application.MessageBox('已做计划单,不能删除数据!','提示',0);
Exit;
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from FHSQ_Main where ConMainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
Open;
end;
if ADOQueryTemp.IsEmpty=False then
begin
Application.MessageBox('已做发货申请,不能删除数据!','提示',0);
Exit;
end;
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
if DelData() then
begin
Order_Main.Delete;
end;
end;
function TfrmContractListPB.DelData():Boolean;
begin
try
Result:=false;
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete JYOrderCon_Sub_PB where MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete JYOrderCon_Main_PB where MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
Result:=True;
except
ADOQueryCmd.Connection.RollbackTrans;
Result:=False;
Application.MessageBox('数据删除异常!','提示',0);
end;
end;
procedure TfrmContractListPB.TBExportClick(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then Exit;
SelExportData(Tv1,ADOQueryMain,'生产指示单列表');
end;
procedure TfrmContractListPB.TBPrintClick(Sender: TObject);
var
fPrintFile,FeeStr:string;
EngMoney:string;
Fint,i,j:Integer;
begin
if Order_Main.IsEmpty then Exit;
fPrintFile:= ExtractFilePath(Application.ExeName) + 'Report\内销合同.rmf' ;
with ADOQueryPrint do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* ');
sql.Add(' from JYOrderCon_Main_PB A inner join JYOrderCon_Sub_PB B on A.MainId=B.MainId ');
sql.Add(' where A.MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
Open;
end;
SCreateCDS20(ADOQueryPrint,CDS_Print);
SInitCDSData20(ADOQueryPrint,CDS_Print);
with ADOQueryPrint do
begin
Close;
sql.Clear;
sql.Add('select MNote=RTrim(B.MNote),XHInt=Cast(XHNo as int),XHStr=Cast(Null as varchar(20)),B.MNID ');
sql.Add(',A.SYRAddress,A.TelNo,A.FaxNo,A.BankName,A.BankNo,A.CTMAddress,A.CTMTelNo,A.CTMFaxNo');
sql.Add(' from JYOrderCon_Main_PB A left join JYOrderCon_Main_Note_PB B on A.MainId=B.MainId ');
sql.Add(' where A.MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
Open;
end;
SCreateCDS20(ADOQueryPrint,CDS_Note);
SInitCDSData20(ADOQueryPrint,CDS_Note);
if (CDS_Note.RecordCount=1) and (Trim(CDS_Note.fieldbyname('MNID').AsString)='') then
begin
begin
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='解决合同纠纷方式:双方友好协商,协商不成由绍兴当地法院管辖;如因不可抗力造成合同不能履行,违约责任另行协商;';
Post;
end;
CopyAddRowCDS(CDS_Note);
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='本合同一式两份,双方各执一份,合同传真件、邮件形式同为有效,双方签订之日起成立。';
Post;
end;
end;
end else
begin
CopyAddRowCDS(CDS_Note);
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='解决合同纠纷方式:双方友好协商,协商不成由绍兴柯桥当地法院管辖;如因不可抗力造成合同不能履行,违约责任另行协商;';
Post;
end;
CopyAddRowCDS(CDS_Note);
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='本合同一式两份,双方各执一份,合同传真件、邮件形式同为有效,双方签订之日起成立。';
Post;
end;
end;
Fint:=CDS_Note.RecordCount;
i:=7;
if Fint=2 then
begin
with CDS_Note do
begin
First;
while not Eof do
begin
i:=i+1;
Edit;
if i=8 then
begin
FieldByName('XHStr').Value:='八、';
end else
begin
FieldByName('XHStr').Value:='九、';
end;
Post;
Next;
end;
end;
end else
begin
with CDS_Note do
begin
First;
while not Eof do
begin
i:=i+1;
Edit;
if i=8 then
begin
FieldByName('XHStr').Value:='八、';
end else
if i=9 then
begin
FieldByName('XHStr').Value:='九、';
end else
if i=10 then
begin
FieldByName('XHStr').Value:='十、';
end else
if i=11 then
begin
FieldByName('XHStr').Value:='十一、';
end else
if i=12 then
begin
FieldByName('XHStr').Value:='十二、';
end else
if i=13 then
begin
FieldByName('XHStr').Value:='十三、';
end else
if i=14 then
begin
FieldByName('XHStr').Value:='十四、';
end else
if i=15 then
begin
FieldByName('XHStr').Value:='十五、';
end else
if i=16 then
begin
FieldByName('XHStr').Value:='十六、';
end;
Post;
Next;
end;
end;
end;
if FileExists(fPrintFile) then
begin
RMVariables['EngMoney']:=EngMoney;
//RMVariables['FeeStr']:=FeeStr;
//RMVariables['printtime']:=Now;
//RMVariables['printer']:=Trim(gUserName);
RM1.LoadFromFile(fPrintFile);
RM1.ShowReport;
end else
begin
Application.MessageBox(PChar('没有找'+ExtractFilePath(Application.ExeName)+'Report\内销合同.rmf'),'提示',0);
end;
end;
procedure TfrmContractListPB.TBRafreshClick(Sender: TObject);
begin
InitGrid();
TBFind.Click;
end;
procedure TfrmContractListPB.TBAddClick(Sender: TObject);
var
maxno:string;
begin
try
frmConInPutNX:=TfrmConInPutNX.Create(Application);
with frmConInPutNX do
begin
PState:=0;
FMainId:='';
if ShowModal=1 then
begin
end;
end;
finally
frmConInPutNX.Free;
end;
end;
procedure TfrmContractListPB.FormShow(Sender: TObject);
begin
fuserName:=DCode;
InitForm();
SetStatus();
end;
procedure TfrmContractListPB.CheckBox1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmContractListPB.CheckBox2Click(Sender: TObject);
begin
TBRafresh.Click;
end;
procedure TfrmContractListPB.N1Click(Sender: TObject);
var
fPrintFile:string;
Porderno:string;
begin
if Order_Main.IsEmpty then Exit;
fPrintFile:= ExtractFilePath(Application.ExeName) + 'Report\生产指示单10.rmf' ;
SDofilter(ADOQueryMain,' OrderNoM='''+Trim(Order_Main.fieldbyname('OrderNoM').AsString)+'''');
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
Porderno:=Trim(Order_Main.fieldbyname('OrderNoM').AsString);
if FileExists(fPrintFile) then
begin
//RMVariables['begindate']:=begindate.DateTime;
//RMVariables['enddate']:=enddate.DateTime;
//RMVariables['printtime']:=Now;
//RMVariables['printer']:=Trim(gUserName);
RM1.LoadFromFile(fPrintFile);
RM1.ShowReport;
end else
begin
Application.MessageBox(PChar('没有找'+ExtractFilePath(Application.ExeName)+'Report\生产指示单10.rmf'),'提示',0);
end;
SDofilter(ADOQueryMain,'');
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
Order_Main.Locate('ordernoM',Porderno,[]);
end;
procedure TfrmContractListPB.ToolButton1Click(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
try
frmConInPutNX:=TfrmConInPutNX.Create(Application);
with frmConInPutNX do
begin
PState:=1;
FMainId:=Trim(Self.Order_Main.fieldbyname('MainId').AsString);
ToolBar2.Visible:=False;
TBSave.Visible:=False;
ScrollBox1.Enabled:=False;
Tv1.OptionsSelection.CellSelect:=False;
if ShowModal=1 then
begin
end;
end;
finally
frmConInPutNX.Free;
end;
end;
procedure TfrmContractListPB.ToolButton2Click(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
try
frmConInPutNX:=TfrmConInPutNX.Create(Application);
with frmConInPutNX do
begin
PState:=1;
CopyInt:=99;
FMainId:=Trim(Self.Order_Main.fieldbyname('MainId').AsString);
if ShowModal=1 then
begin
end;
end;
finally
frmConInPutNX.Free;
end;
end;
procedure TfrmContractListPB.ToolButton3Click(Sender: TObject);
begin
ModalResult:=1;
end;
procedure TfrmContractListPB.CustomerNoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
end;
procedure TfrmContractListPB.tchkClick(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrderCon_Main_PB SET status=''1'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('内销合同审核')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('审核成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('审核失败!','提示信息',0);
end;
end;
procedure TfrmContractListPB.TnochkClick(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrderCon_Main_PB SET status=''0'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('内销合同撤销审核')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('撤销审核成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('撤销审核失败!','提示信息',0);
end;
end;
procedure TfrmContractListPB.cxTabControl1Change(Sender: TObject);
begin
SetStatus();
TBRafresh.Click;
end;
procedure TfrmContractListPB.TqxClick(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
if Application.MessageBox('确定要取消合同吗?','提示',32+4)<>IDYES then Exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrdercon_Main SET status=''2'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('内销合同取消')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('合同取消成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('合同取消失败!','提示信息',0);
end;
end;
procedure TfrmContractListPB.TnoqxClick(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrdercon_Main SET status=''0'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('内销合同撤销取消')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('撤销合同取消成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('撤销合同取消失败!','提示信息',0);
end;
end;
procedure TfrmContractListPB.ToolButton5Click(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
try
frmFjList_RZ:=TfrmFjList_RZ.Create(Application);
with frmFjList_RZ do
begin
// PState:=1;
//if Trim(DParameters1)<>'高权限' then cxButton1.Visible:=false;
if Self.cxTabControl1.TabIndex<>0 then cxButton1.Visible:=false;
fkeyNO:=Trim(Self.Order_Main.fieldbyname('MainId').AsString);
fType:='合同';
if ShowModal=1 then
begin
end;
end;
finally
frmFjList_RZ.Free;
end;
end;
procedure TfrmContractListPB.Tv1CustomDrawCell(
Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
begin
IF AViewInfo.GridRecord.Values[tv1.GetColumnByFieldName('status').Index]='2' then
ACanvas.Brush.Color:=clLime;
end;
procedure TfrmContractListPB.Tv1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
if Order_Main.IsEmpty=False then
sql.Add('select * from JYOrderCon_Sub_PB A where A.MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''')
else
sql.Add('select * from JYOrderCon_Sub_PB A where 1=2');
Open;
end;
SCreateCDS20(ADOQueryTemp,ClientDataSet2);
SInitCDSData20(ADOQueryTemp,ClientDataSet2);
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,736 @@
unit U_ContractListPBKFSH;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, DBClient, cxCheckBox, cxCalendar, cxSplitter,
RM_Dataset, RM_System, RM_Common, RM_Class, RM_GridReport, RM_e_Xls,
Menus, cxPC, cxButtonEdit, RM_E_llPDF, cxDropDownEdit, cxTextEdit;
type
TfrmContractListPBKFSH = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBEdit: TToolButton;
TBPrint: TToolButton;
TBClose: TToolButton;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
cxGridPopupMenu1: TcxGridPopupMenu;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
TBExport: TToolButton;
v1OrdDate: TcxGridDBColumn;
v1DeliveryDate: TcxGridDBColumn;
v1OrdPerson1: TcxGridDBColumn;
v1ConNo: TcxGridDBColumn;
v1MPRTCF: TcxGridDBColumn;
Order_Main: TClientDataSet;
RMDBDataSet1: TRMDBDataSet;
RMXLSExport1: TRMXLSExport;
v1CustomerNoName: TcxGridDBColumn;
v1PRTOrderQty: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
ADOQueryPrint: TADOQuery;
CDS_Print: TClientDataSet;
v1Column4: TcxGridDBColumn;
Panel1: TPanel;
Label1: TLabel;
Label4: TLabel;
Label5: TLabel;
Label8: TLabel;
Label9: TLabel;
Label12: TLabel;
Label13: TLabel;
BegDate: TDateTimePicker;
EndDate: TDateTimePicker;
CustomerNoName: TEdit;
ConPerson1: TEdit;
MPRTCodeName: TEdit;
ConNo: TEdit;
MPRTKZ: TEdit;
MPRTMF: TEdit;
v1Column2: TcxGridDBColumn;
cxTabControl1: TcxTabControl;
cxSplitter1: TcxSplitter;
ADOQuerySub: TADOQuery;
DataSource2: TDataSource;
v1Column8: TcxGridDBColumn;
Label2: TLabel;
KHConNO: TEdit;
Label3: TLabel;
ToolButton5: TToolButton;
v1Column10: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
ClientDataSet2: TClientDataSet;
cxGridPopupMenu2: TcxGridPopupMenu;
CDS_Note: TClientDataSet;
RM1: TRMGridReport;
v1Column22: TcxGridDBColumn;
Label6: TLabel;
XSType: TComboBox;
RMDBDataSet2: TRMDBDataSet;
v1Column3: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
Label7: TLabel;
Label10: TLabel;
PrtCode: TEdit;
PrtCodeName: TEdit;
v1Column14: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
tnochkkf: TToolButton;
tchkkf: TToolButton;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
v1XHNo: TcxGridDBColumn;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
v1PRTColor: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
cxGridDBColumn9: TcxGridDBColumn;
cxGridDBColumn10: TcxGridDBColumn;
cxGridDBColumn11: TcxGridDBColumn;
cxGridDBColumn12: TcxGridDBColumn;
cxGridDBColumn13: TcxGridDBColumn;
v1Column16: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
v1Column11: TcxGridDBColumn;
v1Column17: TcxGridDBColumn;
ToolButton1: TToolButton;
//RMllPDFExport1: TRMllPDFExport;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBPrintClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure CustomerNoNameChange(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure Tv1CustomDrawCell(Sender: TcxCustomGridTableView;
ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo;
var ADone: Boolean);
procedure Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView;
APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord;
ANewItemRecordFocusingChanged: Boolean);
procedure tchkkfClick(Sender: TObject);
procedure tnochkkfClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private
DQdate:TDateTime;
fuserName,canshu2:string;
procedure InitGrid();
procedure InitForm();
function DelData():Boolean;
procedure SetStatus();
{ Private declarations }
public
FFInt,FCloth:Integer;
canshu1:string;
{ Public declarations }
end;
//var
//frmContractListNX: TfrmContractListNX;
implementation
uses
U_DataLink,U_ConInPutNXKFSH,U_Fun,U_ZDYHelp, U_FjList_RZ;
{$R *.dfm}
procedure TfrmContractListPBKFSH.SetStatus();
begin
tchkkf.Visible:=false;
tnochkkf.Visible:=false;
TBEdit.Visible:=false;
TBPrint.Visible:=false;
ToolButton1.Visible:=false;
if Trim(canshu1)='开发审核' then
begin
case cxTabControl1.TabIndex of
0:begin
tchkkf.Visible:=true;
TBEdit.Visible:=true;
ToolButton1.Visible:=true;
end;
1:begin
tnochkkf.Visible:=true;
end;
end;
end;
end;
procedure TfrmContractListPBKFSH.FormDestroy(Sender: TObject);
begin
//frmContractListNX:=nil;
end;
procedure TfrmContractListPBKFSH.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmContractListPBKFSH.FormCreate(Sender: TObject);
begin
cxgrid1.Align:=alClient;
DQdate:=SGetServerDate(ADOQueryTemp);
end;
procedure TfrmContractListPBKFSH.TBCloseClick(Sender: TObject);
begin
Close;
WriteCxGrid('内销合同',Tv1,'生产指示单管理');
WriteCxGrid('内销合同',Tv2,'生产指示单管理');
end;
procedure TfrmContractListPBKFSH.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(',FHPS=(select sum(X.FHPSHZ) from FHSQ_Main X where X.ConMainId=A.MainId ) ');
sql.Add(',Case when isnull((select count(*) from TP_File where WBID=A.MainID and TFType=''合同'' ),0)>0 ');
sql.Add('then Cast(1 as bit) else Cast(0 as bit) end as FJFlag');
sql.Add(',PrtCode=cast((select distinct '' ''+JCS.PrtCode from JYOrderCon_Sub_PB JCS where JCS.MainId=A.MainId for xml path('''')) as varchar(150))');
sql.Add(',PrtCodeName=cast((select distinct '' ''+JCS.PrtCodeName from JYOrderCon_Sub_PB JCS where JCS.MainId=A.MainId for xml path('''')) as varchar(150))');
sql.Add(',Case when isnull((select count(*) from Cloth_Main where ConMainId=A.MainID ),0)>0 ');
sql.Add('then Cast(1 as bit) else Cast(0 as bit) end as JHDFlag');
sql.Add(',Operor=(select top 1 Operor from SY_SysLog where Acction=''开发内销合同审核'' and OPEvent=''合同号:''+A.ConNo order by OperTime desc)');
sql.Add(',OperTime=(select top 1 OperTime from SY_SysLog where Acction=''开发内销合同审核'' and OPEvent=''合同号:''+A.ConNo order by OperTime desc)');
sql.Add(' from JYOrderCon_Main_PB A where 1=1');
sql.Add(' and A.FillTIme>='''+Trim(FormatDateTime('yyyy-MM-dd',BegDate.DateTime))+'''');
sql.Add(' and A.FillTIme<'''+Trim(FormatDateTime('yyyy-MM-dd',EndDate.DateTime+1))+'''');
case cxTabControl1.TabIndex of
0:begin
SQL.Add(' and isnull(A.status,''0'')=''1''');
end;
1:begin
SQL.Add(' and isnull(A.status,''0'') in (''4'',''3'')');
end;
end;
Open;
end;
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmContractListPBKFSH.InitForm();
begin
ReadCxGrid('内销合同',Tv1,'生产指示单管理');
ReadCxGrid('内销合同11',Tv2,'生产指示单管理');
EndDate.DateTime:=SGetServerDate10(ADOQueryTemp);
BegDate.DateTime:=EndDate.DateTime-60;
end;
procedure TfrmContractListPBKFSH.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
end;
procedure TfrmContractListPBKFSH.TBEditClick(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
try
frmConInPutNXKFSH:=TfrmConInPutNXKFSH.Create(Application);
with frmConInPutNXKFSH do
begin
PState:=1;
FMainId:=Trim(Self.Order_Main.fieldbyname('MainId').AsString);
if ShowModal=1 then
begin
end;
end;
finally
frmConInPutNXKFSH.Free;
end;
end;
function TfrmContractListPBKFSH.DelData():Boolean;
begin
try
Result:=false;
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete JYOrderCon_Sub_PB where MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete JYOrderCon_Main_PB where MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
Result:=True;
except
ADOQueryCmd.Connection.RollbackTrans;
Result:=False;
Application.MessageBox('数据删除异常!','提示',0);
end;
end;
procedure TfrmContractListPBKFSH.TBExportClick(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then Exit;
SelExportData(Tv1,ADOQueryMain,'生产指示单列表');
end;
procedure TfrmContractListPBKFSH.TBPrintClick(Sender: TObject);
var
fPrintFile,FeeStr:string;
EngMoney:string;
Fint,i,j:Integer;
begin
if Order_Main.IsEmpty then Exit;
fPrintFile:= ExtractFilePath(Application.ExeName) + 'Report\内销合同.rmf' ;
with ADOQueryPrint do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* ');
sql.Add(' from JYOrderCon_Main_PB A inner join JYOrderCon_Sub_PB B on A.MainId=B.MainId ');
sql.Add(' where A.MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
Open;
end;
SCreateCDS20(ADOQueryPrint,CDS_Print);
SInitCDSData20(ADOQueryPrint,CDS_Print);
with ADOQueryPrint do
begin
Close;
sql.Clear;
sql.Add('select MNote=RTrim(B.MNote),XHInt=Cast(XHNo as int),XHStr=Cast(Null as varchar(20)),B.MNID ');
sql.Add(',A.SYRAddress,A.TelNo,A.FaxNo,A.BankName,A.BankNo,A.CTMAddress,A.CTMTelNo,A.CTMFaxNo');
sql.Add(' from JYOrderCon_Main_PB A left join JYOrderCon_Main_Note_PB B on A.MainId=B.MainId ');
sql.Add(' where A.MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''');
Open;
end;
SCreateCDS20(ADOQueryPrint,CDS_Note);
SInitCDSData20(ADOQueryPrint,CDS_Note);
if (CDS_Note.RecordCount=1) and (Trim(CDS_Note.fieldbyname('MNID').AsString)='') then
begin
begin
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='解决合同纠纷方式:双方友好协商,协商不成由绍兴当地法院管辖;如因不可抗力造成合同不能履行,违约责任另行协商;';
Post;
end;
CopyAddRowCDS(CDS_Note);
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='本合同一式两份,双方各执一份,合同传真件、邮件形式同为有效,双方签订之日起成立。';
Post;
end;
end;
end else
begin
CopyAddRowCDS(CDS_Note);
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='解决合同纠纷方式:双方友好协商,协商不成由绍兴柯桥当地法院管辖;如因不可抗力造成合同不能履行,违约责任另行协商;';
Post;
end;
CopyAddRowCDS(CDS_Note);
with CDS_Note do
begin
Edit;
FieldByName('XHInt').Value:=Null;
FieldByName('XHStr').Value:=Null;
FieldByName('MNote').Value:='本合同一式两份,双方各执一份,合同传真件、邮件形式同为有效,双方签订之日起成立。';
Post;
end;
end;
Fint:=CDS_Note.RecordCount;
i:=7;
if Fint=2 then
begin
with CDS_Note do
begin
First;
while not Eof do
begin
i:=i+1;
Edit;
if i=8 then
begin
FieldByName('XHStr').Value:='八、';
end else
begin
FieldByName('XHStr').Value:='九、';
end;
Post;
Next;
end;
end;
end else
begin
with CDS_Note do
begin
First;
while not Eof do
begin
i:=i+1;
Edit;
if i=8 then
begin
FieldByName('XHStr').Value:='八、';
end else
if i=9 then
begin
FieldByName('XHStr').Value:='九、';
end else
if i=10 then
begin
FieldByName('XHStr').Value:='十、';
end else
if i=11 then
begin
FieldByName('XHStr').Value:='十一、';
end else
if i=12 then
begin
FieldByName('XHStr').Value:='十二、';
end else
if i=13 then
begin
FieldByName('XHStr').Value:='十三、';
end else
if i=14 then
begin
FieldByName('XHStr').Value:='十四、';
end else
if i=15 then
begin
FieldByName('XHStr').Value:='十五、';
end else
if i=16 then
begin
FieldByName('XHStr').Value:='十六、';
end;
Post;
Next;
end;
end;
end;
if FileExists(fPrintFile) then
begin
RMVariables['EngMoney']:=EngMoney;
//RMVariables['FeeStr']:=FeeStr;
//RMVariables['printtime']:=Now;
//RMVariables['printer']:=Trim(gUserName);
RM1.LoadFromFile(fPrintFile);
RM1.ShowReport;
end else
begin
Application.MessageBox(PChar('没有找'+ExtractFilePath(Application.ExeName)+'Report\内销合同.rmf'),'提示',0);
end;
end;
procedure TfrmContractListPBKFSH.TBRafreshClick(Sender: TObject);
begin
InitGrid();
TBFind.Click;
end;
procedure TfrmContractListPBKFSH.FormShow(Sender: TObject);
begin
fuserName:=DCode;
InitForm();
SetStatus();
end;
procedure TfrmContractListPBKFSH.CheckBox1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmContractListPBKFSH.CheckBox2Click(Sender: TObject);
begin
TBRafresh.Click;
end;
procedure TfrmContractListPBKFSH.N1Click(Sender: TObject);
var
fPrintFile:string;
Porderno:string;
begin
if Order_Main.IsEmpty then Exit;
fPrintFile:= ExtractFilePath(Application.ExeName) + 'Report\生产指示单10.rmf' ;
SDofilter(ADOQueryMain,' OrderNoM='''+Trim(Order_Main.fieldbyname('OrderNoM').AsString)+'''');
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
Porderno:=Trim(Order_Main.fieldbyname('OrderNoM').AsString);
if FileExists(fPrintFile) then
begin
//RMVariables['begindate']:=begindate.DateTime;
//RMVariables['enddate']:=enddate.DateTime;
//RMVariables['printtime']:=Now;
//RMVariables['printer']:=Trim(gUserName);
RM1.LoadFromFile(fPrintFile);
RM1.ShowReport;
end else
begin
Application.MessageBox(PChar('没有找'+ExtractFilePath(Application.ExeName)+'Report\生产指示单10.rmf'),'提示',0);
end;
SDofilter(ADOQueryMain,'');
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
Order_Main.Locate('ordernoM',Porderno,[]);
end;
procedure TfrmContractListPBKFSH.CustomerNoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
end;
procedure TfrmContractListPBKFSH.cxTabControl1Change(Sender: TObject);
begin
SetStatus();
TBRafresh.Click;
end;
procedure TfrmContractListPBKFSH.ToolButton5Click(Sender: TObject);
begin
if Order_Main.IsEmpty then Exit;
try
frmFjList_RZ:=TfrmFjList_RZ.Create(Application);
with frmFjList_RZ do
begin
// PState:=1;
//if Trim(DParameters1)<>'高权限' then cxButton1.Visible:=false;
if Self.cxTabControl1.TabIndex<>0 then cxButton1.Visible:=false;
fkeyNO:=Trim(Self.Order_Main.fieldbyname('MainId').AsString);
fType:='合同';
if ShowModal=1 then
begin
end;
end;
finally
frmFjList_RZ.Free;
end;
end;
procedure TfrmContractListPBKFSH.Tv1CustomDrawCell(
Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
begin
IF AViewInfo.GridRecord.Values[tv1.GetColumnByFieldName('status').Index]='2' then
ACanvas.Brush.Color:=clLime;
end;
procedure TfrmContractListPBKFSH.Tv1FocusedRecordChanged(
Sender: TcxCustomGridTableView; APrevFocusedRecord,
AFocusedRecord: TcxCustomGridRecord;
ANewItemRecordFocusingChanged: Boolean);
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
if Order_Main.IsEmpty=False then
sql.Add('select * from JYOrderCon_Sub_PB A where A.MainId='''+Trim(Order_Main.fieldbyname('MainId').AsString)+'''')
else
sql.Add('select * from JYOrderCon_Sub_PB A where 1=2');
Open;
end;
SCreateCDS20(ADOQueryTemp,ClientDataSet2);
SInitCDSData20(ADOQueryTemp,ClientDataSet2);
end;
procedure TfrmContractListPBKFSH.tchkkfClick(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
if ClientDataSet2.Locate('ZhenZhiNote','',[])=True then
begin
Application.MessageBox('针织要求不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('ZhenZhiNote',null,[])=True then
begin
Application.MessageBox('针织要求不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('ZZSunHao','',[])=True then
begin
Application.MessageBox('织造损耗不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('ZZSunHao',null,[])=True then
begin
Application.MessageBox('织造损耗不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('MeiFenZhuanSu',null,[])=True then
begin
Application.MessageBox('转速/分不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('MeiFenZhuanSu',0,[])=True then
begin
Application.MessageBox('转速/分不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('ZongJieNote',null,[])=True then
begin
Application.MessageBox('批量风险总结不能为空!','提示',0);
Exit;
end;
if ClientDataSet2.Locate('ZongJieNote',null,[])=True then
begin
Application.MessageBox('批量风险总结不能为空!','提示',0);
Exit;
end;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrderCon_Main_PB SET status=''4'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('开发内销合同审核')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('开发审核成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('开发审核失败!','提示信息',0);
end;
end;
procedure TfrmContractListPBKFSH.tnochkkfClick(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
if Order_Main.FieldByName('status').AsString<>'4' then exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrderCon_Main_PB SET status=''1'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('开发内销合同撤销审核')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('撤销开发审核成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('撤销开发审核失败!','提示信息',0);
end;
end;
procedure TfrmContractListPBKFSH.ToolButton1Click(Sender: TObject);
begin
if Order_Main.IsEmpty then exit;
if Application.MessageBox('确定要取消合同吗?','提示',32+4)<>IDYES then Exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update JYOrderCon_Main_PB SET status=''2'' ');
sql.Add('where mainID='+quotedstr(trim(Order_Main.fieldbyname('mainID').AsString)));
sql.Add('insert into SY_SysLog(operor,opertime,Model,acction,opevent,result) values( ');
sql.Add(' '+quotedstr(trim(DName)));
sql.Add(',getdate() ');
sql.Add(','+quotedstr(trim(self.Caption)));
sql.Add(','+quotedstr(trim('内销合同取消')));
sql.Add(','+quotedstr(trim('合同号:'+trim(Order_Main.FieldByName('conNo').AsString))));
sql.Add(','+quotedstr(trim('成功')));
sql.Add(')');
execsql;
end;
application.MessageBox('合同取消成功!','提示信息');
TBRafresh.Click;
except
application.MessageBox('合同取消失败!','提示信息',0);
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,71 @@
unit U_DataLink;
interface
uses
SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels,
Windows,Messages,forms,OleCtnrs,DateUtils, cxClasses;
var
DConString:String; {全局连接字符串}
server, dtbase, user, pswd: String; {数据库连接参数}
DCurHandle:hwnd; //当前窗体句柄
DName:string ; //#用户名#//
DCode:string ; //#用户编号#//
Ddatabase:string; //#数据库名称#//
DTitCaption:string; //#主窗体名称#//
PicSvr: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; //公司
type
TDataLink_ContractManagement = class(TDataModule)
AdoDataLink: TADOQuery;
ADOLink: TADOConnection;
ThreeImgList: TImageList;
ThreeLookAndFeelCol: TcxLookAndFeelController;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
procedure DataModuleDestroy(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_ContractManagement: TDataLink_ContractManagement;
implementation
{$R *.dfm}
procedure TDataLink_ContractManagement.DataModuleDestroy(Sender: TObject);
begin
DataLink_ContractManagement:=nil;
end;
end.

View File

@ -0,0 +1,188 @@
object frmFileUp: TfrmFileUp
Left = 247
Top = 162
Width = 634
Height = 447
Caption = #19978#20256#25991#20214
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object cxGrid7: TcxGrid
Left = 0
Top = 41
Width = 555
Height = 367
Align = alClient
TabOrder = 0
object TV7: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
object FileName: TcxGridDBColumn
Tag = 1
Caption = #25991#20214#21517#31216
DataBinding.FieldName = 'FileName'
FooterAlignmentHorz = taCenter
HeaderAlignmentHorz = taCenter
Width = 121
end
object FileDate: TcxGridDBColumn
Tag = 1
Caption = #19978#20256#26085#26399
DataBinding.FieldName = 'FileDate'
FooterAlignmentHorz = taCenter
HeaderAlignmentHorz = taCenter
Width = 104
end
end
object cxGridLevel6: TcxGridLevel
GridView = TV7
end
end
object Panel16: TPanel
Left = 190
Top = 126
Width = 138
Height = 30
BevelInner = bvRaised
Caption = #27491#22312#19978#20256#12290#12290#12290
Color = clSkyBlue
TabOrder = 1
Visible = False
end
object ToolBar6: TToolBar
Left = 555
Top = 41
Width = 63
Height = 367
Align = alRight
AutoSize = True
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Flat = True
Images = DataLink_DDMD.ThreeImgList
List = True
ShowCaptions = True
TabOrder = 2
object FileUp: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #19978#20256
ImageIndex = 109
Wrap = True
OnClick = FileUpClick
end
object FileDel: TToolButton
Left = 0
Top = 30
AutoSize = True
Caption = #21024#38500
ImageIndex = 17
Wrap = True
OnClick = FileDelClick
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 618
Height = 41
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 3
object Label1: TLabel
Left = 8
Top = 14
Width = 68
Height = 16
Caption = #20135#21697#32534#21495
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Image2: TImage
Left = 537
Top = 17
Width = 23
Height = 16
end
object Code: TEdit
Left = 78
Top = 9
Width = 211
Height = 24
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
ReadOnly = True
TabOrder = 0
end
end
object ODPat: TOpenDialog
Options = [ofReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Left = 404
Top = 197
end
object IdFTP1: TIdFTP
MaxLineAction = maException
ReadTimeout = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
Left = 405
Top = 236
end
object SaveDialog1: TSaveDialog
Left = 409
Top = 285
end
object ADOQueryFile: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 488
Top = 144
end
object DataSource1: TDataSource
DataSet = ADOQueryFile
Left = 392
Top = 168
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 496
Top = 216
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 504
Top = 264
end
end

View File

@ -0,0 +1,357 @@
unit U_FileUp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ComCtrls, ToolWin, ExtCtrls,
cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
cxClasses, cxControls, cxGridCustomView, cxGrid, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB,jpeg,
BtnEdit,IniFiles;
type
TfrmFileUp = class(TForm)
cxGrid7: TcxGrid;
TV7: TcxGridDBTableView;
FileName: TcxGridDBColumn;
FileDate: TcxGridDBColumn;
cxGridLevel6: TcxGridLevel;
Panel16: TPanel;
ToolBar6: TToolBar;
FileUp: TToolButton;
FileDel: TToolButton;
Panel1: TPanel;
Label1: TLabel;
Code: TEdit;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
SaveDialog1: TSaveDialog;
ADOQueryFile: TADOQuery;
DataSource1: TDataSource;
ADOQueryCmd: TADOQuery;
ADOQueryTemp: TADOQuery;
Image2: TImage;
procedure FileUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FileDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
lstPat: TStringList;
AJpeg: TJPEGImage;
procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
procedure SaveImageOther();
procedure ReadINIFile10();
{ Private declarations }
public
CYID:String;
{ Public declarations }
end;
var
frmFileUp: TfrmFileUp;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmFileUp.ReadINIFile10();
var
programIni:Tinifile; //配置文件名
FileName:string;
begin
FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI';
programIni:=Tinifile.create(FileName);
server:=programIni.ReadString('SERVER','服务器地址','127.0.0.1');
programIni.Free;
end;
procedure TfrmFileUp.FileUpClick(Sender: TObject);
var
i,j: Integer;
PatFile: String;
FTPPath,FConNo,MaxNo:string;
AJpeg: TJPEGImage;
begin
if Trim(Code.Text)='' then
begin
Application.MessageBox('编号不能为空!','提示',0);
Exit;
end;
lstPat.Clear;
if ODPat.Execute then
begin
lstPat.AddStrings(ODPat.Files);
end;
if lstPat.Count > 0 then
begin
try
ReadINIFile10();
server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1');
IdFTP1.Host :=server;//PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
IdFTP1.Quit;
Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING);
Exit;
end;
end;
Panel16.Visible:=True;
Panel16.Refresh;
AJpeg:=TJpegImage.Create();
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select Count(*) MM from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add('and filetype=''YP''');
Open;
j:=fieldbyname('MM').AsInteger;
end;
Image2.Picture.LoadFromFile(ODPat.FileName);
AJpeg.Assign(Image2.Picture.Graphic);
CreThumb(AJpeg,Image2,216, 187);
try
ADOQueryCmd.Connection.BeginTrans;
for i := 0 to lstPat.Count - 1 do
begin
PatFile := ExtractFileName(lstPat[i]);
PatFile:=Copy(PatFile,(Pos('.',PatFile)+1),(Length(PatFile)-Pos('.',PatFile)) ) ;
FConNo:=Trim(Code.Text);
while Pos('/',FConNo)>0 do
begin
Delete(FConNo,Pos('/',FConNo),1);
end;
PatFile:=Trim(FConNo)+'-'+Inttostr(j+i+1)+'.'+PatFile;
if IdFTP1.Connected then
begin
try
{if not DirectoryExists('D:\图片\'+Trim(gDef1)) then
ForceDirectories('D:\图片\'+Trim(gDef1)); }
IdFTP1.Put(lstPat[i], Trim('\YP')+'\'+Trim(PatFile));
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and filename='''+Trim(PatFile)+'''');
SQL.Add(' and filetype=''YP''');
Open;
if not IsEmpty then
begin
Panel16.Visible:=False;
Application.MessageBox(PChar('文件<'+Trim(PatFile)+'>重复,'+inttostr(i)+'个文件上传成功!'),'提示',0);
Exit;
end;
end;
if GetLSNo(ADOQueryCmd,MaxNo,'YP','XD_File',4,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取图片最大号失败!','提示',0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where 1<>1');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('XFID').Value:=Trim(MaxNo);
FieldByName('CYID').Value:=Trim(CYID);
FieldByName('CYNO').Value:=Trim(Code.Text);
FieldByName('filename').Value:=Trim(PatFile);
FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp);
fieldbyname('FileType').value:=Trim('YP');
Post;
end;
except
//ADOQueryCmd.Connection.RollbackTrans;
//Application.MessageBox('图片上传失败!','提示',0);
end;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update CP_YDang Set TPFlag=1 where CYID='''+Trim(CYID)+'''');
ExecSQL;
end;
SaveImageOther();
ADOQueryCmd.Connection.CommitTrans;
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('图片上传失败!','提示',0);
end;
if IdFTP1.Connected then IdFTP1.Quit;
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
open;
end;
Panel16.Visible:=False;
if i>0 then
Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0);
ModalResult:=1;
end;
procedure TfrmFileUp.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := AJPeg.Width /AJPeg.Height;
if Ratio > 1.333 then
begin
AHeight := Round(Width / Ratio);
AHeightOffset := (Height - AHeight) div 2;
AWidth := Width;
AWidthOffset := 0;
end
else
begin
AWidth := Round(Height * Ratio);
AWidthOffset := (Width - AWidth) div 2;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, AJPeg);
Image1.Picture.Assign(BitMap);
finally
Bitmap.Free;
end;
end;
procedure TfrmFileUp.SaveImageOther();
var
AJpeg: TJPEGImage;
myStream: TADOBlobStream;
ImgMaxNo:String;
i,j: Integer;
PatFile: String;
FTPPath,FConNo,MaxNo,FTFID:string;
begin
if Image2.Picture=nil then Exit;
AJpeg:=TJpegImage.Create();
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from TP_File where WBID='''+Trim(CYID)+'''');
Open;
end;
FTFID:=Trim(ADOQueryTemp.fieldbyname('TFID').AsString);
if Trim(FTFID)='' then
begin
if GetLSNo(ADOQueryCmd,ImgMaxNo,'TF','TP_File',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取图片表最大号失败!','提示',0);
Exit;
end;
end else
begin
ImgMaxNo:=Trim(FTFID);
end;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add( ' select * from TP_File where TFID='''+Trim(FTFID)+'''');
open;
end;
with ADOQueryCmd do
begin
if Trim(FTFID)='' then
begin
Append;
FieldByName('Filler').Value:=Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('TFID').Value:=Trim(ImgMaxNo);
FieldByName('WBID').Value:=Trim(CYID);
//FieldByName('TFIdx').Value:=cxTabControl2.TabIndex;
FieldByName('TFType').Value:='样品';
AJpeg.Assign(Image2.Picture.Graphic);
//CreThumb(AJpeg,Image1,160, 120);
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
AJpeg.Assign(Image2.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
end;
procedure TfrmFileUp.FormCreate(Sender: TObject);
begin
lstPat := TStringList.Create;
end;
procedure TfrmFileUp.FileDelClick(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add(' Delete XD_File where XFID='''+Trim(ADOQueryFile.fieldbyname('XFID').AsString)+'''');
SQL.Add(' Delete TP_File where WBID='''+Trim(CYID)+''' and TFType=''样品'' ');
ExecSQL;
end;
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
open;
end;
if ADOQueryFile.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update CP_YDang Set TPFlag=0 where CYID='''+Trim(CYID)+'''');
ExecSQL;
end;
end;
end;
procedure TfrmFileUp.FormShow(Sender: TObject);
begin
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
Open;
end;
end;
end.

View File

@ -0,0 +1,183 @@
object frmFjList_RZ: TfrmFjList_RZ
Left = 177
Top = 159
Width = 796
Height = 501
BorderIcons = [biSystemMenu, biMinimize]
Caption = #38468#20214#20449#24687
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ListView1: TListView
Left = 40
Top = 20
Width = 429
Height = 77
Columns = <>
TabOrder = 0
OnDblClick = ListView1DblClick
end
object Panel1: TPanel
Left = 629
Top = 0
Width = 151
Height = 462
Align = alRight
TabOrder = 1
object FileName: TcxButton
Left = 30
Top = 60
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #28155#21152
TabOrder = 0
OnClick = FileNameClick
LookAndFeel.Kind = lfOffice11
end
object cxButton1: TcxButton
Left = 30
Top = 96
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #21024#38500
TabOrder = 1
OnClick = cxButton1Click
LookAndFeel.Kind = lfOffice11
end
object cxButton2: TcxButton
Left = 30
Top = 132
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #19979#36733
TabOrder = 2
OnClick = cxButton2Click
LookAndFeel.Kind = lfOffice11
end
object cxButton3: TcxButton
Left = 30
Top = 172
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #20851#38381
TabOrder = 3
Visible = False
OnClick = cxButton3Click
LookAndFeel.Kind = lfOffice11
end
end
object Panel2: TPanel
Left = 176
Top = 140
Width = 193
Height = 41
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = 'Panel2'
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
Visible = False
OnDblClick = Panel2DblClick
end
object cxGrid1: TcxGrid
Left = 0
Top = 20
Width = 593
Height = 345
TabOrder = 3
object Tv1: TcxGridDBTableView
OnDblClick = Tv1DblClick
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.Editing = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
object v1Column1: TcxGridDBColumn
Caption = #25991#20214#21517#31216
DataBinding.FieldName = 'FileName'
HeaderAlignmentHorz = taCenter
Width = 146
end
object v1Column4: TcxGridDBColumn
Caption = #25991#20214#20462#25913#26102#38388
DataBinding.FieldName = 'TFdate'
HeaderAlignmentHorz = taCenter
Width = 140
end
object v1Column2: TcxGridDBColumn
Caption = #25805#20316#21592
DataBinding.FieldName = 'Filler'
HeaderAlignmentHorz = taCenter
Width = 83
end
object v1Column3: TcxGridDBColumn
Caption = #19978#20256#26102#38388
DataBinding.FieldName = 'FillTime'
HeaderAlignmentHorz = taCenter
Width = 140
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
object ADOQueryTmp: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 520
Top = 28
end
object ADOQueryCmd: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 568
Top = 32
end
object ImageList1: TImageList
Left = 536
Top = 228
end
object IdFTP1: TIdFTP
MaxLineAction = maException
ReadTimeout = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
Left = 500
Top = 198
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 532
Top = 240
end
object DataSource1: TDataSource
DataSet = ADOQueryTmp
Left = 548
Top = 140
end
end

View File

@ -0,0 +1,400 @@
unit U_FjList_RZ;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, Menus, cxLookAndFeelPainters, StdCtrls,
cxButtons, DB, ADODB, ImgList,shellapi, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid;
type
TfrmFjList_RZ = class(TForm)
ListView1: TListView;
Panel1: TPanel;
FileName: TcxButton;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
ImageList1: TImageList;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
DataSource1: TDataSource;
v1Column4: TcxGridDBColumn;
procedure cxButton3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FileNameClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
private
procedure InitData();
{ Private declarations }
public
fkeyNO:string;
fType:string;
fId:integer;
fstatus:integer;
// fmanage:string;
{ Public declarations }
end;
var
frmFjList_RZ: TfrmFjList_RZ;
implementation
uses
U_DataLink,U_Fun,U_CompressionFun;
{$R *.dfm}
procedure TfrmFjList_RZ.InitData();
var
ListItem: TListItem;
Flag: Cardinal;
info: SHFILEINFOA;
Icon: TIcon;
begin
ListView1.Items.Clear;
try
with adoqueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
open;
{ if not IsEmpty then
begin
while not eof do
begin
with ListView1 do
begin
LargeImages := ImageList1;
Icon := TIcon.Create;
ListItem := Items.Add;
Listitem.Caption := trim(fieldbyname('fileName').AsString);
// Listitem.SubItems.Add(OpenDiaLog.FileName);
Flag := (SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
SHGetFileInfo(Pchar(trim(fieldbyname('fileName').AsString)), 0, info, Sizeof(info), Flag);
Icon.Handle := info.hIcon;
ImageList1.AddIcon(Icon);
ListItem.ImageIndex := ImageList1.Count - 1;
end;
next;
end;
end; }
end;
except
end;
end;
procedure TfrmFjList_RZ.cxButton3Click(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Items.Free;
ModalResult:=-1;
end;
procedure TfrmFjList_RZ.FormDestroy(Sender: TObject);
begin
frmFjList_RZ:=nil;
end;
procedure TfrmFjList_RZ.FileNameClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName:string;
fFilePath:string;
maxNo:string;
// myStream: TADOBlobStream;
FJStream : TMemoryStream;
mfileSize:integer;
mCreationTime:TdateTime;
mWriteTime:TdateTime;
begin
try
adoqueryCmd.Connection.BeginTrans;
OpenDiaLog := TOpenDialog.Create(Self);
if OpenDiaLog.Execute then
begin
fFilePath:=OpenDiaLog.FileName;
fFileName:=ExtractFileName(OpenDiaLog.FileName);
Panel2.Caption:='正在上传数据,请稍等...';
Panel2.Visible:=true;
application.ProcessMessages;
if GetLSNo(ADOQueryCmd,maxNo,'FJ','TP_File',4,1)=False then
begin
adoqueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败!','提示',0);
Exit;
end;
//获取文件信息
GetFileInfo(fFilePath,mfileSize,mCreationTime,mWriteTime);
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where TFID='+quotedstr(trim(maxNO)));
execsql;
end;
try
FJStream:=TMemoryStream.Create;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where TFID='+quotedstr(trim(maxNO)));
// sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
// sql.Add('and TFType='+quotedstr(trim(fType)));
// sql.Add('and FileName='+quotedstr(trim(fFileName)));
open;
append;
fieldbyname('TFID').Value:=trim(maxNO);
fieldbyname('WBID').Value:=trim(fkeyNO);
fieldbyname('TFType').Value:=trim(fType);
fieldbyname('Filler').Value:=trim(DName);
fieldbyname('FileName').Value:=trim(fFileName);
fieldbyname('TFDate').Value:=mWriteTime;
FJStream.LoadFromFile(fFilePath);
CompressionStream(FJStream);
tblobfield(FieldByName('Filesother')).LoadFromStream(FJStream);
post;
end;
Panel2.Visible:=false;
initdata();
finally
FJStream.Free;
end;
end;
adoqueryCmd.Connection.CommitTrans;
except
adoqueryCmd.Connection.RollbackTrans;
application.MessageBox('附件保存失败!','提示信息',0);
end;
end;
procedure TfrmFjList_RZ.FormCreate(Sender: TObject);
begin
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='';
Connected:=true;
end;
cxGrid1.Align:=alclient;
fstatus:=0;
end;
procedure TfrmFjList_RZ.FormShow(Sender: TObject);
begin
IF fstatus=0 then Panel1.Visible:=true
else Panel1.Visible:=false;
initdata();
end;
procedure TfrmFjList_RZ.ListView1DblClick(Sender: TObject);
var
sFieldName:string;
fileName:string;
begin
if ListView1.Items.Count<1 THEN EXIT;
if listView1.SelCount<1 then exit;
sFieldName:='D:\图片查看';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil);
fileName:=ListView1.Selected.Caption;
sFieldName:=sFieldName+'\'+trim(fileName);
try
IdFTP1.Host := PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
if IdFTP1.Connected then
begin
Panel2.Caption:='正在下载数据,请稍等...';
Panel2.Visible:=true;
application.ProcessMessages;
try
IdFTP1.Get('FJ\'+ Trim(fileName), sFieldName,false, true);
except
Panel2.Visible:=false;
Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Panel2.Visible:=false;
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
Panel2.Visible:=false;
if IdFTP1.Connected then IdFTP1.Quit;
ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
end;
procedure TfrmFjList_RZ.cxButton1Click(Sender: TObject);
var
fFileName:string;
fFilePath:string;
begin
// if listView1.SelCount<1 then exit;
IF ADOQueryTmp.IsEmpty then exit;
try
// fFileName:=ListView1.Selected.Caption;
// ADOQueryTmp.Locate('fileName',fFileName,[]);
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where TFID='+quotedstr(trim(ADOQueryTmp.fieldbyname('TFID').AsString)));
// sql.Add('and TFType='+quotedstr(trim(fType)));
// sql.Add('and FileName='+quotedstr(trim(fFileName)));
execsql;
end;
initData();
except
end;
end;
procedure TfrmFjList_RZ.cxButton2Click(Sender: TObject);
var
SaveDialog: TSaveDialog;
fFileName:string;
fFilePath:string;
ff: TADOBlobStream;
FJStream : TMemoryStream;
begin
if adoqueryTmp.IsEmpty then exit;
try
fFileName:=adoqueryTmp.fieldbyname('FileName').AsString;
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.FileName:=fFileName;
if SaveDialog.Execute then
begin
Panel2.Caption:='正在保存数据,请稍等...';
Panel2.Visible:=true;
application.ProcessMessages;
fFilePath:=SaveDialog.FileName;
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
fjStream:= TMemoryStream.Create ;
ff.SaveToStream(fjStream);
UnCompressionStream(fjStream);
fjStream.SaveToFile(fFilePath);
// ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
finally
fjStream.free;
ff.Free;
end;
Panel2.Visible:=false;
// if IdFTP1.Connected then IdFTP1.Quit;
end;
except
Panel2.Visible:=false;
end;
end;
procedure TfrmFjList_RZ.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId=10 then Action:=cafree
else
Action:=cahide;
end;
procedure TfrmFjList_RZ.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible:=false;
end;
procedure TfrmFjList_RZ.Tv1DblClick(Sender: TObject);
var
sFieldName:string;
fileName:string;
ff: TADOBlobStream;
FJStream : TMemoryStream;
begin
IF adoqueryTmp.IsEmpty then exit;
sFieldName:='D:\图片查看';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil);
fileName:=adoqueryTmp.fieldbyname('FileName').AsString;
sFieldName:=sFieldName+'\'+trim(fileName);
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
fjStream:= TMemoryStream.Create ;
ff.SaveToStream(fjStream);
UnCompressionStream(fjStream);
fjStream.SaveToFile(sFieldName);
ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
finally
fjStream.free;
ff.Free;
end;
end;
end.

View File

@ -0,0 +1,275 @@
unit U_GetDllForm;
interface
uses
Windows, Messages, forms, OleCtnrs, DateUtils, SysUtils, ADODB, Dxcore,
activex;
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;
implementation
uses
U_DataLink, U_ContractListPB, U_ContractListPBKFSH;
/////////////////////////////////////////////////////////////////
// 功能说明:取Dll中得窗体 //
// 参数说明App>>调用应用程序; //
// FormH>>调用窗口句柄 //
// FormID>>窗口号; //
// Language>>语言种类; //
// WinStyle>>窗口类型; //
/////////////////////////////////////////////////////////////////
var
frmContractListPBLR, frmContractListPBChk, frmContractListPBCX: TfrmContractListPB;
frmContractListPBKFChk: TfrmContractListPBKFSH;
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;
MainApplication := App;
DCurHandle := FormH;
IsDelphiLanguage := Language;
Application := TApplication(App);
DCurHandle := 0;
//赋值链接字符串
SetLength(server, 255);
SetLength(dtbase, 255);
SetLength(user, 255);
SetLength(pswd, 255);
server := '101.132.143.144,7781';
dtbase := 'WuJiadata';
user := 'rtsa';
pswd := 'rightsoft@5740';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
DConString := DataBaseStr;
if not ConnData() then
begin
result := 0;
exit;
end;
// 定义窗口类型 、状态
if WinStyle = 0 then
begin
mstyle := fsMDIChild;
mstate := wsMaximized;
mborderstyle := bsSizeable;
end
else
begin
mstyle := fsNormal;
mstate := wsNormal;
mborderstyle := bsSizeable;
end;
/////////////////////
//调用子模块窗口
case FormID of
101: //销售合同录入
begin
bFound := FALSE;
for i := (App.MainForm.MDIChildCount - 1) downto 0 do
begin
if App.MainForm.MDIChildren[i].Caption = '销售合同录入' then
begin
BringWindowToTop(frmContractListPBLR.Handle);
bFound := TRUE;
Break;
end;
end;
if not bFound then
//if frmBaoGuanListBGZL=nil then
begin
frmContractListPBLR := TfrmContractListPB.Create(application.MainForm);
with frmContractListPBLR do
begin
canshu1 := '录入';
Title := '销售合同录入';
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmContractListPBLR.BringToFront;
//句柄
mnewHandle := frmContractListPBLR.Handle;
end;
102: //销售合同审核
begin
bFound := FALSE;
for i := (App.MainForm.MDIChildCount - 1) downto 0 do
begin
if App.MainForm.MDIChildren[i].Caption = '销售合同审核' then
begin
BringWindowToTop(frmContractListPBChk.Handle);
bFound := TRUE;
Break;
end;
end;
if not bFound then
//if frmBaoGuanListBGZL=nil then
begin
frmContractListPBChk := TfrmContractListPB.Create(application.MainForm);
with frmContractListPBChk do
begin
canshu1 := '高权限';
Title := '销售合同审核';
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmContractListPBChk.BringToFront;
//句柄
mnewHandle := frmContractListPBChk.Handle;
end;
104: //销售合同开发审核
begin
bFound := FALSE;
for i := (App.MainForm.MDIChildCount - 1) downto 0 do
begin
if App.MainForm.MDIChildren[i].Caption = '销售合同开发审核' then
begin
BringWindowToTop(frmContractListPBKFChk.Handle);
bFound := TRUE;
Break;
end;
end;
if not bFound then
//if frmBaoGuanListBGZL=nil then
begin
frmContractListPBKFChk := TfrmContractListPBKFSH.Create(application.MainForm);
with frmContractListPBKFChk do
begin
canshu1 := '开发审核';
Title := '销售合同开发审核';
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmContractListPBKFChk.BringToFront;
//句柄
mnewHandle := frmContractListPBKFChk.Handle;
end;
103: //销售合同查看
begin
bFound := FALSE;
for i := (App.MainForm.MDIChildCount - 1) downto 0 do
begin
if App.MainForm.MDIChildren[i].Caption = '销售合同查看' then
begin
BringWindowToTop(frmContractListPBCX.Handle);
bFound := TRUE;
Break;
end;
end;
if not bFound then
//if frmBaoGuanListBGZL=nil then
begin
frmContractListPBCX := TfrmContractListPB.Create(application.MainForm);
with frmContractListPBCX do
begin
canshu1 := '查看';
Title := '销售合同查看';
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmContractListPBCX.BringToFront;
//句柄
mnewHandle := frmContractListPBCX.Handle;
end;
end;
Result := mnewHandle;
// NewDllApp := Application;
end;
//===========================================================
//建立数据库连接池
//===========================================================
function ConnData(): Boolean;
begin
if not Assigned(DataLink_ContractManagement) then
DataLink_ContractManagement := TDataLink_ContractManagement.Create(Application);
try
with DataLink_ContractManagement.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
// OldDllApp := Application;
//
//finalization
// DataLink_ContractManagement.Free;
// Application := OldDllApp;
initialization
CoInitialize(nil);
dxUnitsLoader.Initialize;
finalization
DataLink_ContractManagement.Free;
application := NewDllApp;
dxUnitsLoader.Finalize;
end.

View File

@ -0,0 +1,313 @@
object frmLabelAdd: TfrmLabelAdd
Left = 191
Top = 109
Width = 997
Height = 612
BorderIcons = [biMaximize]
Caption = #26631#31614#32534#36753
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Panel1: TPanel
Left = 0
Top = 28
Width = 413
Height = 513
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object Label2: TLabel
Left = 31
Top = 21
Width = 60
Height = 12
Caption = #26631#31614#25991#20214#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label3: TLabel
Left = 31
Top = 95
Width = 60
Height = 12
Caption = #22791' '#27880#65306
end
object Label9: TLabel
Left = 31
Top = 71
Width = 60
Height = 12
Caption = #26631#31614#21517#31216#65306
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label10: TLabel
Left = 31
Top = 47
Width = 60
Height = 12
Caption = #26631#31614#31867#22411#65306
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object LabelFileName: TBtnEditA
Left = 92
Top = 17
Width = 260
Height = 20
ReadOnly = True
TabOrder = 0
OnBtnClick = LabelFileNameBtnClick
end
object beizhu: TMemo
Left = 92
Top = 92
Width = 257
Height = 149
ScrollBars = ssBoth
TabOrder = 1
end
object LabelCaption: TEdit
Left = 92
Top = 67
Width = 258
Height = 20
ReadOnly = True
TabOrder = 2
end
object LabelType: TFTComboBox
Tag = 99
Left = 92
Top = 43
Width = 260
Height = 20
Style = csDropDownList
ItemHeight = 12
ItemIndex = 0
TabOrder = 3
Text = #20013#25991#26631#31614
Items.Strings = (
#20013#25991#26631#31614
#33521#25991#26631#31614
#20013#33521#25991#26631#31614)
end
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 981
AutoSize = True
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar2'
Color = clBtnFace
Flat = True
Images = DataLink_CYZZ.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 1
Transparent = False
object Tsave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384#26631#31614
ImageIndex = 5
OnClick = TsaveClick
end
object Tclose: TToolButton
Left = 87
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TcloseClick
end
end
object RMPreview1: TRMPreview
Left = 428
Top = 32
Width = 553
Height = 541
Align = alRight
BevelOuter = bvLowered
Caption = #26631#31614#39044#35272
TabOrder = 2
OnDblClick = RMPreview1DblClick
Options.RulerUnit = rmutScreenPixels
Options.RulerVisible = False
Options.DrawBorder = False
Options.BorderPen.Color = clGray
Options.BorderPen.Style = psDash
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_CYZZ.ADOLink
CommandTimeout = 300
Parameters = <>
Left = 512
Top = 208
end
object OpenDialog1: TOpenDialog
Filter = 'RMFl(*.rmf)|*.rmf'
InitialDir = '.'
Left = 200
Top = 4
end
object RMGridReport1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
ShowProgress = False
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
Preview = RMPreview1
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 = 336
Top = 8
ReportData = {}
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_CYZZ.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 528
Top = 184
end
object RMGridReportDesigner1: TRMGridReportDesigner
Left = 376
Top = 8
end
object RMBarCodeObject1: TRMBarCodeObject
Left = 280
Top = 4
end
object RMBMPExport1: TRMBMPExport
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
Left = 408
Top = 8
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 10
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 440
Top = 8
end
object RMDS_Main: TRMDBDataSet
Visible = True
AliasName = #26631#31614#25968#25454
Left = 498
Top = 72
end
object RMDataDictionary1: TRMDataDictionary
FieldFieldNames.TableName = 'TableName'
FieldFieldNames.FieldName = 'FieldName'
FieldFieldNames.FieldAlias = 'FieldAlias'
Left = 562
Top = 72
end
object ADOQuery1: TADOQuery
Connection = DataLink_CYZZ.ADOLink
Parameters = <>
Left = 352
Top = 480
end
object RMGridReport2: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
ShowProgress = False
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDS_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 432
Top = 368
ReportData = {}
end
object ADOQueryCmdSC: TADOQuery
Connection = DataLink_CYZZ.ADOLink
Parameters = <>
Left = 296
Top = 304
object ADOQueryCmdFileContent: TBlobField
FieldName = 'Files'
end
object ADOQueryCmdFtFileName: TStringField
FieldName = 'FileName'
Size = 40
end
object ADOQueryCmdFileEditDate: TDateTimeField
FieldName = 'FileEditDate'
end
object ADOQueryCmdFileSize: TFloatField
FieldName = 'FileSize'
end
object ADOQueryCmdFiller: TStringField
FieldName = 'Filler'
end
object ADOQueryCmdLastEditTime: TDateTimeField
FieldName = 'LastEditTime'
end
object ADOQueryCmdLastEditer: TStringField
FieldName = 'LastEditer'
end
object ADOQueryCmdFileCreateDate: TDateTimeField
FieldName = 'FileCreateDate'
end
object ADOQueryCmdchildPath: TStringField
FieldName = 'FilePath'
end
object ADOQueryCmdFileType: TStringField
FieldName = 'FileType'
end
end
end

View File

@ -0,0 +1,455 @@
unit U_LabelAdd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, ExtCtrls, DB, ADODB,
RM_System, RM_Common, RM_Class, RM_GridReport, Buttons, FTComboBox,
RM_Preview, RM_e_Xls, RM_e_Graphic, RM_e_bmp, RM_BarCode,
RM_DsgGridReport, RM_Dataset, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid;
type
TfrmLabelAdd = class(TForm)
Panel1: TPanel;
Label2: TLabel;
Label3: TLabel;
LabelFileName: TBtnEditA;
beizhu: TMemo;
ToolBar1: TToolBar;
Tsave: TToolButton;
Tclose: TToolButton;
ADOQueryCmd: TADOQuery;
OpenDialog1: TOpenDialog;
RMGridReport1: TRMGridReport;
Label9: TLabel;
LabelCaption: TEdit;
Label10: TLabel;
LabelType: TFTComboBox;
ADOQueryTmp: TADOQuery;
RMPreview1: TRMPreview;
RMGridReportDesigner1: TRMGridReportDesigner;
RMBarCodeObject1: TRMBarCodeObject;
RMBMPExport1: TRMBMPExport;
RMXLSExport1: TRMXLSExport;
RMDS_Main: TRMDBDataSet;
RMDataDictionary1: TRMDataDictionary;
ADOQuery1: TADOQuery;
RMGridReport2: TRMGridReport;
ADOQueryCmdSC: TADOQuery;
ADOQueryCmdFileContent: TBlobField;
ADOQueryCmdFtFileName: TStringField;
ADOQueryCmdFileEditDate: TDateTimeField;
ADOQueryCmdFileSize: TFloatField;
ADOQueryCmdFiller: TStringField;
ADOQueryCmdLastEditTime: TDateTimeField;
ADOQueryCmdLastEditer: TStringField;
ADOQueryCmdFileCreateDate: TDateTimeField;
ADOQueryCmdchildPath: TStringField;
ADOQueryCmdFileType: TStringField;
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TsaveClick(Sender: TObject);
procedure LabelFileNameBtnClick(Sender: TObject);
procedure BtOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RMPreview1DblClick(Sender: TObject);
private
fIsChg:Boolean;
function SaveData():Boolean;
function EditData():Boolean;
procedure InitWinData();
procedure InitVarDictionary();
procedure InitDataSetDictionary();
function PostFileToData():boolean;
procedure GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime);
function CovFileDate(Fd:_FileTime):TDateTime;
public
fcustomNo:string;
fKeyNo:string;
fWinStatus:integer;
end;
var
frmLabelAdd: TfrmLabelAdd;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmLabelAdd.TcloseClick(Sender: TObject);
begin
if fIsChg then
begin
if application.MessageBox('标签设计过,是否要保存?','提示信息',1)=1 then
begin
Tsave.Click ;
end
else
close;
end
else
close;
end;
procedure TfrmLabelAdd.FormCreate(Sender: TObject);
begin
panel1.Align :=alClient;
fIsChg:=false;
// ClearWinData(panel1);
// InitVarDictionary();
end;
procedure TfrmLabelAdd.TsaveClick(Sender: TObject);
begin
if trim(labelCaption.Text)='' then
begin
application.MessageBox('标签名称不能为空!','提示');
labelCaption.SetFocus;
exit;
end;
if trim(LabelFileName.Text)='' then
begin
application.MessageBox('标签文件不能为空,请选择标签!','提示');
LabelFileName.SetFocus;
exit;
end;
PostFileToData();
if fWinStatus=0 then
begin
if SaveData() then
begin
ModalResult:=1;
end;
end
else
begin
if EditData() then
begin
ModalResult:=1;
end;
end;
end;
function TfrmLabelAdd.PostFileToData():boolean;
var
mFileName,fFileName,fpathFileName:string;
Stream : TMemoryStream;
mfileSize:integer;
mCreationTime:TdateTime;
mWriteTime:TdateTime;
begin
result:=false;
fFileName:=Trim(LabelCaption.Text);
fpathFileName:=Trim(LabelFileName.Text);
try
ADOQueryCmdSC.Connection.BeginTrans ;
try
with ADOQueryCmdSC do
begin
close;
sql.Clear ;
sql.Add('delete from RT_FileUpdate');
sql.Add('where FileName='+quotedStr(trim(fFileName)));
execsql;
end;
with ADOQueryCmdSC do
begin
close;
sql.Clear ;
sql.Add('select * from RT_FileUpdate');
sql.Add('where FileName='+quotedStr(trim(fFileName)));
Open;
//////////////////////////
//获取文件信息
GetFileInfo(Trim(fpathFileName),mfileSize,mCreationTime,mWriteTime);
if RecordCount<=0 then
begin
Append;
fieldByName('FileName').AsString := trim(fFileName);
end
else
begin
edit;
end;
fieldByName('FileEditDate').Value :=mWriteTime;
fieldByName('FileCreateDate').Value :=mCreationTime;
fieldByName('FileSize').Value :=mfileSize;
fieldByName('Filler').Value :=Dname;
fieldByName('LastEditer').Value :=Dname;
fieldByName('LastEditTime').Value :=SGetServerDateTime(ADOQueryTmp);
if pos('.rmf',fFileName)>0 then
begin
fieldByName('FilePath').Value :='report';
fieldByName('FileType').Value :='公用';
end
else if pos('.dll',fFileName)>0 then
begin
fieldByName('FilePath').Value :='';
fieldByName('FileType').Value :='一般';
end
else
begin
fieldByName('FilePath').Value :='';
fieldByName('FileType').Value :='公用';
end;
//将OLE数据存入数据库
ADOQueryCmdFileContent.LoadFromFile(fpathFileName);
//ADOQueryCmdFileContent.LoadFromStream(Stream);
post;
end;
finally
end;
result:=true;
ADOQueryCmdSC.Connection.CommitTrans ;
except
ADOQueryCmdSC.Connection.RollbackTrans ;
Result:=False;
application.MessageBox(pchar('提交文件['+trim(fFileName)+']失败!'),'提示信息',MB_ICONERROR);
end;
end;
procedure TfrmLabelAdd.GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime);
var
vSearchRec: TSearchRec;
begin
FindFirst(mFile,faAnyFile,vSearchRec);
mfileSize:=vSearchRec.Size;
CreationTime:=CovFileDate(vSearchRec.FindData.ftCreationTime);//创建时间
//vSearchRec.FindData.ftLastAccessTime//访问时间
WriteTime:=CovFileDate(vSearchRec.FindData.ftLastWriteTime);//修改时间
FindClose(vSearchRec);
end;
function TfrmLabelAdd.CovFileDate(Fd:_FileTime):TDateTime;
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
CovFileDate:=SystemTimeToDateTime(Tct);
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelAdd.SaveData():Boolean;
begin
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from P_Label');
sql.Add('where 1<>1');
Open;
Append;
fieldByName('filler').value:=DName;
fieldByName('filltime').value:=DServerDate;
fieldByName('beizhu').value:= trim(beizhu.text);
fieldByName('LabelCaption').value:=trim(LabelCaption.text);
fieldByName('LabelType').value:=trim(LabelType.text);
fieldByName('LabelFileName').value:= trim(LabelFileName.text);
//TBlobField(FieldByName('LabelFile')).LoadFromStream(fStream);
RMGridReport1.SaveToBlobField(TBlobField(FieldByName('LabelFile')));
Post;
end;
with ADOQueryTmp do
begin
Close;
sql.Clear;
sql.Add('select * from P_Label where LabelCaption='''+Trim(LabelCaption.text)+'''');
Open;
end;
if ADOQueryTmp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Result:=False;
Application.MessageBox('标签名称重复!','提示',0);
Exit;
end;
ADOQueryCmd.Connection.CommitTrans;
result:=true;
except
ADOQueryCmd.Connection.RollbackTrans;
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelAdd.EditData():Boolean;
begin
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from P_Label');
sql.Add('where labelId='+fkeyNo);
Open;
Edit;
fieldByName('LabelCaption').value:=trim(LabelCaption.text);
fieldByName('LabelType').value:=trim(LabelType.text);
fieldByName('LabelFileName').value:= trim(LabelFileName.text);
RMGridReport1.SaveToBlobField(TBlobField(FieldByName('LabelFile')));
fieldByName('Editer').value:=DName;
fieldByName('EditTime').value:=DServerDate;
fieldByName('beizhu').value:= trim(beizhu.text);
Post;
end;
with ADOQueryTmp do
begin
Close;
sql.Clear;
sql.Add('select * from P_Label where LabelCaption='''+Trim(LabelCaption.text)+'''');
Open;
end;
if ADOQueryTmp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Result:=False;
Application.MessageBox('标签名称重复!','提示',0);
Exit;
end;
ADOQueryCmd.Connection.CommitTrans;
result:=true;
except
ADOQueryCmd.Connection.RollbackTrans;
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
procedure TfrmLabelAdd.LabelFileNameBtnClick(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
LabelFileName.Text:=OpenDialog1.FileName;
LabelCaption.Text:=Trim(ExtractFileName(OpenDialog1.FileName));
RMGridReport1.LoadFromFile(LabelFileName.Text);
RMGridReport1.Preview :=RMPreview1;
RMGridReport1.ShowReport ;
end;
end;
procedure TfrmLabelAdd.BtOpenClick(Sender: TObject);
begin
end;
////////////////////////////////////////////////////////////
//初始化窗口数据
////////////////////////////////////////////////////////////
procedure TfrmLabelAdd.InitWinData();
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select A.*');
// sql.Add('customNoName=isnull((select customName from BC_customer where customNO=A.customNo),A.customNo)');
sql.Add('from P_Label A');
sql.Add('WHERE LabelId='+fkeyNo);
Open;
if isEmpty then
begin
close;
exit;
end;
SSetWinData(ADOQueryTmp,panel1);
RMGridReport1.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport2.FileName:=trim(fieldByName('labelFileName').AsString);
RMGridReport2.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport1.Preview :=RMPreview1;
//RMGridReport1.PrepareReport;
RMGridReport1.ShowReport ;
end;
except
end;
end;
procedure TfrmLabelAdd.FormShow(Sender: TObject);
begin
if fWinStatus>0 then
InitWinData();
end;
procedure TfrmLabelAdd.RMPreview1DblClick(Sender: TObject);
begin
//btOpen.Click ;
end;
////////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////////
procedure TfrmLabelAdd.InitVarDictionary();
var
i:integer;
begin
{ try
with RMGridReport2 do
begin
Dictionary.Variables.Clear ;
Dictionary.Variables.AddCategory('客户单位信息');
with ADOQueryTmp do
begin
close;
sql.clear;
sql.Add('exec P_Label_CustPrintData');
sql.Add(quotedStr(fCustomNo));
Open;
for i:=0 to FieldCount-1 do
begin
Dictionary.Variables.Add(trim(fields[i].FieldName)
,'');
Dictionary.Variables.AsString[trim(fields[i].FieldName)]:=trim(fields[i].AsString);
end;
end;
end;
finally
end; }
end;
/////////////////////////////////////////////////
//
/////////////////////////////////////////////////
procedure TfrmLabelAdd.InitDataSetDictionary();
begin
{ with ADOQuery1 do
begin
close;
sql.Clear ;
sql.Add('exec P_Label_PrintSet');
sql.Add(quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
OPen;
end;
with RMGridReport2 do
begin
Dictionary.FieldAliases.Clear;
Dictionary.FieldAliases['RMDS_Main']:= '标签数据';
Dictionary.FieldAliases['RMDS_Main."barcode"']:='标签条码';
end; }
end;
end.

View File

@ -0,0 +1,438 @@
object frmLabelList: TfrmLabelList
Left = 145
Top = 10
Width = 1057
Height = 693
BorderIcons = [biMaximize]
Caption = #26631#31614#20449#24687
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poOwnerFormCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Panel1: TPanel
Left = 12
Top = 80
Width = 452
Height = 561
BevelOuter = bvNone
TabOrder = 0
object Panel2: TPanel
Left = 0
Top = 3
Width = 452
Height = 558
Align = alClient
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object cxGrid1: TcxGrid
Left = 2
Top = 2
Width = 448
Height = 554
Align = alClient
TabOrder = 0
object tv1: TcxGridDBTableView
OnDblClick = tv1DblClick
NavigatorButtons.ConfirmDelete = False
OnCellClick = tv1CellClick
OnFocusedRecordChanged = tv1FocusedRecordChanged
DataController.DataSource = DS_Label
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
object tv1labelId: TcxGridDBColumn
Caption = #26631#31614'ID'
DataBinding.FieldName = 'labelId'
Visible = False
Width = 53
end
object tv1labeltype: TcxGridDBColumn
Caption = #26631#31614#31867#22411
DataBinding.FieldName = 'labeltype'
HeaderAlignmentHorz = taCenter
HeaderAlignmentVert = vaCenter
Width = 107
end
object tv1labelCaption: TcxGridDBColumn
Caption = #26631#31614#21517#31216
DataBinding.FieldName = 'labelCaption'
HeaderAlignmentHorz = taCenter
HeaderAlignmentVert = vaCenter
Width = 261
end
object tv1labelFile: TcxGridDBColumn
Caption = #25991#20214#21517
DataBinding.FieldName = 'labelFile'
Visible = False
HeaderAlignmentHorz = taCenter
HeaderAlignmentVert = vaCenter
Width = 167
end
end
object cxGrid1Level1: TcxGridLevel
GridView = tv1
end
end
end
object Panel3: TPanel
Left = 0
Top = 0
Width = 452
Height = 3
Align = alTop
Caption = 'Panel3'
TabOrder = 1
Visible = False
object Label1: TLabel
Left = 40
Top = 13
Width = 60
Height = 12
Caption = #23458#25143#21517#31216#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label2: TLabel
Left = 52
Top = 35
Width = 48
Height = 12
Caption = #19994#21153#21592#65306
Visible = False
end
object Label4: TLabel
Left = 40
Top = 61
Width = 60
Height = 12
Caption = #30005#35805#21495#30721#65306
end
object Label5: TLabel
Left = 39
Top = 86
Width = 60
Height = 12
Caption = #20844#21496#21517#31216#65306
end
object Label6: TLabel
Left = 14
Top = 108
Width = 84
Height = 12
Caption = #20844#21496#33521#25991#21517#31216#65306
end
object Label7: TLabel
Left = 61
Top = 133
Width = 36
Height = 12
Caption = #22320#22336#65306
end
object Label8: TLabel
Left = 37
Top = 157
Width = 60
Height = 12
Caption = #33521#25991#22320#22336#65306
end
object Label3: TLabel
Left = 61
Top = 192
Width = 36
Height = 12
Caption = #22791#27880#65306
end
object Note: TMemo
Left = 120
Top = 175
Width = 293
Height = 63
ScrollBars = ssBoth
TabOrder = 0
end
object EngAddress: TEdit
Left = 120
Top = 151
Width = 294
Height = 20
Enabled = False
TabOrder = 1
end
object ChnAddress: TEdit
Left = 120
Top = 127
Width = 293
Height = 20
TabOrder = 2
end
object engFactory: TEdit
Left = 119
Top = 104
Width = 295
Height = 20
TabOrder = 3
end
object ChnFactory: TEdit
Left = 119
Top = 81
Width = 294
Height = 20
TabOrder = 4
end
object TelePhone: TEdit
Left = 119
Top = 58
Width = 294
Height = 20
TabOrder = 5
end
object ywy: TEdit
Tag = 99
Left = 119
Top = 31
Width = 295
Height = 20
ReadOnly = True
TabOrder = 6
Text = 'ywy'
Visible = False
end
object customNo: TBtnEditA
Tag = 1
Left = 120
Top = 7
Width = 295
Height = 20
Enabled = False
ReadOnly = True
TabOrder = 7
OnBtnClick = customNoBtnClick
end
end
end
object RMPreview1: TRMPreview
Left = 488
Top = 85
Width = 553
Height = 569
Align = alRight
BevelOuter = bvLowered
Caption = 'Insert After'
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = False
TabOrder = 1
OnDblClick = RMPreview1DblClick
Options.RulerUnit = rmutScreenPixels
Options.RulerVisible = False
Options.DrawBorder = False
Options.BorderPen.Color = clGray
Options.BorderPen.Style = psDash
end
object ToolBar2: TToolBar
Left = 0
Top = 0
Width = 1041
AutoSize = True
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar2'
Color = clBtnFace
Flat = True
Images = DataLink_DDMD.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 2
Transparent = False
object ToolButton1: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = ToolButton1Click
end
object TOK: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #30830#23450
ImageIndex = 10
OnClick = TOkClick
end
object Tadd: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #26032#22686#26631#31614
ImageIndex = 1
OnClick = TaddClick
end
object Tupd: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20462#25913#26631#31614
ImageIndex = 11
OnClick = TupdClick
end
object Tdel: TToolButton
Left = 300
Top = 0
AutoSize = True
Caption = #21024#38500#26631#31614
ImageIndex = 3
OnClick = TdelClick
end
object Tclose: TToolButton
Left = 387
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TcloseClick
end
end
object Panel4: TPanel
Left = 0
Top = 32
Width = 1041
Height = 53
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 3
object Label9: TLabel
Left = 36
Top = 20
Width = 48
Height = 12
Caption = #26631#31614#31867#22411
end
object Label10: TLabel
Left = 280
Top = 20
Width = 48
Height = 12
Caption = #26631#31614#26631#39064
end
object LabelCaption: TEdit
Left = 332
Top = 16
Width = 100
Height = 20
TabOrder = 0
OnChange = LabelTypeChange
end
object LabelType: TFTComboBox
Tag = 99
Left = 88
Top = 17
Width = 100
Height = 20
Style = csDropDownList
ItemHeight = 12
ItemIndex = 0
TabOrder = 1
OnChange = LabelTypeChange
Items.Strings = (
''
#20013#25991#26631#31614
#33521#25991#26631#31614
#20013#33521#25991#26631#31614)
end
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
CommandTimeout = 300
Parameters = <>
Left = 508
Top = 208
end
object OpenDialog1: TOpenDialog
Filter = 'RMFl(*.rmf)|*.rmf'
InitialDir = '.'
Left = 316
Top = 148
end
object RMGridReport1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
ModalPreview = False
ShowProgress = False
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
Preview = RMPreview1
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 = 436
Top = 152
ReportData = {}
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 528
Top = 184
end
object ADOQuery1: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 392
Top = 228
end
object DS_Label: TDataSource
DataSet = ADOQueryLabel
Left = 66
Top = 456
end
object ADOQueryLabel10: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 234
Top = 296
end
object ADOQueryLabel: TClientDataSet
Aggregates = <>
Params = <>
Left = 156
Top = 267
end
end

View File

@ -0,0 +1,591 @@
unit U_LabelList;
interface
uses
Windows, Messages, SysUtils, StrUtils,Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, ExtCtrls, DB, ADODB,
RM_System, RM_Common, RM_Class, RM_GridReport, Buttons, FTComboBox,
RM_Preview, RM_e_Xls, RM_e_Graphic, RM_e_bmp, RM_BarCode,
RM_DsgGridReport, RM_Dataset, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, DBClient;
type
TfrmLabelList = class(TForm)
Panel1: TPanel;
ADOQueryCmd: TADOQuery;
OpenDialog1: TOpenDialog;
RMGridReport1: TRMGridReport;
ADOQueryTmp: TADOQuery;
RMPreview1: TRMPreview;
ADOQuery1: TADOQuery;
Panel2: TPanel;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1labeltype: TcxGridDBColumn;
tv1labelCaption: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
tv1labelFile: TcxGridDBColumn;
DS_Label: TDataSource;
ADOQueryLabel10: TADOQuery;
Panel3: TPanel;
Note: TMemo;
EngAddress: TEdit;
ChnAddress: TEdit;
engFactory: TEdit;
ChnFactory: TEdit;
TelePhone: TEdit;
ywy: TEdit;
customNo: TBtnEditA;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label3: TLabel;
tv1labelId: TcxGridDBColumn;
ToolBar2: TToolBar;
Tadd: TToolButton;
Tupd: TToolButton;
Tdel: TToolButton;
TOK: TToolButton;
Tclose: TToolButton;
Panel4: TPanel;
ToolButton1: TToolButton;
Label9: TLabel;
Label10: TLabel;
LabelCaption: TEdit;
LabelType: TFTComboBox;
ADOQueryLabel: TClientDataSet;
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TsaveClick(Sender: TObject);
procedure customNoBtnClick(Sender: TObject);
procedure BtOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RMPreview1DblClick(Sender: TObject);
procedure TaddClick(Sender: TObject);
procedure TupdClick(Sender: TObject);
procedure tv1FocusedRecordChanged(Sender: TcxCustomGridTableView;
APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord;
ANewItemRecordFocusingChanged: Boolean);
procedure TdelClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure TOkClick(Sender: TObject);
procedure tv1DblClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure LabelTypeChange(Sender: TObject);
procedure tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
private
isLoad:Boolean;
function SaveData():Boolean;
function EditData():Boolean;
function IsCheckCustOk():Boolean;
function DeleteData():Boolean;
procedure InitWinData();
procedure InitVarDictionary();
procedure InitDataSetDictionary();
procedure InitGrid();
procedure OpenLabel();
procedure SetWinStatus();
procedure DoFilter();
public
fSelLabelId,LBName,LBInt,SLBName:String;
fKeyNo:string;
fchg:Boolean;
fIsShowModal:Boolean;
fWinStatus:integer;
end;
var
frmLabelList: TfrmLabelList;
implementation
uses
U_DataLink, U_LabelAdd,U_RTFun;
{$R *.dfm}
procedure TfrmLabelList.DoFilter();
var
filterStr:string;
begin
filterStr:='';
if trim(LabelType.Text) <>'' then
begin
filterStr:=' and LabelType like '+quotedStr('%'+trim(LabelType.Text)+'%');
end;
//名称
if trim(LabelCaption.Text)<>'' then
begin
filterStr:=filterStr+' and LabelCaption like '+quotedStr('%'+trim(LabelCaption.Text)+'%');
end;
try
ADOQueryLabel10.DisableControls ;
if trim(filterStr)='' then
begin
ADOQueryLabel.Filtered:=false;
ADOQueryLabel.EnableControls;
exit;
end;
filterStr:=trim(RightBStr(filterStr,length(filterStr)-4));
with ADOQueryLabel do
begin
filtered:=false;
filter:=filterStr;
filtered:=true;
end;
SCreateCDS20(ADOQueryLabel10,ADOQueryLabel);
SInitCDSData20(ADOQueryLabel10,ADOQueryLabel);
finally
ADOQueryLabel10.EnableControls;
end;
end;
procedure TfrmLabelList.TcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmLabelList.FormCreate(Sender: TObject);
begin
panel1.Align :=alClient;
// ClearWinData(panel3);
fSelLabelId := '';
end;
procedure TfrmLabelList.TsaveClick(Sender: TObject);
begin
if trim(customNO.Text)='' then
begin
application.MessageBox('客户名称不能为空,请选择客户!','提示');
customNo.SetFocus;
exit;
end;
if application.MessageBox('确定要保存吗?','提示信息',1)=2 then exit;
if fWinStatus=0 then
begin
if not IsCheckCustOk() then exit;
if SaveData() then
begin
fWinStatus:=1;
fchg:=true;
SetWinStatus();
end;
end
else
begin
if EditData() then
begin
fchg:=true;
application.MessageBox('保存成功!','提示信息',0)
end;
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelList.SaveData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from JD_Label');
sql.Add('where 1<>1');
Open;
Append;
fieldByName('customno').value:=trim(customno.txtCode);
fieldByName('ChnFactory').value:=trim(ChnFactory.text);
fieldByName('engFactory').value:=trim(engFactory.text);
fieldByName('TelePhone').value:=trim(TelePhone.text);
fieldByName('ChnAddress').value:=trim(ChnAddress.text);
fieldByName('EngAddress').value:=trim(EngAddress.text);
fieldByName('filler').value:=Dname;
fieldByName('filltime').value:=DServerDate;
fieldByName('note').value:= trim(Note.text);
Post;
end;
result:=true;
except
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelList.EditData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from JD_Label');
sql.Add('where customNo='+fKeyNo);
Open;
Edit;
fieldByName('customno').value:=trim(customno.txtCode);
fieldByName('ChnFactory').value:=trim(ChnFactory.text);
fieldByName('engFactory').value:=trim(engFactory.text);
fieldByName('TelePhone').value:=trim(TelePhone.text);
fieldByName('ChnAddress').value:=trim(ChnAddress.text);
fieldByName('EngAddress').value:=trim(EngAddress.text);
fieldByName('note').value:= trim(Note.text);
Post;
end;
result:=true;
except
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
procedure TfrmLabelList.customNoBtnClick(Sender: TObject);
begin
{ FormGetCust:=TFormGetCust.Create(self);
if FormGetCust.ShowModal=mrok then
begin
customNo.TxtCode:=trim(FormGetCust.ADOQuery1.Fieldbyname('customno').AsString);
customNo.Text:=trim(FormGetCust.ADOQuery1.Fieldbyname('shortname').AsString);
end;
FormGetCust.Free; }
{ frmCustHelp:=TfrmCustHelp.create(self);
with frmCustHelp do
begin
if showModal=1 then
begin
customNo.TxtCode:=trim(ADOQueryHelp.Fieldbyname('customno').AsString);
customNo.Text:=trim(ADOQueryHelp.Fieldbyname('shortname').AsString);
end;
free;
end;
}
end;
procedure TfrmLabelList.BtOpenClick(Sender: TObject);
begin
end;
////////////////////////////////////////////////////////////
//初始化窗口数据
////////////////////////////////////////////////////////////
procedure TfrmLabelList.InitWinData();
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select A.* ,B.customName as customNoName');
sql.Add('from JD_Label A');
sql.Add('INNER JOIN BC_customer B ON A.customNO=B.customNo');
sql.Add('WHERE B.customNo='''+fkeyNo+'''');
Open;
if isEmpty then
begin
close;
exit;
end;
// SetWinData(ADOQueryTmp,panel3);
{
RMGridReport1.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport1.Preview :=RMPreview1;
RMGridReport1.PrepareReport;
RMGridReport1.ShowReport ;
}
end;
except
end;
end;
procedure TfrmLabelList.FormShow(Sender: TObject);
begin
if fWinStatus=1 then tok.Visible:=false;
InitGrid();
if Trim(SLBName)<>'' then
begin
ADOQueryLabel.Locate('labelCaption',SLBName,[]);
end;
end;
procedure TfrmLabelList.RMPreview1DblClick(Sender: TObject);
begin
//btOpen.Click ;
end;
////////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////////
procedure TfrmLabelList.InitVarDictionary();
var
TmpList:Tstrings;
mm:string;
i:integer;
begin
try
TmpList:=TstringList.Create();
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select distinct ItemType from JC_LabelSetItems ');
sql.Add('where valid=''Y''');
Open;
TmpList.Clear ;
while not Eof do
begin
TmpList.Add(trim(fieldByName('ItemType').AsString));
Next;
end;
end;
finally
TmpList.Free ;
end;
end;
/////////////////////////////////////////////////
//
/////////////////////////////////////////////////
procedure TfrmLabelList.InitDataSetDictionary();
begin
{ with ADOQuery1 do
begin
close;
sql.Clear ;
sql.Add('exec P_Get_LabelPrintData');
sql.Add(quotedStr(''));
sql.Add(','+quotedStr(''));
sql.Add(','+quotedStr(''));
OPen;
end; }
end;
procedure TfrmLabelList.TaddClick(Sender: TObject);
begin
try
frmLabelAdd:=TfrmLabelAdd.create(self);
with frmLabelAdd do
begin
if showModal =1 then
begin
fchg:=true;
InitGrid();
end;
end;
finally
frmLabelAdd.Free;
end;
end;
procedure TfrmLabelList.TupdClick(Sender: TObject);
begin
if ADOQueryLabel.IsEmpty then exit;
try
frmLabelAdd:=TfrmLabelAdd.create(self);
with frmLabelAdd do
begin
fKeyNo:=ADOQueryLabel.fieldByName('LabelId').AsString ;
fWinstatus:=1;
if showModal =1 then
begin
fchg:=true;
InitGrid();
end;
end;
finally
frmLabelAdd.Free;
end;
end;
/////////////////////////////////////////////
//
/////////////////////////////////////////////
procedure TfrmLabelList.InitGrid();
begin
try
isLoad:=false;
ADOQueryLabel10.DisableControls ;
with ADOQueryLabel10 do
begin
close;
sql.Clear ;
sql.Add('select * from P_Label');
sql.Add('where valid=''Y''');
sql.Add(' order by labelCaption');
Open;
end;
SCreateCDS20(ADOQueryLabel10,ADOQueryLabel);
SInitCDSData20(ADOQueryLabel10,ADOQueryLabel);
finally
ADOQueryLabel10.EnableControls;
isLoad:=true;
//DoFilter();
//OpenLabel();
end;
end;
////////////////////////////////////////////////////////
//函数功能:打开标签文件
////////////////////////////////////////////////////////
procedure TfrmLabelList.OpenLabel();
begin
if ADOQueryLabel.IsEmpty then exit;
with RMGridReport1 do
begin
LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('labelFile')));
//Preview :=RMPreview1;
ShowReport ;
end;
end;
procedure TfrmLabelList.tv1FocusedRecordChanged(
Sender: TcxCustomGridTableView; APrevFocusedRecord,
AFocusedRecord: TcxCustomGridRecord;
ANewItemRecordFocusingChanged: Boolean);
begin
end;
//////////////////////////////////////////////////////////
//函数功能:检查该客户的标签是否已存在
/////////////////////////////////////////////////////////
function TfrmLabelList.IsCheckCustOk():Boolean;
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select count(customNO)as cnt from P_Label');
sql.Add('where customNO='''+trim(customNO.TxtCode)+'''');
Open;
if fieldByName('cnt').AsInteger>0 then
begin
Result:=false ;
application.MessageBox('该客户标签信息已存!','警告信息',0);
end
else
Result:=true;
end;
except
result:=false;
application.MessageBox('检查该客户标签信息是否已存在时发生错误!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////
//
/////////////////////////////////////////////////////////////
function TfrmLabelList.DeleteData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.clear;
sql.Add('delete P_Label');
sql.Add('where labelId='+ADOQueryLabel.fieldByName('LabelID').asString);
execSql;
end;
result:=true;
except
result:=false;
application.MessageBox('删除失败!','警告信息',0);
end;
end;
procedure TfrmLabelList.TdelClick(Sender: TObject);
begin
if ADOQueryLabel.IsEmpty then exit;
if application.MessageBox('确定要删除此标签吗?','警告信息',1)=2 then exit;
if DeleteData() then
begin
fchg:=true;
InitGrid();
end;
end;
//////////////////////////////////////////////////////////
//
/////////////////////////////////////////////////////////
procedure TfrmLabelList.SetWinStatus();
begin
case fWinStatus of
0:
begin
// ToolBar2.Visible :=false;
// tsave.Visible :=true;
customNo.Enabled :=true;
panel3.Enabled :=true;
end;
1:
begin
// ToolBar2.Visible :=true;
// tsave.Visible :=false;
customNo.Enabled :=false;
panel3.Enabled :=false;
TOK.Visible:=false;
end;
5:
begin
// ToolBar2.Visible :=false;
// tsave.Visible :=false;
panel1.Enabled :=false;
panel3.Enabled :=false;
end;
end ;
end;
procedure TfrmLabelList.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
{if fIsShowModal then
Application:=MainApplication ; }
Action:=caFree;
end;
procedure TfrmLabelList.FormDestroy(Sender: TObject);
begin
frmLabelList:=nil;
end;
procedure TfrmLabelList.TOkClick(Sender: TObject);
begin
if ADOQueryLabel.IsEmpty then exit;
LBName:=Trim(ADOQueryLabel.fieldbyname('labelCaption').AsString);
ModalResult:=1;
end;
procedure TfrmLabelList.tv1DblClick(Sender: TObject);
begin
TOk.Click ;
end;
procedure TfrmLabelList.ToolButton1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmLabelList.LabelTypeChange(Sender: TObject);
begin
DoFilter();
end;
procedure TfrmLabelList.tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if isLoad then
OpenLabel();
end;
end.

View File

@ -0,0 +1,181 @@
object frmModuleNote: TfrmModuleNote
Left = 326
Top = 178
Width = 729
Height = 528
Align = alClient
Caption = #25805#20316#35828#26126
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object cxGrid1: TcxGrid
Left = 0
Top = 73
Width = 713
Height = 416
Align = alClient
TabOrder = 0
object TV1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
OnCellDblClick = TV1CellDblClick
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
object V1OrderNo: TcxGridDBColumn
Caption = #26085#26399
DataBinding.FieldName = 'MNDate'
PropertiesClassName = 'TcxDateEditProperties'
Properties.ImmediatePost = True
Properties.SaveTime = False
Properties.ShowTime = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 117
end
object V1Name: TcxGridDBColumn
Tag = 2
Caption = #25805#20316#35828#26126
DataBinding.FieldName = 'MNNOte'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1NamePropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 513
end
end
object cxGrid1Level1: TcxGridLevel
GridView = TV1
end
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 713
Height = 29
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Flat = True
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_DDMD.ThreeImgList
List = True
ParentFont = False
ShowCaptions = True
TabOrder = 1
object ToolButton1: TToolButton
Left = 0
Top = 0
Caption = #36873#25321
ImageIndex = 10
OnClick = ToolButton1Click
end
object TBAdd: TToolButton
Left = 59
Top = 0
Caption = #22686#34892
ImageIndex = 12
OnClick = TBAddClick
end
object TBDel: TToolButton
Left = 118
Top = 0
Caption = #21024#34892
ImageIndex = 13
OnClick = TBDelClick
end
object TBEdit: TToolButton
Left = 177
Top = 0
Caption = #20462#25913
ImageIndex = 11
OnClick = TBEditClick
end
object TBClose: TToolButton
Left = 236
Top = 0
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 29
Width = 713
Height = 44
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 2
object Label2: TLabel
Left = -31
Top = 13
Width = 360
Height = 16
Caption = ' '#27880#65306#28966#28857#31163#24320#24403#21069#32534#36753#21333#20803#26684#20445#23384#25968#25454#12290
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
end
object ADOQueryMain: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 48
Top = 136
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 80
Top = 144
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 112
Top = 152
end
object DataSource1: TDataSource
DataSet = ClientDataSet1
Left = 280
Top = 144
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 208
Top = 144
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 168
Top = 152
end
end

View File

@ -0,0 +1,220 @@
unit U_ModuleNote;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu,
cxTimeEdit, cxCalendar;
type
TfrmModuleNote = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBAdd: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
TBEdit: TToolButton;
V1OrderNo: TcxGridDBColumn;
Panel1: TPanel;
cxGridPopupMenu1: TcxGridPopupMenu;
Label2: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBAddClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure V1NamePropertiesEditValueChanged(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
flag:string;
{ Public declarations }
end;
var
frmModuleNote: TfrmModuleNote;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmModuleNote.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmModuleNote.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Module_Note A where A.MNType='''+flag+'''');
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmModuleNote.TBAddClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
TV1.OptionsSelection.CellSelect:=True;
with ClientDataSet1 do
begin
Append;
FieldByName('MNDate').Value:=Now;
Post;
end;
end;
procedure TfrmModuleNote.TBDelClick(Sender: TObject);
begin
if ClientDataSet1.IsEmpty then Exit;
if (Trim(ClientDataSet1.FieldByName('MNID').AsString)<>'') then
begin
if application.MessageBox('确定要删除吗?','提示信息',1)=2 then exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete SY_Module_Note where MNID='''+Trim(ClientDataSet1.fieldbyname('MNID').AsString)+'''');
ExecSQL;
end;
end;
ClientDataSet1.Delete;
end;
procedure TfrmModuleNote.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
WriteCxGrid('自定义'+Trim(flag),TV1,'模块说明');
Close;
end;
procedure TfrmModuleNote.FormShow(Sender: TObject);
var
fsj,fsj1:string;
begin
InitGrid();
ReadCxGrid('自定义'+Trim(flag),TV1,'模块说明');
frmModuleNote.Caption:=Trim(flag);
end;
procedure TfrmModuleNote.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid('自定义'+Trim(flag),TV1,'模块说明');
ModalResult:=1;
end;
procedure TfrmModuleNote.TBEditClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
TV1.OptionsSelection.CellSelect:=True;
end;
procedure TfrmModuleNote.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if TV1.OptionsData.Editing=False then
begin
ModalResult:=1;
end;
end;
procedure TfrmModuleNote.V1NamePropertiesEditValueChanged(Sender: TObject);
var
maxno,mvalue:string;
begin
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
//Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('MNNote').Value:=Trim(mvalue);
//Post;
end;
try
ADOQueryCmd.Connection.BeginTrans;
if Trim(ClientDataSet1.FieldByName('MNID').AsString)='' then
begin
if GetLSNo(ADOQueryCmd,maxno,'SY','SY_Module_Note',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('取最大编号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('MNID').AsString);
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.add('select * from SY_Module_Note ');
sql.Add(' where MNID='''+Trim(ClientDataSet1.fieldbyname('MNID').AsString)+'''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(ClientDataSet1.fieldbyname('MNID').AsString)='' then
begin
Append;
FieldByName('Filler').Value:=Trim(DName);
FieldByName('FillTime').Value:=Now;
end
else begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=Now;
end;
FieldByName('MNDate').Value:=ClientDataSet1.fieldbyname('MNDate').Value;
FieldByName('MNID').Value:=Trim(maxno);
FieldByName('MNNote').Value:=ClientDataSet1.fieldbyname('MNNote').AsString;
FieldByName('MNType').Value:=flag;
Post;
end;
ADOQueryCmd.Connection.CommitTrans;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('MNID').Value:=Trim(maxno);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
end.

View File

@ -0,0 +1,342 @@
object frmModulePromptList: TfrmModulePromptList
Left = 131
Top = 161
Width = 1133
Height = 547
Caption = #25105#30340#31649#23478
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1117
AutoSize = True
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
Flat = True
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_DDMD.ThreeImgList
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object TBClose: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 32
Width = 1117
Height = 66
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label1: TLabel
Left = 75
Top = 11
Width = 84
Height = 12
Caption = #38144#21806#21512#21516#26410#23457#26680
end
object Label2: TLabel
Left = 48
Top = 8
Width = 27
Height = 16
Caption = 'aa:'
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 242
Top = 11
Width = 96
Height = 12
Caption = #29983#20135#25351#31034#21333#26410#23457#26680
end
object Label4: TLabel
Left = 215
Top = 8
Width = 27
Height = 16
Caption = 'bb:'
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 457
Top = 11
Width = 120
Height = 12
Caption = #29983#20135#25351#31034#21333#24037#24207#26410#23450#20041
end
object Label6: TLabel
Left = 428
Top = 8
Width = 27
Height = 16
Caption = 'cc:'
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label7: TLabel
Left = 75
Top = 40
Width = 120
Height = 12
Caption = #29983#20135#25351#31034#21333#24037#24207#26410#23433#25490
end
object Label8: TLabel
Left = 48
Top = 37
Width = 27
Height = 16
Caption = 'dd:'
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label9: TLabel
Left = 241
Top = 40
Width = 168
Height = 12
Caption = #29983#20135#25351#31034#21333#37319#36141#21152#24037#21512#21516#26410#24405#20837
end
object Label10: TLabel
Left = 214
Top = 37
Width = 27
Height = 16
Caption = 'ee:'
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label11: TLabel
Left = 456
Top = 40
Width = 108
Height = 12
Caption = #29983#20135#25351#31034#21333#29983#20135#36229#26399
end
object Label12: TLabel
Left = 428
Top = 37
Width = 27
Height = 16
Caption = 'ff:'
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label13: TLabel
Left = 627
Top = 11
Width = 84
Height = 12
Caption = #26597' '#35810' '#26465' '#20214
end
object ModuleNote: TEdit
Tag = 2
Left = 608
Top = 36
Width = 121
Height = 20
TabOrder = 0
OnChange = ModuleNoteChange
end
end
object cxGrid1: TcxGrid
Left = 0
Top = 98
Width = 1117
Height = 410
Align = alClient
TabOrder = 2
object Tv1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
OnCellDblClick = Tv1CellDblClick
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
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 = skCount
Column = v1Column5
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
object v1Column5: TcxGridDBColumn
Caption = #24453#22788#29702#20107#39033
DataBinding.FieldName = 'ModuleNote'
HeaderAlignmentHorz = taCenter
Styles.Footer = DataLink_DDMD.FoneRed
Width = 843
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
object cxGridPopupMenu1: TcxGridPopupMenu
PopupMenus = <>
Left = 1128
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 936
end
object ADOQueryMain: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 1000
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 1040
Top = 8
end
object DataSource1: TDataSource
DataSet = Order_Main
Left = 1168
Top = 8
end
object Order_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 815
Top = 7
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDBMain
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 475
Top = 193
ReportData = {}
end
object RMDBMain: TRMDBDataSet
Visible = True
DataSet = CDS_PRT
Left = 400
Top = 192
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 1
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 440
Top = 192
end
object CDS_PRT: TClientDataSet
Aggregates = <>
Params = <>
Left = 877
Top = 9
end
object cxGridPopupMenu2: TcxGridPopupMenu
PopupMenus = <>
Left = 506
Top = 195
end
end

View File

@ -0,0 +1,257 @@
unit U_ModulePromptList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, DBClient, cxCalendar, cxButtonEdit, cxSplitter,
RM_Common, RM_Class, RM_e_Xls, RM_Dataset, RM_System, RM_GridReport,
cxTextEdit, cxPC;
type
TfrmModulePromptList = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
Panel1: TPanel;
cxGridPopupMenu1: TcxGridPopupMenu;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
Order_Main: TClientDataSet;
RM1: TRMGridReport;
RMDBMain: TRMDBDataSet;
RMXLSExport1: TRMXLSExport;
CDS_PRT: TClientDataSet;
cxGridPopupMenu2: TcxGridPopupMenu;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column5: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
ModuleNote: TEdit;
Label13: TLabel;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cxPageControl1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Tv1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure ModuleNoteChange(Sender: TObject);
private
FormID,FormType:Integer;
canshu1,canshu2:string;
formFile,FormPara,Formname,FFormPara:string;
FormPara1,FormPara2,FormPara3,FormPara4,FormPara5:string;
FormPara6,FormPara7,FormPara8,FormPara9,FormPara10:string;
procedure InitGrid();
procedure InitForm();
procedure InitDllEvt(FromFile:String;FormID:Integer;Para:String;FormType:Integer; Title: String;
Def1: String; Def2: String; Def3: String; Def4: String; Def5: String;
Def6: String; Def7: String; Def8: String; Def9: String; Def10: string);
{ Private declarations }
public
{ Public declarations }
userID,username,ADOConnString:string;
end;
var
frmModulePromptList: TfrmModulePromptList;
implementation
uses
U_DataLink,U_RTFun;
type
TMyF = function(
App: TApplication; //主应用程序 (对Delphi而言)
FormH: HWND; //创建窗口的父窗口句柄 (对PB而言)
FormID: Integer; //要调用dll中功能窗体的Id号; 如果只有一个功能窗口FormID默认为0
Language: Integer; //0=Delphi; 1=PB
WinStyle: Integer; //0=子窗口; 1:普通窗口 (PB中都为普通窗口)
UID: PChar; //用户Id
UName: PChar; //用户名
Para: PChar;
Title: PChar;
Defstr1: PChar;
Defstr2: PChar;
Defstr3: PChar;
Defstr4: PChar;
Defstr5: PChar;
Defstr6: PChar;
Defstr7: PChar;
Defstr8: PChar;
Defstr9: PChar;
Defstr10: PChar;
Datalink: PChar
): HWND; stdcall;
var
TP: FARPROC;
Tf: TMyF;
{$R *.dfm}
procedure TfrmModulePromptList.FormDestroy(Sender: TObject);
begin
frmModulePromptList:=nil;
end;
procedure TfrmModulePromptList.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmModulePromptList.TBCloseClick(Sender: TObject);
begin
Close;
WriteCxGrid('工作列表',Tv1,'我的管家');
end;
procedure TfrmModulePromptList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
SQL.Add(' exec P_Chk_Tishi :DName,:DCode');
Parameters.ParamByName('DName').Value:=Trim(DName);
Parameters.ParamByName('DCode').Value:=Trim(DCode);
ExecSQL;
Open;
end;
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmModulePromptList.InitForm();
begin
FFormPara:=Trim(DConString);
ReadCxGrid('工作列表',Tv1,'我的管家');
InitGrid();
end;
procedure TfrmModulePromptList.TBRafreshClick(Sender: TObject);
begin
InitGrid();
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
end;
procedure TfrmModulePromptList.FormShow(Sender: TObject);
begin
InitForm();
end;
procedure TfrmModulePromptList.cxPageControl1Change(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmModulePromptList.FormCreate(Sender: TObject);
begin
canshu1:=Trim(DParameters1);
canshu2:=Trim(DParameters2);
end;
procedure TfrmModulePromptList.InitDllEvt(FromFile:String;FormID:Integer;Para:String;FormType:Integer; Title: String;
Def1: String; Def2: String; Def3: String; Def4: String; Def5: String;
Def6: String; Def7: String; Def8: String; Def9: String; Def10: string);
var
Th: HMODULE;
begin
Th := LoadLibrary(PChar(FromFile));
if Th > 0 then
begin
TP := GetProcAddress(Th, 'GetDllForm');
if TP <> nil then
begin
Tf := TMyF(Tp);
Tf(Application, 0, FormID, 0, FormType, PChar(DCode), PChar(DName), PChar(Para), PChar(Title),
PChar(Def1), PChar(Def2),PChar(Def3),PChar(Def4),PChar(Def5),
PChar(Def6),PChar(Def7),PChar(Def8),PChar(Def9),PChar(Def10),
pchar(FFormPara));
end;
end
else
begin
Application.MessageBox(PChar('打不开文件' + FromFile + ''), '错误', MB_ICONERROR);
end;
end;
procedure TfrmModulePromptList.Tv1CellDblClick(
Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
{ with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_ModuleSub where ModuleId='''+Trim(Order_Main.fieldbyname('ModuleId').AsString)+'''');
sql.Add(' and ModuleSubId='''+Trim(Order_Main.fieldbyname('ModuleSubId').AsString)+'''');
Open;
end;
//FormID,FormType:Integer;
// formFile,FormPara,Formname:string;
// FormPara1,FormPara2,FormPara3,FormPara4,FormPara5:string;
//FormPara6,FormPara7,FormPara8,FormPara9,FormPara10:string;
formFile:=Trim(ADOQueryTemp.fieldbyname('FormFile').AsString);
FormID:=ADOQueryTemp.fieldbyname('FormID').AsInteger;
FormType:=ADOQueryTemp.fieldbyname('FormType').AsInteger;
Formname:=Trim(ADOQueryTemp.fieldbyname('Formname').AsString);
FormPara:=Trim(ADOQueryTemp.fieldbyname('FormPara').AsString);
// ShowMessage(FormPara);
FormPara1:=Trim(ADOQueryTemp.fieldbyname('FormPara1').AsString);
FormPara2:=Trim(ADOQueryTemp.fieldbyname('FormPara2').AsString);
FormPara3:=Trim(ADOQueryTemp.fieldbyname('FormPara3').AsString);
FormPara4:=Trim(ADOQueryTemp.fieldbyname('FormPara4').AsString);
FormPara5:=Trim(ADOQueryTemp.fieldbyname('FormPara5').AsString);
FormPara6:=Trim(ADOQueryTemp.fieldbyname('FormPara6').AsString);
FormPara7:=Trim(ADOQueryTemp.fieldbyname('FormPara7').AsString);
FormPara8:=Trim(ADOQueryTemp.fieldbyname('FormPara8').AsString);
FormPara9:=Trim(ADOQueryTemp.fieldbyname('FormPara9').AsString);
FormPara10:=Trim(ADOQueryTemp.fieldbyname('FormPara10').AsString);
InitDllEvt(formFile,FormID,FormPara,FormType,Formname,FormPara1,FormPara2,
FormPara3,FormPara4,FormPara5,FormPara6,FormPara7,FormPara8,
FormPara9,FormPara10); }
end;
procedure TfrmModulePromptList.ModuleNoteChange(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,Order_Main);
SInitCDSData20(ADOQueryMain,Order_Main);
end;
end.

View File

@ -0,0 +1,36 @@
object frmSLT: TfrmSLT
Left = 0
Top = 0
Width = 161
Height = 138
TabOrder = 0
object Panel1: TPanel
Left = 0
Top = 121
Width = 161
Height = 17
Align = alClient
BevelOuter = bvNone
Caption = 'Panel1'
Color = clWindow
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 0
end
object cxImage1: TcxImage
Left = 0
Top = 0
Align = alTop
Style.BorderStyle = ebsOffice11
StyleHot.TextStyle = []
TabOrder = 1
OnClick = cxImage1Click
OnDblClick = cxImage1DblClick
Height = 121
Width = 161
end
end

View File

@ -0,0 +1,84 @@
unit U_SLT;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,jpeg, cxControls, cxContainer, cxEdit, cxImage,IdFTP,ShellAPI;
type
TfrmSLT = class(TFrame)
cxImage1: TcxImage;
Panel1: TPanel;
procedure cxImage1Click(Sender: TObject);
procedure cxImage1DblClick(Sender: TObject);
private
CYID,FileName:string;
// procedure Sharpen(SrcBmp:TBitmap);
{ Private declarations }
public
procedure Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
{ Public declarations }
end;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmSLT.Init(fCYID:string;fFileName:string;fPicture:TJpegImage);
begin
CYID:=trim(fCYID);
FileName:=trim(fFileName);
Panel1.Caption:=FileName;
cxImage1.Picture.Assign(fPicture);
end;
procedure TfrmSLT.cxImage1Click(Sender: TObject);
begin
// Fsplcode:=splcode;
// FPatFile:=patfile;
/// frmSample_List.Fsplcode:=splcode;
/// frmSample_List.FPatFile:=patfile;
// showmessage(splcode);
end;
procedure TfrmSLT.cxImage1DblClick(Sender: TObject);
var
IdFTP1: TIdFTP;
FPath,FFName:string;
FInt:integer;
begin
try
IdFTP1:=TIdFTP.Create(self);
IdFTP1.Host :=PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
IdFTP1.Quit;
IdFTP1.Free;
Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING);
Exit;
end;
FPath:='D:\Right1209\';
if not DirectoryExists(ExtractFileDir(FPath)) then
CreateDir(ExtractFileDir(FPath));
FFName:=Trim(FileName);
FFName:=FPath+FFName;
if FileExists(FFName) then
begin
FInt:=1;
end;
if FInt<>1 then
IdFTP1.Get('YP\'+FileName,FFName);
if IdFTP1.Connected then
begin
IdFTP1.Quit;
IdFTP1.Free;
end;
ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL);
end;
end.

View File

@ -0,0 +1,311 @@
object frmSYDept: TfrmSYDept
Left = 73
Top = 128
Width = 1004
Height = 509
Caption = #32452#32455#32467#26500
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 988
Height = 33
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_DDMD.ThreeImgList
Flat = True
Images = DataLink_DDMD.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object TBAdd: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #26032#22686#23376#31867
ImageIndex = 12
OnClick = TBAddClick
end
object ToolButton1: TToolButton
Left = 150
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 5
OnClick = ToolButton1Click
end
object TBDel: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 13
OnClick = TBDelClick
end
object ToolButton2: TToolButton
Left = 276
Top = 0
AutoSize = True
Caption = #32452#32455#20998#37197
ImageIndex = 22
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 363
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object cxDBTreeList1: TcxDBTreeList
Left = 0
Top = 33
Width = 249
Height = 437
Align = alLeft
Bands = <
item
end>
BufferedPaint = False
DataController.DataSource = DataSource1
DataController.ParentField = 'DPParent'
DataController.KeyField = 'DPID'
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_DDMD.Red
Styles.Selection = DataLink_DDMD.Red
Styles.IncSearch = DataLink_DDMD.Red
TabOrder = 1
OnClick = cxDBTreeList1Click
OnDblClick = cxDBTreeList1DblClick
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'DPName'
Width = 210
Position.ColIndex = 1
Position.RowIndex = 0
Position.BandIndex = 0
end
end
object Panel1: TPanel
Left = 249
Top = 33
Width = 315
Height = 437
Align = alLeft
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 2
object Label1: TLabel
Left = 41
Top = 40
Width = 48
Height = 12
Caption = #19978#32423#32452#32455
end
object Label2: TLabel
Left = 41
Top = 81
Width = 48
Height = 12
Caption = #32452#32455#21517#31216
end
object Label3: TLabel
Left = 41
Top = 121
Width = 48
Height = 12
Caption = #32452#32455#32534#30721
end
object Label4: TLabel
Left = 24
Top = 16
Width = 60
Height = 14
Caption = #32452#32455#32467#26500
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 41
Top = 159
Width = 48
Height = 12
Caption = #39034' '#24207' '#21495
end
object DPTopName: TEdit
Left = 104
Top = 37
Width = 169
Height = 20
ReadOnly = True
TabOrder = 0
end
object DPName: TEdit
Left = 104
Top = 77
Width = 169
Height = 20
TabOrder = 1
OnKeyPress = DPNameKeyPress
end
object DPNo: TEdit
Left = 104
Top = 117
Width = 169
Height = 20
TabOrder = 2
end
object DPOrder: TEdit
Left = 104
Top = 155
Width = 169
Height = 20
TabOrder = 3
end
end
object cxGrid4: TcxGrid
Left = 564
Top = 33
Width = 424
Height = 437
Align = alClient
TabOrder = 3
object Tv4: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
DataController.DataSource = DSUser
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_DDMD.SHuangSe
Styles.IncSearch = DataLink_DDMD.SHuangSe
Styles.Selection = DataLink_DDMD.SHuangSe
object cxGridDBColumn1: TcxGridDBColumn
Caption = #21592#24037#32534#21495
DataBinding.FieldName = 'UserId'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_DDMD.Default
Width = 84
end
object cxGridDBColumn7: TcxGridDBColumn
Caption = #30331#24405#21517#31216
DataBinding.FieldName = 'UserName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_DDMD.Default
Width = 87
end
object cxGridDBColumn8: TcxGridDBColumn
Caption = #21592#24037#32452#32455
DataBinding.FieldName = 'dept'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_DDMD.Default
Width = 74
end
object v4Column1: TcxGridDBColumn
Caption = #31995#32479#21517#31216
DataBinding.FieldName = 'MoneyUserName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
Properties.OnEditValueChanged = v4Column1PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Styles.Header = DataLink_DDMD.Default
Width = 91
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv4
end
end
object DataSource1: TDataSource
DataSet = CDS_Tree
Left = 147
Top = 219
end
object ADOQueryTree: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 117
Top = 145
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 528
Top = 215
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 520
Top = 258
end
object CDS_Tree: TClientDataSet
Aggregates = <>
Params = <>
Left = 96
Top = 256
end
object CDS_User: TClientDataSet
Aggregates = <>
Params = <>
Left = 680
Top = 272
end
object DSUser: TDataSource
DataSet = CDS_User
Left = 675
Top = 211
end
end

View File

@ -0,0 +1,353 @@
unit U_SYDept;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, ExtCtrls, DBClient, cxFilter, cxData, cxDataStorage, cxEdit,
cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid, cxTextEdit;
type
TfrmSYDept = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBAdd: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DataSource1: TDataSource;
ADOQueryTree: TADOQuery;
ToolButton1: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
DPTopName: TEdit;
DPName: TEdit;
DPNo: TEdit;
CDS_Tree: TClientDataSet;
cxGrid4: TcxGrid;
Tv4: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
Label4: TLabel;
ToolButton2: TToolButton;
CDS_User: TClientDataSet;
DSUser: TDataSource;
Label5: TLabel;
DPOrder: TEdit;
v4Column1: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBRafreshClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure DPNameKeyPress(Sender: TObject; var Key: Char);
procedure FormShow(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure v4Column1PropertiesEditValueChanged(Sender: TObject);
private
{ Private declarations }
PState:Integer;
FCPID,FTopID:String;
procedure InitTree();
public
{ Public declarations }
end;
var
frmSYDept: TfrmSYDept;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmSYDept.InitTree();
var
i:Integer;
begin
try
ADOQueryTree.DisableControls;
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from SY_Dept order by DPlevel,DPOrder,DPName');
Open;
end;
SCreateCDS20(ADOQueryTree,CDS_Tree);
SInitCDSData20(ADOQueryTree,CDS_Tree);
//cxDBTreeList1.Items[0].Expand(false);
cxDBTreeList1.Items[0].Expand(True);
finally
ADOQueryTree.EnableControls;
end;
//cxDBTreeList1.Items[1].Expand(False);
end;
procedure TfrmSYDept.FormDestroy(Sender: TObject);
begin
frmSYDept:=nil;
end;
procedure TfrmSYDept.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSYDept.TBRafreshClick(Sender: TObject);
begin
InitTree();
end;
procedure TfrmSYDept.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmSYDept.TBAddClick(Sender: TObject);
begin
PState:=11;
DPTopName.Text:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
//FTopID:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
FCPID:='';
DPName.Text:='';
DPNo.Text:='';
DPName.SetFocus;
end;
procedure TfrmSYDept.cxDBTreeList1Click(Sender: TObject);
begin
PState:=22;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Dept where DPID='''+Trim(CDS_Tree.fieldbyname('DPParent').AsString)+'''');
Open;
end;
FCPID:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
DPTopName.Text:=Trim(ADOQueryTemp.fieldbyname('DPName').AsString);
DPName.Text:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
DPNo.Text:=Trim(CDS_Tree.fieldbyname('DPNo').AsString);
DPOrder.Text:=Trim(CDS_Tree.fieldbyname('DPOrder').AsString);
end;
procedure TfrmSYDept.ToolButton1Click(Sender: TObject);
var
maxId:String;
FInt:Integer;
begin
if Trim(DPName.Text)='' then
begin
Application.MessageBox('本级名称不能为空!','提示',0);
Exit;
end;
{if Trim(DPNo.Text)='' then
begin
Application.MessageBox('类别编码不能为空!','提示',0);
Exit;
end;}
if Trim(DPOrder.Text)='' then
begin
DPOrder.Text:='99';
end;
if TryStrToInt(Trim(DPOrder.Text),FInt)=False then
begin
Application.MessageBox('顺序号非法数字!','提示',0);
Exit;
end;
try
ADOQueryCmd.Connection.BeginTrans;
if PState=11 then
begin
if GetLSNo(ADOQueryCmd,maxId,'DP','SY_Dept',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('区最大号失败!','提示',0);
Exit;
end;
end else
begin
maxId:=Trim(FCPID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from SY_Dept where DPID='''+Trim(FCPID)+'''');
Open;
end;
with ADOQueryCmd do
begin
if PState=11 then
begin
Append;
FieldByName('DPID').Value:=Trim(maxId);
FieldByName('DPName').Value:=Trim(DPName.Text);
FieldByName('DPNo').Value:=Trim(DPNo.Text);
FieldByName('DPParent').Value:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
FieldByName('DPLevel').Value:=CDS_Tree.fieldbyname('DPLevel').AsInteger+1;
FieldByName('DPOrder').Value:=StrToInt(Trim(DPOrder.Text));
Post;
end else
if PState=22 then
begin
Edit;
FieldByName('DPID').Value:=Trim(maxId);
FieldByName('DPName').Value:=Trim(DPName.Text);
FieldByName('DPNo').Value:=Trim(DPNo.Text);
FieldByName('DPOrder').Value:=StrToInt(Trim(DPOrder.Text));
//FieldByName('CPParent').Value:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
//FieldByName('CPOrder').Value:=ADOQueryTree.fieldbyname('CPOrder').AsInteger+1;
Post;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功!','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
procedure TfrmSYDept.TBDelClick(Sender: TObject);
begin
if ADOQueryTree.FieldByName('DPLevel').AsInteger=0 then Exit;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Dept where DPParent='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
Open;
if not IsEmpty then
begin
Application.MessageBox('已经定义下级组织不能删除!','提示',0);
Exit;
end;
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_User where DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
Open;
if not IsEmpty then
begin
Application.MessageBox('该组织已有人员不能删除!','提示',0);
Exit;
end;
end;
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('delete SY_Dept where DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
sql.Add('delete SY_Dept where DPParent='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
ExecSQL;
end;
InitTree();
end;
procedure TfrmSYDept.DPNameKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
DPNo.SetFocus;
end;
procedure TfrmSYDept.FormShow(Sender: TObject);
begin
InitTree();
end;
procedure TfrmSYDept.ToolButton2Click(Sender: TObject);
begin
if CDS_Tree.IsEmpty=False then
begin
if CDS_User.IsEmpty then Exit;
if Application.MessageBox('确定要进行组织分配吗?','提示',32+4)<>IDYES then Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update SY_User Set DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
sql.Add(' where UserId='''+Trim(CDS_User.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
with CDS_User do
begin
Edit;
FieldByName('Dept').Value:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
Post;
end;
end;
end;
procedure TfrmSYDept.cxDBTreeList1DblClick(Sender: TObject);
begin
if CDS_Tree.FieldByName('DPLevel').Value=0 then
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select A.*,Dept=(select DPName from SY_Dept where DPID=A.DPID) ');
SQL.Add(' from SY_User A where UserId not in(''Admin'',''Test'') ');
SQL.Add(' and Valid=''Y'' ');
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_User);
SInitCDSData20(ADOQueryTemp,CDS_User);
end else
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('exec P_Select_Dept_User :CYType');
Parameters.ParamByName('CYType').Value:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_User);
SInitCDSData20(ADOQueryTemp,CDS_User);
end;
end;
procedure TfrmSYDept.v4Column1PropertiesEditValueChanged(Sender: TObject);
var
mvalue:string;
begin
mvalue:=TcxTextEdit(Sender).EditingText;
with CDS_User do
begin
Edit;
FieldByName('MoneyUserName').Value:=Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update SY_User Set MoneyUserName='''+Trim(mvalue)+'''');
sql.Add(' where UserId='''+Trim(CDS_User.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
end;
end.

View File

@ -0,0 +1,296 @@
object frmSYDeptUserView: TfrmSYDeptUserView
Left = 233
Top = 146
Width = 927
Height = 536
Caption = #32452#32455#32467#26500#20154#21592#21015#34920
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 911
Height = 33
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_CYZZ.ThreeImgList
Flat = True
Images = DataLink_CYZZ.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object TBAdd: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #26032#22686#23376#31867
ImageIndex = 12
Visible = False
OnClick = TBAddClick
end
object ToolButton1: TToolButton
Left = 150
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 5
Visible = False
OnClick = ToolButton1Click
end
object TBDel: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 13
Visible = False
OnClick = TBDelClick
end
object ToolButton2: TToolButton
Left = 276
Top = 0
Caption = #32452#32455#20998#37197
ImageIndex = 22
Visible = False
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 359
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object cxDBTreeList1: TcxDBTreeList
Left = 0
Top = 33
Width = 249
Height = 464
Align = alLeft
Bands = <
item
end>
BufferedPaint = False
DataController.DataSource = DataSource1
DataController.ParentField = 'DPParent'
DataController.KeyField = 'DPID'
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_CYZZ.Red
Styles.Selection = DataLink_CYZZ.Red
Styles.IncSearch = DataLink_CYZZ.Red
TabOrder = 1
OnClick = cxDBTreeList1Click
OnDblClick = cxDBTreeList1DblClick
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'DPName'
Width = 210
Position.ColIndex = 1
Position.RowIndex = 0
Position.BandIndex = 0
end
end
object Panel1: TPanel
Left = 249
Top = 33
Width = 315
Height = 464
Align = alLeft
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 2
Visible = False
object Label1: TLabel
Left = 66
Top = 40
Width = 48
Height = 12
Caption = #19978#32423#32452#32455
end
object Label2: TLabel
Left = 66
Top = 81
Width = 48
Height = 12
Caption = #32452#32455#21517#31216
end
object Label3: TLabel
Left = 66
Top = 121
Width = 48
Height = 12
Caption = #32452#32455#32534#30721
end
object Label4: TLabel
Left = 24
Top = 16
Width = 60
Height = 14
Caption = #32452#32455#32467#26500
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 66
Top = 159
Width = 48
Height = 12
Caption = #39034' '#24207' '#21495
end
object DPTopName: TEdit
Left = 129
Top = 37
Width = 121
Height = 20
ReadOnly = True
TabOrder = 0
end
object DPName: TEdit
Left = 129
Top = 77
Width = 121
Height = 20
TabOrder = 1
OnKeyPress = DPNameKeyPress
end
object DPNo: TEdit
Left = 129
Top = 117
Width = 121
Height = 20
TabOrder = 2
end
object DPOrder: TEdit
Left = 129
Top = 155
Width = 121
Height = 20
TabOrder = 3
end
end
object cxGrid4: TcxGrid
Left = 564
Top = 33
Width = 347
Height = 464
Align = alClient
TabOrder = 3
object Tv4: TcxGridDBTableView
OnDblClick = Tv4DblClick
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
DataController.DataSource = DSUser
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_CYZZ.SHuangSe
Styles.IncSearch = DataLink_CYZZ.SHuangSe
Styles.Selection = DataLink_CYZZ.SHuangSe
object cxGridDBColumn1: TcxGridDBColumn
Caption = #21592#24037#32534#21495
DataBinding.FieldName = 'UserId'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_CYZZ.Default
Width = 84
end
object cxGridDBColumn7: TcxGridDBColumn
Caption = #21592#24037#21517#31216
DataBinding.FieldName = 'UserName'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_CYZZ.Default
Width = 87
end
object cxGridDBColumn8: TcxGridDBColumn
Caption = #21592#24037#32452#32455
DataBinding.FieldName = 'dept'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_CYZZ.Default
Width = 74
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv4
end
end
object DataSource1: TDataSource
DataSet = CDS_Tree
Left = 147
Top = 219
end
object ADOQueryTree: TADOQuery
Connection = DataLink_CYZZ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 117
Top = 145
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_CYZZ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 520
Top = 111
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_CYZZ.ADOLink
Parameters = <>
Left = 520
Top = 146
end
object CDS_Tree: TClientDataSet
Aggregates = <>
Params = <>
Left = 96
Top = 256
end
object CDS_User: TClientDataSet
Aggregates = <>
Params = <>
Left = 680
Top = 272
end
object DSUser: TDataSource
DataSet = CDS_User
Left = 675
Top = 211
end
end

View File

@ -0,0 +1,336 @@
unit U_SYDeptUserView;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, ExtCtrls, DBClient, cxFilter, cxData, cxDataStorage, cxEdit,
cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid;
type
TfrmSYDeptUserView = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBAdd: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DataSource1: TDataSource;
ADOQueryTree: TADOQuery;
ToolButton1: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
DPTopName: TEdit;
DPName: TEdit;
DPNo: TEdit;
CDS_Tree: TClientDataSet;
cxGrid4: TcxGrid;
Tv4: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
Label4: TLabel;
ToolButton2: TToolButton;
CDS_User: TClientDataSet;
DSUser: TDataSource;
Label5: TLabel;
DPOrder: TEdit;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBRafreshClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure DPNameKeyPress(Sender: TObject; var Key: Char);
procedure FormShow(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure Tv4DblClick(Sender: TObject);
private
{ Private declarations }
PState:Integer;
FCPID,FTopID:String;
procedure InitTree();
public
{ Public declarations }
end;
var
frmSYDeptUserView: TfrmSYDeptUserView;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmSYDeptUserView.InitTree();
var
i:Integer;
begin
try
ADOQueryTree.DisableControls;
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from SY_Dept order by DPlevel,DPOrder,DPName');
Open;
end;
SCreateCDS20(ADOQueryTree,CDS_Tree);
SInitCDSData20(ADOQueryTree,CDS_Tree);
//cxDBTreeList1.Items[0].Expand(false);
cxDBTreeList1.Items[0].Expand(True);
finally
ADOQueryTree.EnableControls;
end;
//cxDBTreeList1.Items[1].Expand(False);
end;
procedure TfrmSYDeptUserView.FormDestroy(Sender: TObject);
begin
frmSYDeptUserView:=nil;
end;
procedure TfrmSYDeptUserView.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSYDeptUserView.TBRafreshClick(Sender: TObject);
begin
InitTree();
end;
procedure TfrmSYDeptUserView.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmSYDeptUserView.TBAddClick(Sender: TObject);
begin
PState:=11;
DPTopName.Text:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
//FTopID:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
FCPID:='';
DPName.Text:='';
DPNo.Text:='';
DPName.SetFocus;
end;
procedure TfrmSYDeptUserView.cxDBTreeList1Click(Sender: TObject);
begin
PState:=22;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Dept where DPID='''+Trim(CDS_Tree.fieldbyname('DPParent').AsString)+'''');
Open;
end;
FCPID:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
DPTopName.Text:=Trim(ADOQueryTemp.fieldbyname('DPName').AsString);
DPName.Text:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
DPNo.Text:=Trim(CDS_Tree.fieldbyname('DPNo').AsString);
DPOrder.Text:=Trim(CDS_Tree.fieldbyname('DPOrder').AsString);
end;
procedure TfrmSYDeptUserView.ToolButton1Click(Sender: TObject);
var
maxId:String;
FInt:Integer;
begin
if Trim(DPName.Text)='' then
begin
Application.MessageBox('本级名称不能为空!','提示',0);
Exit;
end;
{if Trim(DPNo.Text)='' then
begin
Application.MessageBox('类别编码不能为空!','提示',0);
Exit;
end;}
if Trim(DPOrder.Text)='' then
begin
DPOrder.Text:='99';
end;
if TryStrToInt(Trim(DPOrder.Text),FInt)=False then
begin
Application.MessageBox('顺序号非法数字!','提示',0);
Exit;
end;
try
ADOQueryCmd.Connection.BeginTrans;
if PState=11 then
begin
if GetLSNo(ADOQueryCmd,maxId,'DP','SY_Dept',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('区最大号失败!','提示',0);
Exit;
end;
end else
begin
maxId:=Trim(FCPID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from SY_Dept where DPID='''+Trim(FCPID)+'''');
Open;
end;
with ADOQueryCmd do
begin
if PState=11 then
begin
Append;
FieldByName('DPID').Value:=Trim(maxId);
FieldByName('DPName').Value:=Trim(DPName.Text);
FieldByName('DPNo').Value:=Trim(DPNo.Text);
FieldByName('DPParent').Value:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
FieldByName('DPLevel').Value:=CDS_Tree.fieldbyname('DPLevel').AsInteger+1;
FieldByName('DPOrder').Value:=StrToInt(Trim(DPOrder.Text));
Post;
end else
if PState=22 then
begin
Edit;
FieldByName('DPID').Value:=Trim(maxId);
FieldByName('DPName').Value:=Trim(DPName.Text);
FieldByName('DPNo').Value:=Trim(DPNo.Text);
FieldByName('DPOrder').Value:=StrToInt(Trim(DPOrder.Text));
//FieldByName('CPParent').Value:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
//FieldByName('CPOrder').Value:=ADOQueryTree.fieldbyname('CPOrder').AsInteger+1;
Post;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功!','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
procedure TfrmSYDeptUserView.TBDelClick(Sender: TObject);
begin
if ADOQueryTree.FieldByName('DPLevel').AsInteger=0 then Exit;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Dept where DPParent='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
Open;
if not IsEmpty then
begin
Application.MessageBox('已经定义下级组织不能删除!','提示',0);
Exit;
end;
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_User where DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
Open;
if not IsEmpty then
begin
Application.MessageBox('该组织已有人员不能删除!','提示',0);
Exit;
end;
end;
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('delete SY_Dept where DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
sql.Add('delete SY_Dept where DPParent='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
ExecSQL;
end;
InitTree();
end;
procedure TfrmSYDeptUserView.DPNameKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
DPNo.SetFocus;
end;
procedure TfrmSYDeptUserView.FormShow(Sender: TObject);
begin
InitTree();
end;
procedure TfrmSYDeptUserView.ToolButton2Click(Sender: TObject);
begin
if CDS_Tree.IsEmpty=False then
begin
if CDS_User.IsEmpty then Exit;
if Application.MessageBox('确定要进行组织分配吗?','提示',32+4)<>IDYES then Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update SY_User Set DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
sql.Add(' where UserId='''+Trim(CDS_User.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
with CDS_User do
begin
Edit;
FieldByName('Dept').Value:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
Post;
end;
end;
end;
procedure TfrmSYDeptUserView.cxDBTreeList1DblClick(Sender: TObject);
begin
if CDS_Tree.FieldByName('DPLevel').Value=0 then
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select A.*,Dept=(select DPName from SY_Dept where DPID=A.DPID) ');
SQL.Add(' from SY_User A where UserId not in(''Admin'',''Test'') ');
SQL.Add(' and Valid=''Y'' ');
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_User);
SInitCDSData20(ADOQueryTemp,CDS_User);
end else
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('exec P_Select_Dept_User :CYType');
Parameters.ParamByName('CYType').Value:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_User);
SInitCDSData20(ADOQueryTemp,CDS_User);
end;
end;
procedure TfrmSYDeptUserView.Tv4DblClick(Sender: TObject);
begin
ModalResult:=1;
end;
end.

View File

@ -0,0 +1,304 @@
object frmSYDeptView: TfrmSYDeptView
Left = 233
Top = 146
Width = 927
Height = 536
Caption = #32452#32455#32467#26500#21015#34920
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 911
Height = 33
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_KangChi.ThreeImgList
Flat = True
Images = DataLink_KangChi.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object ToolButton3: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36873#25321
ImageIndex = 10
OnClick = ToolButton3Click
end
object TBAdd: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #26032#22686#23376#31867
ImageIndex = 12
Visible = False
OnClick = TBAddClick
end
object ToolButton1: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 5
Visible = False
OnClick = ToolButton1Click
end
object TBDel: TToolButton
Left = 276
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 13
Visible = False
OnClick = TBDelClick
end
object ToolButton2: TToolButton
Left = 339
Top = 0
Caption = #32452#32455#20998#37197
ImageIndex = 22
Visible = False
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 422
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object cxDBTreeList1: TcxDBTreeList
Left = 315
Top = 33
Width = 596
Height = 464
Align = alClient
Bands = <
item
end>
BufferedPaint = False
DataController.DataSource = DataSource1
DataController.ParentField = 'DPParent'
DataController.KeyField = 'DPID'
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_KangChi.Red
Styles.Selection = DataLink_KangChi.Red
Styles.IncSearch = DataLink_KangChi.Red
TabOrder = 1
OnClick = cxDBTreeList1Click
OnDblClick = cxDBTreeList1DblClick
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'DPName'
Width = 210
Position.ColIndex = 1
Position.RowIndex = 0
Position.BandIndex = 0
end
end
object Panel1: TPanel
Left = 0
Top = 33
Width = 315
Height = 464
Align = alLeft
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 2
Visible = False
object Label1: TLabel
Left = 66
Top = 40
Width = 48
Height = 12
Caption = #19978#32423#32452#32455
end
object Label2: TLabel
Left = 66
Top = 81
Width = 48
Height = 12
Caption = #32452#32455#21517#31216
end
object Label3: TLabel
Left = 66
Top = 121
Width = 48
Height = 12
Caption = #32452#32455#32534#30721
end
object Label4: TLabel
Left = 24
Top = 16
Width = 60
Height = 14
Caption = #32452#32455#32467#26500
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 66
Top = 159
Width = 48
Height = 12
Caption = #39034' '#24207' '#21495
end
object DPTopName: TEdit
Left = 129
Top = 37
Width = 121
Height = 20
ReadOnly = True
TabOrder = 0
end
object DPName: TEdit
Left = 129
Top = 77
Width = 121
Height = 20
TabOrder = 1
OnKeyPress = DPNameKeyPress
end
object DPNo: TEdit
Left = 129
Top = 117
Width = 121
Height = 20
TabOrder = 2
end
object DPOrder: TEdit
Left = 129
Top = 155
Width = 121
Height = 20
TabOrder = 3
end
end
object cxGrid4: TcxGrid
Left = 352
Top = 64
Width = 359
Height = 273
TabOrder = 3
Visible = False
object Tv4: TcxGridDBTableView
OnDblClick = Tv4DblClick
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
DataController.DataSource = DSUser
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_KangChi.SHuangSe
Styles.IncSearch = DataLink_KangChi.SHuangSe
Styles.Selection = DataLink_KangChi.SHuangSe
object cxGridDBColumn1: TcxGridDBColumn
Caption = #21592#24037#32534#21495
DataBinding.FieldName = 'UserId'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_KangChi.Default
Width = 84
end
object cxGridDBColumn7: TcxGridDBColumn
Caption = #21592#24037#21517#31216
DataBinding.FieldName = 'UserName'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_KangChi.Default
Width = 87
end
object cxGridDBColumn8: TcxGridDBColumn
Caption = #21592#24037#32452#32455
DataBinding.FieldName = 'dept'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Styles.Header = DataLink_KangChi.Default
Width = 74
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv4
end
end
object DataSource1: TDataSource
DataSet = CDS_Tree
Left = 147
Top = 219
end
object ADOQueryTree: TADOQuery
Connection = DataLink_KangChi.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 117
Top = 145
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_KangChi.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 520
Top = 111
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_KangChi.ADOLink
Parameters = <>
Left = 520
Top = 146
end
object CDS_Tree: TClientDataSet
Aggregates = <>
Params = <>
Left = 96
Top = 256
end
object CDS_User: TClientDataSet
Aggregates = <>
Params = <>
Left = 680
Top = 272
end
object DSUser: TDataSource
DataSet = CDS_User
Left = 675
Top = 211
end
end

View File

@ -0,0 +1,344 @@
unit U_SYDeptView;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, ExtCtrls, DBClient, cxFilter, cxData, cxDataStorage, cxEdit,
cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid;
type
TfrmSYDeptView = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBAdd: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DataSource1: TDataSource;
ADOQueryTree: TADOQuery;
ToolButton1: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
DPTopName: TEdit;
DPName: TEdit;
DPNo: TEdit;
CDS_Tree: TClientDataSet;
cxGrid4: TcxGrid;
Tv4: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
Label4: TLabel;
ToolButton2: TToolButton;
CDS_User: TClientDataSet;
DSUser: TDataSource;
Label5: TLabel;
DPOrder: TEdit;
ToolButton3: TToolButton;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBRafreshClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure DPNameKeyPress(Sender: TObject; var Key: Char);
procedure FormShow(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure Tv4DblClick(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
private
{ Private declarations }
PState:Integer;
FCPID,FTopID:String;
procedure InitTree();
public
{ Public declarations }
end;
var
frmSYDeptView: TfrmSYDeptView;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmSYDeptView.InitTree();
var
i:Integer;
begin
try
ADOQueryTree.DisableControls;
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from SY_Dept order by DPlevel,DPOrder,DPName');
Open;
end;
SCreateCDS20(ADOQueryTree,CDS_Tree);
SInitCDSData20(ADOQueryTree,CDS_Tree);
//cxDBTreeList1.Items[0].Expand(false);
cxDBTreeList1.Items[0].Expand(True);
finally
ADOQueryTree.EnableControls;
end;
//cxDBTreeList1.Items[1].Expand(False);
end;
procedure TfrmSYDeptView.FormDestroy(Sender: TObject);
begin
frmSYDeptView:=nil;
end;
procedure TfrmSYDeptView.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSYDeptView.TBRafreshClick(Sender: TObject);
begin
InitTree();
end;
procedure TfrmSYDeptView.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmSYDeptView.TBAddClick(Sender: TObject);
begin
PState:=11;
DPTopName.Text:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
//FTopID:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
FCPID:='';
DPName.Text:='';
DPNo.Text:='';
DPName.SetFocus;
end;
procedure TfrmSYDeptView.cxDBTreeList1Click(Sender: TObject);
begin
PState:=22;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Dept where DPID='''+Trim(CDS_Tree.fieldbyname('DPParent').AsString)+'''');
Open;
end;
FCPID:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
DPTopName.Text:=Trim(ADOQueryTemp.fieldbyname('DPName').AsString);
DPName.Text:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
DPNo.Text:=Trim(CDS_Tree.fieldbyname('DPNo').AsString);
DPOrder.Text:=Trim(CDS_Tree.fieldbyname('DPOrder').AsString);
end;
procedure TfrmSYDeptView.ToolButton1Click(Sender: TObject);
var
maxId:String;
FInt:Integer;
begin
if Trim(DPName.Text)='' then
begin
Application.MessageBox('本级名称不能为空!','提示',0);
Exit;
end;
{if Trim(DPNo.Text)='' then
begin
Application.MessageBox('类别编码不能为空!','提示',0);
Exit;
end;}
if Trim(DPOrder.Text)='' then
begin
DPOrder.Text:='99';
end;
if TryStrToInt(Trim(DPOrder.Text),FInt)=False then
begin
Application.MessageBox('顺序号非法数字!','提示',0);
Exit;
end;
try
ADOQueryCmd.Connection.BeginTrans;
if PState=11 then
begin
if GetLSNo(ADOQueryCmd,maxId,'DP','SY_Dept',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('区最大号失败!','提示',0);
Exit;
end;
end else
begin
maxId:=Trim(FCPID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from SY_Dept where DPID='''+Trim(FCPID)+'''');
Open;
end;
with ADOQueryCmd do
begin
if PState=11 then
begin
Append;
FieldByName('DPID').Value:=Trim(maxId);
FieldByName('DPName').Value:=Trim(DPName.Text);
FieldByName('DPNo').Value:=Trim(DPNo.Text);
FieldByName('DPParent').Value:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
FieldByName('DPLevel').Value:=CDS_Tree.fieldbyname('DPLevel').AsInteger+1;
FieldByName('DPOrder').Value:=StrToInt(Trim(DPOrder.Text));
Post;
end else
if PState=22 then
begin
Edit;
FieldByName('DPID').Value:=Trim(maxId);
FieldByName('DPName').Value:=Trim(DPName.Text);
FieldByName('DPNo').Value:=Trim(DPNo.Text);
FieldByName('DPOrder').Value:=StrToInt(Trim(DPOrder.Text));
//FieldByName('CPParent').Value:=Trim(ADOQueryTree.fieldbyname('CPID').AsString);
//FieldByName('CPOrder').Value:=ADOQueryTree.fieldbyname('CPOrder').AsInteger+1;
Post;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功!','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
procedure TfrmSYDeptView.TBDelClick(Sender: TObject);
begin
if ADOQueryTree.FieldByName('DPLevel').AsInteger=0 then Exit;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Dept where DPParent='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
Open;
if not IsEmpty then
begin
Application.MessageBox('已经定义下级组织不能删除!','提示',0);
Exit;
end;
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_User where DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
Open;
if not IsEmpty then
begin
Application.MessageBox('该组织已有人员不能删除!','提示',0);
Exit;
end;
end;
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('delete SY_Dept where DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
sql.Add('delete SY_Dept where DPParent='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
ExecSQL;
end;
InitTree();
end;
procedure TfrmSYDeptView.DPNameKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
DPNo.SetFocus;
end;
procedure TfrmSYDeptView.FormShow(Sender: TObject);
begin
InitTree();
end;
procedure TfrmSYDeptView.ToolButton2Click(Sender: TObject);
begin
if CDS_Tree.IsEmpty=False then
begin
if CDS_User.IsEmpty then Exit;
if Application.MessageBox('确定要进行组织分配吗?','提示',32+4)<>IDYES then Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update SY_User Set DPID='''+Trim(CDS_Tree.fieldbyname('DPID').AsString)+'''');
sql.Add(' where UserId='''+Trim(CDS_User.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
with CDS_User do
begin
Edit;
FieldByName('Dept').Value:=Trim(CDS_Tree.fieldbyname('DPName').AsString);
Post;
end;
end;
end;
procedure TfrmSYDeptView.cxDBTreeList1DblClick(Sender: TObject);
begin
if CDS_Tree.FieldByName('DPLevel').Value=0 then
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select A.*,Dept=(select DPName from SY_Dept where DPID=A.DPID) ');
SQL.Add(' from SY_User A where UserId not in(''Admin'',''Test'') ');
SQL.Add(' and Valid=''Y'' ');
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_User);
SInitCDSData20(ADOQueryTemp,CDS_User);
end else
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('exec P_Select_Dept_User :CYType');
Parameters.ParamByName('CYType').Value:=Trim(CDS_Tree.fieldbyname('DPID').AsString);
Open;
end;
SCreateCDS20(ADOQueryTemp,CDS_User);
SInitCDSData20(ADOQueryTemp,CDS_User);
end;
ModalResult:=1;
end;
procedure TfrmSYDeptView.Tv4DblClick(Sender: TObject);
begin
ModalResult:=1;
end;
procedure TfrmSYDeptView.ToolButton3Click(Sender: TObject);
begin
ModalResult:=1;
end;
end.

View File

@ -0,0 +1,557 @@
object frmUserModuleNameList: TfrmUserModuleNameList
Left = 97
Top = 61
Width = 1201
Height = 618
Caption = #21592#24037#27169#22359#21015#34920
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1185
Height = 33
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_CYZZ.ThreeImgList
Flat = True
Images = DataLink_CYZZ.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = TBFindClick
end
object TBExport: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 16
OnClick = TBExportClick
end
object TBClose: TToolButton
Left = 189
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 33
Width = 1185
Height = 37
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
end
object cxPageControl1: TcxPageControl
Left = 0
Top = 70
Width = 1185
Height = 509
ActivePage = cxTabSheet1
Align = alClient
Style = 8
TabOrder = 2
OnChange = cxPageControl1Change
ClientRectBottom = 509
ClientRectRight = 1185
ClientRectTop = 23
object cxTabSheet1: TcxTabSheet
Caption = #27169#22359#34920
ImageIndex = 0
object cxGrid3: TcxGrid
Left = 0
Top = 37
Width = 1185
Height = 449
Align = alClient
TabOrder = 0
object Tv3: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Format = 'DefStr1'
end
item
Format = 'YCLCode'
end
item
Kind = skCount
Position = spFooter
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skCount
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.GroupFooters = gfAlwaysVisible
Styles.Inactive = DataLink_CYZZ.SHuangSe
Styles.IncSearch = DataLink_CYZZ.SHuangSe
Styles.Selection = DataLink_CYZZ.SHuangSe
Styles.Header = DataLink_CYZZ.Default
object cxGridDBColumn2: TcxGridDBColumn
Caption = #27169#22359#21517#31216
DataBinding.FieldName = 'FormName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Styles.Content = DataLink_CYZZ.FoneRed
Styles.Footer = DataLink_CYZZ.FoneRed
Styles.Header = DataLink_CYZZ.FoneRed
Width = 256
end
object cxGridDBColumn1: TcxGridDBColumn
Caption = #20351#29992#24773#20917
DataBinding.FieldName = 'FormNameNote'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Content = DataLink_CYZZ.FontBlue
Styles.Footer = DataLink_CYZZ.FontBlue
Styles.Header = DataLink_CYZZ.FontBlue
Width = 917
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv3
end
end
object Panel2: TPanel
Left = 0
Top = 0
Width = 1185
Height = 37
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label1: TLabel
Left = 20
Top = 12
Width = 48
Height = 12
Caption = #27169#22359#21517#31216
end
object Label4: TLabel
Left = 284
Top = 12
Width = 48
Height = 12
Caption = #20351#29992#24773#20917
end
object FormName: TEdit
Tag = 2
Left = 70
Top = 9
Width = 179
Height = 20
TabOrder = 0
OnChange = UserIdChange
end
object FormNameNote: TEdit
Tag = 2
Left = 334
Top = 9
Width = 179
Height = 20
TabOrder = 1
OnChange = UserIdChange
end
end
end
object cxTabSheet2: TcxTabSheet
Caption = #37096#38376#27169#22359#34920
ImageIndex = 1
object cxGrid2: TcxGrid
Left = 0
Top = 37
Width = 1185
Height = 449
Align = alClient
TabOrder = 0
object Tv2: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Format = 'DefStr1'
end
item
Format = 'YCLCode'
end
item
Kind = skCount
Position = spFooter
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skCount
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.GroupFooters = gfAlwaysVisible
Styles.Inactive = DataLink_CYZZ.SHuangSe
Styles.IncSearch = DataLink_CYZZ.SHuangSe
Styles.Selection = DataLink_CYZZ.SHuangSe
Styles.Header = DataLink_CYZZ.Default
object cxGridDBColumn3: TcxGridDBColumn
Caption = #37096#38376
DataBinding.FieldName = 'DPName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Content = DataLink_CYZZ.FontBlue
Styles.Footer = DataLink_CYZZ.FontBlue
Styles.Header = DataLink_CYZZ.FontBlue
Width = 116
end
object cxGridDBColumn4: TcxGridDBColumn
Caption = #27169#22359#21517#31216
DataBinding.FieldName = 'DFormName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Styles.Content = DataLink_CYZZ.FoneRed
Styles.Footer = DataLink_CYZZ.FoneRed
Styles.Header = DataLink_CYZZ.FoneRed
Width = 263
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object Panel3: TPanel
Left = 0
Top = 0
Width = 1185
Height = 37
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label2: TLabel
Left = 242
Top = 12
Width = 48
Height = 12
Caption = #27169#22359#21517#31216
end
object Label5: TLabel
Left = 20
Top = 12
Width = 24
Height = 12
Caption = #37096#38376
end
object DFormName: TEdit
Tag = 2
Left = 292
Top = 9
Width = 179
Height = 20
TabOrder = 0
OnChange = UserIdChange
end
object DPName: TEdit
Tag = 2
Left = 45
Top = 9
Width = 179
Height = 20
TabOrder = 1
OnChange = UserIdChange
end
end
end
object cxTabSheet3: TcxTabSheet
Caption = #21592#24037#27169#22359#34920
ImageIndex = 2
object cxGrid1: TcxGrid
Left = 0
Top = 37
Width = 1185
Height = 449
Align = alClient
TabOrder = 0
object Tv1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <
item
Format = 'DefStr1'
end
item
Format = 'YCLCode'
end
item
Kind = skCount
Position = spFooter
Column = v1ShortName
end>
DataController.Summary.FooterSummaryItems = <
item
Kind = skCount
Column = v1ShortName
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.GroupFooters = gfAlwaysVisible
Styles.Inactive = DataLink_CYZZ.SHuangSe
Styles.IncSearch = DataLink_CYZZ.SHuangSe
Styles.Selection = DataLink_CYZZ.SHuangSe
Styles.Header = DataLink_CYZZ.Default
object v1ShortName: TcxGridDBColumn
Caption = #21592#24037#32534#21495
DataBinding.FieldName = 'UserId'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Width = 108
end
object v1UnitName: TcxGridDBColumn
Tag = 2
Caption = #30331#24405#21517#31216
DataBinding.FieldName = 'UserName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Width = 90
end
object v1Column1: TcxGridDBColumn
Caption = #37096#38376
DataBinding.FieldName = 'UDPName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Options.Editing = False
Styles.Content = DataLink_CYZZ.FontBlue
Styles.Footer = DataLink_CYZZ.FontBlue
Styles.Header = DataLink_CYZZ.FontBlue
Width = 106
end
object v1Quantity: TcxGridDBColumn
Caption = #27169#22359#21517#31216
DataBinding.FieldName = 'UFormName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
Properties.Alignment.Vert = taVCenter
HeaderAlignmentHorz = taCenter
Styles.Content = DataLink_CYZZ.FoneRed
Styles.Footer = DataLink_CYZZ.FoneRed
Styles.Header = DataLink_CYZZ.FoneRed
Width = 241
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
object Panel4: TPanel
Left = 0
Top = 0
Width = 1185
Height = 37
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 20
Top = 12
Width = 48
Height = 12
Caption = #21592#24037#32534#21495
end
object Label6: TLabel
Left = 212
Top = 12
Width = 48
Height = 12
Caption = #30331#24405#21517#31216
end
object Label7: TLabel
Left = 412
Top = 12
Width = 24
Height = 12
Caption = #37096#38376
end
object Label8: TLabel
Left = 585
Top = 12
Width = 48
Height = 12
Caption = #27169#22359#21517#31216
end
object UserId: TEdit
Tag = 2
Left = 70
Top = 9
Width = 127
Height = 20
TabOrder = 0
OnChange = UserIdChange
end
object UserName: TEdit
Tag = 2
Left = 262
Top = 9
Width = 127
Height = 20
TabOrder = 1
OnChange = UserIdChange
end
object UDPName: TEdit
Tag = 2
Left = 437
Top = 9
Width = 127
Height = 20
TabOrder = 2
OnChange = UserIdChange
end
object UFormName: TEdit
Tag = 2
Left = 635
Top = 9
Width = 127
Height = 20
TabOrder = 3
OnChange = UserIdChange
end
end
end
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 680
Top = 8
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_CYZZ.ADOLink
Parameters = <>
Left = 432
Top = 200
end
object ADOQueryMain: TADOQuery
Connection = DataLink_CYZZ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 464
Top = 200
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_CYZZ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 496
Top = 200
end
object DataSource1: TDataSource
DataSet = CDS_Main
Left = 600
Top = 8
end
object CDS_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 636
Top = 8
end
object DataSource2: TDataSource
DataSet = ClientDataSet2
Left = 448
Top = 8
end
object ClientDataSet2: TClientDataSet
Aggregates = <>
Params = <>
Left = 476
Top = 8
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 504
Top = 8
end
object DataSource3: TDataSource
DataSet = ClientDataSet3
Left = 296
end
object ClientDataSet3: TClientDataSet
Aggregates = <>
Params = <>
Left = 332
end
object cxGridPopupMenu3: TcxGridPopupMenu
Grid = cxGrid3
PopupMenus = <>
Left = 368
end
end

View File

@ -0,0 +1,221 @@
unit U_UserModuleNameList; //
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, cxCalendar, cxButtonEdit, cxDropDownEdit,
DBClient, Menus, cxSplitter, cxTextEdit, RM_Common, RM_Class,
RM_GridReport, RM_System, RM_Dataset, RM_e_Xls, dxPSGlbl, dxPSUtl,
dxPSEngn, dxPrnPg, dxBkgnd, dxWrap, dxPrnDev, dxPSCompsProvider,
dxPSFillPatterns, dxPSEdgePatterns, dxPSCore, dxPScxCommon, dxPScxGridLnk,
cxPC;
type
TfrmUserModuleNameList = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBClose: TToolButton;
cxGridPopupMenu1: TcxGridPopupMenu;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
TBExport: TToolButton;
Panel1: TPanel;
CDS_Main: TClientDataSet;
DataSource2: TDataSource;
ClientDataSet2: TClientDataSet;
cxGridPopupMenu2: TcxGridPopupMenu;
cxPageControl1: TcxPageControl;
cxTabSheet1: TcxTabSheet;
cxTabSheet2: TcxTabSheet;
cxTabSheet3: TcxTabSheet;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1ShortName: TcxGridDBColumn;
v1UnitName: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Quantity: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
cxGrid3: TcxGrid;
Tv3: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridDBColumn3: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
DataSource3: TDataSource;
ClientDataSet3: TClientDataSet;
cxGridPopupMenu3: TcxGridPopupMenu;
Panel2: TPanel;
Label1: TLabel;
FormName: TEdit;
Panel3: TPanel;
Label2: TLabel;
DFormName: TEdit;
Panel4: TPanel;
Label3: TLabel;
UserId: TEdit;
Label4: TLabel;
FormNameNote: TEdit;
Label5: TLabel;
DPName: TEdit;
Label6: TLabel;
UserName: TEdit;
Label7: TLabel;
UDPName: TEdit;
Label8: TLabel;
UFormName: TEdit;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure UserIdChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cxPageControl1Change(Sender: TObject);
private
canshu1,canshu2:String;
procedure InitGrid();
procedure InitForm();
{ Private declarations }
public
{ Public declarations }
end;
var
frmUserModuleNameList: TfrmUserModuleNameList;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmUserModuleNameList.FormDestroy(Sender: TObject);
begin
frmUserModuleNameList:=nil;
end;
procedure TfrmUserModuleNameList.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmUserModuleNameList.FormCreate(Sender: TObject);
begin
canshu1:=Trim(DParameters1);
canshu2:=Trim(DParameters2);
end;
procedure TfrmUserModuleNameList.TBCloseClick(Sender: TObject);
begin
Close;
WriteCxGrid('员工模块列表',Tv1,'系统管理');
WriteCxGrid('部门模块列表',Tv2,'系统管理');
WriteCxGrid('模块列表',Tv3,'系统管理');
end;
procedure TfrmUserModuleNameList.InitGrid();
begin
with ADOQueryMain do
begin
Filtered:=False;
Close;
sql.Clear;
if cxPageControl1.ActivePageIndex=0 then
begin
SQL.Add(' exec P_View_ModuleName ');
end else
if cxPageControl1.ActivePageIndex=1 then
begin
SQL.Add(' exec P_View_DeptModuleName ');
end else
if cxPageControl1.ActivePageIndex=2 then
begin
SQL.Add(' exec P_View_UserModuleName ');
end;
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
end;
procedure TfrmUserModuleNameList.InitForm();
begin
ReadCxGrid('员工模块列表',Tv1,'系统管理');
ReadCxGrid('部门模块列表',Tv2,'系统管理');
ReadCxGrid('模块列表',Tv3,'系统管理');
cxPageControl1.ActivePageIndex:=0;
//InitGrid();
end;
procedure TfrmUserModuleNameList.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
if cxPageControl1.ActivePageIndex=0 then
SDofilter(ADOQueryMain,SGetFilters(Panel2,1,2))
else if cxPageControl1.ActivePageIndex=1 then
SDofilter(ADOQueryMain,SGetFilters(Panel3,1,2))
else if cxPageControl1.ActivePageIndex=2 then
SDofilter(ADOQueryMain,SGetFilters(Panel4,1,2));
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
end;
procedure TfrmUserModuleNameList.TBExportClick(Sender: TObject);
begin
if CDS_Main.IsEmpty then Exit;
if cxPageControl1.ActivePageIndex=0 then
TcxGridToExcel('模块列表',cxGrid3)
else if cxPageControl1.ActivePageIndex=1 then
TcxGridToExcel('部门模块列表',cxGrid2)
else if cxPageControl1.ActivePageIndex=2 then
TcxGridToExcel('员工模块列表',cxGrid1);
end;
procedure TfrmUserModuleNameList.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmUserModuleNameList.UserIdChange(Sender: TObject);
begin
if ADOQueryMain.Active=False then Exit;
if cxPageControl1.ActivePageIndex=0 then
SDofilter(ADOQueryMain,SGetFilters(Panel2,1,2))
else if cxPageControl1.ActivePageIndex=1 then
SDofilter(ADOQueryMain,SGetFilters(Panel3,1,2))
else if cxPageControl1.ActivePageIndex=2 then
SDofilter(ADOQueryMain,SGetFilters(Panel4,1,2));
SCreateCDS20(ADOQueryMain,CDS_Main);
SInitCDSData20(ADOQueryMain,CDS_Main);
end;
procedure TfrmUserModuleNameList.FormShow(Sender: TObject);
begin
InitForm();
end;
procedure TfrmUserModuleNameList.cxPageControl1Change(Sender: TObject);
begin
InitGrid();
end;
end.

View File

@ -0,0 +1,275 @@
object frmZDYHelp: TfrmZDYHelp
Left = 466
Top = 188
Width = 465
Height = 528
Caption = #39033#30446#32500#25252
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object cxGrid1: TcxGrid
Left = 0
Top = 73
Width = 449
Height = 417
Align = alClient
TabOrder = 2
object TV1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
OnCellDblClick = TV1CellDblClick
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
object V1Code: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'ZDYNo'
Visible = False
HeaderAlignmentHorz = taCenter
Width = 97
end
object V1OrderNo: TcxGridDBColumn
Caption = #39034#24207#21495
DataBinding.FieldName = 'OrderNo'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1OrderNoPropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 49
end
object V1Name: TcxGridDBColumn
Tag = 2
Caption = #21517#31216
DataBinding.FieldName = 'ZDYName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1NamePropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 326
end
object V1Note: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1NotePropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 109
end
object V1ZdyFlag: TcxGridDBColumn
Caption = #26631#24535
DataBinding.FieldName = 'ZdyFlag'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1Column1PropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 57
end
object V1HelpType: TcxGridDBColumn
Caption = #24110#21161#31867#27604
DataBinding.FieldName = 'HelpType'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1HelpTypePropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 55
end
object V1ZdyStr1: TcxGridDBColumn
DataBinding.FieldName = 'ZdyStr1'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1ZdyStr1PropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 61
end
object V1ZdyStr2: TcxGridDBColumn
DataBinding.FieldName = 'ZdyStr2'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1ZdyStr1PropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 60
end
object V1ZdyStr3: TcxGridDBColumn
DataBinding.FieldName = 'ZdyStr3'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1ZdyStr1PropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 57
end
object V1ZdyStr4: TcxGridDBColumn
DataBinding.FieldName = 'ZdyStr4'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1ZdyStr1PropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 61
end
object V1ZdyStr5: TcxGridDBColumn
DataBinding.FieldName = 'ZdyStr5'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1ZdyStr1PropertiesEditValueChanged
Visible = False
HeaderAlignmentHorz = taCenter
Width = 61
end
end
object cxGrid1Level1: TcxGridLevel
GridView = TV1
end
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 449
Height = 29
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Flat = True
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_ContractManagement.ThreeImgList
List = True
ParentFont = False
ShowCaptions = True
TabOrder = 0
object ToolButton1: TToolButton
Left = 0
Top = 0
Caption = #36873#25321
ImageIndex = 10
OnClick = ToolButton1Click
end
object TBAdd: TToolButton
Left = 59
Top = 0
Caption = #22686#34892
ImageIndex = 12
OnClick = TBAddClick
end
object TBDel: TToolButton
Left = 118
Top = 0
Caption = #21024#34892
ImageIndex = 13
OnClick = TBDelClick
end
object TBEdit: TToolButton
Left = 177
Top = 0
Caption = #20462#25913
ImageIndex = 11
OnClick = TBEditClick
end
object TBSave: TToolButton
Left = 236
Top = 0
Caption = #20445#23384
ImageIndex = 15
Visible = False
OnClick = TBSaveClick
end
object TBClose: TToolButton
Left = 295
Top = 0
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 29
Width = 449
Height = 44
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 1
object Label1: TLabel
Left = 18
Top = 17
Width = 24
Height = 12
Caption = #21517#31216
end
object Label2: TLabel
Left = 240
Top = 11
Width = 120
Height = 24
Caption = #27880#65306#28966#28857#31163#24320#24403#21069#32534#36753#13#10' '#21333#20803#26684#20445#23384#25968#25454#12290
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentFont = False
end
object ZDYName: TEdit
Tag = 2
Left = 53
Top = 12
Width = 169
Height = 20
TabOrder = 0
OnChange = ZDYNameChange
end
end
object ADOQueryMain: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 48
Top = 136
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 80
Top = 144
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
Parameters = <>
Left = 112
Top = 152
end
object DataSource1: TDataSource
DataSet = ClientDataSet1
Left = 280
Top = 144
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 208
Top = 144
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 168
Top = 152
end
end

View File

@ -0,0 +1,724 @@
unit U_ZDYHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu,
cxTimeEdit;
type
TfrmZDYHelp = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Code: TcxGridDBColumn;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBAdd: TToolButton;
TBSave: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
TBEdit: TToolButton;
V1Note: TcxGridDBColumn;
V1OrderNo: TcxGridDBColumn;
Panel1: TPanel;
Label1: TLabel;
ZDYName: TEdit;
Label2: TLabel;
cxGridPopupMenu1: TcxGridPopupMenu;
V1ZdyFlag: TcxGridDBColumn;
V1HelpType: TcxGridDBColumn;
V1ZdyStr1: TcxGridDBColumn;
V1ZdyStr2: TcxGridDBColumn;
V1ZdyStr3: TcxGridDBColumn;
V1ZdyStr4: TcxGridDBColumn;
V1ZdyStr5: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBAddClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure ZDYNameChange(Sender: TObject);
procedure V1NamePropertiesEditValueChanged(Sender: TObject);
procedure V1OrderNoPropertiesEditValueChanged(Sender: TObject);
procedure V1NotePropertiesEditValueChanged(Sender: TObject);
procedure V1Column1PropertiesEditValueChanged(Sender: TObject);
procedure V1HelpTypePropertiesEditValueChanged(Sender: TObject);
procedure V1ZdyStr1PropertiesEditValueChanged(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
flag,flagname,snote,MainType:string;
fnote,forderno,fZdyFlag,ViewFlag:Boolean;
PPSTE:integer;
{ Public declarations }
end;
var
frmZDYHelp: TfrmZDYHelp;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmZDYHelp.FormCreate(Sender: TObject);
begin
{try
cxGrid1.Align:=alClient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='';
Connected:=true;
end;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
{frmRTZDYHelp.Free;
end; }
end;
procedure TfrmZDYHelp.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ZDYName.SetFocus;
WriteCxGrid('自定义'+Trim(flag),TV1,'自定义数据');
Action:=caFree;
end;
procedure TfrmZDYHelp.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,ZJM=dbo.getPinYin(A.ZdyName) from KH_ZDY A where A.Type='''+flag+'''');
if Trim(MainType)<>'' then
begin
sql.Add(' and A.MainType='''+Trim(MainType)+'''');
end;
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZDYHelp.TBAddClick(Sender: TObject);
var
i:Integer;
begin
ZDYName.SetFocus;
TV1.OptionsData.Editing:=True;
TV1.OptionsSelection.CellSelect:=True;
for i:=0 to 5 do
begin
with ClientDataSet1 do
begin
Append;
Post;
end;
end;
end;
procedure TfrmZDYHelp.TBSaveClick(Sender: TObject);
var
maxno:string;
begin
if ClientDataSet1.IsEmpty then Exit;
ZDYName.SetFocus;
if ClientDataSet1.Locate('ZDYName',null,[]) then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
if ClientDataSet1.Locate('ZDYName','',[]) then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from KH_ZDY where ZdyNo='''+Trim(flag)+'''');
open;
end;
if ADOQueryTemp.IsEmpty then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYName,Type,MainType) select :ZDYNo,:ZDYName,:Type,:MainType ');
Parameters.ParamByName('ZDYNo').Value:=Trim(flag);
Parameters.ParamByName('ZDYName').Value:=Trim(flagname);
Parameters.ParamByName('Type').Value:='Main';
Parameters.ParamByName('MainType').Value:=Trim(MainType);
ExecSQL;
end;
end;
with ADOQueryCmd do
begin
ClientDataSet1.DisableControls;
with ClientDataSet1 do
begin
First;
while not eof do
begin
if Trim(ClientDataSet1.FieldByName('ZDYNO').AsString)='' then
begin
if GetLSNo(ADOQueryTemp,maxno,'SY','KH_ZDY',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
ClientDataSet1.EnableControls;
Application.MessageBox('取最大编号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.add('select * from KH_Zdy where Type='''+Trim(flag)+'''');
if Trim(MainType)<>'' then
SQL.Add(' and MainType='''+Trim(MainType)+'''');
sql.Add(' and ZdyName='''+Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)+'''');
Open;
end;
if ADOQueryTemp.IsEmpty=False then
begin
if ADOQueryTemp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
if Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end else
begin
if Trim(ADOQueryTemp.fieldbyname('ZdyNo').AsString)<>Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString) then
begin
ADOQueryCmd.Connection.RollbackTrans;
ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add('delete KH_ZDY where ZDYNO='''+Trim(ClientDataSet1.fieldbyname('ZDYNO').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where 1<>1');
Open;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('ZDYNo').Value:=Trim(maxno);
ADOQueryCmd.FieldByName('ZDYName').Value:=ClientDataSet1.fieldbyname('ZDYName').Value;
ADOQueryCmd.FieldByName('note').Value:=Trim(snote);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('Type').Value:=flag;
ADOQueryCmd.FieldByName('valid').Value:='Y';
if Trim(MainType)<>'' then
ADOQueryCmd.FieldByName('MainType').Value:=Trim(MainType);
//ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('ZDYNo').Value:=Trim(maxno);
ClientDataSet1.Post;
Next;
end;
end;
ClientDataSet1.EnableControls;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功!','提示',0);
TV1.OptionsData.Editing:=False;
TV1.OptionsSelection.CellSelect:=False;
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
procedure TfrmZDYHelp.TBDelClick(Sender: TObject);
begin
if ClientDataSet1.IsEmpty then Exit;
if (Trim(ClientDataSet1.FieldByName('ZDYNo').AsString)<>'') or
(Trim(ClientDataSet1.FieldByName('ZDYname').AsString)<>'') then
begin
if application.MessageBox('确定要删除吗?','提示信息',1)=2 then exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete KH_ZDY where ZDYNo='''+Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString)+'''');
SQL.Add(' and Type='''+Trim(flag)+'''');
ExecSQL;
end;
end;
ClientDataSet1.Delete;
end;
procedure TfrmZDYHelp.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
ZDYName.SetFocus;
WriteCxGrid('自定义'+Trim(flag),TV1,'自定义数据');
Close;
end;
procedure TfrmZDYHelp.FormShow(Sender: TObject);
var
fsj,fsj1:string;
begin
{if PPSTE=1 then
begin
Application.Terminate;
Exit;
end; }
InitGrid();
fsj:=Trim(flag)+'01';
fsj1:=Trim(flagname)+'01';
{if ClientDataSet1.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYname,Type,note)');
sql.Add('select '''+Trim(fsj)+'''');
sql.Add(','''+Trim(fsj1)+'''');
SQL.Add(','''+Trim(flag)+'''');
sql.Add(','''+Trim(snote)+'''');
ExecSQL;
end;
InitGrid();
end;}
//frmZDYHelp.Caption:=Trim(flagname)+'<'+Trim(flag)+'>';
//ReadCxGrid('自定义',TV1,'自定义数据');
ReadCxGrid('自定义'+Trim(flag),TV1,'自定义数据');
frmZDYHelp.Caption:=Trim(flagname);
V1Note.Visible:=fnote;
V1ZdyFlag.Visible:=fZdyFlag;
V1OrderNo.Visible:=forderno;
if ViewFlag=True then
begin
TBAdd.Visible:=False;
TBSave.Visible:=False;
TBDel.Visible:=False;
TBEdit.Visible:=False;
Label2.Visible:=False;
end;
end;
procedure TfrmZDYHelp.ToolButton1Click(Sender: TObject);
begin
ZDYName.SetFocus;
WriteCxGrid('自定义'+Trim(flag),TV1,'自定义数据');
ModalResult:=1;
end;
procedure TfrmZDYHelp.TBEditClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
TV1.OptionsSelection.CellSelect:=True;
end;
procedure TfrmZDYHelp.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if TV1.OptionsData.Editing=False then
begin
ModalResult:=1;
end;
end;
procedure TfrmZDYHelp.ZDYNameChange(Sender: TObject);
var
fsj:String;
begin
if Trim(ZDYName.Text)<>'' then
begin
fsj:=' zdyname like '''+'%'+Trim(ZDYName.Text)+'%'+''''
+' or Note like '''+'%'+Trim(ZDYName.Text)+'%'+''''
+' or ZJM like '''+'%'+Trim(ZDYName.Text)+'%'+'''';
end;
if ADOQueryMain.Active then
begin
// SDofilter(ADOQueryMain,fsj);
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
if Trim(fsj)='' then
begin
Filtered:=False;
end else
begin
Filtered:=False;
Filter:=fsj;
Filtered:=True;
end;
end;
finally
ADOQueryMain.EnableControls;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
end;
end;
procedure TfrmZDYHelp.V1NamePropertiesEditValueChanged(Sender: TObject);
var
maxno,mvalue:string;
begin
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
//Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('ZdyName').Value:=Trim(mvalue);
//Post;
end;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from KH_ZDY where ZdyNo='''+Trim(flag)+'''');
open;
end;
if ADOQueryTemp.IsEmpty then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYName,Type,MainType) select :ZDYNo,:ZDYName,:Type,:MainType ');
Parameters.ParamByName('ZDYNo').Value:=Trim(flag);
Parameters.ParamByName('ZDYName').Value:=Trim(flagname);
Parameters.ParamByName('Type').Value:='Main';
Parameters.ParamByName('MainType').Value:=Trim(MainType);
ExecSQL;
end;
end;
with ADOQueryCmd do
begin
//ClientDataSet1.DisableControls;
//with ClientDataSet1 do
//begin
//First;
//while not eof do
//begin
if Trim(ClientDataSet1.FieldByName('ZDYNO').AsString)='' then
begin
if GetLSNo(ADOQueryTemp,maxno,'SY','KH_ZDY',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('取最大编号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.add('select * from KH_Zdy where Type='''+Trim(flag)+'''');
if Trim(MainType)<>'' then
SQL.Add(' and MainType='''+Trim(MainType)+'''');
sql.Add(' and ZdyName='''+Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)+'''');
Open;
end;
if ADOQueryTemp.IsEmpty=False then
begin
if ADOQueryTemp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
if Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end else
begin
if Trim(ADOQueryTemp.fieldbyname('ZdyNo').AsString)<>Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString) then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add('delete KH_ZDY where ZDYNO='''+Trim(ClientDataSet1.fieldbyname('ZDYNO').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where 1<>1');
Open;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('ZDYNo').Value:=Trim(maxno);
ADOQueryCmd.FieldByName('ZDYName').Value:=ClientDataSet1.fieldbyname('ZDYName').AsString;
ADOQueryCmd.FieldByName('note').Value:=Trim(snote);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('Type').Value:=flag;
ADOQueryCmd.FieldByName('valid').Value:='Y';
if Trim(MainType)<>'' then
ADOQueryCmd.FieldByName('MainType').Value:=Trim(MainType);
//ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('ZDYNo').Value:=Trim(maxno);
//ClientDataSet1.Post;
// Next;
//end;
//end;
// ClientDataSet1.EnableControls;
end;
ADOQueryCmd.Connection.CommitTrans;
//Application.MessageBox('保存成功!','提示',0);
//TV1.OptionsData.Editing:=False;
//TV1.OptionsSelection.CellSelect:=False;
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
procedure TfrmZDYHelp.V1OrderNoPropertiesEditValueChanged(Sender: TObject);
var
mvalue:string;
begin
if Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)='' then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
mvalue:='0';
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('OrderNo').Value:=mvalue;
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update KH_Zdy Set OrderNo='+mvalue);
sql.Add(' where ZdyNo='''+Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)+'''');
ExecSQL;
end;
end;
procedure TfrmZDYHelp.V1NotePropertiesEditValueChanged(Sender: TObject);
var
mvalue:string;
begin
if Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)='' then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
mvalue:='0';
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('Note').Value:=mvalue;
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update KH_Zdy Set Note='''+Trim(mvalue)+'''');
sql.Add(' where ZdyNo='''+Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)+'''');
ExecSQL;
end;
end;
procedure TfrmZDYHelp.V1Column1PropertiesEditValueChanged(Sender: TObject);
var
mvalue:String;
begin
if Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)='' then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
mvalue:='0';
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('ZdyFlag').Value:=StrToInt(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update KH_Zdy Set ZdyFlag='+Trim(mvalue));
sql.Add(' where ZdyNo='''+Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)+'''');
ExecSQL;
end;
end;
procedure TfrmZDYHelp.V1HelpTypePropertiesEditValueChanged(
Sender: TObject);
var
mvalue:string;
begin
if Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)='' then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
mvalue:='0';
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('HelpType').Value:=mvalue;
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update KH_Zdy Set HelpType='''+Trim(mvalue)+'''');
sql.Add(' where ZdyNo='''+Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)+'''');
ExecSQL;
end;
end;
procedure TfrmZDYHelp.V1ZdyStr1PropertiesEditValueChanged(Sender: TObject);
var
mvalue,FFieldName:string;
begin
if Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)='' then
begin
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
mvalue:=TcxTextEdit(Sender).EditingText;
FFieldName:=TV1.Controller.FocusedColumn.DataBinding.FilterFieldName;
if Trim(mvalue)='' then
begin
mvalue:='';
end;
with ClientDataSet1 do
begin
Edit;
FieldByName(FFieldName).Value:=mvalue;
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('Update KH_Zdy Set '+FFieldName+'='''+Trim(mvalue)+'''');
sql.Add(' where ZdyNo='''+Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)+'''');
ExecSQL;
end;
end;
end.

View File

@ -0,0 +1,224 @@
object frmZDYHelpSel: TfrmZDYHelpSel
Left = 392
Top = 169
Width = 574
Height = 598
Caption = #39033#30446#32500#25252
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object cxGrid1: TcxGrid
Left = 0
Top = 73
Width = 558
Height = 486
Align = alClient
TabOrder = 0
object TV1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
OnCellDblClick = TV1CellDblClick
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.FocusCellOnTab = True
OptionsBehavior.GoToNextCellOnEnter = True
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsView.GroupByBox = False
object V1Code: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'ZDYNo'
Visible = False
HeaderAlignmentHorz = taCenter
Width = 97
end
object V1Column1: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
Properties.NullStyle = nssUnchecked
HeaderAlignmentHorz = taCenter
Width = 48
end
object V1Name: TcxGridDBColumn
Tag = 2
Caption = #21517#31216
DataBinding.FieldName = 'ZDYName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = V1NamePropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 208
end
object V1Note: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
Visible = False
HeaderAlignmentHorz = taCenter
Width = 57
end
object V1OrderNo: TcxGridDBColumn
Caption = #39034#24207#21495
DataBinding.FieldName = 'OrderNo'
Visible = False
HeaderAlignmentHorz = taCenter
Width = 53
end
end
object cxGrid1Level1: TcxGridLevel
GridView = TV1
end
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 558
Height = 29
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Flat = True
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_DDMD.ThreeImgList
List = True
ParentFont = False
ShowCaptions = True
TabOrder = 1
object ToolButton1: TToolButton
Left = 0
Top = 0
Caption = #30830#23450
ImageIndex = 10
OnClick = ToolButton1Click
end
object TBAdd: TToolButton
Left = 59
Top = 0
Caption = #22686#34892
ImageIndex = 12
OnClick = TBAddClick
end
object TBDel: TToolButton
Left = 118
Top = 0
Caption = #21024#34892
ImageIndex = 13
OnClick = TBDelClick
end
object TBEdit: TToolButton
Left = 177
Top = 0
Caption = #20462#25913
ImageIndex = 11
OnClick = TBEditClick
end
object TBSave: TToolButton
Left = 236
Top = 0
Caption = #20445#23384
ImageIndex = 15
Visible = False
OnClick = TBSaveClick
end
object TBClose: TToolButton
Left = 295
Top = 0
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 29
Width = 558
Height = 44
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 2
object Label1: TLabel
Left = 19
Top = 17
Width = 24
Height = 12
Caption = #21517#31216
end
object Label2: TLabel
Left = 240
Top = 11
Width = 120
Height = 24
Caption = #27880#65306#28966#28857#31163#24320#24403#21069#32534#36753#13#10' '#21333#20803#26684#20445#23384#25968#25454#12290
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentFont = False
end
object ZDYName: TEdit
Tag = 2
Left = 54
Top = 12
Width = 169
Height = 20
TabOrder = 0
OnChange = ZDYNameChange
end
end
object ADOQueryMain: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 48
Top = 136
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 80
Top = 144
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 112
Top = 152
end
object DataSource1: TDataSource
DataSet = ClientDataSet1
Left = 280
Top = 144
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 200
Top = 144
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 352
Top = 248
end
end

View File

@ -0,0 +1,465 @@
unit U_ZDYHelpSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxCheckBox, cxTextEdit, cxGridCustomPopupMenu,
cxGridPopupMenu;
type
TfrmZDYHelpSel = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Code: TcxGridDBColumn;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBAdd: TToolButton;
TBSave: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
TBEdit: TToolButton;
V1Note: TcxGridDBColumn;
V1OrderNo: TcxGridDBColumn;
Panel1: TPanel;
Label1: TLabel;
ZDYName: TEdit;
V1Column1: TcxGridDBColumn;
Label2: TLabel;
cxGridPopupMenu1: TcxGridPopupMenu;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBAddClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure ZDYNameChange(Sender: TObject);
procedure V1NamePropertiesEditValueChanged(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
flag,flagname,snote,MainType,ReturnStr,FGStr:string;
fnote,forderno:Boolean;
PPSTE,JiangeStr:integer;
{ Public declarations }
end;
var
frmZDYHelpSel: TfrmZDYHelpSel;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmZDYHelpSel.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ZDYName.SetFocus;
Action:=caFree;
end;
procedure TfrmZDYHelpSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where Type='''+flag+'''');
if Trim(MainType)<>'' then
begin
sql.Add(' and MainType='''+Trim(MainType)+'''');
end;
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZDYHelpSel.TBAddClick(Sender: TObject);
var
i:Integer;
begin
ZDYName.SetFocus;
TV1.OptionsData.Editing:=True;
TV1.OptionsSelection.CellSelect:=True;
for i:=0 to 5 do
begin
with ClientDataSet1 do
begin
Append;
Post;
end;
end;
end;
procedure TfrmZDYHelpSel.TBSaveClick(Sender: TObject);
var
maxno:string;
begin
if ClientDataSet1.IsEmpty then Exit;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from KH_ZDY where ZdyNo='''+Trim(flag)+'''');
open;
end;
if ADOQueryTemp.IsEmpty then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYName,Type,MainType) select :ZDYNo,:ZDYName,:Type,:MainType ');
Parameters.ParamByName('ZDYNo').Value:=Trim(flag);
Parameters.ParamByName('ZDYName').Value:=Trim(flagname);
Parameters.ParamByName('Type').Value:='Main';
Parameters.ParamByName('MainType').Value:=Trim(MainType);
ExecSQL;
end;
end;
with ADOQueryCmd do
begin
with ClientDataSet1 do
begin
First;
while not eof do
begin
if Trim(ClientDataSet1.FieldByName('ZDYNO').AsString)='' then
begin
if GetLSNo(ADOQueryTemp,maxno,'SY','KH_ZDY',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大编号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add('delete KH_ZDY where ZDYNO='''+Trim(ClientDataSet1.fieldbyname('ZDYNO').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where 1<>1');
Open;
end;
if Trim(ClientDataSet1.FieldByName('ZDYName').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('ZDYNo').Value:=Trim(maxno);
ADOQueryCmd.FieldByName('ZDYName').Value:=ClientDataSet1.fieldbyname('ZDYName').AsString;
ADOQueryCmd.FieldByName('note').Value:=Trim(snote);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('Type').Value:=flag;
ADOQueryCmd.FieldByName('valid').Value:='Y';
if Trim(MainType)<>'' then
ADOQueryCmd.FieldByName('MainType').Value:=Trim(MainType);
//ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('ZDYNo').Value:=Trim(maxno);
ClientDataSet1.Post;
Next;
end;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功!','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
// TV1.OptionsData.Editing:=False;
end;
procedure TfrmZDYHelpSel.TBDelClick(Sender: TObject);
begin
if ClientDataSet1.IsEmpty then Exit;
if (Trim(ClientDataSet1.FieldByName('ZDYNo').AsString)<>'') or
(Trim(ClientDataSet1.FieldByName('ZDYname').AsString)<>'') then
begin
if application.MessageBox('确定要删除吗?','提示信息',1)=2 then exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete KH_ZDY where ZDYNo='''+Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString)+'''');
SQL.Add(' and Type='''+Trim(flag)+'''');
ExecSQL;
end;
end;
ClientDataSet1.Delete;
end;
procedure TfrmZDYHelpSel.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
ZDYName.SetFocus;
WriteCxGrid('自定义'+Trim(flag),TV1,'自定义数据');
Close;
end;
procedure TfrmZDYHelpSel.FormShow(Sender: TObject);
var
fsj,fsj1:string;
begin
{if PPSTE=1 then
begin
Application.Terminate;
Exit;
end; }
InitGrid();
fsj:=Trim(flag)+'01';
fsj1:=Trim(flagname)+'01';
ReadCxGrid('自定义'+Trim(flag),TV1,'自定义数据');
{if ClientDataSet1.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYname,Type,note)');
sql.Add('select '''+Trim(fsj)+'''');
sql.Add(','''+Trim(fsj1)+'''');
SQL.Add(','''+Trim(flag)+'''');
sql.Add(','''+Trim(snote)+'''');
ExecSQL;
end;
InitGrid();
end;}
//frmZDYHelp.Caption:=Trim(flagname)+'<'+Trim(flag)+'>';
frmZDYHelpSel.Caption:=Trim(flagname);
end;
procedure TfrmZDYHelpSel.ToolButton1Click(Sender: TObject);
begin
ReturnStr:='';
with ClientDataSet1 do
begin
First;
while not Eof do
begin
if FieldByName('SSel').AsBoolean=True then
begin
if JiangeStr<>99 then
begin
if FGStr<>'' then
ReturnStr:=ReturnStr+Trim(fieldbyname('ZDYName').AsString)+FGStr
else
ReturnStr:=ReturnStr+Trim(fieldbyname('ZDYName').AsString)+';'
end
else
ReturnStr:=ReturnStr+Trim(fieldbyname('ZDYName').AsString);
end;
Next;
end;
end;
if JiangeStr<>99 then
ReturnStr:=Copy(ReturnStr,1,Length(ReturnStr)-1);
ModalResult:=1;
end;
procedure TfrmZDYHelpSel.TBEditClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
end;
procedure TfrmZDYHelpSel.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if TV1.OptionsData.Editing=False then
begin
ModalResult:=1;
end;
end;
procedure TfrmZDYHelpSel.ZDYNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
end;
end;
procedure TfrmZDYHelpSel.V1NamePropertiesEditValueChanged(Sender: TObject);
var
maxno,mvalue:string;
begin
mvalue:=TcxTextEdit(Sender).EditingText;
if Trim(mvalue)='' then
begin
//Application.MessageBox('名称不能为空!','提示',0);
Exit;
end;
with ClientDataSet1 do
begin
Edit;
FieldByName('ZdyName').Value:=Trim(mvalue);
//Post;
end;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from KH_ZDY where ZdyNo='''+Trim(flag)+'''');
open;
end;
if ADOQueryTemp.IsEmpty then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYName,Type,MainType) select :ZDYNo,:ZDYName,:Type,:MainType ');
Parameters.ParamByName('ZDYNo').Value:=Trim(flag);
Parameters.ParamByName('ZDYName').Value:=Trim(flagname);
Parameters.ParamByName('Type').Value:='Main';
Parameters.ParamByName('MainType').Value:=Trim(MainType);
ExecSQL;
end;
end;
with ADOQueryCmd do
begin
//ClientDataSet1.DisableControls;
//with ClientDataSet1 do
//begin
//First;
//while not eof do
//begin
if Trim(ClientDataSet1.FieldByName('ZDYNO').AsString)='' then
begin
if GetLSNo(ADOQueryTemp,maxno,'SY','KH_ZDY',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('取最大编号失败!','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.add('select * from KH_Zdy where Type='''+Trim(flag)+'''');
if Trim(MainType)<>'' then
SQL.Add(' and MainType='''+Trim(MainType)+'''');
sql.Add(' and ZdyName='''+Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)+'''');
Open;
end;
if ADOQueryTemp.IsEmpty=False then
begin
if ADOQueryTemp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
if Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end else
begin
if Trim(ADOQueryTemp.fieldbyname('ZdyNo').AsString)<>Trim(ClientDataSet1.fieldbyname('ZdyNo').AsString) then
begin
ADOQueryCmd.Connection.RollbackTrans;
//ClientDataSet1.EnableControls;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add('delete KH_ZDY where ZDYNO='''+Trim(ClientDataSet1.fieldbyname('ZDYNO').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where 1<>1');
Open;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('ZDYNo').Value:=Trim(maxno);
ADOQueryCmd.FieldByName('ZDYName').Value:=ClientDataSet1.fieldbyname('ZDYName').AsString;
ADOQueryCmd.FieldByName('note').Value:=Trim(snote);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('Type').Value:=flag;
ADOQueryCmd.FieldByName('valid').Value:='Y';
if Trim(MainType)<>'' then
ADOQueryCmd.FieldByName('MainType').Value:=Trim(MainType);
//ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('ZDYNo').Value:=Trim(maxno);
//ClientDataSet1.Post;
// Next;
//end;
//end;
// ClientDataSet1.EnableControls;
end;
ADOQueryCmd.Connection.CommitTrans;
//Application.MessageBox('保存成功!','提示',0);
//TV1.OptionsData.Editing:=False;
//TV1.OptionsSelection.CellSelect:=False;
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!','提示',0);
end;
end;
end.

View File

@ -0,0 +1,218 @@
object frmZdyAttInput: TfrmZdyAttInput
Left = 219
Top = 254
Width = 920
Height = 370
Caption = #23458#25143#36164#26009#24405#20837
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 912
Height = 31
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_BaseInfo.ThreeImgList
Flat = True
Images = DataLink_BaseInfo.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object ToolButton3: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 14
OnClick = ToolButton3Click
end
object TBClose: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 55
OnClick = TBCloseClick
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 31
Width = 912
Height = 302
Align = alClient
TabOrder = 1
object Tv2: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
DataController.DataSource = DS_HZ
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
Styles.Header = DataLink_BaseInfo.handBlack
object v2Column6: TcxGridDBColumn
Caption = #23458#25143#21517#31216
DataBinding.FieldName = 'ZdyName'
HeaderAlignmentHorz = taCenter
Width = 147
end
object v2Column2: TcxGridDBColumn
Caption = #23458#25143#32534#21495
DataBinding.FieldName = 'ZdyCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 91
end
object v2Column3: TcxGridDBColumn
Caption = #30005#35805
DataBinding.FieldName = 'DEFstr1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 63
end
object v2Column4: TcxGridDBColumn
Caption = #25163#26426
DataBinding.FieldName = 'DEFstr2'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 70
end
object v2Column5: TcxGridDBColumn
Caption = #20256#30495
DataBinding.FieldName = 'DEFstr3'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 64
end
object v2Column10: TcxGridDBColumn
Caption = #19994#21153#21592
DataBinding.FieldName = 'DEFstr5'
HeaderAlignmentHorz = taCenter
Width = 71
end
object v2Column7: TcxGridDBColumn
Caption = #20844#21496#22320#22336
DataBinding.FieldName = 'DEFNote1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 67
end
object v2Column8: TcxGridDBColumn
Caption = #21457#36135#22320#22336
DataBinding.FieldName = 'DEFNote2'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 72
end
object v2Column9: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'DEFstr4'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 73
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 154
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_BaseInfo.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 789
Top = 9
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_BaseInfo.ADOLink
Parameters = <>
Left = 829
Top = 1
end
object ADOQueryMain: TADOQuery
Connection = DataLink_BaseInfo.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 949
Top = 225
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 864
Top = 224
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
Left = 928
Top = 216
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 888
Top = 224
end
object DS_HZ: TDataSource
DataSet = CDS_HZ
Left = 899
Top = 235
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 872
Top = 224
end
end

View File

@ -0,0 +1,236 @@
unit U_ZdyAttInput;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP,ShellAPI,IniFiles, cxCheckBox, cxCalendar,
cxButtonEdit, cxTextEdit;
type
TfrmZdyAttInput = class(TForm)
ToolBar1: TToolBar;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
RM1: TRMGridReport;
RMDB_Main: TRMDBDataSet;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_HZ: TDataSource;
CDS_HZ: TClientDataSet;
ToolButton3: TToolButton;
v2Column6: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
v2Column5: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
v2Column8: TcxGridDBColumn;
v2Column9: TcxGridDBColumn;
v2Column10: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
function SaveData():Boolean;
public
{ Public declarations }
RKFlag,FCYID:String;
end;
var
frmZdyAttInput: TfrmZdyAttInput;
implementation
uses
U_DataLink,U_Fun,U_ZDYHelp;
{$R *.dfm}
procedure TfrmZdyAttInput.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
SQL.Clear;
sql.Add(' select * from KH_Zdy_Attachment where ATID='''+Trim(FCYID)+'''');
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZdyAttInput.FormDestroy(Sender: TObject);
begin
//frmZdyAttInput:=nil;
end;
procedure TfrmZdyAttInput.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//Action:=caFree;
end;
procedure TfrmZdyAttInput.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('客户资料录入',Tv2,'客户自定义');
Close;
end;
procedure TfrmZdyAttInput.FormShow(Sender: TObject);
begin
ReadCxGrid('客户资料录入',Tv2,'客户自定义');
InitGrid();
if Trim(FCYID)='' then
begin
CDS_HZ.Append;
CDS_HZ.Post;
end;
end;
procedure TfrmZdyAttInput.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
function TfrmZdyAttInput.SaveData():Boolean;
var
maxId,CRID:String;
begin
try
ADOQueryCmd.Connection.BeginTrans;
if Trim(FCYID)='' then
begin
if GetLSNo(ADOQueryCmd,maxId,'AT','KH_Zdy_Attachment',4,1)=False then
begin
Result:=False;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败!','提示',0);
Exit;
end;
end else
begin
maxId:=Trim(FCYID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from KH_Zdy_Attachment where ATID='''+Trim(FCYID)+'''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCYID)='' then
begin
Append;
FieldByName('Filler').Value:=Trim(DName);
end else
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('Edittime').Value:=SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('ATID').Value:=Trim(maxId);
FieldByName('ZdyName').Value:=Trim(CDS_HZ.fieldbyname('ZdyName').AsString);
RTSetSaveDataCDS(ADOQueryCmd,Tv2,CDS_HZ,'',0);
FieldByName('Type').Value:='KHName';
FieldByName('Filler').Value:=Trim(DName);
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from KH_Zdy where ZdyNo='''+Trim(FCYID)+'''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCYID)='' then
begin
Append;
end else
begin
Edit;
end;
FieldByName('ZdyNo').Value:=Trim(maxId);
FieldByName('ZdyName').Value:=Trim(CDS_HZ.fieldbyname('ZdyName').AsString);
FieldByName('Type').Value:='KHName';
FieldByName('MainType').Value:=Trim(CDS_HZ.fieldbyname('DEFstr5').AsString);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_Zdy where ZdyName='''+Trim(CDS_HZ.fieldbyname('ZdyName').AsString)+'''');
sql.Add(' and Type=''KHName'' ');
Open;
end;
if ADOQueryCmd.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称重复!','提示',0);
Exit;
end;
with CDS_HZ do
begin
Edit;
FieldByName('ATID').Value:=Trim(maxId);
Post;
end;
ADOQueryCmd.Connection.CommitTrans;
Result:=True;
except
Result:=True;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存异常!','提示',0);
end;
end;
procedure TfrmZdyAttInput.ToolButton3Click(Sender: TObject);
begin
if Trim(CDS_HZ.FieldByName('ZdyName').AsString)='' then
begin
Application.MessageBox('客户名称不能为空!','提示',0);
Exit;
end;
if Application.MessageBox('确定要保存数据吗?','提示',32+4)<>IDYES then Exit;
ToolBar1.SetFocus;
if SaveData() then
begin
Application.MessageBox('保存成功!','提示',0);
ModalResult:=1;
end;
end;
end.

View File

@ -0,0 +1,393 @@
object frmZdyAttachCP: TfrmZdyAttachCP
Left = 108
Top = 101
Width = 1075
Height = 569
Caption = #20135#21697#36164#26009#31649#29702
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1067
Height = 31
ButtonHeight = 30
ButtonWidth = 113
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_PBMDDJ.ThreeImgList
Flat = True
Images = DataLink_PBMDDJ.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = ToolButton2Click
end
object ToolButton5: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #25552#21462'Excel'#25968#25454
ImageIndex = 68
Visible = False
OnClick = ToolButton5Click
end
object ToolButton1: TToolButton
Left = 243
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 68
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 306
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 31
Width = 1067
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 191
Top = 13
Width = 48
Height = 12
Caption = #20135#21697#21517#31216
end
object Label1: TLabel
Left = 22
Top = 13
Width = 48
Height = 12
Caption = #20135#21697#32534#21495
end
object Label2: TLabel
Left = 369
Top = 13
Width = 24
Height = 12
Caption = #31867#22411
end
object ZdyName: TEdit
Tag = 2
Left = 241
Top = 9
Width = 89
Height = 20
TabOrder = 0
OnChange = ZdyNameChange
end
object ZdyCode: TEdit
Tag = 2
Left = 71
Top = 9
Width = 89
Height = 20
TabOrder = 1
OnChange = ZdyNameChange
end
object DEFstr5: TComboBox
Tag = 1
Left = 398
Top = 8
Width = 81
Height = 20
Style = csDropDownList
ItemHeight = 12
TabOrder = 2
OnChange = ZdyNameChange
Items.Strings = (
#22383#24067
#25104#21697
'')
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 70
Width = 1067
Height = 468
Align = alClient
TabOrder = 2
object Tv2: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
OnCellDblClick = Tv2CellDblClick
DataController.DataSource = DS_HZ
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
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_PBMDDJ.SHuangSe
Styles.IncSearch = DataLink_PBMDDJ.SHuangSe
Styles.Selection = DataLink_PBMDDJ.SHuangSe
Styles.Header = DataLink_PBMDDJ.handBlack
object v2Column2: TcxGridDBColumn
Caption = #20135#21697#32534#21495
DataBinding.FieldName = 'ZdyCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 80
end
object v2Column6: TcxGridDBColumn
Caption = #20135#21697#21517#31216
DataBinding.FieldName = 'ZdyName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Options.Sorting = False
Width = 124
end
object v2Column11: TcxGridDBColumn
Caption = #31867#22411
DataBinding.FieldName = 'DEFstr5'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 53
end
object v2Column3: TcxGridDBColumn
Caption = #35268#26684
DataBinding.FieldName = 'DEFstr1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 72
end
object v2Column4: TcxGridDBColumn
Caption = #25104#20221
DataBinding.FieldName = 'DEFstr2'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 74
end
object v2Column5: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'DEFstr3'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 68
end
object v2Mrate: TcxGridDBColumn
Caption = #35745#21010#32553#29575'(%)'
DataBinding.FieldName = 'Mrate'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 80
end
object v2Column13: TcxGridDBColumn
Caption = #24037#33402
DataBinding.FieldName = 'defNote2'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 100
end
object v2Column8: TcxGridDBColumn
Caption = #33457#21495
DataBinding.FieldName = 'DEFstr4'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 58
end
object v2Column10: TcxGridDBColumn
Caption = #33394#21495
DataBinding.FieldName = 'DEFstr6'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 61
end
object v2Column9: TcxGridDBColumn
Caption = #38376#24133
DataBinding.FieldName = 'DEFstr7'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 73
end
object v2Column7: TcxGridDBColumn
Caption = #20811#37325
DataBinding.FieldName = 'DEFstr8'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 61
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 114
end
object v2Column14: TcxGridDBColumn
Caption = #25805#20316#21592
DataBinding.FieldName = 'Filler'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 60
end
object v2Column15: TcxGridDBColumn
Caption = #25805#20316#26102#38388
DataBinding.FieldName = 'FillTime'
HeaderAlignmentHorz = taCenter
Options.Sorting = False
Width = 80
end
object v2Column16: TcxGridDBColumn
Caption = #20179#20301
DataBinding.FieldName = 'DEFstr4'
Visible = False
HeaderAlignmentHorz = taCenter
Hidden = True
Width = 70
end
object v2Column17: TcxGridDBColumn
Caption = #20179#20301#25968
DataBinding.FieldName = 'DEFstr5'
Visible = False
HeaderAlignmentHorz = taCenter
Hidden = True
Width = 70
end
object v2defflt1: TcxGridDBColumn
Caption = #20215#26684#22686#24133
DataBinding.FieldName = 'defflt1'
Visible = False
HeaderAlignmentHorz = taCenter
Hidden = True
Options.Editing = False
Width = 60
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 789
Top = 9
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
Parameters = <>
Left = 829
Top = 1
end
object ADOQueryMain: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 741
Top = 161
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 864
Top = 224
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
Left = 928
Top = 216
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 888
Top = 224
end
object DS_HZ: TDataSource
DataSet = CDS_HZ
Left = 843
Top = 147
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 840
Top = 128
end
object OpenDialog1: TOpenDialog
Left = 936
Top = 41
end
end

View File

@ -0,0 +1,400 @@
unit U_ZdyAttachCP;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ComObj,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP,ShellAPI,IniFiles, cxCheckBox, cxCalendar,
cxButtonEdit, cxTextEdit;
type
FdDy=record
inc: integer; //客户端套接字句柄
FDdys:string[32]; //客户端套接字
FdDysName:string[32]; //客户端套接字
end;
TfrmZdyAttachCP = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
ToolButton1: TToolButton;
RM1: TRMGridReport;
RMDB_Main: TRMDBDataSet;
Label3: TLabel;
ZdyName: TEdit;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_HZ: TDataSource;
CDS_HZ: TClientDataSet;
v2Column6: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
v2Column5: TcxGridDBColumn;
v2Column9: TcxGridDBColumn;
Label1: TLabel;
ZdyCode: TEdit;
Label2: TLabel;
DEFstr5: TComboBox;
v2Column7: TcxGridDBColumn;
v2Column8: TcxGridDBColumn;
v2Column10: TcxGridDBColumn;
v2Column11: TcxGridDBColumn;
v2Column13: TcxGridDBColumn;
OpenDialog1: TOpenDialog;
ToolButton5: TToolButton;
v2Mrate: TcxGridDBColumn;
v2Column14: TcxGridDBColumn;
v2Column15: TcxGridDBColumn;
v2Column16: TcxGridDBColumn;
v2Column17: TcxGridDBColumn;
v2defflt1: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ZdyNameChange(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure Tv2CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
private
{ Private declarations }
procedure InitGrid();
public
fkhType:string;
dFdDy: array[0..20] of FdDy; //客户端连接数组
end;
var
frmZdyAttachCP: TfrmZdyAttachCP;
implementation
uses
U_DataLink,U_RTFun,U_ZDYHelp;
{$R *.dfm}
procedure TfrmZdyAttachCP.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
SQL.Clear;
sql.Add(' select * from KH_Zdy_Attachment where Type=''CP'' ');
sql.Add(' and isnull(khType,'''')='+quotedstr(trim(fkhType)));
sql.Add(' order by zdyCode ');
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZdyAttachCP.FormDestroy(Sender: TObject);
begin
frmZdyAttachCP:=nil;
end;
procedure TfrmZdyAttachCP.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmZdyAttachCP.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('产品资料',Tv2,'客户自定义');
Close;
end;
procedure TfrmZdyAttachCP.TBDelClick(Sender: TObject);
begin
if CDS_HZ.IsEmpty then Exit;
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
if Trim(CDS_HZ.fieldbyname('ATID').AsString)<>'' then
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('delete KH_Zdy_Attachment where ATID='''+Trim(CDS_HZ.fieldbyname('ATID').AsString)+'''');
sql.Add('delete KH_Zdy where ZdyNo='''+Trim(CDS_HZ.fieldbyname('ATID').AsString)+'''');
ExecSQL;
end;
end;
CDS_HZ.Delete;
end;
procedure TfrmZdyAttachCP.FormShow(Sender: TObject);
begin
ReadCxGrid('产品资料',Tv2,'客户自定义');
InitGrid();
end;
procedure TfrmZdyAttachCP.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmZdyAttachCP.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
end;
end;
procedure TfrmZdyAttachCP.ZdyNameChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmZdyAttachCP.ToolButton1Click(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then Exit;
TcxGridToExcel(self.Caption,cxgrid2);
// SelExportData(Tv2,ADOQueryMain,'产品资料列表');
end;
procedure TfrmZdyAttachCP.ToolButton4Click(Sender: TObject);
begin
{ try
frmZdyAttInputCP:=TfrmZdyAttInputCP.Create(Application);
with frmZdyAttInputCP do
begin
FCYID:=Trim(Self.CDS_HZ.fieldbyname('ATID').AsString);
fkhType:=self.fkhType;
if ShowModal=1 then
begin
TBRafresh.Click;
end;
end;
finally
frmZdyAttInputCP.Free;
end; }
end;
procedure TfrmZdyAttachCP.ToolButton3Click(Sender: TObject);
begin
{ try
frmZdyAttInputCP:=TfrmZdyAttInputCP.Create(Application);
with frmZdyAttInputCP do
begin
FCYID:='';
fkhType:=self.fkhType;
if ShowModal=1 then
begin
TBRafresh.Click;
end;
end;
finally
frmZdyAttInputCP.Free;
end; }
end;
procedure TfrmZdyAttachCP.ToolButton5Click(Sender: TObject);
var
excelApp,WorkBook:Variant;
i,j,k,ExcelRowCount:integer;
maxId:string;
begin
try
ExcelApp := CreateOleObject('Excel.Application');
openDialog1.Filter:='*.CSV;*.xls';
if opendialog1.Execute then
begin
WorkBook :=ExcelApp.WorkBooks.Open(OpenDialog1.FileName);
end
else
exit;
ExcelApp.Visible := false;
ExcelRowCount := WorkBook.WorkSheets[1].UsedRange.Rows.Count;
except
application.MessageBox('加载EXCEL错误','错误信息',MB_ICONERROR);
exit;
end;
try
k:=0;
for i:=1 to 20 do
begin
if trim(excelapp.Cells[1,i].value)='' then break;
if trim(excelapp.Cells[1,i].value)='产品编号' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='ZdyCode';
dFdDy[k].FdDysName:='产品编号';
end;
if trim(excelapp.Cells[1,i].value)='产品名称' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='ZdyName';
dFdDy[k].FdDysName:='产品名称';
end;
if trim(excelapp.Cells[1,i].value)='名称' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='defNote1';
dFdDy[k].FdDysName:='名称';
end;
if trim(excelapp.Cells[1,i].value)='颜色' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='DEFstr3';
dFdDy[k].FdDysName:='名称';
end;
if trim(excelapp.Cells[1,i].value)='工艺' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='defNote2';
dFdDy[k].FdDysName:='工艺';
end;
if trim(excelapp.Cells[1,i].value)='类型' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='DEFstr5';
dFdDy[k].FdDysName:='类型';
end;
if trim(excelapp.Cells[1,i].value)='规格' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='DEFstr1';
dFdDy[k].FdDysName:='规格';
end;
if trim(excelapp.Cells[1,i].value)='成份' then
begin
dFdDy[k].inc:=i;
dFdDy[k].FDdys:='DEFstr2';
dFdDy[k].FdDysName:='成份';
end;
k:=k+1;
end;
except
end;
ADOQueryCmd.Connection.BeginTrans;
try
for i := 2 to excelrowcount do
begin
if GetLSNo(ADOQueryCmd,maxId,'AT','KH_Zdy_Attachment',4,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败!','提示',0);
Exit;
end;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from KH_Zdy_Attachment where 1=2');
open;
end;
ADOQueryCmd.Append;
for j:=0 to k-1 do
begin
ADOQueryCmd.fieldbyname(dFdDy[j].FDdys).Value:=excelapp.Cells[i,dFdDy[j].inc].Value;
end;
ADOQueryCmd.FieldByName('ATID').Value:=Trim(maxId);
ADOQueryCmd.FieldByName('Type').Value:='CP';
ADOQueryCmd.FieldByName('Filler').Value:=Trim(DName);
ADOQueryCmd.Post;
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select * from KH_Zdy_Attachment where ATID='''+trim(maxId)+''' ');
open;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from KH_Zdy where ZdyNo='''+Trim(maxId)+'''');
Open;
end;
with ADOQueryCmd do
begin
if ADOQueryCmd.IsEmpty then
begin
Append;
end else
begin
Edit;
end;
FieldByName('ZdyNo').Value:=Trim(maxId);
FieldByName('ZdyName').Value:=Trim(ADOQueryTemp.fieldbyname('ZdyName').AsString);
FieldByName('Type').Value:='CP';
FieldByName('MainType').Value:=Trim(ADOQueryTemp.fieldbyname('DEFstr5').AsString);
Post;
end;
end;
WorkBook.Close;
ExcelApp.Quit;
ExcelApp := Unassigned;
WorkBook := Unassigned;
ADOQueryCmd.Connection.CommitTrans;
InitGrid();
except
WorkBook.Close;
ExcelApp.Quit;
ExcelApp := Unassigned;
WorkBook := Unassigned;
ADOQueryCmd.Connection.RollbackTrans;
end;
end;
procedure TfrmZdyAttachCP.Tv2CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
IF cds_Hz.IsEmpty then exit;
ModalResult:=1;
end;
end.

View File

@ -0,0 +1,337 @@
object frmZdyAttachGYS: TfrmZdyAttachGYS
Left = 192
Top = 103
Width = 1038
Height = 618
Caption = #20379#24212#21830#36164#26009#31649#29702
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1022
Height = 31
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_PBMDDJ.ThreeImgList
Flat = True
Images = DataLink_PBMDDJ.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = ToolButton2Click
end
object ToolButton3: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 1
Visible = False
OnClick = ToolButton3Click
end
object ToolButton4: TToolButton
Left = 189
Top = 0
Caption = #20462#25913
ImageIndex = 11
Visible = False
OnClick = ToolButton4Click
end
object TBDel: TToolButton
Left = 248
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 3
Visible = False
OnClick = TBDelClick
end
object ToolButton1: TToolButton
Left = 311
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 68
Visible = False
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 374
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 31
Width = 1022
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 203
Top = 13
Width = 60
Height = 12
Caption = #20379#24212#21830#21517#31216
end
object Label1: TLabel
Left = 22
Top = 13
Width = 60
Height = 12
Caption = #20379#24212#21830#32534#21495
end
object Label2: TLabel
Left = 395
Top = 13
Width = 24
Height = 12
Caption = #31867#22411
end
object ZdyName: TEdit
Tag = 2
Left = 267
Top = 9
Width = 89
Height = 20
TabOrder = 0
OnChange = ZdyNameChange
end
object ZdyCode: TEdit
Tag = 2
Left = 83
Top = 9
Width = 89
Height = 20
TabOrder = 1
OnChange = ZdyNameChange
end
object DEFstr5: TComboBox
Tag = 1
Left = 424
Top = 8
Width = 81
Height = 20
Style = csDropDownList
ItemHeight = 12
TabOrder = 2
OnChange = ZdyNameChange
Items.Strings = (
#22383#24067
#21152#24037#21378)
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 70
Width = 1022
Height = 509
Align = alClient
TabOrder = 2
object Tv2: TcxGridDBTableView
OnDblClick = Tv2DblClick
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
DataController.DataSource = DS_HZ
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
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_PBMDDJ.SHuangSe
Styles.IncSearch = DataLink_PBMDDJ.SHuangSe
Styles.Selection = DataLink_PBMDDJ.SHuangSe
Styles.Header = DataLink_PBMDDJ.handBlack
object v2Column2: TcxGridDBColumn
Caption = #20379#24212#21830#32534#21495
DataBinding.FieldName = 'ZdyCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 80
end
object v2Column6: TcxGridDBColumn
Caption = #20379#24212#21830#21517#31216
DataBinding.FieldName = 'ZdyName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Width = 124
end
object v2Column10: TcxGridDBColumn
Caption = #32479#35745#21333#20301#21517#31216
DataBinding.FieldName = 'zdyNameTj'
HeaderAlignmentHorz = taCenter
Width = 111
end
object v2Column8: TcxGridDBColumn
Caption = #31867#22411
DataBinding.FieldName = 'DEFstr5'
HeaderAlignmentHorz = taCenter
Width = 77
end
object v2Column3: TcxGridDBColumn
Caption = #30005#35805
DataBinding.FieldName = 'DEFstr1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 72
end
object v2Column4: TcxGridDBColumn
Caption = #25163#26426
DataBinding.FieldName = 'DEFstr2'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 74
end
object v2Column5: TcxGridDBColumn
Caption = #20256#30495
DataBinding.FieldName = 'DEFstr3'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 68
end
object v2Column7: TcxGridDBColumn
Caption = #20844#21496#22320#22336
DataBinding.FieldName = 'DEFNote1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 69
end
object v2Column9: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'DEFstr4'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 73
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 114
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 773
Top = 17
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
Parameters = <>
Left = 813
Top = 17
end
object ADOQueryMain: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 733
Top = 17
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 768
Top = 216
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
Left = 776
Top = 184
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 824
Top = 184
end
object DS_HZ: TDataSource
DataSet = CDS_HZ
Left = 731
Top = 179
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 712
Top = 184
end
end

View File

@ -0,0 +1,214 @@
unit U_ZdyAttachGYS;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP,ShellAPI,IniFiles, cxCheckBox, cxCalendar,
cxButtonEdit, cxTextEdit;
type
TfrmZdyAttachGYS = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
ToolButton1: TToolButton;
RM1: TRMGridReport;
RMDB_Main: TRMDBDataSet;
Label3: TLabel;
ZdyName: TEdit;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_HZ: TDataSource;
CDS_HZ: TClientDataSet;
ToolButton3: TToolButton;
v2Column6: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
v2Column5: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
v2Column9: TcxGridDBColumn;
Label1: TLabel;
ZdyCode: TEdit;
ToolButton4: TToolButton;
v2Column8: TcxGridDBColumn;
Label2: TLabel;
DEFstr5: TComboBox;
v2Column10: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ZdyNameChange(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure Tv2DblClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
public
end;
var
frmZdyAttachGYS: TfrmZdyAttachGYS;
implementation
uses
U_DataLink,U_RTFun,U_ZDYHelp;
{$R *.dfm}
procedure TfrmZdyAttachGYS.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
SQL.Clear;
sql.Add(' select * from KH_Zdy_Attachment where Type=''GYS'' ');
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZdyAttachGYS.FormDestroy(Sender: TObject);
begin
frmZdyAttachGYS:=nil;
end;
procedure TfrmZdyAttachGYS.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmZdyAttachGYS.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('供应商资料',Tv2);
Close;
end;
procedure TfrmZdyAttachGYS.TBDelClick(Sender: TObject);
begin
{ if CDS_HZ.IsEmpty then Exit;
if Application.MessageBox('确定要删除数据吗?','提示',32+4)<>IDYES then Exit;
if Trim(CDS_HZ.fieldbyname('ATID').AsString)<>'' then
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('delete KH_Zdy_Attachment where ATID='''+Trim(CDS_HZ.fieldbyname('ATID').AsString)+'''');
sql.Add('delete KH_Zdy where ZdyNo='''+Trim(CDS_HZ.fieldbyname('ATID').AsString)+'''');
ExecSQL;
end;
end;
CDS_HZ.Delete;}
end;
procedure TfrmZdyAttachGYS.FormShow(Sender: TObject);
begin
ReadCxGrid('供应商资料',Tv2);
InitGrid();
end;
procedure TfrmZdyAttachGYS.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmZdyAttachGYS.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
end;
end;
procedure TfrmZdyAttachGYS.ZdyNameChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmZdyAttachGYS.ToolButton1Click(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then Exit;
//SelExportData(Tv2,ADOQueryMain,'客户资料列表');
end;
procedure TfrmZdyAttachGYS.ToolButton4Click(Sender: TObject);
begin
{ try
frmZdyAttInputGYS:=TfrmZdyAttInputGYS.Create(Application);
with frmZdyAttInputGYS do
begin
FCYID:=Trim(Self.CDS_HZ.fieldbyname('ATID').AsString);
if ShowModal=1 then
begin
end;
end;
finally
frmZdyAttInputGYS.Free;
end; }
end;
procedure TfrmZdyAttachGYS.ToolButton3Click(Sender: TObject);
begin
{ try
frmZdyAttInputGYS:=TfrmZdyAttInputGYS.Create(Application);
with frmZdyAttInputGYS do
begin
FCYID:='';
if ShowModal=1 then
begin
end;
end;
finally
frmZdyAttInputGYS.Free;
end; }
end;
procedure TfrmZdyAttachGYS.Tv2DblClick(Sender: TObject);
begin
if CDS_HZ.IsEmpty then exit;
ModalResult:=1;
end;
end.

View File

@ -0,0 +1,287 @@
object frmZdyAttachment: TfrmZdyAttachment
Left = 249
Top = 112
Width = 1142
Height = 613
Caption = #23458#25143#36164#26009#31649#29702
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1126
Height = 31
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_ContractManagement.ThreeImgList
Flat = True
Images = DataLink_ContractManagement.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 31
Width = 1126
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 190
Top = 13
Width = 48
Height = 12
Caption = #23458#25143#21517#31216
end
object Label1: TLabel
Left = 22
Top = 13
Width = 48
Height = 12
Caption = #23458#25143#32534#21495
end
object CoName: TEdit
Tag = 2
Left = 238
Top = 9
Width = 89
Height = 20
TabOrder = 1
OnChange = CoNameChange
end
object CoCode: TEdit
Tag = 2
Left = 70
Top = 9
Width = 89
Height = 20
TabOrder = 0
OnChange = CoNameChange
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 70
Width = 1126
Height = 505
Align = alClient
TabOrder = 2
object Tv2: TcxGridDBTableView
OnDblClick = Tv2DblClick
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
DataController.DataSource = DS_HZ
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
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_ContractManagement.SHuangSe
Styles.IncSearch = DataLink_ContractManagement.SHuangSe
Styles.Selection = DataLink_ContractManagement.SHuangSe
Styles.Header = DataLink_ContractManagement.Default
object v2Column2: TcxGridDBColumn
Caption = #23458#25143#32534#21495
DataBinding.FieldName = 'CoCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #23458#25143#21517#31216
DataBinding.FieldName = 'CoName'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Width = 127
end
object v2Column15: TcxGridDBColumn
Caption = #23458#25143#31616#31216
DataBinding.FieldName = 'CoHRName'
HeaderAlignmentHorz = taCenter
Width = 93
end
object v2Column11: TcxGridDBColumn
Caption = #20844#24335#22320#22336
DataBinding.FieldName = 'CoAddress'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 71
end
object v2Column10: TcxGridDBColumn
Caption = #19994#21153#21592
DataBinding.FieldName = 'Salesman'
HeaderAlignmentHorz = taCenter
Width = 56
end
object v2Column3: TcxGridDBColumn
Caption = #30005#35805
DataBinding.FieldName = 'Telephone'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 71
end
object v2Column4: TcxGridDBColumn
Caption = #25163#26426
DataBinding.FieldName = 'PhoneNumber'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 74
end
object v2Column5: TcxGridDBColumn
Caption = #20256#30495
DataBinding.FieldName = 'Fax'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 68
end
object v2Column9: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'Contacts'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 87
end
object v2Column7: TcxGridDBColumn
Caption = #38134#34892#36134#25143
DataBinding.FieldName = 'BankNo'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 91
end
object v2Column8: TcxGridDBColumn
Caption = #24320#25143#34892
DataBinding.FieldName = 'BankName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 67
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 165
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 789
Top = 9
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
Parameters = <>
Left = 829
Top = 1
end
object ADOQueryMain: TADOQuery
Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 949
Top = 225
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 864
Top = 224
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
Left = 928
Top = 216
end
object cxGridPopupMenu2: TcxGridPopupMenu
PopupMenus = <>
Left = 888
Top = 224
end
object DS_HZ: TDataSource
DataSet = CDS_HZ
Left = 899
Top = 235
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 872
Top = 224
end
end

View File

@ -0,0 +1,150 @@
unit U_ZdyAttachment;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin,
StdCtrls, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP,ShellAPI,IniFiles, cxCheckBox, cxCalendar,
cxButtonEdit, cxTextEdit;
type
TfrmZdyAttachment = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
RM1: TRMGridReport;
RMDB_Main: TRMDBDataSet;
Label3: TLabel;
CoName: TEdit;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_HZ: TDataSource;
CDS_HZ: TClientDataSet;
Label1: TLabel;
CoCode: TEdit;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
v2Column2: TcxGridDBColumn;
v2Column6: TcxGridDBColumn;
v2Column15: TcxGridDBColumn;
v2Column11: TcxGridDBColumn;
v2Column10: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
v2Column5: TcxGridDBColumn;
v2Column9: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
v2Column8: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure CoNameChange(Sender: TObject);
procedure Tv2DblClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
public
canshu1:string;
end;
var
frmZdyAttachment: TfrmZdyAttachment;
implementation
uses
U_DataLink,U_RTFun,U_RTZDYHelp;
{$R *.dfm}
procedure TfrmZdyAttachment.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered:=False;
Close;
SQL.Clear;
sql.Add(' select * from Company A left join Company_contact B ');
sql.Add(' on A.CoID=B.CoID and B.IsDefault=1 where A.CoType=''客户'' and A.Valid=''Y'' ' );
if trim(canshu1)='业务员' then
sql.Add(' and A.Salesman='+quotedstr(trim(dname)) );
Open;
end;
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZdyAttachment.FormDestroy(Sender: TObject);
begin
frmZdyAttachment:=nil;
end;
procedure TfrmZdyAttachment.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmZdyAttachment.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('客户资料',Tv2,'客户自定义');
Close;
end;
procedure TfrmZdyAttachment.FormShow(Sender: TObject);
begin
ReadCxGrid('客户资料',Tv2,'客户自定义');
InitGrid();
end;
procedure TfrmZdyAttachment.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmZdyAttachment.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,CDS_HZ);
SInitCDSData20(ADOQueryMain,CDS_HZ);
end;
end;
procedure TfrmZdyAttachment.CoNameChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmZdyAttachment.Tv2DblClick(Sender: TObject);
begin
ModalResult:=1;
end;
end.

View File

@ -0,0 +1,17 @@
object frmZdyInput: TfrmZdyInput
Left = 165
Top = 188
Width = 870
Height = 500
Caption = #23458#25143#36164#26009#24405#20837
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
end

View File

@ -0,0 +1,30 @@
unit U_ZdyInput;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TfrmZdyInput = class(TForm)
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmZdyInput: TfrmZdyInput;
implementation
{$R *.dfm}
procedure TfrmZdyInput.FormDestroy(Sender: TObject);
begin
frmZdyInput:=nil;
end;
end.

View File

@ -0,0 +1,65 @@
unit U_iniParam;
interface
uses
IniFiles,SysUtils;
var
Filename:string; //文件名
iParam2:integer;
bParam1:Boolean;
bParam2:Boolean;
SCXFlag:String; //生产线 根据此标志获取卷条码前缀 不能包含字母 1,2
SCXCount:String; //机台个数
PortNoStr:string;//端口号
DllName:string;//端口Dll文件
Function IsINIFile():Boolean; //判断InI配置文件是否存在
procedure ReadINIFile();
procedure WriteINIFile();
implementation
///////////////////////////////////////////////////////////////////
//读取ini文件设置参数
//参数:
////////////////////////////////////////////////////////////////////
procedure ReadINIFile();
var
programIni:Tinifile; //配置文件名
begin
FileName:=ExtractFilePath(Paramstr(0))+'File.INI';
programIni:=Tinifile.create(FileName);
SCXFlag:=programIni.ReadString('生产车间配置','卷条码机台标志','1');
SCXCount:=programIni.ReadString('生产车间配置','机台个数','1');
PortNoStr:=programIni.ReadString('生产车间配置','端口号','com1');
DllName:=programIni.ReadString('生产车间配置','端口Dll文件','JZCRS323C.DLL');
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//写设置信息到INI文件
//参数
//////////////////////////////////////////////////////////////////
procedure WriteINIFile();
var
programIni:Tinifile; //配置文件名
begin
FileName:=ExtractFilePath(Paramstr(0))+'File.INI';
programIni:=Tinifile.create(FileName);
programIni.WriteString('生产车间配置','卷条码机台标志',SCXFlag);
programIni.WriteString('生产车间配置','机台个数',SCXCount);
programIni.WriteString('生产车间配置','端口号',PortNoStr);
programIni.WriteString('生产车间配置','端口Dll文件',DllName);
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//判断InI文件是否存在
//////////////////////////////////////////////////////////////////
Function IsINIFile():Boolean;
begin
FileName:=ExtractFilePath(Paramstr(0))+'File.INI';
if FileExists(FileName) then
Result:=true
else
Result:=false;
end;
end.

View File

@ -0,0 +1,221 @@
object Form1: TForm1
Left = 203
Top = 121
Width = 791
Height = 554
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsMDIForm
Menu = MainMenu1
OldCreateOrder = False
WindowState = wsMaximized
OnClose = FormClose
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 775
Height = 25
ButtonWidth = 57
Caption = 'ToolBar1'
Flat = True
Images = ImageList1
TabOrder = 0
object Edit1: TEdit
Left = 0
Top = 0
Width = 81
Height = 22
TabOrder = 0
Text = '1'
end
object ToolButton1: TToolButton
Left = 81
Top = 0
Caption = #20851#38381
ImageIndex = 0
OnClick = ToolButton1Click
end
object Label1: TLabel
Left = 138
Top = 0
Width = 79
Height = 22
Caption = ' DllName'#65306
end
object DllName: TEdit
Left = 217
Top = 0
Width = 135
Height = 22
TabOrder = 1
end
end
object MainMenu1: TMainMenu
Left = 232
Top = 40
object test1: TMenuItem
Caption = 'test'
OnClick = test1Click
end
end
object ImageList1: TImageList
Left = 320
Top = 56
Bitmap = {
494C010101000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000EFEFEF000000
0000EFEFEF00EFEFEF000000000000000000EFEFEF0000000000000000000000
0000EFEFEF00EFEFEF0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000EFEFEF0000000000EFEFEF00EFEFEF0000000000EFEFEF00000000008080
00008080000000000000C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000EFEFEF00EFEFEF000000
0000EFEFEF00EFEFEF000000000000000000C0C0C00000000000000000008080
00008080000080800000EFEFEF00EFEFEF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000EFEFEF0000000000000000000000000000000000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000EFEFEF0000000000808080008080800080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000008080000000000000808080008080800080808000000000008080
0000000000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000EFEFEF00EFEF
EF0000000000FFFF000080800000000000008080800080808000000000000000
0000000000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFF0000FFFF0000808000000000000080808000000000008080
0000000000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000808000008080
000080800000FFFF0000FFFF0000FFFF00000000000080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFF0000FFFF
0000FFFF0000FFFF000000000000FFFF00000000000080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFF0000FFFF0000FFFF00000000000080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000808000000000000080808000808080008080800080808000FFFF
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000808080008080800080808000808080000000
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFF000000000000D343000000000000
F4810000000000009340000000000000F801000000000000F001000000000000
F001000000000000C001000000000000C001000000000000C001000000000000
C201000000000000C001000000000000F001000000000000F001000000000000
FC03000000000000FFFF00000000000000000000000000000000000000000000
000000000000}
end
object ADOConnection1: TADOConnection
ConnectionString =
'Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ' +
'ID=sa;Initial Catalog=rzdata;Data Source=6GMFFMYKYMJDZW7'
LoginPrompt = False
Provider = 'SQLOLEDB.1'
Left = 408
Top = 64
end
end

View File

@ -0,0 +1,106 @@
unit U_testdll;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, ToolWin, ComCtrls, ImgList, DB, ADODB;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
test1: TMenuItem;
ToolBar1: TToolBar;
Edit1: TEdit;
ToolButton1: TToolButton;
ImageList1: TImageList;
ADOConnection1: TADOConnection;
DllName: TEdit;
Label1: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure test1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
newh:hwnd;
implementation
{$R *.dfm}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sendmessage(newh,1034,4,0);
action:=cafree;
end;
procedure TForm1.test1Click(Sender: TObject);
type
TMyFunc = function(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;stdcall;
var
Tf: TMyFunc;
Tp: TFarProc;
Th:Thandle;
begin
//静态加载
//newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa'));
//动态加载
// showMessage(intTostr(application.Handle));
Th := LoadLibrary('ContractManagement.dll');
if Th > 0 then
begin
try
Tp := GetProcAddress(Th, 'GetDllForm');
if Tp <> nil then
begin
Tf := TMyFunc(Tp);
newh:=Tf(Application,0,strToint(edit1.text),0,0,
PChar('ygcode'),
PChar('ygname'),
PChar('datebase'),
PChar('title'),
PChar(''),
PChar(''),
'','','','','','','','',''
);
end
else
begin
ShowMessage('打印执行错误');
end;
finally
// FreeLibrary();
end;
end
else
begin
ShowMessage('找不到'+Trim(DllName.Text));
end;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
sendmessage(newh,1034,1,0);
end;
end.

View File

@ -0,0 +1,2 @@
[SERVER]
SERVER=192.168.88.254

View File

@ -0,0 +1,38 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,136 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\selfware_83398\selfware\马国钢开发代码\项目代码\self\坯布码单待检DDMD.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=

View File

@ -0,0 +1,14 @@
program testDll;
uses
Forms,
U_testdll in 'U_testdll.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,38 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,136 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\selfware_83398\selfware\马国钢开发代码\项目代码\self\长阳针织(CYZZ.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=

Binary file not shown.

View File

@ -0,0 +1,4 @@
[生产车间配置]
卷条码机台标志=99
成品DLL文件=CYZZ.dll
成品DLL调用号=11

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

View File

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

View File

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

View File

@ -0,0 +1,42 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-U"D:\말繫ERP"
-O"D:\말繫ERP"
-I"D:\말繫ERP"
-R"D:\말繫ERP"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,138 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=D:\富通ERP
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOffice2k;Rave50CLX;Rave50VCL
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\朱哲飞开发代码\项目代码\武嘉\圆机管理(Machine.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
c:\program files\borland\delphi7\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package

View File

@ -0,0 +1,45 @@
library Machine;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
U_GetDllForm in 'U_GetDllForm.pas',
U_RTFun in '..\..\..\RTFunAndForm\Fun\U_RTFun.pas',
U_ModuleNote in 'U_ModuleNote.pas' {frmModuleNote},
U_DataLink in 'U_DataLink.pas' {DataLink_Machine: TDataModule},
U_ZDYHelpSel in 'U_ZDYHelpSel.pas' {frmZDYHelpSel},
U_iniParam in 'U_iniParam.pas',
U_ZDYHelp in 'U_ZDYHelp.pas' {frmZDYHelp},
U_Fun in '..\..\..\ThreeFun\Fun\U_Fun.pas',
U_SelExportField in '..\..\..\ThreeFun\Fun\U_SelExportField.pas' {frmSelExportField},
U_ColumnSet in '..\..\..\ThreeFun\Form\U_ColumnSet.pas' {frmColumnSet},
U_ColumnBandSet in '..\..\..\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet},
U_SelPrintFieldNew in '..\..\..\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew};
{$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.

Binary file not shown.

View File

@ -0,0 +1,45 @@
library Machine;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
U_GetDllForm in 'U_GetDllForm.pas',
U_RTFun in '..\..\..\RTFunAndForm\Fun\U_RTFun.pas',
U_ModuleNote in 'U_ModuleNote.pas' {frmModuleNote},
U_DataLink in 'U_DataLink.pas' {DataLink_Machine: TDataModule},
U_ZDYHelpSel in 'U_ZDYHelpSel.pas' {frmZDYHelpSel},
U_iniParam in 'U_iniParam.pas',
U_ZDYHelp in 'U_ZDYHelp.pas' {frmZDYHelp},
U_Fun in '..\..\..\ThreeFun\Fun\U_Fun.pas',
U_SelExportField in '..\..\..\ThreeFun\Fun\U_SelExportField.pas' {frmSelExportField},
U_ColumnSet in '..\..\..\ThreeFun\Form\U_ColumnSet.pas' {frmColumnSet},
U_ColumnBandSet in '..\..\..\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet},
U_SelPrintFieldNew in '..\..\..\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew};
{$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.

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)

View File

@ -0,0 +1,3 @@
[SERVER]
服务器地址=172.168.1.246
软件名称=欣戈纺织

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,70 @@
unit U_DataLink;
interface
uses
SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels,
Windows,Messages,forms,OleCtnrs,DateUtils, cxClasses;
var
DConString:String; {全局连接字符串}
server, dtbase, user, pswd: String; {数据库连接参数}
DCurHandle:hwnd; //当前窗体句柄
DName:string ; //#用户名#//
DCode:string ; //#用户编号#//
Ddatabase:string; //#数据库名称#//
DTitCaption: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; //公司
type
TDataLink_Machine = class(TDataModule)
AdoDataLink: TADOQuery;
ADOLink: TADOConnection;
ThreeImgList: TImageList;
ThreeLookAndFeelCol: TcxLookAndFeelController;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
procedure DataModuleDestroy(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_Machine: TDataLink_Machine;
implementation
{$R *.dfm}
procedure TDataLink_Machine.DataModuleDestroy(Sender: TObject);
begin
DataLink_Machine:=nil;
end;
end.

View File

@ -0,0 +1,188 @@
object frmFileUp: TfrmFileUp
Left = 247
Top = 162
Width = 634
Height = 447
Caption = #19978#20256#25991#20214
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object cxGrid7: TcxGrid
Left = 0
Top = 41
Width = 555
Height = 367
Align = alClient
TabOrder = 0
object TV7: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsBehavior.FocusCellOnCycle = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Editing = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
object FileName: TcxGridDBColumn
Tag = 1
Caption = #25991#20214#21517#31216
DataBinding.FieldName = 'FileName'
FooterAlignmentHorz = taCenter
HeaderAlignmentHorz = taCenter
Width = 121
end
object FileDate: TcxGridDBColumn
Tag = 1
Caption = #19978#20256#26085#26399
DataBinding.FieldName = 'FileDate'
FooterAlignmentHorz = taCenter
HeaderAlignmentHorz = taCenter
Width = 104
end
end
object cxGridLevel6: TcxGridLevel
GridView = TV7
end
end
object Panel16: TPanel
Left = 190
Top = 126
Width = 138
Height = 30
BevelInner = bvRaised
Caption = #27491#22312#19978#20256#12290#12290#12290
Color = clSkyBlue
TabOrder = 1
Visible = False
end
object ToolBar6: TToolBar
Left = 555
Top = 41
Width = 63
Height = 367
Align = alRight
AutoSize = True
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Flat = True
Images = DataLink_DDMD.ThreeImgList
List = True
ShowCaptions = True
TabOrder = 2
object FileUp: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #19978#20256
ImageIndex = 109
Wrap = True
OnClick = FileUpClick
end
object FileDel: TToolButton
Left = 0
Top = 30
AutoSize = True
Caption = #21024#38500
ImageIndex = 17
Wrap = True
OnClick = FileDelClick
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 618
Height = 41
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 3
object Label1: TLabel
Left = 8
Top = 14
Width = 68
Height = 16
Caption = #20135#21697#32534#21495
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Image2: TImage
Left = 537
Top = 17
Width = 23
Height = 16
end
object Code: TEdit
Left = 78
Top = 9
Width = 211
Height = 24
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
ReadOnly = True
TabOrder = 0
end
end
object ODPat: TOpenDialog
Options = [ofReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Left = 404
Top = 197
end
object IdFTP1: TIdFTP
MaxLineAction = maException
ReadTimeout = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
Left = 405
Top = 236
end
object SaveDialog1: TSaveDialog
Left = 409
Top = 285
end
object ADOQueryFile: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 488
Top = 144
end
object DataSource1: TDataSource
DataSet = ADOQueryFile
Left = 392
Top = 168
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 496
Top = 216
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 504
Top = 264
end
end

View File

@ -0,0 +1,357 @@
unit U_FileUp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ComCtrls, ToolWin, ExtCtrls,
cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
cxClasses, cxControls, cxGridCustomView, cxGrid, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB,jpeg,
BtnEdit,IniFiles;
type
TfrmFileUp = class(TForm)
cxGrid7: TcxGrid;
TV7: TcxGridDBTableView;
FileName: TcxGridDBColumn;
FileDate: TcxGridDBColumn;
cxGridLevel6: TcxGridLevel;
Panel16: TPanel;
ToolBar6: TToolBar;
FileUp: TToolButton;
FileDel: TToolButton;
Panel1: TPanel;
Label1: TLabel;
Code: TEdit;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
SaveDialog1: TSaveDialog;
ADOQueryFile: TADOQuery;
DataSource1: TDataSource;
ADOQueryCmd: TADOQuery;
ADOQueryTemp: TADOQuery;
Image2: TImage;
procedure FileUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FileDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
lstPat: TStringList;
AJpeg: TJPEGImage;
procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
procedure SaveImageOther();
procedure ReadINIFile10();
{ Private declarations }
public
CYID:String;
{ Public declarations }
end;
var
frmFileUp: TfrmFileUp;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmFileUp.ReadINIFile10();
var
programIni:Tinifile; //配置文件名
FileName:string;
begin
FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI';
programIni:=Tinifile.create(FileName);
server:=programIni.ReadString('SERVER','服务器地址','127.0.0.1');
programIni.Free;
end;
procedure TfrmFileUp.FileUpClick(Sender: TObject);
var
i,j: Integer;
PatFile: String;
FTPPath,FConNo,MaxNo:string;
AJpeg: TJPEGImage;
begin
if Trim(Code.Text)='' then
begin
Application.MessageBox('编号不能为空!','提示',0);
Exit;
end;
lstPat.Clear;
if ODPat.Execute then
begin
lstPat.AddStrings(ODPat.Files);
end;
if lstPat.Count > 0 then
begin
try
ReadINIFile10();
server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1');
IdFTP1.Host :=server;//PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
IdFTP1.Quit;
Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING);
Exit;
end;
end;
Panel16.Visible:=True;
Panel16.Refresh;
AJpeg:=TJpegImage.Create();
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select Count(*) MM from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add('and filetype=''YP''');
Open;
j:=fieldbyname('MM').AsInteger;
end;
Image2.Picture.LoadFromFile(ODPat.FileName);
AJpeg.Assign(Image2.Picture.Graphic);
CreThumb(AJpeg,Image2,216, 187);
try
ADOQueryCmd.Connection.BeginTrans;
for i := 0 to lstPat.Count - 1 do
begin
PatFile := ExtractFileName(lstPat[i]);
PatFile:=Copy(PatFile,(Pos('.',PatFile)+1),(Length(PatFile)-Pos('.',PatFile)) ) ;
FConNo:=Trim(Code.Text);
while Pos('/',FConNo)>0 do
begin
Delete(FConNo,Pos('/',FConNo),1);
end;
PatFile:=Trim(FConNo)+'-'+Inttostr(j+i+1)+'.'+PatFile;
if IdFTP1.Connected then
begin
try
{if not DirectoryExists('D:\图片\'+Trim(gDef1)) then
ForceDirectories('D:\图片\'+Trim(gDef1)); }
IdFTP1.Put(lstPat[i], Trim('\YP')+'\'+Trim(PatFile));
with ADOQueryTemp do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and filename='''+Trim(PatFile)+'''');
SQL.Add(' and filetype=''YP''');
Open;
if not IsEmpty then
begin
Panel16.Visible:=False;
Application.MessageBox(PChar('文件<'+Trim(PatFile)+'>重复,'+inttostr(i)+'个文件上传成功!'),'提示',0);
Exit;
end;
end;
if GetLSNo(ADOQueryCmd,MaxNo,'YP','XD_File',4,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取图片最大号失败!','提示',0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where 1<>1');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('XFID').Value:=Trim(MaxNo);
FieldByName('CYID').Value:=Trim(CYID);
FieldByName('CYNO').Value:=Trim(Code.Text);
FieldByName('filename').Value:=Trim(PatFile);
FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp);
fieldbyname('FileType').value:=Trim('YP');
Post;
end;
except
//ADOQueryCmd.Connection.RollbackTrans;
//Application.MessageBox('图片上传失败!','提示',0);
end;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update CP_YDang Set TPFlag=1 where CYID='''+Trim(CYID)+'''');
ExecSQL;
end;
SaveImageOther();
ADOQueryCmd.Connection.CommitTrans;
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('图片上传失败!','提示',0);
end;
if IdFTP1.Connected then IdFTP1.Quit;
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
open;
end;
Panel16.Visible:=False;
if i>0 then
Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0);
ModalResult:=1;
end;
procedure TfrmFileUp.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := AJPeg.Width /AJPeg.Height;
if Ratio > 1.333 then
begin
AHeight := Round(Width / Ratio);
AHeightOffset := (Height - AHeight) div 2;
AWidth := Width;
AWidthOffset := 0;
end
else
begin
AWidth := Round(Height * Ratio);
AWidthOffset := (Width - AWidth) div 2;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, AJPeg);
Image1.Picture.Assign(BitMap);
finally
Bitmap.Free;
end;
end;
procedure TfrmFileUp.SaveImageOther();
var
AJpeg: TJPEGImage;
myStream: TADOBlobStream;
ImgMaxNo:String;
i,j: Integer;
PatFile: String;
FTPPath,FConNo,MaxNo,FTFID:string;
begin
if Image2.Picture=nil then Exit;
AJpeg:=TJpegImage.Create();
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from TP_File where WBID='''+Trim(CYID)+'''');
Open;
end;
FTFID:=Trim(ADOQueryTemp.fieldbyname('TFID').AsString);
if Trim(FTFID)='' then
begin
if GetLSNo(ADOQueryCmd,ImgMaxNo,'TF','TP_File',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取图片表最大号失败!','提示',0);
Exit;
end;
end else
begin
ImgMaxNo:=Trim(FTFID);
end;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add( ' select * from TP_File where TFID='''+Trim(FTFID)+'''');
open;
end;
with ADOQueryCmd do
begin
if Trim(FTFID)='' then
begin
Append;
FieldByName('Filler').Value:=Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('TFID').Value:=Trim(ImgMaxNo);
FieldByName('WBID').Value:=Trim(CYID);
//FieldByName('TFIdx').Value:=cxTabControl2.TabIndex;
FieldByName('TFType').Value:='样品';
AJpeg.Assign(Image2.Picture.Graphic);
//CreThumb(AJpeg,Image1,160, 120);
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
AJpeg.Assign(Image2.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
end;
procedure TfrmFileUp.FormCreate(Sender: TObject);
begin
lstPat := TStringList.Create;
end;
procedure TfrmFileUp.FileDelClick(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add(' Delete XD_File where XFID='''+Trim(ADOQueryFile.fieldbyname('XFID').AsString)+'''');
SQL.Add(' Delete TP_File where WBID='''+Trim(CYID)+''' and TFType=''样品'' ');
ExecSQL;
end;
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
open;
end;
if ADOQueryFile.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update CP_YDang Set TPFlag=0 where CYID='''+Trim(CYID)+'''');
ExecSQL;
end;
end;
end;
procedure TfrmFileUp.FormShow(Sender: TObject);
begin
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
Open;
end;
end;
end.

View File

@ -0,0 +1,198 @@
unit U_GetDllForm;
interface
uses
Windows, Messages, forms, OleCtnrs, DateUtils, SysUtils, ADODB, dxCore,
ActiveX;
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;
implementation
uses
U_DataLink, U_MachineArea, U_WeiXiuList, U_MachineManage;
/////////////////////////////////////////////////////////////////
// 功能说明:取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
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;
MainApplication := App;
DCurHandle := FormH;
IsDelphiLanguage := Language;
Application := TApplication(App);
DCurHandle := 0;
//赋值链接字符串
SetLength(server, 255);
SetLength(dtbase, 255);
SetLength(user, 255);
SetLength(pswd, 255);
server := '101.132.143.144,7781';
dtbase := 'WuJiadata';
user := 'rtsa';
pswd := 'rightsoft@5740';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
DConString := DataBaseStr;
if not ConnData() then
begin
result := 0;
exit;
end;
// 定义窗口类型 、状态
if WinStyle = 0 then
begin
mstyle := fsMDIChild;
mstate := wsMaximized;
mborderstyle := bsSizeable;
end
else
begin
mstyle := fsNormal;
mstate := wsNormal;
mborderstyle := bsSizeable;
end;
/////////////////////
//调用子模块窗口
case FormID of
111: //机台看板
begin
if frmMachineArea = nil then
begin
frmMachineArea := TfrmMachineArea.Create(application.MainForm);
with frmMachineArea do
begin
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmMachineArea.BringToFront;
//句柄
mnewHandle := frmMachineArea.Handle;
end;
101: //机台管理
begin
if frmMachineManage = nil then
begin
frmMachineManage := TfrmMachineManage.Create(application.MainForm);
with frmMachineManage do
begin
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmMachineManage.BringToFront;
//句柄
mnewHandle := frmMachineManage.Handle;
end;
121: //维修记录
begin
if frmWeiXiuList = nil then
begin
frmWeiXiuList := TfrmWeiXiuList.Create(application.MainForm);
with frmWeiXiuList do
begin
caption := Trim(Title);
FormStyle := mstyle;
windowState := mstate;
BorderStyle := mborderstyle;
//show;
end;
end
else
frmWeiXiuList.BringToFront;
//句柄
mnewHandle := frmWeiXiuList.Handle;
end;
end;
Result := mnewHandle;
// NewDllApp := Application;
end;
//===========================================================
//建立数据库连接池
//===========================================================
function ConnData(): Boolean;
begin
if not Assigned(DataLink_Machine) then
DataLink_Machine := TDataLink_Machine.Create(Application);
try
with DataLink_Machine.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
// OldDllApp := Application;
//
//finalization
// DataLink_Machine.Free;
// Application := OldDllApp;
initialization
CoInitialize(nil);
dxUnitsLoader.Initialize;
finalization
DataLink_Machine.Free;
application := NewDllApp;
dxUnitsLoader.Finalize;
end.

View File

@ -0,0 +1,313 @@
object frmLabelAdd: TfrmLabelAdd
Left = 191
Top = 109
Width = 997
Height = 612
BorderIcons = [biMaximize]
Caption = #26631#31614#32534#36753
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Panel1: TPanel
Left = 0
Top = 28
Width = 413
Height = 513
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object Label2: TLabel
Left = 31
Top = 21
Width = 60
Height = 12
Caption = #26631#31614#25991#20214#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label3: TLabel
Left = 31
Top = 95
Width = 60
Height = 12
Caption = #22791' '#27880#65306
end
object Label9: TLabel
Left = 31
Top = 71
Width = 60
Height = 12
Caption = #26631#31614#21517#31216#65306
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label10: TLabel
Left = 31
Top = 47
Width = 60
Height = 12
Caption = #26631#31614#31867#22411#65306
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object LabelFileName: TBtnEditA
Left = 92
Top = 17
Width = 260
Height = 20
ReadOnly = True
TabOrder = 0
OnBtnClick = LabelFileNameBtnClick
end
object beizhu: TMemo
Left = 92
Top = 92
Width = 257
Height = 149
ScrollBars = ssBoth
TabOrder = 1
end
object LabelCaption: TEdit
Left = 92
Top = 67
Width = 258
Height = 20
ReadOnly = True
TabOrder = 2
end
object LabelType: TFTComboBox
Tag = 99
Left = 92
Top = 43
Width = 260
Height = 20
Style = csDropDownList
ItemHeight = 12
ItemIndex = 0
TabOrder = 3
Text = #20013#25991#26631#31614
Items.Strings = (
#20013#25991#26631#31614
#33521#25991#26631#31614
#20013#33521#25991#26631#31614)
end
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 981
AutoSize = True
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar2'
Color = clBtnFace
Flat = True
Images = DataLink_CYZZ.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 1
Transparent = False
object Tsave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384#26631#31614
ImageIndex = 5
OnClick = TsaveClick
end
object Tclose: TToolButton
Left = 87
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TcloseClick
end
end
object RMPreview1: TRMPreview
Left = 428
Top = 32
Width = 553
Height = 541
Align = alRight
BevelOuter = bvLowered
Caption = #26631#31614#39044#35272
TabOrder = 2
OnDblClick = RMPreview1DblClick
Options.RulerUnit = rmutScreenPixels
Options.RulerVisible = False
Options.DrawBorder = False
Options.BorderPen.Color = clGray
Options.BorderPen.Style = psDash
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_CYZZ.ADOLink
CommandTimeout = 300
Parameters = <>
Left = 512
Top = 208
end
object OpenDialog1: TOpenDialog
Filter = 'RMFl(*.rmf)|*.rmf'
InitialDir = '.'
Left = 200
Top = 4
end
object RMGridReport1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
ShowProgress = False
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
Preview = RMPreview1
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 = 336
Top = 8
ReportData = {}
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_CYZZ.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 528
Top = 184
end
object RMGridReportDesigner1: TRMGridReportDesigner
Left = 376
Top = 8
end
object RMBarCodeObject1: TRMBarCodeObject
Left = 280
Top = 4
end
object RMBMPExport1: TRMBMPExport
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
Left = 408
Top = 8
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 10
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 440
Top = 8
end
object RMDS_Main: TRMDBDataSet
Visible = True
AliasName = #26631#31614#25968#25454
Left = 498
Top = 72
end
object RMDataDictionary1: TRMDataDictionary
FieldFieldNames.TableName = 'TableName'
FieldFieldNames.FieldName = 'FieldName'
FieldFieldNames.FieldAlias = 'FieldAlias'
Left = 562
Top = 72
end
object ADOQuery1: TADOQuery
Connection = DataLink_CYZZ.ADOLink
Parameters = <>
Left = 352
Top = 480
end
object RMGridReport2: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
ShowProgress = False
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDS_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 432
Top = 368
ReportData = {}
end
object ADOQueryCmdSC: TADOQuery
Connection = DataLink_CYZZ.ADOLink
Parameters = <>
Left = 296
Top = 304
object ADOQueryCmdFileContent: TBlobField
FieldName = 'Files'
end
object ADOQueryCmdFtFileName: TStringField
FieldName = 'FileName'
Size = 40
end
object ADOQueryCmdFileEditDate: TDateTimeField
FieldName = 'FileEditDate'
end
object ADOQueryCmdFileSize: TFloatField
FieldName = 'FileSize'
end
object ADOQueryCmdFiller: TStringField
FieldName = 'Filler'
end
object ADOQueryCmdLastEditTime: TDateTimeField
FieldName = 'LastEditTime'
end
object ADOQueryCmdLastEditer: TStringField
FieldName = 'LastEditer'
end
object ADOQueryCmdFileCreateDate: TDateTimeField
FieldName = 'FileCreateDate'
end
object ADOQueryCmdchildPath: TStringField
FieldName = 'FilePath'
end
object ADOQueryCmdFileType: TStringField
FieldName = 'FileType'
end
end
end

View File

@ -0,0 +1,455 @@
unit U_LabelAdd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, ExtCtrls, DB, ADODB,
RM_System, RM_Common, RM_Class, RM_GridReport, Buttons, FTComboBox,
RM_Preview, RM_e_Xls, RM_e_Graphic, RM_e_bmp, RM_BarCode,
RM_DsgGridReport, RM_Dataset, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid;
type
TfrmLabelAdd = class(TForm)
Panel1: TPanel;
Label2: TLabel;
Label3: TLabel;
LabelFileName: TBtnEditA;
beizhu: TMemo;
ToolBar1: TToolBar;
Tsave: TToolButton;
Tclose: TToolButton;
ADOQueryCmd: TADOQuery;
OpenDialog1: TOpenDialog;
RMGridReport1: TRMGridReport;
Label9: TLabel;
LabelCaption: TEdit;
Label10: TLabel;
LabelType: TFTComboBox;
ADOQueryTmp: TADOQuery;
RMPreview1: TRMPreview;
RMGridReportDesigner1: TRMGridReportDesigner;
RMBarCodeObject1: TRMBarCodeObject;
RMBMPExport1: TRMBMPExport;
RMXLSExport1: TRMXLSExport;
RMDS_Main: TRMDBDataSet;
RMDataDictionary1: TRMDataDictionary;
ADOQuery1: TADOQuery;
RMGridReport2: TRMGridReport;
ADOQueryCmdSC: TADOQuery;
ADOQueryCmdFileContent: TBlobField;
ADOQueryCmdFtFileName: TStringField;
ADOQueryCmdFileEditDate: TDateTimeField;
ADOQueryCmdFileSize: TFloatField;
ADOQueryCmdFiller: TStringField;
ADOQueryCmdLastEditTime: TDateTimeField;
ADOQueryCmdLastEditer: TStringField;
ADOQueryCmdFileCreateDate: TDateTimeField;
ADOQueryCmdchildPath: TStringField;
ADOQueryCmdFileType: TStringField;
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TsaveClick(Sender: TObject);
procedure LabelFileNameBtnClick(Sender: TObject);
procedure BtOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RMPreview1DblClick(Sender: TObject);
private
fIsChg:Boolean;
function SaveData():Boolean;
function EditData():Boolean;
procedure InitWinData();
procedure InitVarDictionary();
procedure InitDataSetDictionary();
function PostFileToData():boolean;
procedure GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime);
function CovFileDate(Fd:_FileTime):TDateTime;
public
fcustomNo:string;
fKeyNo:string;
fWinStatus:integer;
end;
var
frmLabelAdd: TfrmLabelAdd;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmLabelAdd.TcloseClick(Sender: TObject);
begin
if fIsChg then
begin
if application.MessageBox('标签设计过,是否要保存?','提示信息',1)=1 then
begin
Tsave.Click ;
end
else
close;
end
else
close;
end;
procedure TfrmLabelAdd.FormCreate(Sender: TObject);
begin
panel1.Align :=alClient;
fIsChg:=false;
// ClearWinData(panel1);
// InitVarDictionary();
end;
procedure TfrmLabelAdd.TsaveClick(Sender: TObject);
begin
if trim(labelCaption.Text)='' then
begin
application.MessageBox('标签名称不能为空!','提示');
labelCaption.SetFocus;
exit;
end;
if trim(LabelFileName.Text)='' then
begin
application.MessageBox('标签文件不能为空,请选择标签!','提示');
LabelFileName.SetFocus;
exit;
end;
PostFileToData();
if fWinStatus=0 then
begin
if SaveData() then
begin
ModalResult:=1;
end;
end
else
begin
if EditData() then
begin
ModalResult:=1;
end;
end;
end;
function TfrmLabelAdd.PostFileToData():boolean;
var
mFileName,fFileName,fpathFileName:string;
Stream : TMemoryStream;
mfileSize:integer;
mCreationTime:TdateTime;
mWriteTime:TdateTime;
begin
result:=false;
fFileName:=Trim(LabelCaption.Text);
fpathFileName:=Trim(LabelFileName.Text);
try
ADOQueryCmdSC.Connection.BeginTrans ;
try
with ADOQueryCmdSC do
begin
close;
sql.Clear ;
sql.Add('delete from RT_FileUpdate');
sql.Add('where FileName='+quotedStr(trim(fFileName)));
execsql;
end;
with ADOQueryCmdSC do
begin
close;
sql.Clear ;
sql.Add('select * from RT_FileUpdate');
sql.Add('where FileName='+quotedStr(trim(fFileName)));
Open;
//////////////////////////
//获取文件信息
GetFileInfo(Trim(fpathFileName),mfileSize,mCreationTime,mWriteTime);
if RecordCount<=0 then
begin
Append;
fieldByName('FileName').AsString := trim(fFileName);
end
else
begin
edit;
end;
fieldByName('FileEditDate').Value :=mWriteTime;
fieldByName('FileCreateDate').Value :=mCreationTime;
fieldByName('FileSize').Value :=mfileSize;
fieldByName('Filler').Value :=Dname;
fieldByName('LastEditer').Value :=Dname;
fieldByName('LastEditTime').Value :=SGetServerDateTime(ADOQueryTmp);
if pos('.rmf',fFileName)>0 then
begin
fieldByName('FilePath').Value :='report';
fieldByName('FileType').Value :='公用';
end
else if pos('.dll',fFileName)>0 then
begin
fieldByName('FilePath').Value :='';
fieldByName('FileType').Value :='一般';
end
else
begin
fieldByName('FilePath').Value :='';
fieldByName('FileType').Value :='公用';
end;
//将OLE数据存入数据库
ADOQueryCmdFileContent.LoadFromFile(fpathFileName);
//ADOQueryCmdFileContent.LoadFromStream(Stream);
post;
end;
finally
end;
result:=true;
ADOQueryCmdSC.Connection.CommitTrans ;
except
ADOQueryCmdSC.Connection.RollbackTrans ;
Result:=False;
application.MessageBox(pchar('提交文件['+trim(fFileName)+']失败!'),'提示信息',MB_ICONERROR);
end;
end;
procedure TfrmLabelAdd.GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime);
var
vSearchRec: TSearchRec;
begin
FindFirst(mFile,faAnyFile,vSearchRec);
mfileSize:=vSearchRec.Size;
CreationTime:=CovFileDate(vSearchRec.FindData.ftCreationTime);//创建时间
//vSearchRec.FindData.ftLastAccessTime//访问时间
WriteTime:=CovFileDate(vSearchRec.FindData.ftLastWriteTime);//修改时间
FindClose(vSearchRec);
end;
function TfrmLabelAdd.CovFileDate(Fd:_FileTime):TDateTime;
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
CovFileDate:=SystemTimeToDateTime(Tct);
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelAdd.SaveData():Boolean;
begin
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from P_Label');
sql.Add('where 1<>1');
Open;
Append;
fieldByName('filler').value:=DName;
fieldByName('filltime').value:=DServerDate;
fieldByName('beizhu').value:= trim(beizhu.text);
fieldByName('LabelCaption').value:=trim(LabelCaption.text);
fieldByName('LabelType').value:=trim(LabelType.text);
fieldByName('LabelFileName').value:= trim(LabelFileName.text);
//TBlobField(FieldByName('LabelFile')).LoadFromStream(fStream);
RMGridReport1.SaveToBlobField(TBlobField(FieldByName('LabelFile')));
Post;
end;
with ADOQueryTmp do
begin
Close;
sql.Clear;
sql.Add('select * from P_Label where LabelCaption='''+Trim(LabelCaption.text)+'''');
Open;
end;
if ADOQueryTmp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Result:=False;
Application.MessageBox('标签名称重复!','提示',0);
Exit;
end;
ADOQueryCmd.Connection.CommitTrans;
result:=true;
except
ADOQueryCmd.Connection.RollbackTrans;
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelAdd.EditData():Boolean;
begin
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from P_Label');
sql.Add('where labelId='+fkeyNo);
Open;
Edit;
fieldByName('LabelCaption').value:=trim(LabelCaption.text);
fieldByName('LabelType').value:=trim(LabelType.text);
fieldByName('LabelFileName').value:= trim(LabelFileName.text);
RMGridReport1.SaveToBlobField(TBlobField(FieldByName('LabelFile')));
fieldByName('Editer').value:=DName;
fieldByName('EditTime').value:=DServerDate;
fieldByName('beizhu').value:= trim(beizhu.text);
Post;
end;
with ADOQueryTmp do
begin
Close;
sql.Clear;
sql.Add('select * from P_Label where LabelCaption='''+Trim(LabelCaption.text)+'''');
Open;
end;
if ADOQueryTmp.RecordCount>1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Result:=False;
Application.MessageBox('标签名称重复!','提示',0);
Exit;
end;
ADOQueryCmd.Connection.CommitTrans;
result:=true;
except
ADOQueryCmd.Connection.RollbackTrans;
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
procedure TfrmLabelAdd.LabelFileNameBtnClick(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
LabelFileName.Text:=OpenDialog1.FileName;
LabelCaption.Text:=Trim(ExtractFileName(OpenDialog1.FileName));
RMGridReport1.LoadFromFile(LabelFileName.Text);
RMGridReport1.Preview :=RMPreview1;
RMGridReport1.ShowReport ;
end;
end;
procedure TfrmLabelAdd.BtOpenClick(Sender: TObject);
begin
end;
////////////////////////////////////////////////////////////
//初始化窗口数据
////////////////////////////////////////////////////////////
procedure TfrmLabelAdd.InitWinData();
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select A.*');
// sql.Add('customNoName=isnull((select customName from BC_customer where customNO=A.customNo),A.customNo)');
sql.Add('from P_Label A');
sql.Add('WHERE LabelId='+fkeyNo);
Open;
if isEmpty then
begin
close;
exit;
end;
SSetWinData(ADOQueryTmp,panel1);
RMGridReport1.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport2.FileName:=trim(fieldByName('labelFileName').AsString);
RMGridReport2.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport1.Preview :=RMPreview1;
//RMGridReport1.PrepareReport;
RMGridReport1.ShowReport ;
end;
except
end;
end;
procedure TfrmLabelAdd.FormShow(Sender: TObject);
begin
if fWinStatus>0 then
InitWinData();
end;
procedure TfrmLabelAdd.RMPreview1DblClick(Sender: TObject);
begin
//btOpen.Click ;
end;
////////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////////
procedure TfrmLabelAdd.InitVarDictionary();
var
i:integer;
begin
{ try
with RMGridReport2 do
begin
Dictionary.Variables.Clear ;
Dictionary.Variables.AddCategory('客户单位信息');
with ADOQueryTmp do
begin
close;
sql.clear;
sql.Add('exec P_Label_CustPrintData');
sql.Add(quotedStr(fCustomNo));
Open;
for i:=0 to FieldCount-1 do
begin
Dictionary.Variables.Add(trim(fields[i].FieldName)
,'');
Dictionary.Variables.AsString[trim(fields[i].FieldName)]:=trim(fields[i].AsString);
end;
end;
end;
finally
end; }
end;
/////////////////////////////////////////////////
//
/////////////////////////////////////////////////
procedure TfrmLabelAdd.InitDataSetDictionary();
begin
{ with ADOQuery1 do
begin
close;
sql.Clear ;
sql.Add('exec P_Label_PrintSet');
sql.Add(quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
OPen;
end;
with RMGridReport2 do
begin
Dictionary.FieldAliases.Clear;
Dictionary.FieldAliases['RMDS_Main']:= '标签数据';
Dictionary.FieldAliases['RMDS_Main."barcode"']:='标签条码';
end; }
end;
end.

View File

@ -0,0 +1,438 @@
object frmLabelList: TfrmLabelList
Left = 145
Top = 10
Width = 1057
Height = 693
BorderIcons = [biMaximize]
Caption = #26631#31614#20449#24687
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poOwnerFormCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Panel1: TPanel
Left = 12
Top = 80
Width = 452
Height = 561
BevelOuter = bvNone
TabOrder = 0
object Panel2: TPanel
Left = 0
Top = 3
Width = 452
Height = 558
Align = alClient
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object cxGrid1: TcxGrid
Left = 2
Top = 2
Width = 448
Height = 554
Align = alClient
TabOrder = 0
object tv1: TcxGridDBTableView
OnDblClick = tv1DblClick
NavigatorButtons.ConfirmDelete = False
OnCellClick = tv1CellClick
OnFocusedRecordChanged = tv1FocusedRecordChanged
DataController.DataSource = DS_Label
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
object tv1labelId: TcxGridDBColumn
Caption = #26631#31614'ID'
DataBinding.FieldName = 'labelId'
Visible = False
Width = 53
end
object tv1labeltype: TcxGridDBColumn
Caption = #26631#31614#31867#22411
DataBinding.FieldName = 'labeltype'
HeaderAlignmentHorz = taCenter
HeaderAlignmentVert = vaCenter
Width = 107
end
object tv1labelCaption: TcxGridDBColumn
Caption = #26631#31614#21517#31216
DataBinding.FieldName = 'labelCaption'
HeaderAlignmentHorz = taCenter
HeaderAlignmentVert = vaCenter
Width = 261
end
object tv1labelFile: TcxGridDBColumn
Caption = #25991#20214#21517
DataBinding.FieldName = 'labelFile'
Visible = False
HeaderAlignmentHorz = taCenter
HeaderAlignmentVert = vaCenter
Width = 167
end
end
object cxGrid1Level1: TcxGridLevel
GridView = tv1
end
end
end
object Panel3: TPanel
Left = 0
Top = 0
Width = 452
Height = 3
Align = alTop
Caption = 'Panel3'
TabOrder = 1
Visible = False
object Label1: TLabel
Left = 40
Top = 13
Width = 60
Height = 12
Caption = #23458#25143#21517#31216#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label2: TLabel
Left = 52
Top = 35
Width = 48
Height = 12
Caption = #19994#21153#21592#65306
Visible = False
end
object Label4: TLabel
Left = 40
Top = 61
Width = 60
Height = 12
Caption = #30005#35805#21495#30721#65306
end
object Label5: TLabel
Left = 39
Top = 86
Width = 60
Height = 12
Caption = #20844#21496#21517#31216#65306
end
object Label6: TLabel
Left = 14
Top = 108
Width = 84
Height = 12
Caption = #20844#21496#33521#25991#21517#31216#65306
end
object Label7: TLabel
Left = 61
Top = 133
Width = 36
Height = 12
Caption = #22320#22336#65306
end
object Label8: TLabel
Left = 37
Top = 157
Width = 60
Height = 12
Caption = #33521#25991#22320#22336#65306
end
object Label3: TLabel
Left = 61
Top = 192
Width = 36
Height = 12
Caption = #22791#27880#65306
end
object Note: TMemo
Left = 120
Top = 175
Width = 293
Height = 63
ScrollBars = ssBoth
TabOrder = 0
end
object EngAddress: TEdit
Left = 120
Top = 151
Width = 294
Height = 20
Enabled = False
TabOrder = 1
end
object ChnAddress: TEdit
Left = 120
Top = 127
Width = 293
Height = 20
TabOrder = 2
end
object engFactory: TEdit
Left = 119
Top = 104
Width = 295
Height = 20
TabOrder = 3
end
object ChnFactory: TEdit
Left = 119
Top = 81
Width = 294
Height = 20
TabOrder = 4
end
object TelePhone: TEdit
Left = 119
Top = 58
Width = 294
Height = 20
TabOrder = 5
end
object ywy: TEdit
Tag = 99
Left = 119
Top = 31
Width = 295
Height = 20
ReadOnly = True
TabOrder = 6
Text = 'ywy'
Visible = False
end
object customNo: TBtnEditA
Tag = 1
Left = 120
Top = 7
Width = 295
Height = 20
Enabled = False
ReadOnly = True
TabOrder = 7
OnBtnClick = customNoBtnClick
end
end
end
object RMPreview1: TRMPreview
Left = 488
Top = 85
Width = 553
Height = 569
Align = alRight
BevelOuter = bvLowered
Caption = 'Insert After'
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = False
TabOrder = 1
OnDblClick = RMPreview1DblClick
Options.RulerUnit = rmutScreenPixels
Options.RulerVisible = False
Options.DrawBorder = False
Options.BorderPen.Color = clGray
Options.BorderPen.Style = psDash
end
object ToolBar2: TToolBar
Left = 0
Top = 0
Width = 1041
AutoSize = True
ButtonHeight = 30
ButtonWidth = 83
Caption = 'ToolBar2'
Color = clBtnFace
Flat = True
Images = DataLink_DDMD.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 2
Transparent = False
object ToolButton1: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = ToolButton1Click
end
object TOK: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #30830#23450
ImageIndex = 10
OnClick = TOkClick
end
object Tadd: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #26032#22686#26631#31614
ImageIndex = 1
OnClick = TaddClick
end
object Tupd: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20462#25913#26631#31614
ImageIndex = 11
OnClick = TupdClick
end
object Tdel: TToolButton
Left = 300
Top = 0
AutoSize = True
Caption = #21024#38500#26631#31614
ImageIndex = 3
OnClick = TdelClick
end
object Tclose: TToolButton
Left = 387
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TcloseClick
end
end
object Panel4: TPanel
Left = 0
Top = 32
Width = 1041
Height = 53
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 3
object Label9: TLabel
Left = 36
Top = 20
Width = 48
Height = 12
Caption = #26631#31614#31867#22411
end
object Label10: TLabel
Left = 280
Top = 20
Width = 48
Height = 12
Caption = #26631#31614#26631#39064
end
object LabelCaption: TEdit
Left = 332
Top = 16
Width = 100
Height = 20
TabOrder = 0
OnChange = LabelTypeChange
end
object LabelType: TFTComboBox
Tag = 99
Left = 88
Top = 17
Width = 100
Height = 20
Style = csDropDownList
ItemHeight = 12
ItemIndex = 0
TabOrder = 1
OnChange = LabelTypeChange
Items.Strings = (
''
#20013#25991#26631#31614
#33521#25991#26631#31614
#20013#33521#25991#26631#31614)
end
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_DDMD.ADOLink
CommandTimeout = 300
Parameters = <>
Left = 508
Top = 208
end
object OpenDialog1: TOpenDialog
Filter = 'RMFl(*.rmf)|*.rmf'
InitialDir = '.'
Left = 316
Top = 148
end
object RMGridReport1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
ModalPreview = False
ShowProgress = False
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
Preview = RMPreview1
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 = 436
Top = 152
ReportData = {}
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 528
Top = 184
end
object ADOQuery1: TADOQuery
Connection = DataLink_DDMD.ADOLink
Parameters = <>
Left = 392
Top = 228
end
object DS_Label: TDataSource
DataSet = ADOQueryLabel
Left = 66
Top = 456
end
object ADOQueryLabel10: TADOQuery
Connection = DataLink_DDMD.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 234
Top = 296
end
object ADOQueryLabel: TClientDataSet
Aggregates = <>
Params = <>
Left = 156
Top = 267
end
end

View File

@ -0,0 +1,591 @@
unit U_LabelList;
interface
uses
Windows, Messages, SysUtils, StrUtils,Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, ExtCtrls, DB, ADODB,
RM_System, RM_Common, RM_Class, RM_GridReport, Buttons, FTComboBox,
RM_Preview, RM_e_Xls, RM_e_Graphic, RM_e_bmp, RM_BarCode,
RM_DsgGridReport, RM_Dataset, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, DBClient;
type
TfrmLabelList = class(TForm)
Panel1: TPanel;
ADOQueryCmd: TADOQuery;
OpenDialog1: TOpenDialog;
RMGridReport1: TRMGridReport;
ADOQueryTmp: TADOQuery;
RMPreview1: TRMPreview;
ADOQuery1: TADOQuery;
Panel2: TPanel;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1labeltype: TcxGridDBColumn;
tv1labelCaption: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
tv1labelFile: TcxGridDBColumn;
DS_Label: TDataSource;
ADOQueryLabel10: TADOQuery;
Panel3: TPanel;
Note: TMemo;
EngAddress: TEdit;
ChnAddress: TEdit;
engFactory: TEdit;
ChnFactory: TEdit;
TelePhone: TEdit;
ywy: TEdit;
customNo: TBtnEditA;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label3: TLabel;
tv1labelId: TcxGridDBColumn;
ToolBar2: TToolBar;
Tadd: TToolButton;
Tupd: TToolButton;
Tdel: TToolButton;
TOK: TToolButton;
Tclose: TToolButton;
Panel4: TPanel;
ToolButton1: TToolButton;
Label9: TLabel;
Label10: TLabel;
LabelCaption: TEdit;
LabelType: TFTComboBox;
ADOQueryLabel: TClientDataSet;
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TsaveClick(Sender: TObject);
procedure customNoBtnClick(Sender: TObject);
procedure BtOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RMPreview1DblClick(Sender: TObject);
procedure TaddClick(Sender: TObject);
procedure TupdClick(Sender: TObject);
procedure tv1FocusedRecordChanged(Sender: TcxCustomGridTableView;
APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord;
ANewItemRecordFocusingChanged: Boolean);
procedure TdelClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure TOkClick(Sender: TObject);
procedure tv1DblClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure LabelTypeChange(Sender: TObject);
procedure tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
private
isLoad:Boolean;
function SaveData():Boolean;
function EditData():Boolean;
function IsCheckCustOk():Boolean;
function DeleteData():Boolean;
procedure InitWinData();
procedure InitVarDictionary();
procedure InitDataSetDictionary();
procedure InitGrid();
procedure OpenLabel();
procedure SetWinStatus();
procedure DoFilter();
public
fSelLabelId,LBName,LBInt,SLBName:String;
fKeyNo:string;
fchg:Boolean;
fIsShowModal:Boolean;
fWinStatus:integer;
end;
var
frmLabelList: TfrmLabelList;
implementation
uses
U_DataLink, U_LabelAdd,U_RTFun;
{$R *.dfm}
procedure TfrmLabelList.DoFilter();
var
filterStr:string;
begin
filterStr:='';
if trim(LabelType.Text) <>'' then
begin
filterStr:=' and LabelType like '+quotedStr('%'+trim(LabelType.Text)+'%');
end;
//名称
if trim(LabelCaption.Text)<>'' then
begin
filterStr:=filterStr+' and LabelCaption like '+quotedStr('%'+trim(LabelCaption.Text)+'%');
end;
try
ADOQueryLabel10.DisableControls ;
if trim(filterStr)='' then
begin
ADOQueryLabel.Filtered:=false;
ADOQueryLabel.EnableControls;
exit;
end;
filterStr:=trim(RightBStr(filterStr,length(filterStr)-4));
with ADOQueryLabel do
begin
filtered:=false;
filter:=filterStr;
filtered:=true;
end;
SCreateCDS20(ADOQueryLabel10,ADOQueryLabel);
SInitCDSData20(ADOQueryLabel10,ADOQueryLabel);
finally
ADOQueryLabel10.EnableControls;
end;
end;
procedure TfrmLabelList.TcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmLabelList.FormCreate(Sender: TObject);
begin
panel1.Align :=alClient;
// ClearWinData(panel3);
fSelLabelId := '';
end;
procedure TfrmLabelList.TsaveClick(Sender: TObject);
begin
if trim(customNO.Text)='' then
begin
application.MessageBox('客户名称不能为空,请选择客户!','提示');
customNo.SetFocus;
exit;
end;
if application.MessageBox('确定要保存吗?','提示信息',1)=2 then exit;
if fWinStatus=0 then
begin
if not IsCheckCustOk() then exit;
if SaveData() then
begin
fWinStatus:=1;
fchg:=true;
SetWinStatus();
end;
end
else
begin
if EditData() then
begin
fchg:=true;
application.MessageBox('保存成功!','提示信息',0)
end;
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelList.SaveData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from JD_Label');
sql.Add('where 1<>1');
Open;
Append;
fieldByName('customno').value:=trim(customno.txtCode);
fieldByName('ChnFactory').value:=trim(ChnFactory.text);
fieldByName('engFactory').value:=trim(engFactory.text);
fieldByName('TelePhone').value:=trim(TelePhone.text);
fieldByName('ChnAddress').value:=trim(ChnAddress.text);
fieldByName('EngAddress').value:=trim(EngAddress.text);
fieldByName('filler').value:=Dname;
fieldByName('filltime').value:=DServerDate;
fieldByName('note').value:= trim(Note.text);
Post;
end;
result:=true;
except
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能:保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelList.EditData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from JD_Label');
sql.Add('where customNo='+fKeyNo);
Open;
Edit;
fieldByName('customno').value:=trim(customno.txtCode);
fieldByName('ChnFactory').value:=trim(ChnFactory.text);
fieldByName('engFactory').value:=trim(engFactory.text);
fieldByName('TelePhone').value:=trim(TelePhone.text);
fieldByName('ChnAddress').value:=trim(ChnAddress.text);
fieldByName('EngAddress').value:=trim(EngAddress.text);
fieldByName('note').value:= trim(Note.text);
Post;
end;
result:=true;
except
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
procedure TfrmLabelList.customNoBtnClick(Sender: TObject);
begin
{ FormGetCust:=TFormGetCust.Create(self);
if FormGetCust.ShowModal=mrok then
begin
customNo.TxtCode:=trim(FormGetCust.ADOQuery1.Fieldbyname('customno').AsString);
customNo.Text:=trim(FormGetCust.ADOQuery1.Fieldbyname('shortname').AsString);
end;
FormGetCust.Free; }
{ frmCustHelp:=TfrmCustHelp.create(self);
with frmCustHelp do
begin
if showModal=1 then
begin
customNo.TxtCode:=trim(ADOQueryHelp.Fieldbyname('customno').AsString);
customNo.Text:=trim(ADOQueryHelp.Fieldbyname('shortname').AsString);
end;
free;
end;
}
end;
procedure TfrmLabelList.BtOpenClick(Sender: TObject);
begin
end;
////////////////////////////////////////////////////////////
//初始化窗口数据
////////////////////////////////////////////////////////////
procedure TfrmLabelList.InitWinData();
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select A.* ,B.customName as customNoName');
sql.Add('from JD_Label A');
sql.Add('INNER JOIN BC_customer B ON A.customNO=B.customNo');
sql.Add('WHERE B.customNo='''+fkeyNo+'''');
Open;
if isEmpty then
begin
close;
exit;
end;
// SetWinData(ADOQueryTmp,panel3);
{
RMGridReport1.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport1.Preview :=RMPreview1;
RMGridReport1.PrepareReport;
RMGridReport1.ShowReport ;
}
end;
except
end;
end;
procedure TfrmLabelList.FormShow(Sender: TObject);
begin
if fWinStatus=1 then tok.Visible:=false;
InitGrid();
if Trim(SLBName)<>'' then
begin
ADOQueryLabel.Locate('labelCaption',SLBName,[]);
end;
end;
procedure TfrmLabelList.RMPreview1DblClick(Sender: TObject);
begin
//btOpen.Click ;
end;
////////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////////
procedure TfrmLabelList.InitVarDictionary();
var
TmpList:Tstrings;
mm:string;
i:integer;
begin
try
TmpList:=TstringList.Create();
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select distinct ItemType from JC_LabelSetItems ');
sql.Add('where valid=''Y''');
Open;
TmpList.Clear ;
while not Eof do
begin
TmpList.Add(trim(fieldByName('ItemType').AsString));
Next;
end;
end;
finally
TmpList.Free ;
end;
end;
/////////////////////////////////////////////////
//
/////////////////////////////////////////////////
procedure TfrmLabelList.InitDataSetDictionary();
begin
{ with ADOQuery1 do
begin
close;
sql.Clear ;
sql.Add('exec P_Get_LabelPrintData');
sql.Add(quotedStr(''));
sql.Add(','+quotedStr(''));
sql.Add(','+quotedStr(''));
OPen;
end; }
end;
procedure TfrmLabelList.TaddClick(Sender: TObject);
begin
try
frmLabelAdd:=TfrmLabelAdd.create(self);
with frmLabelAdd do
begin
if showModal =1 then
begin
fchg:=true;
InitGrid();
end;
end;
finally
frmLabelAdd.Free;
end;
end;
procedure TfrmLabelList.TupdClick(Sender: TObject);
begin
if ADOQueryLabel.IsEmpty then exit;
try
frmLabelAdd:=TfrmLabelAdd.create(self);
with frmLabelAdd do
begin
fKeyNo:=ADOQueryLabel.fieldByName('LabelId').AsString ;
fWinstatus:=1;
if showModal =1 then
begin
fchg:=true;
InitGrid();
end;
end;
finally
frmLabelAdd.Free;
end;
end;
/////////////////////////////////////////////
//
/////////////////////////////////////////////
procedure TfrmLabelList.InitGrid();
begin
try
isLoad:=false;
ADOQueryLabel10.DisableControls ;
with ADOQueryLabel10 do
begin
close;
sql.Clear ;
sql.Add('select * from P_Label');
sql.Add('where valid=''Y''');
sql.Add(' order by labelCaption');
Open;
end;
SCreateCDS20(ADOQueryLabel10,ADOQueryLabel);
SInitCDSData20(ADOQueryLabel10,ADOQueryLabel);
finally
ADOQueryLabel10.EnableControls;
isLoad:=true;
//DoFilter();
//OpenLabel();
end;
end;
////////////////////////////////////////////////////////
//函数功能:打开标签文件
////////////////////////////////////////////////////////
procedure TfrmLabelList.OpenLabel();
begin
if ADOQueryLabel.IsEmpty then exit;
with RMGridReport1 do
begin
LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('labelFile')));
//Preview :=RMPreview1;
ShowReport ;
end;
end;
procedure TfrmLabelList.tv1FocusedRecordChanged(
Sender: TcxCustomGridTableView; APrevFocusedRecord,
AFocusedRecord: TcxCustomGridRecord;
ANewItemRecordFocusingChanged: Boolean);
begin
end;
//////////////////////////////////////////////////////////
//函数功能:检查该客户的标签是否已存在
/////////////////////////////////////////////////////////
function TfrmLabelList.IsCheckCustOk():Boolean;
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select count(customNO)as cnt from P_Label');
sql.Add('where customNO='''+trim(customNO.TxtCode)+'''');
Open;
if fieldByName('cnt').AsInteger>0 then
begin
Result:=false ;
application.MessageBox('该客户标签信息已存!','警告信息',0);
end
else
Result:=true;
end;
except
result:=false;
application.MessageBox('检查该客户标签信息是否已存在时发生错误!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////
//
/////////////////////////////////////////////////////////////
function TfrmLabelList.DeleteData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.clear;
sql.Add('delete P_Label');
sql.Add('where labelId='+ADOQueryLabel.fieldByName('LabelID').asString);
execSql;
end;
result:=true;
except
result:=false;
application.MessageBox('删除失败!','警告信息',0);
end;
end;
procedure TfrmLabelList.TdelClick(Sender: TObject);
begin
if ADOQueryLabel.IsEmpty then exit;
if application.MessageBox('确定要删除此标签吗?','警告信息',1)=2 then exit;
if DeleteData() then
begin
fchg:=true;
InitGrid();
end;
end;
//////////////////////////////////////////////////////////
//
/////////////////////////////////////////////////////////
procedure TfrmLabelList.SetWinStatus();
begin
case fWinStatus of
0:
begin
// ToolBar2.Visible :=false;
// tsave.Visible :=true;
customNo.Enabled :=true;
panel3.Enabled :=true;
end;
1:
begin
// ToolBar2.Visible :=true;
// tsave.Visible :=false;
customNo.Enabled :=false;
panel3.Enabled :=false;
TOK.Visible:=false;
end;
5:
begin
// ToolBar2.Visible :=false;
// tsave.Visible :=false;
panel1.Enabled :=false;
panel3.Enabled :=false;
end;
end ;
end;
procedure TfrmLabelList.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
{if fIsShowModal then
Application:=MainApplication ; }
Action:=caFree;
end;
procedure TfrmLabelList.FormDestroy(Sender: TObject);
begin
frmLabelList:=nil;
end;
procedure TfrmLabelList.TOkClick(Sender: TObject);
begin
if ADOQueryLabel.IsEmpty then exit;
LBName:=Trim(ADOQueryLabel.fieldbyname('labelCaption').AsString);
ModalResult:=1;
end;
procedure TfrmLabelList.tv1DblClick(Sender: TObject);
begin
TOk.Click ;
end;
procedure TfrmLabelList.ToolButton1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmLabelList.LabelTypeChange(Sender: TObject);
begin
DoFilter();
end;
procedure TfrmLabelList.tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if isLoad then
OpenLabel();
end;
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,369 @@
object frmMachineManage: TfrmMachineManage
Left = 297
Top = 109
Width = 1123
Height = 706
Caption = #26426#21488#31649#29702
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
KeyPreview = True
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1107
Height = 31
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
Flat = True
Images = DataLink_Machine.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = ToolButton2Click
end
object ToolButton4: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #22686#34892
ImageIndex = 57
OnClick = ToolButton4Click
end
object ToolButton5: TToolButton
Left = 189
Top = 0
AutoSize = True
Caption = #21024#34892
ImageIndex = 113
OnClick = ToolButton5Click
end
object ToolButton3: TToolButton
Left = 252
Top = 0
AutoSize = True
Caption = #25171#21360
ImageIndex = 4
OnClick = ToolButton3Click
end
object ToolButton1: TToolButton
Left = 315
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 6
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 378
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 89
Width = 1107
Height = 578
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 2
object Tv2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_HZ
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
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>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Header = DataLink_Machine.Default
object v2Column12: TcxGridDBColumn
Caption = #26426#21488#21495
DataBinding.FieldName = 'MCNO'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 83
end
object v2Column1: TcxGridDBColumn
Caption = #36710#38388
DataBinding.FieldName = 'MCCJ'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 70
end
object v2Column8: TcxGridDBColumn
Caption = #21697#29260
DataBinding.FieldName = 'MCPP'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 102
end
object v2C_CodeName: TcxGridDBColumn
Caption = #36873#38024#22120
DataBinding.FieldName = 'MCType'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 66
end
object v2Column4: TcxGridDBColumn
Caption = #38024#22411
DataBinding.FieldName = 'MCZX'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 74
end
object v2Column17: TcxGridDBColumn
Caption = #36335#25968
DataBinding.FieldName = 'MCLS'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 66
end
object v2Column29: TcxGridDBColumn
Caption = #36141#20080#26085#26399
DataBinding.FieldName = 'GMDate'
PropertiesClassName = 'TcxDateEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 77
end
object v2Column6: TcxGridDBColumn
Caption = #38024#31570#26356#25442#24773#20917
DataBinding.FieldName = 'ISGHZT'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 108
end
object v2Column7: TcxGridDBColumn
Caption = #38024#31570#26356#25442#26102#38388
DataBinding.FieldName = 'ZTDate'
PropertiesClassName = 'TcxDateEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 115
end
object v2Column5: TcxGridDBColumn
Caption = #36873#38024#22120#26356#25442#24773#20917
DataBinding.FieldName = 'ISGHXZQ'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 129
end
object v2Column9: TcxGridDBColumn
Caption = #36873#38024#22120#26356#25442#26102#38388
DataBinding.FieldName = 'XZQDate'
PropertiesClassName = 'TcxDateEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 148
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object Panel1: TPanel
Left = 0
Top = 31
Width = 1107
Height = 58
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label1: TLabel
Left = 182
Top = 20
Width = 36
Height = 12
Caption = #26426#21488#21495
end
object Label2: TLabel
Left = 46
Top = 20
Width = 24
Height = 12
Caption = #36710#38388
end
object MCNO: TEdit
Tag = 2
Left = 221
Top = 16
Width = 89
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 1
OnChange = CustomerChange
end
object MCCJ: TEdit
Tag = 2
Left = 77
Top = 16
Width = 89
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 0
OnChange = CustomerChange
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Machine.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 299
Top = 209
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Machine.ADOLink
Parameters = <>
Left = 261
Top = 209
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Machine.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 229
Top = 209
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 355
Top = 344
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
DataSet = ADOQueryPrt
Left = 288
Top = 344
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 520
Top = 264
end
object DS_HZ: TDataSource
DataSet = CDS_HZ
Left = 283
Top = 259
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 384
Top = 208
end
object PopupMenu1: TPopupMenu
Left = 192
Top = 240
object N1: TMenuItem
Caption = #20840#36873
OnClick = N1Click
end
object N2: TMenuItem
Caption = #20840#24323
OnClick = N2Click
end
end
object RMXLSExport2: TRMXLSExport
ShowAfterExport = False
ExportPrecision = 1
PagesOfSheet = 1
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 420
Top = 344
end
object ADOQueryPrt: TADOQuery
Connection = DataLink_Machine.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 229
Top = 345
end
end

View File

@ -0,0 +1,340 @@
unit U_MachineManage;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxPC, cxCheckComboBox, cxDropDownEdit, Menus, RM_e_Xls, TeEngine,
Series, TeeProcs, Chart, DbChart, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator;
type
TfrmMachineManage = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
ToolButton1: TToolButton;
RM1: TRMGridReport;
RMDB_Main: TRMDBDataSet;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_HZ: TDataSource;
CDS_HZ: TClientDataSet;
v2C_CodeName: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
v2Column17: TcxGridDBColumn;
Panel1: TPanel;
MCNO: TEdit;
RMXLSExport2: TRMXLSExport;
v2Column6: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
v2Column8: TcxGridDBColumn;
v2Column5: TcxGridDBColumn;
v2Column9: TcxGridDBColumn;
v2Column29: TcxGridDBColumn;
Label1: TLabel;
v2Column12: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
ToolButton3: TToolButton;
ADOQueryPrt: TADOQuery;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
Label2: TLabel;
MCCJ: TEdit;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure CustomerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure v2Column8PropertiesEditValueChanged(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
private
{ Private declarations }
procedure PrintReport(FZDYNo: string);
procedure InitGrid();
public
fFlag: integer;
{ Public declarations }
RKFlag, FCYID, fmanage: string;
end;
var
frmMachineManage: TfrmMachineManage;
implementation
uses
U_DataLink, U_Fun, U_ZDYHelp;
{$R *.dfm}
procedure TfrmMachineManage.PrintReport(FZDYNo: string);
var
fPrintFile, FFCYID: string;
i, j: Integer;
Txt, fImagePath: string;
Moudle: THandle;
Makebar: TMakebar;
Mixtext: TMixtext;
begin
if CDS_HZ.IsEmpty then
Exit;
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\机台标签.rmf';
with ADOQueryPrt do
begin
close;
sql.Clear;
sql.Add(' select * from Machine where MCNO=''' + Trim(FZDYNo) + '''');
open;
end;
try
Moudle := LoadLibrary('MakeQRBarcode.dll');
@Makebar := GetProcAddress(Moudle, 'Make');
@Mixtext := GetProcAddress(Moudle, 'MixText');
Txt := Trim(FZDYNo);
fImagePath := ExtractFilePath(Application.ExeName) + 'image\temp.bmp';
if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then
CreateDirectory(pchar(ExtractFilePath(Application.ExeName) + 'image'), nil);
if FileExists(fImagePath) then
DeleteFile(fImagePath);
Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3);
except
CDS_HZ.EnableControls;
application.MessageBox('条形码生成失败!', '提示信息', MB_ICONERROR);
exit;
end;
RMVariables['QRBARCODE'] := fImagePath;
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.PrintReport;
// RM1.ShowReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile + '!'), '提示', 0);
Exit;
end;
end;
procedure TfrmMachineManage.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
SQL.Clear;
sql.Add(' select A.* from Machine A order by MCNO ');
Open;
end;
SCreateCDS20(ADOQueryMain, CDS_HZ);
SInitCDSData20(ADOQueryMain, CDS_HZ);
finally
ADOQueryMain.EnableControls;
ToolButton2.Click;
end;
end;
procedure TfrmMachineManage.FormDestroy(Sender: TObject);
begin
frmMachineManage := nil;
end;
procedure TfrmMachineManage.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmMachineManage.TBCloseClick(Sender: TObject);
begin
WriteCxGrid(Trim(Self.Caption), Tv2, '机台管理');
Close;
end;
procedure TfrmMachineManage.FormShow(Sender: TObject);
begin
ReadCxGrid(Trim(Self.Caption), Tv2, '机台管理');
// Enddate.DateTime:=SGetServerDate(ADOQueryTemp);
// begdate.DateTime:=Enddate.DateTime-30;
InitGrid();
end;
procedure TfrmMachineManage.TBRafreshClick(Sender: TObject);
begin
MCCJ.SetFocus;
InitGrid();
end;
procedure TfrmMachineManage.ToolButton2Click(Sender: TObject);
var
sql: string;
begin
if ADOQueryMain.Active then
begin
sql := SGetFilters(Panel1, 1, 2);
SDofilter(ADOQueryMain, sql);
SCreateCDS20(ADOQueryMain, CDS_HZ);
SInitCDSData20(ADOQueryMain, CDS_HZ);
end;
end;
procedure TfrmMachineManage.ToolButton1Click(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then
Exit;
SelExportData(Tv2, ADOQueryMain, trim(Self.Caption));
end;
procedure TfrmMachineManage.cxTabControl1Change(Sender: TObject);
begin
InitGrid;
end;
procedure TfrmMachineManage.N1Click(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
exit;
with CDS_HZ do
begin
DisableControls;
first;
while not eof do
begin
edit;
fieldbyname('ssel').Value := true;
post;
next;
end;
First;
EnableControls;
end;
end;
procedure TfrmMachineManage.N2Click(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
exit;
with CDS_HZ do
begin
DisableControls;
first;
while not eof do
begin
edit;
fieldbyname('ssel').Value := false;
post;
next;
end;
First;
EnableControls;
end;
end;
procedure TfrmMachineManage.CustomerChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmMachineManage.FormCreate(Sender: TObject);
begin
fmanage := Trim(DParameters1);
end;
procedure TfrmMachineManage.v2Column8PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv2.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_HZ do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate Machine ');
sql.Add(' Set ' + FFieldName + '=''' + Trim(mvalue) + '''');
sql.Add(' where MCID=' + CDS_HZ.fieldbyname('MCID').AsString);
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv2.Controller.EditingController.ShowEdit();
except
tv2.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!', '提示', 0);
end
end;
procedure TfrmMachineManage.ToolButton3Click(Sender: TObject);
begin
PrintReport(Trim(CDS_HZ.fieldbyname('MCNO').AsString));
end;
procedure TfrmMachineManage.ToolButton4Click(Sender: TObject);
begin
MCCJ.SetFocus;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into Machine(Filler) values(' + quotedstr(Trim(dname)) + ')');
ExecSQL;
end;
InitGrid();
end;
procedure TfrmMachineManage.ToolButton5Click(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
Exit;
MCCJ.SetFocus;
if Application.MessageBox('确定要删除数据吗?', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete Machine where MCID=' + inttostr(CDS_HZ.FieldByName('MCID').AsInteger));
ExecSQL;
end;
CDS_HZ.Delete;
end;
end.

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