This commit is contained in:
“ddf” 2024-12-14 17:23:12 +08:00
commit 56b1ef408f
785 changed files with 655636 additions and 0 deletions

18
.gitignore vendored Normal file
View File

@ -0,0 +1,18 @@
**/layout
**/report
**/实施文件
**/image
**/doc
**/wav
**/__history
**/__recovery
*.dll
*.exe
*.ddp
*.dcu
*.~pas
*.~dfm
*.~ddp
*.~dpr
*.identcache
*.local

View File

@ -0,0 +1,145 @@
unit U_CustomFun;
interface
uses
System.SysUtils, System.Classes, Data.DB, System.Generics.Collections,
System.StrUtils, Datasnap.DBClient;
type
TProductTotals = class
private
FPieceCount: Integer;
FQuantity: Double;
public
property PieceCount: Integer read FPieceCount write FPieceCount;
property Quantity: Double read FQuantity write FQuantity;
constructor Create;
end;
TProductNameTotalsDict = TDictionary<string, TProductTotals>;
function GetMergedResultsAsString(ClientDataSet: TClientDataSet): string;
function CustomSelCDSKey(CDS_1: TclientDataSet; Keys: TArray<string>): TArray<string>;
implementation
//uses
// U_printPdf, U_RTFun, U_DataLink;
constructor TProductTotals.Create;
begin
FPieceCount := 0;
FQuantity := 0.0;
end;
function CustomSelCDSKey(CDS_1: TclientDataSet; Keys: TArray<string>): TArray<string>;
var
RTValues: TArray<string>;
i, j, CurRow: Integer;
begin
SetLength(RTValues, Length(Keys));
CurRow := CDS_1.recno;
CDS_1.DisableControls;
with CDS_1 do
begin
First;
j := 0;
while not Eof do
begin
if j = 0 then
begin
for i := 0 to Length(RTValues) - 1 do
begin
RTValues[i] := Trim(CDS_1.fieldbyname(Keys[i]).AsString) + ',';
end;
end
else
begin
for i := 0 to Length(RTValues) - 1 do
begin
RTValues[i] := RTValues[i] + Trim(CDS_1.fieldbyname(Keys[i]).AsString) + ',';
end;
end;
j := j + 1;
CDS_1.Next;
end;
end;
CDS_1.recno := CurRow;
CDS_1.EnableControls;
for i := 0 to Length(RTValues) - 1 do
begin
RTValues[i] := copy(RTValues[i], 1, Length(RTValues[i]) - 1);
end;
Result := RTValues;
end;
function GetMergedResultsAsString(ClientDataSet: TClientDataSet): string;
var
ProductNameTotalsDict: TProductNameTotalsDict;
ProductName: string;
PieceCount: Integer;
Quantity: Double;
ProductNameList: TStringList;
ProductTotals: TProductTotals;
I: Integer;
begin
ProductNameTotalsDict := TProductNameTotalsDict.Create;
try
ClientDataSet.IndexName := ''; // 清空索引
ClientDataSet.First;
while not ClientDataSet.Eof do
begin
ProductName := ClientDataSet.FieldByName('Grade').AsString;
PieceCount := ClientDataSet.FieldByName('Piece').AsInteger;
Quantity := ClientDataSet.FieldByName('Qty').AsFloat;
if not ProductNameTotalsDict.ContainsKey(ProductName) then
begin
ProductTotals := TProductTotals.Create;
ProductTotals.PieceCount := PieceCount;
ProductTotals.Quantity := Quantity;
ProductNameTotalsDict.Add(ProductName, ProductTotals);
end
else
begin
ProductTotals := ProductNameTotalsDict[ProductName];
ProductTotals.PieceCount := ProductTotals.PieceCount + PieceCount;
ProductTotals.Quantity := ProductTotals.Quantity + Quantity;
end;
ClientDataSet.Next;
end;
ProductNameList := TStringList.Create;
try
for ProductName in ProductNameTotalsDict.Keys do
begin
ProductTotals := ProductNameTotalsDict[ProductName];
ProductNameList.Add(Format('%s: 支数=%d, 数量=%.2f', [ProductName, ProductTotals.PieceCount, ProductTotals.Quantity]));
end;
ProductNameList.Sort;
Result := StringReplace(ProductNameList.Text, #13#10, '; ', [rfReplaceAll]);
finally
ProductNameList.Free;
// 清理字典中的对象,避免内存泄漏
for ProductTotals in ProductNameTotalsDict.Values do
begin
ProductTotals.Free;
end;
ProductNameTotalsDict.Clear;
end;
finally
ProductNameTotalsDict.Free;
end;
end;
end.

View File

@ -0,0 +1,180 @@
unit U_PrintLabFun;
interface
uses
ADODB, System.SysUtils, Vcl.Forms;
procedure PrintServerLabel(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
procedure PrintServerLabel1(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1, MLabVolume: string);
procedure PrintServerLabelStkId(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
implementation
uses
U_printPdf, U_RTFun, U_DataLink;
procedure PrintServerLabel1(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1, MLabVolume: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' exec P_BS_Cloth_Prt2 ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
if Trim(MLabVolume) <> '' then
LBName := Trim(MLabVolume)
else
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_BS_Cloth_Prt2';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure PrintServerLabel(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' EXEC P_Trade_Card_Prt1 ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_Trade_Card_Prt1';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure PrintServerLabelStkId(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' EXEC P_Trade_Cloth_Prt_Lab ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_Trade_Cloth_Prt_Lab';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
end.

4
A00通用模板/File.INI Normal file
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,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:\땀둑룟역랙덜쯤\淃커덜쯤\낀菫介놉\虔廉셕뺍데(ShuttleSchedule.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,56 @@
library InformationBase;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
midaslib,
U_GetDllForm in 'U_GetDllForm.pas',
U_DataLink in 'U_DataLink.pas' {DataLink_InformationBase: TDataModule},
U_iniParam in 'U_iniParam.pas',
U_BaseHelp in '..\..\..\public10\design\U_BaseHelp.pas' {frmBaseHelp},
U_BaseInput in '..\..\..\public10\design\U_BaseInput.pas' {frmBaseInput},
U_BaseList in '..\..\..\public10\design\U_BaseList.pas' {frmBaseList},
U_cxGridCustomCss in '..\..\..\public10\design\U_cxGridCustomCss.pas',
U_globalVar in '..\..\..\public10\design\U_globalVar.pas',
U_WindowFormdesign in '..\..\..\public10\design\U_WindowFormdesign.pas',
U_CompressionFun in '..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas',
U_RTFun in '..\..\..\public10\ThreeFun\Fun\U_RTFun.pas',
U_ZDYHelp in '..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas' {frmZDYHelp},
Unit1 in 'Unit1.pas' {Form1},
U_AttachmentUpload in '..\A00通用窗体\U_AttachmentUpload.pas' {frmFjList_RZ},
U_ClothInfoSel in '..\A00通用窗体\U_ClothInfoSel.pas' {frmClothInfoSel},
U_CompanySel in '..\A00通用窗体\U_CompanySel.pas' {frmCompanySel},
U_EmployeeSel in '..\A00通用窗体\U_EmployeeSel.pas' {frmEmployeeSel},
U_LabelMapSet in '..\A00通用窗体\U_LabelMapSet.pas' {frmLabelMapSet},
U_LabelPrint in '..\A00通用窗体\U_LabelPrint.pas' {frmLabelPrint},
U_BaseDataLink in '..\..\..\public10\design\U_BaseDataLink.pas' {BaseDataLink: TDataModule};
{$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,928 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7B70AA99-C84C-40AE-B4AE-13C5223B874C}</ProjectGuid>
<MainSource>InformationBase.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>38017</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>19.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
<Base_Android64>true</Base_Android64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
<Base_iOSDevice64>true</Base_iOSDevice64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Android64)'!=''">
<Cfg_2_Android64>true</Cfg_2_Android64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_2)'=='true') or '$(Cfg_2_iOSDevice64)'!=''">
<Cfg_2_iOSDevice64>true</Cfg_2_iOSDevice64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX64>true</Cfg_2_OSX64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_UnitSearchPath>D:\富通ERP;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_UsePackage>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;$(DCC_UsePackage)</DCC_UsePackage>
<GenDll>true</GenDll>
<SanitizedProjectName>InformationBase</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>2052</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android64)'!=''">
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
<iOS_AppStore1024>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png</iOS_AppStore1024>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Icon_MainIcon>InformationBase_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>InformationBase_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Android64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_iOSDevice64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<Debugger_HostApplication>D:\Dp10RepoV1\项目代码\RTBasicsV1\A00通用模板\testDll.exe</Debugger_HostApplication>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="U_GetDllForm.pas"/>
<DCCReference Include="U_DataLink.pas">
<Form>DataLink_InformationBase</Form>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="U_iniParam.pas"/>
<DCCReference Include="..\..\..\public10\design\U_BaseHelp.pas">
<Form>frmBaseHelp</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseInput.pas">
<Form>frmBaseInput</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseList.pas">
<Form>frmBaseList</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_cxGridCustomCss.pas"/>
<DCCReference Include="..\..\..\public10\design\U_globalVar.pas"/>
<DCCReference Include="..\..\..\public10\design\U_WindowFormdesign.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_RTFun.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas">
<Form>frmZDYHelp</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Unit1.pas">
<Form>Form1</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_AttachmentUpload.pas">
<Form>frmFjList_RZ</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_ClothInfoSel.pas">
<Form>frmClothInfoSel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_CompanySel.pas">
<Form>frmCompanySel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_EmployeeSel.pas">
<Form>frmEmployeeSel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_LabelMapSet.pas">
<Form>frmLabelMapSet</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_LabelPrint.pas">
<Form>frmLabelPrint</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseDataLink.pas">
<Form>BaseDataLink</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">InformationBase.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Android64">True</Platform>
<Platform value="iOSDevice64">True</Platform>
<Platform value="Linux64">True</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
<Deployment Version="3">
<DeployFile LocalName="InformationBase.dll" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>InformationBase.dll</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiv7aFile">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="Android64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements"/>
<DeployClass Name="ProjectiOSInfoPList"/>
<DeployClass Name="ProjectiOSLaunchScreen"/>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug"/>
<DeployClass Name="ProjectOSXEntitlements"/>
<DeployClass Name="ProjectOSXInfoPList"/>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
</Deployment>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 766 B

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,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{D75EC075-444C-40C2-8ACB-0AAD801B39FF}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="InformationBase.dproj">
<Dependencies/>
</Projects>
<Projects Include="testDll.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="InformationBase">
<MSBuild Projects="InformationBase.dproj"/>
</Target>
<Target Name="InformationBase:Clean">
<MSBuild Projects="InformationBase.dproj" Targets="Clean"/>
</Target>
<Target Name="InformationBase:Make">
<MSBuild Projects="InformationBase.dproj" Targets="Make"/>
</Target>
<Target Name="testDll">
<MSBuild Projects="testDll.dproj"/>
</Target>
<Target Name="testDll:Clean">
<MSBuild Projects="testDll.dproj" Targets="Clean"/>
</Target>
<Target Name="testDll:Make">
<MSBuild Projects="testDll.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="InformationBase;testDll"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="InformationBase:Clean;testDll:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="InformationBase:Make;testDll:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

View File

@ -0,0 +1,6 @@
[SERVER]
服务器地址=101.132.143.144
服务器地址类型=2002
是否自动更新=1
软件名称=睿特版本库
登陆标题=sss

14276
A00通用模板/U_DataLink.dfm Normal file

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

@ -0,0 +1,77 @@
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文件
DZCDYDllName: string; //电子秤调用Dll文件
MBDYDllName: 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');
DZCDYDllName := programIni.ReadString('生产车间配置', '电子秤调用Dll文件', '');
MBDYDllName := programIni.ReadString('生产车间配置', '码表调用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
Caption = 'Form1'
ClientHeight = 426
ClientWidth = 716
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 = 716
Height = 25
ButtonWidth = 57
Caption = 'ToolBar1'
Images = ImageList1
TabOrder = 0
ExplicitWidth = 120
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,94 @@
unit U_testdll;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, ToolWin, ComCtrls, ImgList, DB, ADODB,
System.ImageList;
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('InformationBase.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.

64
A00通用模板/Unit1.dfm Normal file
View File

@ -0,0 +1,64 @@
inherited Form1: TForm1
Caption = 'Form1'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Height = -11
Font.Name = 'Tahoma'
ExplicitWidth = 651
ExplicitHeight = 338
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton [0]
Left = 32
Top = 16
Width = 75
Height = 25
Caption = #23458#25143
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton [1]
Left = 32
Top = 47
Width = 75
Height = 25
Caption = #26679#21697
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton [2]
Left = 32
Top = 78
Width = 75
Height = 25
Caption = #24037#24207#36873#25321
TabOrder = 2
end
object Button4: TButton [3]
Left = 32
Top = 118
Width = 75
Height = 25
Caption = #21592#24037#36873#25321
TabOrder = 3
OnClick = Button4Click
end
object Button5: TButton [4]
Left = 32
Top = 174
Width = 75
Height = 25
Caption = #26631#31614#25171#21360
TabOrder = 4
OnClick = Button5Click
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_InformationBase.ADOLink
Left = 345
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_InformationBase.ADOLink
end
end

106
A00通用模板/Unit1.pas Normal file
View File

@ -0,0 +1,106 @@
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, U_BaseList,
Data.DB, Data.Win.ADODB, Vcl.StdCtrls;
type
TForm1 = class(TfrmBaseList)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
U_DataLink, U_CompanySel, U_ClothInfoSel, U_EmployeeSel, U_LabelPrint;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
try
frmClothInfoSel := TfrmClothInfoSel.Create(Application);
with frmClothInfoSel do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmClothInfoSel.Free;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
try
frmEmployeeSel := TfrmEmployeeSel.Create(Application);
with frmEmployeeSel do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmEmployeeSel.Free;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
try
frmLabelPrint := TfrmLabelPrint.Create(Application);
with frmLabelPrint do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmLabelPrint.Free;
end;
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

136
A00通用模板/testDll.dof Normal file
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.

View File

@ -0,0 +1,184 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6ED24B72-E038-4A45-BA13-AC1AB432C410}</ProjectGuid>
<MainSource>testDll.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>38017</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>19.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
<Base_Android64>true</Base_Android64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
<Base_iOSDevice64>true</Base_iOSDevice64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Android64)'!=''">
<Cfg_2_Android64>true</Cfg_2_Android64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_2)'=='true') or '$(Cfg_2_iOSDevice64)'!=''">
<Cfg_2_iOSDevice64>true</Cfg_2_iOSDevice64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX64>true</Cfg_2_OSX64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<SanitizedProjectName>testDll</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>2052</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android64)'!=''">
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
<iOS_AppStore1024>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png</iOS_AppStore1024>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>testDll_Icon.ico</Icon_MainIcon>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>testDll_Icon.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Android64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_iOSDevice64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="U_testdll.pas">
<Form>Form1</Form>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">testDll.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Android64">True</Platform>
<Platform value="iOSDevice64">True</Platform>
<Platform value="Linux64">True</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
A00通用模板/testDll.res Normal file

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.

Binary file not shown.

After

Width:  |  Height:  |  Size: 766 B

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,402 @@
unit U_AttachmentUpload;
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, cxLookAndFeels, cxNavigator,
dxDateRanges, IdExplicitTLSClientServerBase, System.ImageList, U_BaseHelp,
Vcl.ToolWin, dxScrollbarAnnotations, cxImageList;
type
TfrmAttachmentUpload = class(TfrmBaseHelp)
ListView1: TListView;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
DataSource1: TDataSource;
v1Column4: TcxGridDBColumn;
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBAdd: TToolButton;
TBClose: TToolButton;
TBDel: TToolButton;
btnDown: TToolButton;
ImageList1: TImageList;
cxImageList_bar: TcxImageList;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure btnDownClick(Sender: TObject);
private
procedure InitData();
{ Private declarations }
public
fkeyNO: string;
fType: string;
fId: integer;
FEditAuthority: Boolean;
{ Public declarations }
end;
var
frmAttachmentUpload: TfrmAttachmentUpload;
implementation
uses
U_DataLink, U_RTFun, U_CompressionFun;
{$R *.dfm}
procedure TfrmAttachmentUpload.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 FJ_File ');
sql.Add('where WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
open;
end;
except
end;
end;
procedure TfrmAttachmentUpload.FormDestroy(Sender: TObject);
begin
frmAttachmentUpload := nil;
end;
procedure TfrmAttachmentUpload.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmAttachmentUpload.FormShow(Sender: TObject);
begin
if FEditAuthority then
begin
btnDown.Visible := True;
TBDel.Visible := True;
TBAdd.Visible := True;
end
else
begin
btnDown.Visible := false;
TBDel.Visible := false;
TBAdd.Visible := false;
end;
initdata();
end;
procedure TfrmAttachmentUpload.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 TfrmAttachmentUpload.btnDownClick(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 TfrmAttachmentUpload.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId = 10 then
Action := cafree
else
Action := cahide;
end;
procedure TfrmAttachmentUpload.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible := false;
end;
procedure TfrmAttachmentUpload.TBAddClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName: string;
fFilePath: string;
maxNo: string;
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', 'FJ_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 FJ_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 FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(maxNo)));
open;
append;
fieldbyname('TFID').Value := trim(maxNo);
fieldbyname('WBID').Value := trim(fkeyNO);
fieldbyname('TFType').Value := trim(fType);
fieldbyname('Filler').Value := trim(DName);
fieldbyname('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 TfrmAttachmentUpload.TBCloseClick(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Free;
ModalResult := 1;
end;
procedure TfrmAttachmentUpload.TBDelClick(Sender: TObject);
var
fFileName: string;
fFilePath: string;
begin
if ADOQueryTmp.IsEmpty then
exit;
if trim(ADOQueryTmp.fieldbyname('Filler').AsString) <> trim(DName) then
begin
Application.MessageBox('权限不足,上传账户可删除!', '提示', 0);
Exit;
end;
if Application.MessageBox('确定要删除数据吗?', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(ADOQueryTmp.fieldbyname('TFID').AsString)));
execsql;
end;
initData();
end;
procedure TfrmAttachmentUpload.TBRafreshClick(Sender: TObject);
begin
initData();
end;
procedure TfrmAttachmentUpload.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.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,182 @@
unit U_BankSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxDropDownEdit, dxScrollbarAnnotations, cxContainer;
type
TfrmBankSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
BankName: TcxTextEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
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;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v2Column1: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure BankNamePropertiesChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmBankSel: TfrmBankSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmBankSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmBankSel.BankNamePropertiesChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmBankSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BankName.SetFocus;
Action := cahide;
end;
procedure TfrmBankSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select * from BS_Bank order by SerialNo ');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmBankSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmBankSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmBankSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmBankSel.ToolButton1Click(Sender: TObject);
begin
BankName.SetFocus;
ModalResult := 1;
end;
procedure TfrmBankSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmBankSel.FormDestroy(Sender: TObject);
begin
inherited;
frmBankSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,422 @@
unit U_ClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math,
dxScrollbarAnnotations, cxImageList, cxContainer;
type
TfrmClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TcxTextEdit;
C_Name: TcxTextEdit;
C_GramWeight: TcxTextEdit;
C_Composition: TcxTextEdit;
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;
cxImageList_bar: TcxImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column10: TcxGridDBColumn;
v1Column11: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
Tv1Column13: TcxGridDBColumn;
Tv1Column23: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column12: TcxGridDBColumn;
Tv1Column14: TcxGridDBColumn;
Tv1Column15: TcxGridDBColumn;
Tv1Column16: TcxGridDBColumn;
Tv1Column17: TcxGridDBColumn;
Tv1Column18: TcxGridDBColumn;
Tv1Column22: TcxGridDBColumn;
Tv1Column19: TcxGridDBColumn;
Tv1Column20: TcxGridDBColumn;
Tv1Column21: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Label1: TLabel;
Label2: TLabel;
Label5: TLabel;
Label6: TLabel;
GC_Name: TcxTextEdit;
CraftCode: TcxTextEdit;
C_Spec: TcxTextEdit;
C_EComposition: TcxTextEdit;
Label7: TLabel;
Label10: TLabel;
CraftEName: TcxTextEdit;
CraftName: TcxTextEdit;
GroupBox1: TGroupBox;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
GPM_2: TcxGridPopupMenu;
CDS_Selok: TClientDataSet;
DS_2: TDataSource;
cxtxtdtscan: TcxTextEdit;
Label11: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure cxtxtdtscanKeyPress(Sender: TObject; var Key: Char);
procedure GC_NameKeyPress(Sender: TObject; var Key: Char);
private
IsOnShow: Boolean;
CurrentPage, RecordsNumber: Integer;
procedure InitGrid(PType: string);
procedure InitTree();
{ Private declarations }
public
IsMultipleSelection: Boolean;
FCTType: string;
{ Public declarations }
end;
var
frmClothInfoSel: TfrmClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type ');
if Trim(FCTType) = '全部' then
begin
end
else if FCTType = '坯布' then
begin
SQL.Add(' where CTType in (''梭织'',''针织'') ');
end
else
begin
SQL.Add(' where CTType=' + quotedstr(FCTType));
end;
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid('');
end;
procedure TfrmClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid('');
end;
procedure TfrmClothInfoSel.cxDBTreeList1DblClick(Sender: TObject);
begin
InitGrid('');
end;
procedure TfrmClothInfoSel.cxtxtdtscanKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
SClearData(Panel1, 2);
C_Code.Text := cxtxtdtscan.Text;
InitGrid('回车');
if CDS_1.RecordCount = 1 then
begin
if not CDS_Selok.Locate('C_Code', C_Code.Text, []) then
MoveCDS(CDS_1, CDS_Selok);
end;
cxtxtdtscan.Text := '';
C_Code.Text := '';
end;
end;
procedure TfrmClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmClothInfoSel.InitGrid(PType: string);
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
if PType = '回车' then
sql.Add(' @CTID= ''''')
else
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
if IsOnShow then
SCreateCDS(ADOQueryMain, CDS_Selok);
IsOnShow := False;
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
IsOnShow := true;
if IsMultipleSelection then
GroupBox1.Visible := True;
RecordsNumber := 500;
CurrentPage := 1;
if Trim(FCTType) = '' then
FCTType := '通用';
ReadCxGrid(trim(self.Caption) + 'TV1', TV1, '自定义数据');
ReadCxGrid(trim(self.Caption) + 'TV2', TV2, '自定义数据');
InitTree();
InitGrid('');
end;
procedure TfrmClothInfoSel.GC_NameKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
InitGrid('回车');
end;
end;
procedure TfrmClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(trim(self.Caption) + 'TV1', TV1, '自定义数据');
WriteCxGrid(trim(self.Caption) + 'TV2', TV2, '自定义数据');
end;
procedure TfrmClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid('');
end;
procedure TfrmClothInfoSel.ToolButton1Click(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmClothInfoSel.TV1DblClick(Sender: TObject);
begin
if IsMultipleSelection then
begin
if not CDS_Selok.Locate('C_Code', CDS_1.FieldByName('C_Code').AsString, []) then
MoveCDS(CDS_1, CDS_Selok)
end
else
ModalResult := 1;
end;
procedure TfrmClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmClothInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,246 @@
unit U_ClothPurchasePlanSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus, cxCalendar, cxPC;
type
TfrmClothPurchasePlanSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
Y_Spec: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SPName: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1QtyUnit: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
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;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Tv1Column4: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Label2: TLabel;
Y_Name: TEdit;
Label3: TLabel;
SellName: TEdit;
Label4: TLabel;
PurNo: TEdit;
Label5: TLabel;
BegDate: TDateTimePicker;
EndDate: TDateTimePicker;
IsJYTime: TCheckBox;
Tv1Column10: TcxGridDBColumn;
cxTabControl1: TcxTabControl;
ToolButton2: TToolButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure Y_SpecChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority: string;
{ Public declarations }
end;
var
frmClothPurchasePlanSel: TfrmClothPurchasePlanSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmClothPurchasePlanSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
EndDate.DateTime := SGetServerDate(ADOQueryTemp);
BegDate.DateTime := EndDate.DateTime - 90;
end;
procedure TfrmClothPurchasePlanSel.Y_SpecChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmClothPurchasePlanSel.cxTabControl1Change(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmClothPurchasePlanSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Y_Name.SetFocus;
Action := cahide;
end;
procedure TfrmClothPurchasePlanSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.*,B.* ');
sql.Add(' from Pur_YarnPlan_Main A');
sql.Add(' inner join BS_YarnPurPlan_Sub B on A.PurMId=B.PurMId');
sql.Add(' where isnull(A.status,''0'')=''9''');
sql.add(' and A.ConDate>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.DateTime)) + '''');
sql.Add(' and A.ConDate<''' + Trim(FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1)) + '''');
case cxTabControl1.TabIndex of
0:
begin
sql.Add(' and not EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
1:
begin
sql.Add(' and EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
end;
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmClothPurchasePlanSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmClothPurchasePlanSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmClothPurchasePlanSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmClothPurchasePlanSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmClothPurchasePlanSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmClothPurchasePlanSel.ToolButton1Click(Sender: TObject);
begin
Y_Name.SetFocus;
ModalResult := 1;
end;
procedure TfrmClothPurchasePlanSel.ToolButton2Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmClothPurchasePlanSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmClothPurchasePlanSel.FormDestroy(Sender: TObject);
begin
inherited;
frmClothPurchasePlanSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,178 @@
unit U_CompanyBankSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator, dxDateRanges, dxBarBuiltInMenu,
System.ImageList, U_BaseInput, cxContainer, cxImageList,
dxScrollbarAnnotations, dxSkinsCore, dxSkinsDefaultPainters;
type
TfrmCompanyBankSel = class(TfrmBaseHelp)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
TV1Column2: TcxGridDBColumn;
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;
BankName: TcxTextEdit;
cxImageList_bar: TcxImageList;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNamePropertiesChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoCode: string;
{ Public declarations }
end;
var
frmCompanyBankSel: TfrmCompanyBankSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmCompanyBankSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmCompanyBankSel.CoNamePropertiesChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmCompanyBankSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ToolBar1.SetFocus;
Action := cahide;
end;
procedure TfrmCompanyBankSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.* ');
sql.Add('from Bs_Company_Bank A ');
sql.Add('inner join Bs_Company B on A.CoID=B.CoID ');
sql.Add(' where B.CoCode=''' + Trim(FCoCode) + '''');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCompanyBankSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(Trim(self.Caption), TV1, '自定义数据');
end;
procedure TfrmCompanyBankSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmCompanyBankSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(Trim(self.Caption), TV1, '自定义数据');
end;
procedure TfrmCompanyBankSel.ToolButton1Click(Sender: TObject);
begin
ToolBar1.SetFocus;
ModalResult := 1;
end;
procedure TfrmCompanyBankSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmCompanyBankSel.FormDestroy(Sender: TObject);
begin
inherited;
frmCompanyBankSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,169 @@
unit U_CompanyContactSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator, dxDateRanges, dxBarBuiltInMenu,
System.ImageList, U_BaseInput, cxContainer, cxImageList,
dxScrollbarAnnotations, dxSkinsDefaultPainters;
type
TfrmCompanyContactSel = class(TfrmBaseHelp)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
TV1Column1: TcxGridDBColumn;
TV1Column2: TcxGridDBColumn;
TV1Column3: TcxGridDBColumn;
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;
cxImageList_bar: TcxImageList;
TV1Column4: TcxGridDBColumn;
TV1Column5: TcxGridDBColumn;
TV1Column6: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoCode: string;
{ Public declarations }
end;
var
frmCompanyContactSel: TfrmCompanyContactSel;
implementation
uses
U_DataLink, U_RTFun, U_CompanySel;
{$R *.dfm}
procedure TfrmCompanyContactSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmCompanyContactSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
toolbar1.SetFocus;
Action := cahide;
end;
procedure TfrmCompanyContactSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* from BS_Company A ');
sql.Add('left join BS_Company_contact B ON A.COID=B.COID ');
sql.Add('where 1=1 ');
sql.Add(' and A.CoCode=''' + Trim(FCoCode) + '''');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCompanyContactSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(Self.Caption, TV1, '自定义数据');
end;
procedure TfrmCompanyContactSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmCompanyContactSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(Self.Caption, TV1, '自定义数据');
end;
procedure TfrmCompanyContactSel.ToolButton1Click(Sender: TObject);
begin
toolbar1.SetFocus;
ModalResult := 1;
end;
procedure TfrmCompanyContactSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmCompanyContactSel.FormDestroy(Sender: TObject);
begin
inherited;
frmCompanyContactSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,196 @@
unit U_CompanySel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator, dxDateRanges, dxBarBuiltInMenu,
System.ImageList, U_BaseInput, cxContainer, cxImageList,
dxScrollbarAnnotations;
type
TfrmCompanySel = class(TfrmBaseHelp)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
TV1Column1: TcxGridDBColumn;
TV1Column2: TcxGridDBColumn;
TV1Column3: TcxGridDBColumn;
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;
CoName: TcxTextEdit;
cxImageList_bar: TcxImageList;
TV1Column4: TcxGridDBColumn;
TV1Column5: TcxGridDBColumn;
TV1Column6: TcxGridDBColumn;
Label2: TLabel;
CoAbbrName: TcxTextEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNamePropertiesChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmCompanySel: TfrmCompanySel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmCompanySel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmCompanySel.CoNamePropertiesChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmCompanySel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmCompanySel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* ');
sql.Add(',BankName=(select top 1 BankName from Bs_Company_Bank X where X.CoID=A.CoID ) ');
sql.Add(',ContactsId=(select top 1 UserID from SY_User X where X.UserName=B.Contacts ) ');
sql.Add('from BS_Company A ');
sql.Add('left join BS_Company_contact B ON A.COID=B.COID ');
sql.Add('where 1=1 ');
if Trim(FCoType) <> '' then
begin
sql.Add(' and A.CoType=''' + Trim(FCoType) + '''');
end;
if Trim(FAuthority) = '理单业务' then
begin
sql.Add(' and ( SalesId=' + quotedstr(trim(DCode)) + ' or exists (select * from [dbo].[F_Tool_SplitString](TallyId,'','') X where X.RTValue =' + quotedstr(trim(DCode)) + '))');
end;
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCompanySel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmCompanySel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmCompanySel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmCompanySel.ToolButton1Click(Sender: TObject);
begin
CoName.SetFocus;
ModalResult := 1;
end;
procedure TfrmCompanySel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmCompanySel.FormDestroy(Sender: TObject);
begin
inherited;
frmCompanySel := nil;
end;
end.

View File

@ -0,0 +1,937 @@
inherited frmEmployeeSel: TfrmEmployeeSel
Left = 342
Top = 13
Caption = #25968#25454#36873#25321
ClientHeight = 637
ClientWidth = 731
Font.Charset = GB2312_CHARSET
Font.Height = -12
Font.Name = #23435#20307
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 747
ExplicitHeight = 676
PixelsPerInch = 96
TextHeight = 12
object ScrollBox1: TScrollBox [0]
Left = 0
Top = 0
Width = 731
Height = 637
Align = alClient
TabOrder = 0
object btn1: TSpeedButton
Left = 23
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
OnClick = btn1Click
end
object btn2: TSpeedButton
Left = 111
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn3: TSpeedButton
Left = 199
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn4: TSpeedButton
Left = 287
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn5: TSpeedButton
Left = 375
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn6: TSpeedButton
Left = 463
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn7: TSpeedButton
Left = 551
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn8: TSpeedButton
Left = 639
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn58: TSpeedButton
Left = 23
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn9: TSpeedButton
Left = 111
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn10: TSpeedButton
Left = 199
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn11: TSpeedButton
Left = 287
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn12: TSpeedButton
Left = 375
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn13: TSpeedButton
Left = 463
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn14: TSpeedButton
Left = 551
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn15: TSpeedButton
Left = 639
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn59: TSpeedButton
Left = 23
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn16: TSpeedButton
Left = 111
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn17: TSpeedButton
Left = 199
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn18: TSpeedButton
Left = 287
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn19: TSpeedButton
Left = 375
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn20: TSpeedButton
Left = 463
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn21: TSpeedButton
Left = 551
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn22: TSpeedButton
Left = 639
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn60: TSpeedButton
Left = 23
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn23: TSpeedButton
Left = 111
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn24: TSpeedButton
Left = 199
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn25: TSpeedButton
Left = 287
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn26: TSpeedButton
Left = 375
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn27: TSpeedButton
Left = 463
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn28: TSpeedButton
Left = 551
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn29: TSpeedButton
Left = 639
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn61: TSpeedButton
Left = 23
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn30: TSpeedButton
Left = 111
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn31: TSpeedButton
Left = 199
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn32: TSpeedButton
Left = 287
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn33: TSpeedButton
Left = 375
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn34: TSpeedButton
Left = 463
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn35: TSpeedButton
Left = 551
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn36: TSpeedButton
Left = 639
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn62: TSpeedButton
Left = 23
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn37: TSpeedButton
Left = 111
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn38: TSpeedButton
Left = 199
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn39: TSpeedButton
Left = 287
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn40: TSpeedButton
Left = 375
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn41: TSpeedButton
Left = 463
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn42: TSpeedButton
Left = 551
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn43: TSpeedButton
Left = 639
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn63: TSpeedButton
Left = 23
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn44: TSpeedButton
Left = 111
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn45: TSpeedButton
Left = 199
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn46: TSpeedButton
Left = 287
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn47: TSpeedButton
Left = 375
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn48: TSpeedButton
Left = 463
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn49: TSpeedButton
Left = 551
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn50: TSpeedButton
Left = 639
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn64: TSpeedButton
Left = 23
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn51: TSpeedButton
Left = 111
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn52: TSpeedButton
Left = 199
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn53: TSpeedButton
Left = 287
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn54: TSpeedButton
Left = 375
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn55: TSpeedButton
Left = 463
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn56: TSpeedButton
Left = 551
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn57: TSpeedButton
Left = 639
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = ADOConnection1
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = ADOConnection1
end
object ADOTmp: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 120
Top = 176
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 296
Top = 192
end
end

View File

@ -0,0 +1,218 @@
unit U_EmployeeSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, DB, ADODB, U_BaseHelp, System.ImageList, Vcl.ImgList;
type
TfrmEmployeeSel = class(TfrmBaseHelp)
ScrollBox1: TScrollBox;
btn1: TSpeedButton;
btn2: TSpeedButton;
btn3: TSpeedButton;
btn4: TSpeedButton;
btn5: TSpeedButton;
btn6: TSpeedButton;
btn7: TSpeedButton;
btn8: TSpeedButton;
btn58: TSpeedButton;
btn9: TSpeedButton;
btn10: TSpeedButton;
btn11: TSpeedButton;
btn12: TSpeedButton;
btn13: TSpeedButton;
btn14: TSpeedButton;
btn15: TSpeedButton;
btn59: TSpeedButton;
btn16: TSpeedButton;
btn17: TSpeedButton;
btn18: TSpeedButton;
btn19: TSpeedButton;
btn20: TSpeedButton;
btn21: TSpeedButton;
btn22: TSpeedButton;
btn60: TSpeedButton;
btn23: TSpeedButton;
btn24: TSpeedButton;
btn25: TSpeedButton;
btn26: TSpeedButton;
btn27: TSpeedButton;
btn28: TSpeedButton;
btn29: TSpeedButton;
btn61: TSpeedButton;
btn30: TSpeedButton;
btn31: TSpeedButton;
btn32: TSpeedButton;
btn33: TSpeedButton;
btn34: TSpeedButton;
btn35: TSpeedButton;
btn36: TSpeedButton;
btn62: TSpeedButton;
btn37: TSpeedButton;
btn38: TSpeedButton;
btn39: TSpeedButton;
btn40: TSpeedButton;
btn41: TSpeedButton;
btn42: TSpeedButton;
btn43: TSpeedButton;
btn63: TSpeedButton;
btn44: TSpeedButton;
btn45: TSpeedButton;
btn46: TSpeedButton;
btn47: TSpeedButton;
btn48: TSpeedButton;
btn49: TSpeedButton;
btn50: TSpeedButton;
btn64: TSpeedButton;
btn51: TSpeedButton;
btn52: TSpeedButton;
btn53: TSpeedButton;
btn54: TSpeedButton;
btn55: TSpeedButton;
btn56: TSpeedButton;
btn57: TSpeedButton;
ADOTmp: TADOQuery;
ADOConnection1: TADOConnection;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure InitEmployee();
{ Private declarations }
public
FRCode, FRName, FPost: string;
{ Public declarations }
end;
var
frmEmployeeSel: TfrmEmployeeSel;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmEmployeeSel.FormDestroy(Sender: TObject);
begin
inherited;
frmEmployeeSel := nil;
end;
procedure TfrmEmployeeSel.InitEmployee();
type
FdDy = record
inc: integer;
FCode: string[32];
FName: string[32];
end;
var
BB: array[0..100] of FdDy;
i, j: Integer;
begin
with ADOTmp do
begin
Close;
sql.Clear;
sql.Add('select EECode,EEName from SY_Employee where Post=''' + Trim(FPost) + ''' ');
SQL.Add('order by EECode,EEName ');
Open;
end;
if ADOTmp.IsEmpty then
begin
Application.MessageBox('没有定义数据!', '提示', 0);
Exit;
end;
with ADOTmp do
begin
First;
i := 0;
while not Eof do
begin
BB[i].inc := i;
BB[i].FCode := Trim(fieldbyname('EECode').AsString);
BB[i].FName := Trim(fieldbyname('EEName').AsString);
i := i + 1;
Next;
end;
end;
i := i - 1;
if i > 63 then
begin
i := 63;
end;
for j := 0 to i do
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[j]).Visible := True;
TSpeedButton(Controls[j]).Hint := BB[j].FCode;
TSpeedButton(Controls[j]).Caption := BB[j].FName;
{TSpeedButton(Controls[j]).Hint:=BB[j];
if Length(BB[j])>4 then
begin
TSpeedButton(Controls[j]).Caption:=Copy(Trim(BB[j]),1,4)+#13+Copy(Trim(BB[j]),5,Length(BB[j])-4);
end else
TSpeedButton(Controls[j]).Caption:=BB[j]; }
end;
end;
end;
procedure TfrmEmployeeSel.FormShow(Sender: TObject);
begin
inherited;
InitEmployee();
end;
procedure TfrmEmployeeSel.btn1Click(Sender: TObject);
begin
FRCode := Trim(TSpeedButton(Sender).Hint);
FRName := Trim(TSpeedButton(Sender).Caption);
ModalResult := 1;
end;
procedure TfrmEmployeeSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
// Action:=caHide;
end;
procedure TfrmEmployeeSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
end;
end;
end.

View File

@ -0,0 +1,317 @@
unit U_HttpFun;
interface
uses
System.SysUtils, System.Net.HttpClientComponent, System.Classes, System.JSON,
Datasnap.DBClient, Data.DB;
function UrlDecode(const AStr: AnsiString): AnsiString;
function GetRequest(Url: string): string;
procedure JsonToDataset(JsonStr, ArrName: string; CDS_1: TclientDataSet);
function JsonErr(JsonStr, Success: string): string;
function JsonGetChildValue(JsonStr, KeyName: string): string;
function JsonGetChildObject(JsonStr, KeyName: string): string;
function YongYouGettoken(): string;
function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
implementation
uses
U_DataLink;
procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
JSONObject, JSONObject2: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, j, k: Integer; // 循环变量
Cloint: Integer; // 循环变量
temp: string; // 临时使用变量
jsonArray: TJSONArray; // JSON数组变量
mfieldName: string;
mSize: Integer;
begin
JSONObject := nil;
try
CDS_1.DisableControls;
CDS_1.FieldDefs.Clear;
CDS_1.FieldDefs.Add('code', ftString, 255);
CDS_1.FieldDefs.Add('name', ftString, 255);
CDS_1.FieldDefs.Add('specs', ftString, 255);
CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
CDS_1.close;
CDS_1.CreateDataSet;
{ 从字符串生成JSON }
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObject.Count > 0 then
begin
// json数组
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
if jsonArray.Count > 0 then
begin
// 循环取得JSON数组中每个元素
for i := 0 to jsonArray.Size - 1 do
begin
with CDS_1 do
begin
Append;
Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
for k := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
if Findfield(JSONPair.JsonString.Value) <> nil then
begin
FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
end;
end;
Post;
end;
end;
end;
end
else
begin
temp := '没有数据!';
end;
finally
CDS_1.First;
CDS_1.EnableControls;
JSONObject.Free;
end;
end;
function YongYouGettoken(): string;
var
JsonStr: string;
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
begin
Result := '';
BJ_Url := 'https://api.yonyouup.com/api/';
BJ_FromAccount := 'hbyl2024';
BJ_ToAccount := 'hbyl2024:mesapp';
BJ_appKey := 'opaeaf8afe01e3fe21f';
JsonStr := GetRequest('https://api.yonyouup.com/system/token?from_account=hbyl2024&app_key=opaeaf8afe01e3fe21f&app_secret=8d699f9b39ac41139941f224d5da154e');
if JsonErr(JsonStr, '0') = '0' then
begin
BJ_token := JsonGetChildValue(JsonGetChildObject(JsonStr, 'token'), 'id');
end
else
begin
Result := JsonStr;
end;
end;
function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
begin
Result := BsUrl + ChildUrl + '?from_account=' + from_account + '&to_account=' + to_account + '&app_key=' + app_key + '&token=' + token + arg;
end;
function UrlDecode(const AStr: AnsiString): AnsiString;
var
Sp, Rp, Cp: PAnsiChar;
s: AnsiString;
begin
SetLength(Result, Length(AStr));
Sp := PAnsiChar(AStr);
Rp := PAnsiChar(Result);
Cp := Sp;
while Sp^ <> #0 do
begin
case Sp^ of
'+':
Rp^ := ' ';
'%':
begin
Inc(Sp);
if Sp^ = '%' then
Rp^ := '%'
else
begin
Cp := Sp;
Inc(Sp);
if (Cp^ <> #0) and (Sp^ <> #0) then
begin
s := AnsiChar('$') + Cp^ + Sp^;
Rp^ := AnsiChar(StrToInt(string(s)));
end;
end;
Cp := Cp;
end;
else
Rp^ := Sp^;
end;
Inc(Rp);
Inc(Sp);
end;
SetLength(Result, Rp - PAnsiChar(Result));
end;
function GetRequest(Url: string): string;
var
vHttp: TNetHTTPClient;
vUTF8: TStringStream;
begin
vHttp := TNetHTTPClient.Create(nil);
vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
try
with vHttp do
begin
vUTF8.Clear;
ConnectionTimeout := 2000; // 2
ResponseTimeout := 10000; // 10
AcceptCharSet := 'utf-8';
AcceptEncoding := '65001';
AcceptLanguage := 'zh-CN';
ContentType := 'text/html';
UserAgent := 'Embarcadero URI Client/1.0';
try
Get(Url, vUTF8);
Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString); //TNetEncoding.URL.
except
on E: Exception do
// Error sending data: (12002) 操作超时.
// Error receiving data: (12002) 操作超时
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
Result := '{"RtErr":"接口连接失败!"}'
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
Result := '{"RtErr":"接口传输数据失败,请延长接收超时时间"}'
else
Result := '{"RtErr":"' + E.Message + '"}';
end;
end;
finally
vUTF8.Free;
vHttp.Free;
end;
end;
procedure JsonToDataset(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
JSONObject, JSONObject2: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, j, k: Integer; // 循环变量
Cloint: Integer; // 循环变量
temp: string; // 临时使用变量
jsonArray: TJSONArray; // JSON数组变量
mfieldName: string;
mSize: Integer;
begin
JSONObject := nil;
try
CDS_1.DisableControls;
{ 从字符串生成JSON }
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObject.Count > 0 then
begin
// json数组
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
if jsonArray.Count > 0 then
begin
// 循环取得JSON数组中每个元素
for i := 0 to jsonArray.Size - 1 do
begin
if i = 0 then
begin
Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
CDS_1.FieldDefs.Clear;
for j := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[j];
CDS_1.FieldDefs.Add(JSONPair.JsonString.Value, ftString, 255);
end;
CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
CDS_1.close;
CDS_1.CreateDataSet;
end;
with CDS_1 do
begin
Append;
for k := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
if Findfield(JSONPair.JsonString.Value) <> nil then
FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
end;
Post;
end;
end;
end;
end
else
begin
temp := '没有数据!';
end;
finally
CDS_1.First;
CDS_1.EnableControls;
JSONObject.Free;
end;
end;
function JsonErr(JsonStr, Success: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
begin
Result := Success;
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
if JSONPair.JsonString.Value = 'errcode' then
Result := JSONPair.JSONValue.Value;
end;
end;
function JsonGetChildObject(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Result := JSONObject.GetValue(KeyName).ToString;
end;
function JsonGetChildValue(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
Z, X: string;
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
Z := JSONPair.JsonString.Value;
X := JSONPair.JSONValue.Value;
if JSONPair.JsonString.Value = KeyName then
Result := JSONPair.JSONValue.Value;
end;
end;
end.

View File

@ -0,0 +1,67 @@
object frmInputBoxSingleNumber: TfrmInputBoxSingleNumber
Left = 682
Top = 315
Caption = #35831#36755#20837#25968#23383
ClientHeight = 100
ClientWidth = 362
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 362
Height = 100
Align = alClient
TabOrder = 0
ExplicitTop = 1
object Label1: TLabel
Left = 31
Top = 37
Width = 66
Height = 21
Caption = #25968#23383#65306
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 217
Top = 33
Width = 83
Height = 29
Caption = #30830#35748
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Price: TEdit
Left = 90
Top = 33
Width = 121
Height = 29
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
end
end
end

View File

@ -0,0 +1,39 @@
unit U_InputBoxSingleNumber;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DB, ADODB;
type
TfrmInputBoxSingleNumber = class(TForm)
Panel1: TPanel;
Button1: TButton;
Label1: TLabel;
Price: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
FFFIDS: string;
{ Public declarations }
end;
var
frmInputBoxSingleNumber: TfrmInputBoxSingleNumber;
implementation
{$R *.dfm}
procedure TfrmInputBoxSingleNumber.Button1Click(Sender: TObject);
begin
if StrToFloatDef(Price.Text, 0) = 0 then
Price.Text := '0';
ModalResult := 1;
end;
end.

View File

@ -0,0 +1,54 @@
object frmInputBoxSingleString: TfrmInputBoxSingleString
Left = 682
Top = 315
Caption = #35831#36755#20837#25991#26412
ClientHeight = 123
ClientWidth = 467
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 467
Height = 123
Align = alClient
TabOrder = 0
ExplicitHeight = 122
object Button1: TButton
Left = 340
Top = 12
Width = 111
Height = 93
Caption = #30830#35748
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -35
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 13
Top = 12
Width = 306
Height = 93
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 1
end
end
end

View File

@ -0,0 +1,37 @@
unit U_InputBoxSingleString;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DB, ADODB;
type
TfrmInputBoxSingleString = class(TForm)
Panel1: TPanel;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
FFFIDS: string;
{ Public declarations }
end;
var
frmInputBoxSingleString: TfrmInputBoxSingleString;
implementation
{$R *.dfm}
procedure TfrmInputBoxSingleString.Button1Click(Sender: TObject);
begin
ModalResult := 1;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,293 @@
unit U_KnitClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math;
type
TfrmKnitClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TEdit;
C_Name: TEdit;
C_GramWeight: TEdit;
C_Width: TEdit;
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;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
private
CurrentPage, RecordsNumber: Integer;
procedure InitGrid();
procedure InitTree();
{ Private declarations }
public
FCoType: string;
{ Public declarations }
end;
var
frmKnitClothInfoSel: TfrmKnitClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmKnitClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type where CTType=''针织'' ');
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmKnitClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmKnitClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid();
end;
procedure TfrmKnitClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid();
end;
procedure TfrmKnitClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmKnitClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmKnitClothInfoSel.InitGrid();
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmKnitClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
RecordsNumber := 500;
CurrentPage := 1;
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
InitTree();
InitGrid();
end;
procedure TfrmKnitClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmKnitClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmKnitClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid();
end;
procedure TfrmKnitClothInfoSel.ToolButton1Click(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmKnitClothInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmKnitClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmKnitClothInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,408 @@
unit U_LabelMapSet;
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,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList,
Vcl.ImgList, U_BaseHelp, Vcl.Clipbrd, dxScrollbarAnnotations, dxSkinsCore,
dxSkinsDefaultPainters;
type
TfrmLabelMapSet = class(Tform)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
Panel1: TPanel;
LMName: TEdit;
v2Column8: TcxGridDBColumn;
Label1: TLabel;
v2Column12: TcxGridDBColumn;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
Label2: TLabel;
LMType: TEdit;
v2Column1: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
ToolButton1: TToolButton;
Tv1Column2: TcxGridDBColumn;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxGridLevel2: TcxGridLevel;
DS_2: TDataSource;
ToolBar2: TToolBar;
ToolButton12: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton3: TToolButton;
ADO_2: TADOQuery;
PM_2: TPopupMenu;
N3: TMenuItem;
Tv1Column3: 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 ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure CustomerChange(Sender: TObject);
procedure v2Column8PropertiesEditValueChanged(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure TextEdit(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
procedure Getfields(MSql: Integer);
public
IsSql1, IsSql2, IsSql3: Boolean;
FLMType: string;
FFiltration1, FFiltration2, FFiltration3: string;
{ Public declarations }
end;
var
frmLabelMapSet: TfrmLabelMapSet;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp;
{$R *.dfm}
procedure TfrmLabelMapSet.Getfields(MSql: Integer);
begin
case MSql of
1:
begin
if trim(CDS_1.fieldbyname('LMSql1').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
if IsSql1 then
begin
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql1').AsString));
sql.add(FFiltration1);
end
else
begin
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql1').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
end;
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
2:
begin
if trim(CDS_1.fieldbyname('LMSql2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
if IsSql1 then
begin
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql2').AsString));
sql.add(FFiltration2);
end
else
begin
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
end;
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(False); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
3:
begin
if trim(CDS_1.fieldbyname('LMSql3').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
if IsSql1 then
begin
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql3').AsString));
sql.add(FFiltration3);
end
else
begin
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
end;
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
end;
end;
procedure TfrmLabelMapSet.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
SQL.Clear;
sql.Add(' select A.* from BS_Label_Map A ');
sql.Add(' where LMType=' + quotedstr(FLMType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
ToolButton2.Click;
end;
end;
procedure TfrmLabelMapSet.N3Click(Sender: TObject);
begin
Clipboard.SetTextBuf(PChar(TV2.Controller.FocusedColumn.DataBinding.FilterFieldName));
end;
procedure TfrmLabelMapSet.FormDestroy(Sender: TObject);
begin
frmLabelMapSet := nil;
end;
procedure TfrmLabelMapSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmLabelMapSet.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
// ADOQueryBaseCmd.Connection := ADOConnection1;
// ADOQueryBaseTemp.Connection := ADOConnection1;
except
end;
end;
procedure TfrmLabelMapSet.TBCloseClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelMapSet.FormShow(Sender: TObject);
begin
ReadCxGrid(Trim(Self.Caption), Tv1, '标签管理');
InitGrid();
end;
procedure TfrmLabelMapSet.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmLabelMapSet.ToolButton12Click(Sender: TObject);
begin
Getfields(1);
end;
procedure TfrmLabelMapSet.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(Trim(Self.Caption), Tv1, '标签管理');
end;
procedure TfrmLabelMapSet.ToolButton2Click(Sender: TObject);
var
sql: string;
begin
if ADOQueryMain.Active then
begin
sql := SGetFilters(Panel1, 1, 2);
SDofilter(ADOQueryMain, sql);
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmLabelMapSet.ToolButton3Click(Sender: TObject);
begin
TcxGridToExcel('sql字段', cxgrid2);
end;
procedure TfrmLabelMapSet.cxTabControl1Change(Sender: TObject);
begin
InitGrid;
end;
procedure TfrmLabelMapSet.CustomerChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmLabelMapSet.v2Column8PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Label_Map ');
sql.Add(' Set ' + FFieldName + '=''' + Trim(mvalue) + '''');
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where LMID=' + quotedstr(CDS_1.fieldbyname('LMID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv1.Controller.EditingController.ShowEdit();
except
tv1.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!', '提示', 0);
end
end;
procedure TfrmLabelMapSet.ToolButton4Click(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into BS_Label_Map(LMType,Filler) values(' + quotedstr(Trim(FLMType)) + ',' + quotedstr(Trim(dname)) + ')');
ExecSQL;
end;
InitGrid();
end;
procedure TfrmLabelMapSet.ToolButton5Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗?', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete BS_Label_Map where LMID=' + QuotedStr(CDS_1.FieldByName('LMID').AsString));
ExecSQL;
end;
CDS_1.Delete;
end;
procedure TfrmLabelMapSet.ToolButton6Click(Sender: TObject);
begin
Getfields(2);
end;
procedure TfrmLabelMapSet.ToolButton7Click(Sender: TObject);
begin
Getfields(3);
end;
procedure TfrmLabelMapSet.TextEdit(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Label_Map ');
sql.Add(' Set ' + FFieldName + '=' + Trim(mvalue));
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where LMID=' + quotedstr(CDS_1.fieldbyname('LMID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv1.Controller.EditingController.ShowEdit();
except
tv1.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!', '提示', 0);
end
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,420 @@
unit U_LabelPrint;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Vcl.Printers, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxDateRanges,
dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common, RM_Class,
RM_GridReport, RM_Dataset, Vcl.Buttons, RM_E_llPDF, RM_BarCode, RM_e_Graphic,
RM_e_Jpeg, RM_e_Xls, cxContainer, cxMaskEdit, cxDropDownEdit, cxMRUEdit,
System.Net.HttpClient, System.Net.HttpClientComponent, System.JSON,
dxSkinsCore, dxSkinsDefaultPainters;
type
TfrmLabelPrint = class(TfrmBaseHelp)
ADOQueryTemp: TADOQuery;
ADOConnection1: TADOConnection;
Panel1: TPanel;
ImageList1: TImageList;
RMDB_1: TRMDBDataSet;
RM1: TRMGridReport;
RMDB_2: TRMDBDataSet;
CDS_Label: TClientDataSet;
ADO_1: TADOQuery;
btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject;
RMllPDFExport1: TRMllPDFExport;
CheckBox1: TCheckBox;
Label1: TLabel;
cbbLab: TcxMRUEdit;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
ADOQueryCmd: TADOQuery;
ADO_While: TADOQuery;
ComboBox1: TcxComboBox;
ComboBox_Print: TcxComboBox;
btnPrint: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
procedure cbbLabPropertiesButtonClick(Sender: TObject);
private
procedure InitGrid();
procedure PrintLabel(MIsShow: Boolean);
procedure PrintServerLabel(MIsShow: Boolean);
function JsonGetChildValue(JsonStr, KeyName: string): string;
{ Private declarations }
public
FPreviewPrint, IsSql1, IsSql2, IsSql3: Boolean;
FLMType: string; //标签类型
FFiltration1, FFiltration2, FFiltration3: string;
FparamBlclid: string;
{ Public declarations }
end;
var
frmLabelPrint: TfrmLabelPrint;
implementation
uses
U_DataLink, U_RTFun, U_LabelMapSet, U_printPdf;
{$R *.dfm}
function TfrmLabelPrint.JsonGetChildValue(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
Z, X: string;
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
Z := JSONPair.JsonString.Value;
X := JSONPair.JSONValue.Value;
if JSONPair.JsonString.Value = KeyName then
Result := JSONPair.JSONValue.Value;
end;
end;
procedure TfrmLabelPrint.PrintServerLabel(MIsShow: Boolean);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
HttpClient: THttpClient;
Request: TStringStream;
Response: IHTTPResponse;
ResponseString: string;
jsonArray: TJSONArray; // JSON数组变量
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
JSONStr: string;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
mprintFlag, mprinter: Integer;
begin
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
LBName := cbbLab.text;
if CDS_Label.Locate('LMName', LBName, []) then
begin
if GetLSNo(ADOQueryCmd, MaxBLCLID, 'X', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := trim(CDS_Label.fieldbyname('LMName').AsString);
FieldByName('LMSql1').Value := trim(CDS_Label.fieldbyname('LMSql1').AsString);
FieldByName('LMSql2').Value := trim(CDS_Label.fieldbyname('LMSql2').AsString);
FieldByName('LMSql3').Value := trim(CDS_Label.fieldbyname('LMSql3').AsString);
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('Filtration2').Value := Trim(FFiltration2);
FieldByName('Filtration3').Value := Trim(FFiltration3);
FieldByName('IsSql1').Value := IsSql1;
FieldByName('IsSql2').Value := IsSql2;
FieldByName('IsSql3').Value := IsSql3;
FieldByName('Sheets').Value := strtointdef(ComboBox1.Text, 1);
FieldByName('paramBlclid').Value := StrToFloatDef(FparamBlclid, 0);
Post;
end;
end;
if MIsShow then
mprintFlag := 1
else
mprintFlag := 0;
mprinter := ComboBox_Print.ItemIndex;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), StrToIntDef(ComboBox1.Text, 1), mprintFlag, mprinter, PChar(DConString))// HttpClient := THttpClient.Create;
end;
procedure TfrmLabelPrint.PrintLabel(MIsShow: Boolean);
var
fPrintFile, fPrintFile10, FMainID, LBName: string;
begin
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
RMllPDFExport1.ShowDialog := CheckBox2.Checked;
RMJPEGExport1.ShowDialog := CheckBox2.Checked;
RMXLSExport1.ShowDialog := CheckBox2.Checked;
RM1.ShowPrintDialog := CheckBox1.Checked;
LBName := cbbLab.text;
ExportFtErpFile(LBName + '.rmf', ADOQueryTemp);
if CDS_Label.Locate('LMName', LBName, []) then
begin
if trim(CDS_Label.fieldbyname('LMSql1').AsString) <> '' then
begin
with ADO_1 do
begin
Close;
sql.Clear;
if IsSql1 then
begin
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql1').AsString));
sql.add(FFiltration1);
end
else
begin
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql1').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
end;
Open;
end;
end;
if trim(CDS_Label.fieldbyname('LMSql2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
if IsSql1 then
begin
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql2').AsString));
sql.add(FFiltration2);
end
else
begin
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
end;
Open;
end;
end;
if trim(CDS_Label.fieldbyname('LMSql3').AsString) <> '' then
begin
with ADO_3 do
begin
Close;
sql.Clear;
if IsSql1 then
begin
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql3').AsString));
sql.add(FFiltration3);
end
else
begin
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
end;
Open;
end;
end;
end;
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
RMVariables['LBPrtCode'] := dcode;
RMVariables['LBPrtName'] := dname;
if MIsShow then
RM1.ShowReport
else
RM1.PrintReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
end;
end;
procedure TfrmLabelPrint.FormCreate(Sender: TObject);
begin
inherited;
FPreviewPrint := True;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
end;
end;
procedure TfrmLabelPrint.btnPrintClick(Sender: TObject);
begin
if not CheckBox3.Checked then
begin
PrintLabel(False);
end
else
begin
PrintServerLabel(False);
end;
ModalResult := 1;
end;
procedure TfrmLabelPrint.btnShowClick(Sender: TObject);
begin
if not CheckBox3.Checked then
begin
PrintLabel(true);
end
else
begin
PrintServerLabel(true);
end;
end;
procedure TfrmLabelPrint.cbbLabPropertiesButtonClick(Sender: TObject);
begin
try
frmLabelMapSet := TfrmLabelMapSet.Create(Application);
with frmLabelMapSet do
begin
IsSql1 := self.IsSql1;
IsSql2 := self.IsSql2;
IsSql3 := self.IsSql3;
FFiltration1 := self.FFiltration1;
FFiltration2 := self.FFiltration2;
FFiltration3 := self.FFiltration3;
FLMType := self.FLMType;
if ShowModal = 1 then
begin
Self.InitGrid();
end;
end;
finally
frmLabelMapSet.Free;
end;
end;
procedure TfrmLabelPrint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cahide;
end;
procedure TfrmLabelPrint.InitGrid();
begin
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select LMName name from BS_Label_Map where LMType=' + QuotedStr(TRIM(FLMType)));
sql.Add(' order by SerialNo ');
Open;
if isEmpty then
begin
exit;
end;
cbbLab.Properties.LookupItems.Clear;
while not Eof do
begin
cbbLab.Properties.LookupItems.Add(Trim(fieldByName('Name').AsString));
Next;
end;
cbbLab.ItemIndex := 0;
end;
with ADOQueryTemp do
begin
Filtered := False;
Close;
sql.Clear;
Sql.Add('select * from BS_Label_Map where LMType=' + QuotedStr(TRIM(FLMType)));
Open;
end;
SCreateCDS(ADOQueryTemp, CDS_Label);
SInitCDSData(ADOQueryTemp, CDS_Label);
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
end;
procedure TfrmLabelPrint.FormShow(Sender: TObject);
begin
inherited;
if FPreviewPrint then
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
else
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
if Trim(FFiltration2) = '' then
FFiltration2 := FFiltration1;
if Trim(FFiltration3) = '' then
FFiltration3 := FFiltration1;
ComboBox_Print.Properties.Items.Assign(printer.Printers);
InitGrid();
end;
procedure TfrmLabelPrint.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelPrint.FormDestroy(Sender: TObject);
begin
inherited;
frmLabelPrint := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,189 @@
unit U_LabelPrintSql;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Class, RM_GridReport, RM_Dataset, Vcl.Buttons, RM_E_llPDF, RM_BarCode,
RM_e_Graphic, RM_e_Jpeg, RM_e_Xls, cxContainer, cxMaskEdit, cxDropDownEdit,
cxMRUEdit;
type
TfrmLabelPrintSql = class(TfrmBaseHelp)
ADOQueryTemp: TADOQuery;
ADOConnection1: TADOConnection;
Panel1: TPanel;
ImageList1: TImageList;
RMDB_1: TRMDBDataSet;
RM1: TRMGridReport;
RMDB_2: TRMDBDataSet;
ADO_1: TADOQuery;
btnPrint: TSpeedButton;
btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject;
RMllPDFExport1: TRMllPDFExport;
CheckBox1: TCheckBox;
ComboBox1: TComboBox;
Label1: TLabel;
CheckBox2: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
private
procedure PrintLabel(MIsShow: Boolean);
{ Private declarations }
public
FPreviewPrint, IsWhile: Boolean;
MSQLS: TStringList;
{ Public declarations }
end;
var
frmLabelPrintSql: TfrmLabelPrintSql;
implementation
uses
U_DataLink, U_RTFun, U_LabelPrint;
{$R *.dfm}
procedure TfrmLabelPrintSql.PrintLabel(MIsShow: Boolean);
var
fPrintFile, fPrintFile10, FMainID, LBName: string;
i: Integer;
begin
RMllPDFExport1.ShowDialog := CheckBox2.Checked;
RMJPEGExport1.ShowDialog := CheckBox2.Checked;
RMXLSExport1.ShowDialog := CheckBox2.Checked;
RM1.ShowPrintDialog := CheckBox1.Checked;
for i := 1 to MSQLS.Count do
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add(MSQLS[i - 1]);
Open;
end;
LBName := Trim(ADO_1.FieldByName('LBName').AsString);
if LBName <> '' then
begin
ExportFtErpFile(LBName + '.rmf', ADOQueryTemp);
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
RMVariables['LBPrtCode'] := dcode;
RMVariables['LBPrtName'] := dname;
if MIsShow then
RM1.ShowReport
else
RM1.PrintReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
Exit;
end;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
Exit;
end;
end;
end;
procedure TfrmLabelPrintSql.FormCreate(Sender: TObject);
begin
inherited;
FPreviewPrint := True;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
end;
end;
procedure TfrmLabelPrintSql.btnPrintClick(Sender: TObject);
var
i: Integer;
begin
PrintLabel(False);
ModalResult := 1;
end;
procedure TfrmLabelPrintSql.btnShowClick(Sender: TObject);
begin
PrintLabel(true);
end;
procedure TfrmLabelPrintSql.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cahide;
end;
procedure TfrmLabelPrintSql.FormShow(Sender: TObject);
begin
inherited;
if FPreviewPrint then
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
else
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
end;
procedure TfrmLabelPrintSql.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelPrintSql.FormDestroy(Sender: TObject);
begin
inherited;
frmLabelPrint := nil;
end;
end.

View File

@ -0,0 +1,521 @@
unit U_PicUpload;
interface
uses
Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Buttons,
StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, IdExplicitTLSClientServerBase, System.ImageList,
Vcl.ImgList;
type
TfrmPictureUpload = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
SpeedButton3: TSpeedButton;
ADOQuery1: TADOQuery;
SaveDialog1: TSavePictureDialog;
adoqueryImage: TADOQuery;
IdFTP1: TIdFTP;
ToolBar1: TToolBar;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ImageList1: TImageList;
ADOConnection1: TADOConnection;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Initimage();
procedure TBCloseClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
private
hWndC: THandle;
CapturingAVI: bool;
ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
FilePath, FileName: string;
MyJpeg: TJPEGImage;
procedure CreThumb(Width, Height: Integer);
function SaveImage(): Boolean;
procedure Rotate90(Source: TGraphic; Target: TJpegImage);
public
FTFType, fFlileFlag: string;
FWidth, FHeight: Integer;
FPictureName, FDataId: string;
{ Public declarations }
end;
var
frmPictureUpload: TfrmPictureUpload;
implementation
uses
U_DataLink, U_RTFun;
const
WM_CAP_START = WM_USER;
const
WM_CAP_STOP = WM_CAP_START + 68;
const
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const
WM_CAP_SAVEDIB = WM_CAP_START + 25;
const
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const
WM_CAP_SEQUENCE = WM_CAP_START + 62;
const
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const
WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
const
WM_CAP_SET_OVERLAY = WM_CAP_START + 51;
const
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
const
WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;
const
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
const
WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
const
WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
const
WM_CAP_SET_SCALE = WM_CAP_START + 53;
const
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';
{$R *.dfm}
procedure TfrmPictureUpload.Rotate90(Source: TGraphic; Target: TJpegImage);
var
SourceBmp, TargetBmp: TBitmap;
r, c: Integer;
x, y: Integer;
begin
SourceBmp := TBitmap.Create;
SourceBmp.Assign(Source);
TargetBmp := TBitmap.Create;
TargetBmp.Width := SourceBmp.Height;
TargetBmp.Height := SourceBmp.Width;
for r := 0 to SourceBmp.Height - 1 do
begin
for c := 0 to SourceBmp.Width - 1 do
begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
x := r; //90
y := (SourceBmp.Width - 1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
end;
end;
Target.Assign(TargetBmp);
SourceBmp.Free;
TargetBmp.Free;
end;
procedure TfrmPictureUpload.Initimage();
var
jpg: TJpegImage;
myStream: TADOBlobStream;
sFieldName: string;
JPStream: TMemoryStream;
begin
jpg := TJpegImage.Create();
JPStream := TMemoryStream.Create;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if not IsEmpty then
begin
if not fieldbyname('FilesOther').IsNull then
begin
myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname('FilesOther')), bmread);
jpg.LoadFromStream(myStream);
Image2.Picture.Assign(jpg);
myStream.Free;
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
JPStream.Clear;
if IdFTP1.Connected then
begin
try
IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname('FileName').AsString), JPStream);
except
Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
if IdFTP1.Connected then
IdFTP1.Quit;
JPStream.Position := 0;
jpg.LoadFromStream(JPStream);
Image1.Picture.Assign(jpg);
end;
end;
end;
finally
jpg.free;
JPStream.Free;
end;
end;
function TfrmPictureUpload.SaveImage(): Boolean;
var
myStream: TADOBlobStream;
maxNo: string;
fNewFileName: string;
begin
//取文件后缀 ExtractFileExt(FilePath)
if FPictureName = '' then
begin
fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
FPictureName := fNewFileName;
end;
if FDataId = '' then
FDataId := FPictureName;
result := false;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if RecordCount <= 0 then
begin
Append;
if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
fieldByName('TFID').AsString := maxNo;
fieldByName('WBID').AsString := FDataId;
end
else
begin
edit;
end;
fieldByName('FileName').AsString := trim(FPictureName);
fieldByName('Filler').AsString := trim(dName);
fieldByName('TFType').AsString := trim(FTFType);
myStream := TADOBlobStream.Create(TBlobField(FieldByName('FilesOther')), bmWrite);
MyJpeg.Assign(Image2.Picture.Graphic);
MyJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
if FilePath <> '' then
begin
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(FPictureName));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit;
result := true;
except
myStream.Free;
end;
end;
procedure TfrmPictureUpload.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmPictureUpload.TBSaveClick(Sender: TObject);
begin
if SaveImage() then
begin
ModalResult := 1;
end
else
begin
application.MessageBox('数据保存失败!', '提示信息', 0)
end;
end;
procedure TfrmPictureUpload.ToolButton1Click(Sender: TObject);
var
Jpeg: TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
Image1.Top := 0;
Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FilePath := OpenPictureDialog1.FileName;
FileName := ExtractFileName(FilePath);
// Jpeg := TJPEGImage.Create;
// Rotate90(Image1.Picture.Graphic, Jpeg);
// Image1.Picture.Assign(Jpeg);
// Jpeg.Free;
CreThumb(FWidth, FHeight);
TBSave.Enabled := TRUE;
end;
end;
procedure TfrmPictureUpload.ToolButton2Click(Sender: TObject);
begin
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FPictureName)));
open;
if RecordCount > 0 then
begin
edit;
fieldByName('FileName').Value := null;
FieldByName('FilesOther').Value := null;
post;
Image1.Picture.Assign(nil);
Image2.Picture.Assign(nil);
end;
end;
except
end;
end;
procedure TfrmPictureUpload.ToolButton3Click(Sender: TObject);
var
MJPG: TJpegImage;
pathFile: string;
begin
if Image1.Picture.Graphic = nil then
exit;
MJPG := TJpegImage.Create;
try
SaveDialog1.FileName := FileName;
if SaveDialog1.Execute then
begin
if SaveDialog1.FileName <> '' then
begin
pathFile := trim(SaveDialog1.FileName);
if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
begin
pathFile := pathFile + '.JPG';
end;
MJPG.Assign(Image1.Picture.Graphic);
if fileexists(pathFile) then
begin
if application.MessageBox(pchar('文件[' + trim(pathFile) + ']已存在,是否要替换它?'), '提示信息', MB_YESNO + mb_iconinformation + MB_DEFBUTTON2) = idyes then
MJPG.SaveToFile(pathFile);
end
else
MJPG.SaveToFile(pathFile);
end;
end;
finally
MJPG.Free;
end;
end;
procedure TfrmPictureUpload.ToolButton4Click(Sender: TObject);
begin
ModalResult := 2;
end;
procedure TfrmPictureUpload.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
Image1.Picture.Assign(Image);
Cancel := TRUE;
CreThumb(150, 150);
TBSave.Enabled := TRUE;
end;
procedure TfrmPictureUpload.FormShow(Sender: TObject);
var
Ini: TIniFile;
begin
{ Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
SelectedSource := Ini.ReadInteger( 'SCANNER', 'Scanner', 0);
PicLeft := Ini.ReadInteger( 'SCANNER', 'Left', 0);
PicTop := Ini.ReadInteger( 'SCANNER', 'Top', 0);
PicWidth := Ini.ReadInteger( 'SCANNER', 'Width', 100);
PicHeight := Ini.ReadInteger( 'SCANNER', 'Height', 100);
finally
Ini.Free;
end; }
Initimage();
end;
procedure TfrmPictureUpload.CreThumb(Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
if Ratio > 0.75 then
begin
AHeight := Round(Width / Ratio);
AHeightOffset := (Height - AHeight) div 2;
AWidth := Width;
AWidthOffset := 0;
end
else
begin
AWidth := Round(Height * Ratio);
AWidthOffset := (Width - AWidth) div 2;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
Image2.Picture.Assign(Bitmap);
finally
Bitmap.Free;
end;
end;
procedure TfrmPictureUpload.FormCreate(Sender: TObject);
begin
MyJpeg := TJpegImage.Create;
TBSave.Enabled := false;
if FWidth = 0 then
FWidth := 197;
if FHeight = 0 then
FHeight := 110;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
// ADOQueryBaseCmd.Connection := ADOConnection1;
// ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmPictureUpload.FormDestroy(Sender: TObject);
begin
// MyJpeg1.Free;
MyJpeg.Free;
end;
procedure TfrmPictureUpload.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClickPos.x := X;
ClickPos.y := Y;
end;
procedure TfrmPictureUpload.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
NewPos: TPoint;
begin
{The left button was pressed}
if ssLeft in Shift then
begin
{Calculate new position}
NewPos.X := Image1.Left + X - ClickPos.x;
NewPos.Y := Image1.Top + Y - ClickPos.y;
if NewPos.x + Image1.Width < ScrollBox1.Width then
NewPos.x := ScrollBox1.Width - Image1.Width;
if NewPos.y + Image1.Height < ScrollBox1.Height then
NewPos.y := ScrollBox1.Height - Image1.Height;
if NewPos.X > 0 then
NewPos.X := 0;
if NewPos.Y > 0 then
NewPos.Y := 0;
Image1.Top := NewPos.Y;
Image1.Left := NewPos.X;
end {if ssLeft in Shift}
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,229 @@
unit U_PictureList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdFTP, Winapi.UrlMon, Winapi.ShellAPI;
type
TfrmPictureList = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
CoName: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
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;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column1: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ToolButton2: TToolButton;
IdFTP1: TIdFTP;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNameChange(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
private
procedure InitGrid();
{ Private declarations }
public
FWBID: string;
{ Public declarations }
end;
var
frmPictureList: TfrmPictureList;
implementation
uses
U_DataLink, U_RTFun, U_CompanySel;
{$R *.dfm}
procedure TfrmPictureList.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmPictureList.CoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmPictureList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmPictureList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select * from TP_File A');
sql.Add('where isnull(WBID,'''')<>'''' and WBID=' + quotedstr(Trim(FWBID)));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmPictureList.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('图片列表', TV1, '自定义数据');
end;
procedure TfrmPictureList.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmPictureList.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('图片列表', TV1, '自定义数据');
end;
procedure TfrmPictureList.ToolButton1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmPictureList.ToolButton2Click(Sender: TObject);
var
IdFTP1: TIdFTP;
FPath, FFName, fPdfFilePath, fPdfFilePath1: string;
FInt: integer;
begin
if CDS_1.IsEmpty then
Exit;
fPdfFilePath := ExtractFilePath(Application.ExeName) + '\Picture';
if not DirectoryExists(PChar(fPdfFilePath)) then
CreateDirectory(pchar(fPdfFilePath), nil);
fPdfFilePath := fPdfFilePath + '\' + FWBID;
if not DirectoryExists(pchar(fPdfFilePath)) then
CreateDirectory(pchar(fPdfFilePath), nil);
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select * from TP_File A');
sql.Add('where isnull(WBID,'''')<>'''' and WBID=' + quotedstr(Trim(FWBID)));
open;
end;
ADOQueryTemp.First;
while not ADOQueryTemp.Eof do
begin
if Trim(ADOQueryTemp.FieldByName('URL').AsString) <> '' then
begin
fPdfFilePath1 := fPdfFilePath + '\' + trim(Trim(ADOQueryTemp.FieldByName('FileName').AsString));
UrlDownloadToFile(nil, PChar(Trim(ADOQueryTemp.FieldByName('URL').AsString)), PChar(fPdfFilePath1), 0, nil);
end;
ADOQueryTemp.Next;
end;
ShellExecute(Handle, 'open', PChar(fPdfFilePath + '\' + trim(CDS_1.FieldByName('FileName').AsString)), '', '', SW_SHOWNORMAL);
end;
procedure TfrmPictureList.Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
begin
ToolButton2.Click;
end;
procedure TfrmPictureList.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmPictureList.FormDestroy(Sender: TObject);
begin
inherited;
frmPictureList := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,531 @@
unit U_PictureUpload;
interface
uses
Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Buttons,
StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, IdExplicitTLSClientServerBase, System.ImageList,
Vcl.ImgList;
type
TfrmPictureUpload = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
SpeedButton3: TSpeedButton;
ADOQuery1: TADOQuery;
SaveDialog1: TSavePictureDialog;
adoqueryImage: TADOQuery;
IdFTP1: TIdFTP;
ToolBar1: TToolBar;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ImageList1: TImageList;
ADOConnection1: TADOConnection;
ADOCmd: TADOQuery;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Initimage();
procedure TBCloseClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
private
hWndC: THandle;
CapturingAVI: bool;
ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
FilePath, FileName: string;
MyJpeg: TJPEGImage;
procedure CreThumb(Width, Height: Integer);
function SaveImage(): Boolean;
procedure Rotate90(Source: TGraphic; Target: TJpegImage);
public
FTFType, fFlileFlag: string;
FWidth, FHeight: Integer;
FPictureName, FDataId: string;
{ Public declarations }
end;
var
frmPictureUpload: TfrmPictureUpload;
implementation
uses
U_DataLink, U_RTFun;
const
WM_CAP_START = WM_USER;
const
WM_CAP_STOP = WM_CAP_START + 68;
const
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const
WM_CAP_SAVEDIB = WM_CAP_START + 25;
const
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const
WM_CAP_SEQUENCE = WM_CAP_START + 62;
const
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const
WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
const
WM_CAP_SET_OVERLAY = WM_CAP_START + 51;
const
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
const
WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;
const
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
const
WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
const
WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
const
WM_CAP_SET_SCALE = WM_CAP_START + 53;
const
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';
{$R *.dfm}
procedure TfrmPictureUpload.Rotate90(Source: TGraphic; Target: TJpegImage);
var
SourceBmp, TargetBmp: TBitmap;
r, c: Integer;
x, y: Integer;
begin
SourceBmp := TBitmap.Create;
SourceBmp.Assign(Source);
TargetBmp := TBitmap.Create;
TargetBmp.Width := SourceBmp.Height;
TargetBmp.Height := SourceBmp.Width;
for r := 0 to SourceBmp.Height - 1 do
begin
for c := 0 to SourceBmp.Width - 1 do
begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
x := r; //90
y := (SourceBmp.Width - 1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
end;
end;
Target.Assign(TargetBmp);
SourceBmp.Free;
TargetBmp.Free;
end;
procedure TfrmPictureUpload.Initimage();
var
jpg: TJpegImage;
myStream: TADOBlobStream;
sFieldName: string;
JPStream: TMemoryStream;
begin
jpg := TJpegImage.Create();
JPStream := TMemoryStream.Create;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if not IsEmpty then
begin
if not fieldbyname('FilesOther').IsNull then
begin
myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname('FilesOther')), bmread);
jpg.LoadFromStream(myStream);
Image2.Picture.Assign(jpg);
myStream.Free;
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
JPStream.Clear;
if IdFTP1.Connected then
begin
try
IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname('FileName').AsString), JPStream);
except
Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
if IdFTP1.Connected then
IdFTP1.Quit;
JPStream.Position := 0;
jpg.LoadFromStream(JPStream);
Image1.Picture.Assign(jpg);
end;
end;
end;
finally
jpg.free;
JPStream.Free;
end;
end;
function TfrmPictureUpload.SaveImage(): Boolean;
var
myStream: TADOBlobStream;
maxNo: string;
fNewFileName: string;
begin
//取文件后缀 ExtractFileExt(FilePath)
if FPictureName = '' then
begin
fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
FPictureName := fNewFileName;
end;
if FDataId = '' then
FDataId := FPictureName;
result := false;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if RecordCount <= 0 then
begin
Append;
if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
fieldByName('TFID').AsString := maxNo;
fieldByName('WBID').AsString := FDataId;
end
else
begin
edit;
end;
fieldByName('FileName').AsString := trim(FPictureName);
fieldByName('Filler').AsString := trim(dName);
fieldByName('TFType').AsString := trim(FTFType);
myStream := TADOBlobStream.Create(TBlobField(FieldByName('FilesOther')), bmWrite);
MyJpeg.Assign(Image2.Picture.Graphic);
MyJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
if FilePath <> '' then
begin
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(FPictureName));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit;
result := true;
except
myStream.Free;
end;
end;
procedure TfrmPictureUpload.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmPictureUpload.TBSaveClick(Sender: TObject);
begin
if SaveImage() then
begin
ModalResult := 1;
end
else
begin
application.MessageBox('数据保存失败!', '提示信息', 0)
end;
end;
procedure TfrmPictureUpload.ToolButton1Click(Sender: TObject);
var
Jpeg: TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
Image1.Top := 0;
Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FilePath := OpenPictureDialog1.FileName;
FileName := ExtractFileName(FilePath);
// Jpeg := TJPEGImage.Create;
// Rotate90(Image1.Picture.Graphic, Jpeg);
// Image1.Picture.Assign(Jpeg);
// Jpeg.Free;
CreThumb(FWidth, FHeight);
TBSave.Enabled := TRUE;
end;
end;
procedure TfrmPictureUpload.ToolButton2Click(Sender: TObject);
begin
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FPictureName)));
open;
if RecordCount > 0 then
begin
edit;
fieldByName('FileName').Value := null;
FieldByName('FilesOther').Value := null;
post;
Image1.Picture.Assign(nil);
Image2.Picture.Assign(nil);
end;
with ADOCmd do
begin
Close;
sql.Clear;
sql.Add('delete TP_File where WBID=''' + Trim(FPictureName) + '''');
ExecSQL;
end;
end;
except
end;
end;
procedure TfrmPictureUpload.ToolButton3Click(Sender: TObject);
var
MJPG: TJpegImage;
pathFile: string;
begin
if Image1.Picture.Graphic = nil then
exit;
MJPG := TJpegImage.Create;
try
SaveDialog1.FileName := FileName;
if SaveDialog1.Execute then
begin
if SaveDialog1.FileName <> '' then
begin
pathFile := trim(SaveDialog1.FileName);
if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
begin
pathFile := pathFile + '.JPG';
end;
MJPG.Assign(Image1.Picture.Graphic);
if fileexists(pathFile) then
begin
if application.MessageBox(pchar('文件[' + trim(pathFile) + ']已存在,是否要替换它?'), '提示信息', MB_YESNO + mb_iconinformation + MB_DEFBUTTON2) = idyes then
MJPG.SaveToFile(pathFile);
end
else
MJPG.SaveToFile(pathFile);
end;
end;
finally
MJPG.Free;
end;
end;
procedure TfrmPictureUpload.ToolButton4Click(Sender: TObject);
begin
ModalResult := 2;
end;
procedure TfrmPictureUpload.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
Image1.Picture.Assign(Image);
Cancel := TRUE;
CreThumb(150, 150);
TBSave.Enabled := TRUE;
end;
procedure TfrmPictureUpload.FormShow(Sender: TObject);
var
Ini: TIniFile;
begin
{ Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
SelectedSource := Ini.ReadInteger( 'SCANNER', 'Scanner', 0);
PicLeft := Ini.ReadInteger( 'SCANNER', 'Left', 0);
PicTop := Ini.ReadInteger( 'SCANNER', 'Top', 0);
PicWidth := Ini.ReadInteger( 'SCANNER', 'Width', 100);
PicHeight := Ini.ReadInteger( 'SCANNER', 'Height', 100);
finally
Ini.Free;
end; }
Initimage();
end;
procedure TfrmPictureUpload.CreThumb(Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
if Ratio > 0.75 then
begin
AHeight := Round(Width / Ratio);
AHeightOffset := (Height - AHeight) div 2;
AWidth := Width;
AWidthOffset := 0;
end
else
begin
AWidth := Round(Height * Ratio);
AWidthOffset := (Width - AWidth) div 2;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
Image2.Picture.Assign(Bitmap);
finally
Bitmap.Free;
end;
end;
procedure TfrmPictureUpload.FormCreate(Sender: TObject);
begin
MyJpeg := TJpegImage.Create;
TBSave.Enabled := false;
if FWidth = 0 then
FWidth := 197;
if FHeight = 0 then
FHeight := 110;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
// ADOQueryBaseCmd.Connection := ADOConnection1;
// ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmPictureUpload.FormDestroy(Sender: TObject);
begin
// MyJpeg1.Free;
MyJpeg.Free;
end;
procedure TfrmPictureUpload.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClickPos.x := X;
ClickPos.y := Y;
end;
procedure TfrmPictureUpload.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
NewPos: TPoint;
begin
{The left button was pressed}
if ssLeft in Shift then
begin
{Calculate new position}
NewPos.X := Image1.Left + X - ClickPos.x;
NewPos.Y := Image1.Top + Y - ClickPos.y;
if NewPos.x + Image1.Width < ScrollBox1.Width then
NewPos.x := ScrollBox1.Width - Image1.Width;
if NewPos.y + Image1.Height < ScrollBox1.Height then
NewPos.y := ScrollBox1.Height - Image1.Height;
if NewPos.X > 0 then
NewPos.X := 0;
if NewPos.Y > 0 then
NewPos.Y := 0;
Image1.Top := NewPos.Y;
Image1.Left := NewPos.X;
end {if ssLeft in Shift}
end;
end.

View File

@ -0,0 +1,986 @@
inherited frmPositionSel: TfrmPositionSel
Left = 342
Top = 13
Caption = #25968#25454#36873#25321
ClientHeight = 668
ClientWidth = 731
Font.Charset = GB2312_CHARSET
Font.Height = -12
Font.Name = #23435#20307
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 747
ExplicitHeight = 707
PixelsPerInch = 96
TextHeight = 12
object ScrollBox1: TScrollBox [0]
Left = 0
Top = 0
Width = 731
Height = 668
Align = alClient
TabOrder = 0
object btn1: TSpeedButton
Left = 23
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
OnClick = btn1Click
end
object btn2: TSpeedButton
Left = 111
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn3: TSpeedButton
Left = 199
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn4: TSpeedButton
Left = 287
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn5: TSpeedButton
Left = 375
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn6: TSpeedButton
Left = 463
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn7: TSpeedButton
Left = 551
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn8: TSpeedButton
Left = 639
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn58: TSpeedButton
Left = 23
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn9: TSpeedButton
Left = 111
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn10: TSpeedButton
Left = 199
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn11: TSpeedButton
Left = 287
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn12: TSpeedButton
Left = 375
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn13: TSpeedButton
Left = 463
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn14: TSpeedButton
Left = 551
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn15: TSpeedButton
Left = 639
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn59: TSpeedButton
Left = 23
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn16: TSpeedButton
Left = 111
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn17: TSpeedButton
Left = 199
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn18: TSpeedButton
Left = 287
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn19: TSpeedButton
Left = 375
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn20: TSpeedButton
Left = 463
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn21: TSpeedButton
Left = 551
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn22: TSpeedButton
Left = 639
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn60: TSpeedButton
Left = 23
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn23: TSpeedButton
Left = 111
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn24: TSpeedButton
Left = 199
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn25: TSpeedButton
Left = 287
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn26: TSpeedButton
Left = 375
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn27: TSpeedButton
Left = 463
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn28: TSpeedButton
Left = 551
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn29: TSpeedButton
Left = 639
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn61: TSpeedButton
Left = 23
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn30: TSpeedButton
Left = 111
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn31: TSpeedButton
Left = 199
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn32: TSpeedButton
Left = 287
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn33: TSpeedButton
Left = 375
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn34: TSpeedButton
Left = 463
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn35: TSpeedButton
Left = 551
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn36: TSpeedButton
Left = 639
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn62: TSpeedButton
Left = 23
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn37: TSpeedButton
Left = 111
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn38: TSpeedButton
Left = 199
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn39: TSpeedButton
Left = 287
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn40: TSpeedButton
Left = 375
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn41: TSpeedButton
Left = 463
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn42: TSpeedButton
Left = 551
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn43: TSpeedButton
Left = 639
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn63: TSpeedButton
Left = 23
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn44: TSpeedButton
Left = 111
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn45: TSpeedButton
Left = 199
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn46: TSpeedButton
Left = 287
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn47: TSpeedButton
Left = 375
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn48: TSpeedButton
Left = 463
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn49: TSpeedButton
Left = 551
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn50: TSpeedButton
Left = 639
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn64: TSpeedButton
Left = 23
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn51: TSpeedButton
Left = 111
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn52: TSpeedButton
Left = 199
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn53: TSpeedButton
Left = 287
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn54: TSpeedButton
Left = 375
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn55: TSpeedButton
Left = 463
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn56: TSpeedButton
Left = 551
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn57: TSpeedButton
Left = 639
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object Label1: TLabel
Left = 352
Top = 626
Width = 33
Height = 19
Caption = '1/1'
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 199
Top = 623
Width = 75
Height = 25
Caption = #19978#19968#39029
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 445
Top = 623
Width = 75
Height = 25
Caption = #19979#19968#39029
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = Button2Click
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = ADOConnection1
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = ADOConnection1
end
object ADOTmp: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 120
Top = 176
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 296
Top = 192
end
object CDS_All: TClientDataSet
Aggregates = <>
Params = <>
Left = 296
Top = 272
end
end

View File

@ -0,0 +1,237 @@
unit U_PositionSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, DB, ADODB, U_BaseHelp, System.ImageList, Vcl.ImgList,
Datasnap.DBClient, Vcl.StdCtrls, math;
type
TfrmPositionSel = class(TfrmBaseHelp)
ScrollBox1: TScrollBox;
btn1: TSpeedButton;
btn2: TSpeedButton;
btn3: TSpeedButton;
btn4: TSpeedButton;
btn5: TSpeedButton;
btn6: TSpeedButton;
btn7: TSpeedButton;
btn8: TSpeedButton;
btn58: TSpeedButton;
btn9: TSpeedButton;
btn10: TSpeedButton;
btn11: TSpeedButton;
btn12: TSpeedButton;
btn13: TSpeedButton;
btn14: TSpeedButton;
btn15: TSpeedButton;
btn59: TSpeedButton;
btn16: TSpeedButton;
btn17: TSpeedButton;
btn18: TSpeedButton;
btn19: TSpeedButton;
btn20: TSpeedButton;
btn21: TSpeedButton;
btn22: TSpeedButton;
btn60: TSpeedButton;
btn23: TSpeedButton;
btn24: TSpeedButton;
btn25: TSpeedButton;
btn26: TSpeedButton;
btn27: TSpeedButton;
btn28: TSpeedButton;
btn29: TSpeedButton;
btn61: TSpeedButton;
btn30: TSpeedButton;
btn31: TSpeedButton;
btn32: TSpeedButton;
btn33: TSpeedButton;
btn34: TSpeedButton;
btn35: TSpeedButton;
btn36: TSpeedButton;
btn62: TSpeedButton;
btn37: TSpeedButton;
btn38: TSpeedButton;
btn39: TSpeedButton;
btn40: TSpeedButton;
btn41: TSpeedButton;
btn42: TSpeedButton;
btn43: TSpeedButton;
btn63: TSpeedButton;
btn44: TSpeedButton;
btn45: TSpeedButton;
btn46: TSpeedButton;
btn47: TSpeedButton;
btn48: TSpeedButton;
btn49: TSpeedButton;
btn50: TSpeedButton;
btn64: TSpeedButton;
btn51: TSpeedButton;
btn52: TSpeedButton;
btn53: TSpeedButton;
btn54: TSpeedButton;
btn55: TSpeedButton;
btn56: TSpeedButton;
btn57: TSpeedButton;
ADOTmp: TADOQuery;
ADOConnection1: TADOConnection;
CDS_All: TClientDataSet;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FPOSNO: string;
FPage: Integer;
{ Public declarations }
end;
var
frmPositionSel: TfrmPositionSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmPositionSel.FormDestroy(Sender: TObject);
begin
inherited;
frmPositionSel := nil;
end;
procedure TfrmPositionSel.InitGrid();
var
i: Integer;
str: string;
begin
with ADOTmp do
begin
Close;
sql.Clear;
sql.Add('select POSNO,POSName ');
sql.Add(',ROW_NUMBER() over(order by A.POSNO) as keyNo ');
sql.Add('from Bs_Position A ');
SQL.Add('order by POSNO,POSName ');
Open;
end;
if ADOTmp.IsEmpty then
begin
Application.MessageBox('没有定义数据!', '提示', 0);
Exit;
end;
SCreateCDS(ADOTmp, CDS_All);
SInitCDSData(ADOTmp, CDS_All);
if CDS_All.RecordCount < FPage * 64 then
begin
FPage := FPage - 1;
end;
if FPage <= 0 then
begin
FPage := 1;
end;
if CDS_All.RecordCount mod 64 > 0 then
Label1.Caption := IntToStr(FPage) + '/' + IntToStr(Floor(CDS_All.RecordCount / 64 + 1))
else
Label1.Caption := IntToStr(FPage) + '/' + IntToStr(Floor(CDS_All.RecordCount / 64));
for i := 0 to 63 do
begin
if CDS_All.Locate('keyNo', (FPage - 1) * 64 + i + 1, []) then
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[i]).Visible := True;
TSpeedButton(Controls[i]).Hint := CDS_All.fieldbyname('POSNO').AsString;
TSpeedButton(Controls[i]).Caption := CDS_All.fieldbyname('POSNO').AsString;
end;
end
else
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[i]).Visible := False;
TSpeedButton(Controls[i]).Hint := '';
TSpeedButton(Controls[i]).Caption := '';
end;
end;
end;
end;
procedure TfrmPositionSel.FormShow(Sender: TObject);
begin
inherited;
FPage := 1;
InitGrid();
end;
procedure TfrmPositionSel.btn1Click(Sender: TObject);
begin
FPOSNO := Trim(TSpeedButton(Sender).Hint);
ModalResult := 1;
end;
procedure TfrmPositionSel.Button1Click(Sender: TObject);
begin
FPage := FPage - 1;
InitGrid();
end;
procedure TfrmPositionSel.Button2Click(Sender: TObject);
begin
FPage := FPage + 1;
InitGrid();
end;
procedure TfrmPositionSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
// Action:=caHide;
end;
procedure TfrmPositionSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,178 @@
unit U_ProductInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxDropDownEdit;
type
TfrmProductInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
CoName: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
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;
cxGrid2: TcxGrid;
Tv1: TcxGridDBTableView;
Tv1Column2: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid2Level1: TcxGridLevel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNameChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName: string;
{ Public declarations }
end;
var
frmProductInfoSel: TfrmProductInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmProductInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmProductInfoSel.CoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmProductInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmProductInfoSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' from BS_Product_Info A');
sql.Add(' where isnull(STKNAME,'''')=''' + Trim(FSTKName) + '''');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmProductInfoSel.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid('物料类型' + Trim(FSTKName), TV1, '通用窗体');
InitGrid();
end;
procedure TfrmProductInfoSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmProductInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('物料类型' + Trim(FSTKName), TV1, '通用窗体');
end;
procedure TfrmProductInfoSel.ToolButton1Click(Sender: TObject);
begin
CoName.SetFocus;
ModalResult := 1;
end;
procedure TfrmProductInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmProductInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmProductInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,301 @@
unit U_ReportImgSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Preview, RM_Dataset, RM_Class, RM_GridReport, RM_e_Graphic, RM_e_Jpeg,
RM_BarCode, RM_Designer, RM_DsgGridReport;
type
TfrmReportImgSet = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADO_1: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
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;
RMPreview1: TRMPreview;
RMDB_Label: TRMDBDataSet;
ADOQueryLabel: TADOQuery;
RMJPEGExport1: TRMJPEGExport;
RMLabel: TRMGridReport;
RMBarCodeObject1: TRMBarCodeObject;
RMReport1: TRMReport;
RMGridReportDesigner1: TRMGridReportDesigner;
RMDesigner1: TRMDesigner;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
private
FFilePath, FFileName: string;
procedure DownloadLabel();
procedure InitLabel();
function SaveData(): Boolean;
{ Private declarations }
public
FDataID, FLabelName: string;
{ Public declarations }
end;
var
frmReportImgSet: TfrmReportImgSet;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
function TfrmReportImgSet.SaveData(): Boolean;
var
MaxId, FImagePath1, FImagePath2: string;
FJStream: TMemoryStream;
begin
with RMLabel do
begin
// LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('Files')));
FImagePath1 := ExtractFilePath(Application.ExeName) + 'image\label0001.jpg';
if FileExists(FImagePath1) then
DeleteFile(FImagePath1);
FImagePath2 := ExtractFilePath(Application.ExeName) + 'image\label.jpg';
PrepareReport;
ExportTo(RMjpegExport1, FImagePath2);
end;
try
FJStream := TMemoryStream.Create;
FJStream.LoadFromFile(FImagePath1);
ADOQueryCmd.Connection.BeginTrans;
if Trim(FDataID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'R', 'BS_Img_Label', 4, 1) = False then
begin
raise Exception.Create('取最大号失败!');
end;
end
else
begin
MaxId := Trim(FDataID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Img_Label where LabelId=''' + Trim(FDataID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FDataID) = '' then
begin
Append;
FieldByName('Filler').Value := Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('LabelId').Value := Trim(MaxId);
FieldByName('DataID').Value := Trim(FDataID);
tblobfield(FieldByName('LabelFile')).LoadFromFile(FFilePath);
tblobfield(FieldByName('ImgFile')).LoadFromStream(FJStream);
Post;
end;
ADOQueryCmd.Connection.CommitTrans;
FJStream.Free;
Result := True;
except
Result := false;
FJStream.Free;
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmReportImgSet.DownloadLabel();
var
ff: TADOBlobstream;
Stream: TMemoryStream;
begin
if FileExists(FFilePath) then
begin
DeleteFile(FFilePath);
end;
with ADOQueryLabel do
begin
close;
sql.Clear;
sql.Add(' select * from BS_Img_Label ');
sql.Add(' where DataId= ' + quotedstr(FDataId));
Open;
end;
if not ADOQueryLabel.IsEmpty then
begin
ff := TADOBlobstream.create(ADOQueryLabel.fieldByName('LabelFile') as TblobField, bmRead);
if ff <> nil then
begin
try
Stream := TMemoryStream.create;
ff.SaveToStream(Stream);
Stream.SaveToFile(FFilePath);
finally
Stream.Free;
end;
end;
end;
end;
procedure TfrmReportImgSet.InitLabel();
begin
with RMLabel do
begin
Clear;
LoadFromFile(FFilePath);
Preview := RMPreview1;
ShowReport;
end;
end;
procedure TfrmReportImgSet.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmReportImgSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
procedure TfrmReportImgSet.FormShow(Sender: TObject);
begin
inherited;
self.Caption := FLabelName;
with ADO_1 do
begin
close;
sql.Clear;
sql.Add(' select x=1');
Open;
end;
FFilePath := ExtractFilePath(Application.ExeName) + 'report\' + trim(FDataID) + '.rmf';
FFileName := trim(FDataID) + '.rmf';
if not FileExists(FFilePath) then
begin
ExportFtErpFile(FLabelName + '.rmf', ADOQueryTemp);
CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\' + FLabelName + '.rmf'), PChar(FFilePath), False);
end;
DownloadLabel();
Initlabel();
end;
procedure TfrmReportImgSet.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmReportImgSet.TBSaveClick(Sender: TObject);
begin
if SaveData() then
begin
ModalResult := 1;
end
else
begin
Application.MessageBox('保存数据失败!', '提示', 0);
Exit;
end;
end;
procedure TfrmReportImgSet.ToolButton1Click(Sender: TObject);
begin
// with RMLabel do
// begin
// Clear;
// RMDB_Label.DataSet := nil;
// Dictionary.FieldAliases.Clear;
// Dictionary.FieldAliases['RMDB_Label'] := '标签数据';
// RMDB_Label.DataSet := ADO_1;
// LoadFromFile(FFilePath);
// application.ProcessMessages;
// RMLabel.DesignReport();
// end;
RMLabel.DesignReport();
InitLabel();
end;
procedure TfrmReportImgSet.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmReportImgSet.FormDestroy(Sender: TObject);
begin
inherited;
frmReportImgSet := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,305 @@
unit U_ReportImgSet1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Preview, RM_Dataset, RM_Class, RM_GridReport, RM_e_Graphic, RM_e_Jpeg;
type
TfrmReportImgSet1 = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADO_1: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
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;
RMPreview1: TRMPreview;
RMLabel: TRMGridReport;
RMDB_Label: TRMDBDataSet;
ADOQueryLabel: TADOQuery;
RMJPEGExport1: TRMJPEGExport;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
private
FFilePath, FFileName: string;
procedure DownloadLabel();
procedure InitLabel();
function SaveData(): Boolean;
{ Private declarations }
public
FDataID, FLabelName: string;
{ Public declarations }
end;
var
frmReportImgSet1: TfrmReportImgSet1;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
function TfrmReportImgSet1.SaveData(): Boolean;
var
MaxId, FImagePath1, FImagePath2: string;
FJStream: TMemoryStream;
begin
with RMLabel do
begin
// LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('Files')));
FImagePath1 := ExtractFilePath(Application.ExeName) + 'image\label0001.jpg';
if FileExists(FImagePath1) then
DeleteFile(FImagePath1);
FImagePath2 := ExtractFilePath(Application.ExeName) + 'image\label.jpg';
PrepareReport;
ExportTo(RMjpegExport1, FImagePath2);
end;
try
FJStream := TMemoryStream.Create;
FJStream.LoadFromFile(FImagePath1);
ADOQueryCmd.Connection.BeginTrans;
if Trim(FDataID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'R', 'BS_Img_Label', 4, 1) = False then
begin
raise Exception.Create('取最大号失败!');
end;
end
else
begin
MaxId := Trim(FDataID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Img_Label where LabelId=''' + Trim(FDataID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FDataID) = '' then
begin
Append;
FieldByName('Filler').Value := Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('LabelId').Value := Trim(MaxId);
FieldByName('DataID').Value := Trim(FDataID);
tblobfield(FieldByName('LabelFile')).LoadFromFile(FFilePath);
tblobfield(FieldByName('ImgFile')).LoadFromStream(FJStream);
Post;
end;
ADOQueryCmd.Connection.CommitTrans;
FJStream.Free;
Result := True;
except
Result := false;
FJStream.Free;
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmReportImgSet1.DownloadLabel();
var
ff: TADOBlobstream;
Stream: TMemoryStream;
begin
if FileExists(FFilePath) then
begin
DeleteFile(FFilePath);
end;
with ADOQueryLabel do
begin
close;
sql.Clear;
sql.Add(' select * from BS_Img_Label ');
sql.Add(' where DataId= ' + quotedstr(FDataId));
Open;
end;
if not ADOQueryLabel.IsEmpty then
begin
ff := TADOBlobstream.create(ADOQueryLabel.fieldByName('LabelFile') as TblobField, bmRead);
if ff <> nil then
begin
try
Stream := TMemoryStream.create;
ff.SaveToStream(Stream);
Stream.SaveToFile(FFilePath);
finally
Stream.Free;
end;
end;
end;
end;
procedure TfrmReportImgSet1.InitLabel();
begin
with RMLabel do
begin
Clear;
LoadFromFile(FFilePath);
Preview := RMPreview1;
ShowReport;
end;
end;
procedure TfrmReportImgSet1.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmReportImgSet1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
procedure TfrmReportImgSet1.FormShow(Sender: TObject);
begin
inherited;
self.Caption := FLabelName;
with ADO_1 do
begin
close;
sql.Clear;
sql.Add(' select x=1');
Open;
end;
FFilePath := ExtractFilePath(Application.ExeName) + 'report\' + trim(FDataID) + '.rmf';
FFileName := trim(FDataID) + '.rmf';
if not FileExists(FFilePath) then
begin
ExportFtErpFile(FLabelName + '.rmf', ADOQueryTemp);
CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\' + FLabelName + '.rmf'), PChar(FFilePath), False);
end;
DownloadLabel();
Initlabel();
end;
procedure TfrmReportImgSet1.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmReportImgSet1.TBSaveClick(Sender: TObject);
begin
if SaveData() then
begin
ModalResult := 1;
end
else
begin
Application.MessageBox('保存数据失败!', '提示', 0);
Exit;
end;
end;
procedure TfrmReportImgSet1.ToolButton1Click(Sender: TObject);
begin
//
// MLabelID := TRIM(CDS_Label.fieldByName('LabelID').asString);
// MLabelCaption := TRIM(CDS_Label.fieldByName('LabelCaption').asString);
// ExportFtErpFile(MLabelCaption + '.rmf', ADOQueryTemp);
// fPrintFile := ExtractFilePath(Application.ExeName) + 'report\' + MLabelCaption + '.rmf';
//
// if not FileExists(fPrintFile) then
// CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\模板标签.rmf'), PChar(fPrintFile), False);
with RMLabel do
begin
RMLabel.Clear;
RMDB_Label.DataSet := nil;
Dictionary.FieldAliases.Clear;
Dictionary.FieldAliases['RMDB_Label'] := '标签数据';
// RMDB_Label.DataSet := ADO_1;
LoadFromFile(FFilePath);
application.ProcessMessages;
DesignReport();
end;
InitLabel();
end;
procedure TfrmReportImgSet1.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmReportImgSet1.FormDestroy(Sender: TObject);
begin
inherited;
frmReportImgSet1 := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,216 @@
unit U_SalesContractSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxDropDownEdit, cxCheckBox, Vcl.Menus;
type
TfrmSalesContractSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
ConNo: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
cxGrid1: TcxGrid;
TV1: TcxGridDBTableView;
VC_SCSCode: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
v1PRTOrderQty: TcxGridDBColumn;
v1OrderUnit: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
TV1Column1: TcxGridDBColumn;
TV1Column2: TcxGridDBColumn;
TV1Column3: TcxGridDBColumn;
TV1Column4: TcxGridDBColumn;
TV1Column5: TcxGridDBColumn;
TV1Column6: TcxGridDBColumn;
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;
TV1Column7: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Label2: TLabel;
C_Name: TEdit;
Label3: TLabel;
BuyName: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ConNoChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmSalesContractSel: TfrmSalesContractSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmSalesContractSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmSalesContractSel.ConNoChange(Sender: TObject);
begin
if ADOQueryMain.Active = False then
Exit;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
procedure TfrmSalesContractSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ConNo.SetFocus;
Action := cahide;
end;
procedure TfrmSalesContractSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* from BS_Contract_Main A inner join BS_Contract_Sub B on A.ConMId=B.ConMId ');
sql.Add(' and isnull(A.status,''0'')=''9''');
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmSalesContractSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, True);
end;
procedure TfrmSalesContractSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmSalesContractSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(Trim(self.Caption), TV1, '自定义数据');
end;
procedure TfrmSalesContractSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmSalesContractSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(Trim(self.Caption), TV1, '自定义数据');
end;
procedure TfrmSalesContractSel.ToolButton1Click(Sender: TObject);
begin
ConNo.SetFocus;
ModalResult := 1;
end;
procedure TfrmSalesContractSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmSalesContractSel.FormDestroy(Sender: TObject);
begin
inherited;
frmSalesContractSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,304 @@
unit U_TatClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math;
type
TfrmTatClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TEdit;
C_Name: TEdit;
C_GramWeight: TEdit;
C_Width: TEdit;
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;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
private
CurrentPage, RecordsNumber: Integer;
procedure InitGrid();
procedure InitTree();
{ Private declarations }
public
FCoType: string;
{ Public declarations }
end;
var
frmTatClothInfoSel: TfrmTatClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmTatClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type where CTType=''梭织'' ');
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmTatClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
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; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmTatClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.cxDBTreeList1DblClick(Sender: TObject);
begin
CurrentPage := 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmTatClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmTatClothInfoSel.InitGrid();
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmTatClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
RecordsNumber := 500;
CurrentPage := 1;
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
InitTree();
InitGrid();
end;
procedure TfrmTatClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
;
end;
procedure TfrmTatClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmTatClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid();
end;
procedure TfrmTatClothInfoSel.ToolButton1Click(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmTatClothInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmTatClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmTatClothInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,236 @@
unit U_UserSel;
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, cxDBLookupComboBox, ComObj, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, dxDateRanges, U_BaseHelp,
dxBarBuiltInMenu, System.ImageList, Vcl.ImgList,
dxScrollbarAnnotations, cxImageList, cxContainer;
type
FdDy = record
inc: integer; //客户端套接字句柄
FDdys: string[32]; //客户端套接字
FdDysName: string[32]; //客户端套接字
end;
TfrmUserSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
Label3: TLabel;
UserName: TcxTextEdit;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
Label1: TLabel;
UserID: TcxTextEdit;
btnOK: TToolButton;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
VC_SSel: TcxGridDBColumn;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
cxImageList_bar: TcxImageList;
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 btnOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
procedure UserIDPropertiesChange(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
procedure CheckGrid();
public
Fdept: string;
FMultiple: Boolean;
FRTUserID, FRTUserName: string;
end;
var
frmUserSel: TfrmUserSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmUserSel.CheckGrid();
var
fsj, fsj1: string;
FStrs: TStringList;
i: integer;
begin
if Trim(FRTUserID) <> '' then
begin
FStrs := TStringList.Create();
ExtractStrings([','], [' '], PChar(FRTUserID), FStrs);
with CDS_1 do
begin
First;
while not eof do
begin
if FStrs.IndexOf(Trim(FieldByName('UserID').AsString)) >= 0 then
begin
Edit;
FieldByName('SSel').Value := true;
Post;
end;
Next;
end;
end;
FStrs.Free;
end;
end;
procedure TfrmUserSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from SY_User where 1=1 ');
if Trim(Fdept) <> '' then
begin
sql.Add('and Udept=' + QuotedStr(Trim(Fdept)));
end;
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
CheckGrid();
end;
procedure TfrmUserSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmUserSel.FormDestroy(Sender: TObject);
begin
inherited;
frmUserSel := nil;
end;
procedure TfrmUserSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmUserSel.TBCloseClick(Sender: TObject);
begin
WriteCxGrid(trim(self.caption), Tv1, '账户选择');
Close;
end;
procedure TfrmUserSel.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(trim(self.Caption), Tv1, '账户选择');
if FMultiple then
begin
VC_SSel.Visible := True;
VC_SSel.Hidden := False;
end
else
begin
VC_SSel.Visible := False;
VC_SSel.Hidden := True;
end;
InitGrid();
end;
procedure TfrmUserSel.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmUserSel.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmUserSel.Tv1DblClick(Sender: TObject);
begin
btnOK.Click;
end;
procedure TfrmUserSel.UserIDPropertiesChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmUserSel.btnOKClick(Sender: TObject);
var
RTValues: TArray<string>;
begin
if FMultiple then
begin
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
end;
RTValues := SelCDSKey(CDS_1, ['UserID', 'UserName']);
FRTUserID := RTValues[0];
FRTUserName := RTValues[1];
ModalResult := 1;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,223 @@
unit U_WBSpecSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus,
dxScrollbarAnnotations, cxImageList;
type
TfrmWBSpecSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
WB_Code: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
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;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
Tv1Column1: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
Tv1Column10: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
Tv1Column12: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column17: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
cxImageList_bar: TcxImageList;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure WB_CodeChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority, FYType: string;
{ Public declarations }
end;
var
frmWBSpecSel: TfrmWBSpecSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmWBSpecSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmWBSpecSel.WB_CodeChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmWBSpecSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
WB_Code.SetFocus;
Action := cahide;
end;
procedure TfrmWBSpecSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' from Tat_WB_Spec A');
// if Trim(FYType) <> '' then
// sql.Add(' where Y_Type=' + QuotedStr(FYType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmWBSpecSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmWBSpecSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmWBSpecSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmWBSpecSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmWBSpecSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmWBSpecSel.ToolButton1Click(Sender: TObject);
begin
WB_Code.SetFocus;
ModalResult := 1;
end;
procedure TfrmWBSpecSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmWBSpecSel.FormDestroy(Sender: TObject);
begin
inherited;
frmWBSpecSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,218 @@
unit U_YarnInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus,
dxScrollbarAnnotations, cxContainer, cxImageList;
type
TfrmYarnInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
Y_Name: TcxTextEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column2: TcxGridDBColumn;
v1Column18: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
v1SPName: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1QtyUnit: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
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;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
cxImageList_bar: TcxImageList;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure Y_NamePropertiesEditValueChanged(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority, FYType: string;
{ Public declarations }
end;
var
frmYarnInfoSel: TfrmYarnInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmYarnInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmYarnInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Y_Name.SetFocus;
Action := cahide;
end;
procedure TfrmYarnInfoSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' from BS_Yarn_Info A');
if Trim(FYType) <> '' then
sql.Add(' where Y_Type=' + QuotedStr(FYType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmYarnInfoSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmYarnInfoSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmYarnInfoSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmYarnInfoSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmYarnInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmYarnInfoSel.ToolButton1Click(Sender: TObject);
begin
Y_Name.SetFocus;
ModalResult := 1;
end;
procedure TfrmYarnInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmYarnInfoSel.Y_NamePropertiesEditValueChanged(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmYarnInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmYarnInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,249 @@
unit U_YarnPurchasePlanSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus, cxCalendar, cxPC, dxScrollbarAnnotations;
type
TfrmYarnPurchasePlanSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
Y_Spec: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SPName: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1QtyUnit: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
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;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Tv1Column4: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
Label2: TLabel;
Y_Name: TEdit;
Label3: TLabel;
SellName: TEdit;
Label4: TLabel;
PurNo: TEdit;
Label5: TLabel;
BegDate: TDateTimePicker;
EndDate: TDateTimePicker;
IsJYTime: TCheckBox;
Tv1Column10: TcxGridDBColumn;
cxTabControl1: TcxTabControl;
ToolButton2: TToolButton;
Tv1Column11: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure Y_SpecChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority: string;
{ Public declarations }
end;
var
frmYarnPurchasePlanSel: TfrmYarnPurchasePlanSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmYarnPurchasePlanSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
EndDate.DateTime := SGetServerDate(ADOQueryTemp);
BegDate.DateTime := EndDate.DateTime - 90;
end;
procedure TfrmYarnPurchasePlanSel.Y_SpecChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmYarnPurchasePlanSel.cxTabControl1Change(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmYarnPurchasePlanSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Y_Name.SetFocus;
Action := cahide;
end;
procedure TfrmYarnPurchasePlanSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.*,B.* ');
sql.Add(' from Pur_YarnPlan_Main A');
sql.Add(' inner join Pur_YarnPlan_sub B on A.PurMId=B.PurMId');
sql.Add(' where isnull(A.status,''0'')=''9''');
sql.add(' and A.PurDate>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.DateTime)) + '''');
sql.Add(' and A.PurDate<''' + Trim(FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1)) + '''');
case cxTabControl1.TabIndex of
0:
begin
sql.Add(' and not EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
1:
begin
sql.Add(' and EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
end;
// ShowMessage(sql.Text);
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmYarnPurchasePlanSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmYarnPurchasePlanSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmYarnPurchasePlanSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmYarnPurchasePlanSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmYarnPurchasePlanSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmYarnPurchasePlanSel.ToolButton1Click(Sender: TObject);
begin
Y_Name.SetFocus;
ModalResult := 1;
end;
procedure TfrmYarnPurchasePlanSel.ToolButton2Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmYarnPurchasePlanSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmYarnPurchasePlanSel.FormDestroy(Sender: TObject);
begin
inherited;
frmYarnPurchasePlanSel := nil;
end;
end.

144
A00通用窗体/getpic.dfm Normal file
View File

@ -0,0 +1,144 @@
object FormGetPic: TFormGetPic
Left = 697
Top = 183
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #33719#21462#22270#29255
ClientHeight = 449
ClientWidth = 670
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Image2: TImage
Left = 464
Top = 8
Width = 160
Height = 120
end
object SpeedButton1: TSpeedButton
Left = 500
Top = 334
Width = 80
Height = 22
Caption = #25171#24320#22270#29255'...'
OnClick = SpeedButton1Click
end
object SpeedButton2: TSpeedButton
Left = 500
Top = 380
Width = 80
Height = 22
Caption = #30830#23450
Enabled = False
OnClick = SpeedButton2Click
end
object SpeedButton3: TSpeedButton
Left = 500
Top = 426
Width = 80
Height = 22
Caption = #25918#24323
OnClick = SpeedButton3Click
end
object SpeedButton4: TSpeedButton
Left = 500
Top = 358
Width = 80
Height = 22
Caption = #22270#29255#21478#23384'...'
OnClick = SpeedButton4Click
end
object SpeedButton5: TSpeedButton
Left = 500
Top = 404
Width = 80
Height = 22
Caption = #21024#38500
OnClick = SpeedButton5Click
end
object ScrollBox1: TScrollBox
Left = 5
Top = 5
Width = 300
Height = 400
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
TabOrder = 0
object Image1: TImage
Left = 0
Top = 0
Width = 296
Height = 396
Cursor = crSizeAll
Align = alClient
Center = True
IncrementalDisplay = True
Stretch = True
OnMouseDown = Image1MouseDown
OnMouseMove = Image1MouseMove
ExplicitLeft = -2
ExplicitTop = 3
ExplicitWidth = 275
ExplicitHeight = 436
end
end
object Button1: TButton
Left = 464
Top = 252
Width = 81
Height = 21
Caption = #25171#24320#25668#20687#22836
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 560
Top = 252
Width = 81
Height = 21
Caption = #25235#22270
TabOrder = 2
OnClick = Button2Click
end
object OpenPictureDialog1: TOpenPictureDialog
Left = 336
Top = 176
end
object ADOQuery1: TADOQuery
Connection = DataLink_YPGL.ADOLink
Parameters = <>
Left = 504
Top = 280
end
object SaveDialog1: TSavePictureDialog
Left = 344
Top = 251
end
object adoqueryImage: TADOQuery
Connection = DataLink_YPGL.ADOLink
Parameters = <>
Left = 488
Top = 184
end
object IdFTP1: TIdFTP
ConnectTimeout = 0
NATKeepAlive.UseKeepAlive = False
NATKeepAlive.IdleTimeMS = 0
NATKeepAlive.IntervalMS = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
ReadTimeout = 0
Left = 492
Top = 134
end
end

669
A00通用窗体/getpic.pas Normal file
View File

@ -0,0 +1,669 @@
unit getpic;
interface
uses
Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Buttons,
StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, IdExplicitTLSClientServerBase;
type
TFormGetPic = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
Button1: TButton;
Button2: TButton;
ADOQuery1: TADOQuery;
SpeedButton4: TSpeedButton;
SaveDialog1: TSavePictureDialog;
adoqueryImage: TADOQuery;
IdFTP1: TIdFTP;
SpeedButton5: TSpeedButton;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure Initimage();
procedure SpeedButton5Click(Sender: TObject);
private
hWndC: THandle;
CapturingAVI: bool;
{ Private declarations }
ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
procedure CreThumb(Width, Height: Integer);
function SaveImage(): Boolean;
procedure Rotate90(Source: TGraphic; Target: TJpegImage);
public
FilePath: string;
FileName: string;
FTFType: string;
pat1: string;
pic1: string;
fkeyNo, FMainId: string;
fFlileFlag: string;
FWidth, FHeight: INTEGER;
{ Public declarations }
MyJpeg: TJPEGImage;
// JPStream: TMemoryStream;
end;
var
FormGetPic: TFormGetPic;
implementation
uses
U_DataLink, U_RTFun;
const
WM_CAP_START = WM_USER;
const
WM_CAP_STOP = WM_CAP_START + 68;
const
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const
WM_CAP_SAVEDIB = WM_CAP_START + 25;
const
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const
WM_CAP_SEQUENCE = WM_CAP_START + 62;
const
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const
WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
const
WM_CAP_SET_OVERLAY = WM_CAP_START + 51;
const
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
const
WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;
const
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
const
WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
const
WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
const
WM_CAP_SET_SCALE = WM_CAP_START + 53;
const
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';
{$R *.dfm}
procedure TFormGetPic.Rotate90(Source: TGraphic; Target: TJpegImage);
var
SourceBmp, TargetBmp: TBitmap;
r, c: Integer;
x, y: Integer;
begin
SourceBmp := TBitmap.Create;
SourceBmp.Assign(Source);
TargetBmp := TBitmap.Create;
TargetBmp.Width := SourceBmp.Height;
TargetBmp.Height := SourceBmp.Width;
for r := 0 to SourceBmp.Height - 1 do
begin
for c := 0 to SourceBmp.Width - 1 do
begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
x := r; //90
y := (SourceBmp.Width - 1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
end;
end;
Target.Assign(TargetBmp);
SourceBmp.Free;
TargetBmp.Free;
end;
procedure TFormGetPic.Initimage();
var
jpg: TJpegImage;
myStream: TADOBlobStream;
sFieldName: string;
JPStream: TMemoryStream;
begin
jpg := TJpegImage.Create();
JPStream := TMemoryStream.Create;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FMainId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if not IsEmpty then
begin
if not fieldbyname(pic1).IsNull then
begin
myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname(pic1)), bmread);
jpg.LoadFromStream(myStream);
Image2.Picture.Assign(jpg);
myStream.Free;
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
JPStream.Clear;
if IdFTP1.Connected then
begin
try
IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname(pat1).AsString), JPStream);
except
Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
if IdFTP1.Connected then
IdFTP1.Quit;
JPStream.Position := 0;
jpg.LoadFromStream(JPStream);
Image1.Picture.Assign(jpg);
end;
end;
end;
finally
jpg.free;
JPStream.Free;
end;
end;
function TFormGetPic.SaveImage(): Boolean;
var
myStream: TADOBlobStream;
maxNo: string;
fNewFileName: string;
begin
//取文件后缀 ExtractFileExt(FilePath)
if fkeyNO = '' then
begin
fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
fkeyNO := fNewFileName;
end;
result := false;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FMainId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if RecordCount <= 0 then
begin
Append;
if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
fieldByName('TFID').AsString := maxNo;
fieldByName('WBID').AsString := FMainId;
end
else
begin
edit;
end;
fieldByName(pat1).AsString := trim(fkeyNO);
fieldByName('Filler').AsString := trim(dName);
fieldByName('TFType').AsString := trim(FTFType);
myStream := TADOBlobStream.Create(TBlobField(FieldByName(pic1)), bmWrite);
MyJpeg.Assign(Image2.Picture.Graphic);
MyJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
if FilePath <> '' then
begin
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
// IdFTP1.Delete(fFlileFlag + '\' + Trim(fNewFileName));
IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(fkeyNO));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit;
result := true;
except
myStream.Free;
end;
end;
procedure TFormGetPic.ToolButton1Click(Sender: TObject);
var
Ini: TIniFile;
begin
// if Twain.LoadLibrary then
// begin
// {Load source manager}
// Twain.SourceManagerLoaded := TRUE;
// {Allow user to select source}
// SelectedSource := Twain.SelectSource;
// if SelectedSource <> -1 then
// begin
// Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
// try
// Ini.WriteInteger( 'SCANNER', 'Scanner', SelectedSource);
// finally
// Ini.Free;
// end;
// end {if SelectedSource <> -1}
// end
// else
// ShowMessage('未安装扫描仪');
end;
procedure TFormGetPic.ToolButton3Click(Sender: TObject);
begin
// if Twain.LoadLibrary then
// begin
// {Load source manager}
// Twain.SourceManagerLoaded := TRUE;
//
// if SelectedSource <> -1 then
// begin
// {Load source, select transference method and enable (display interface)}
// Twain.Source[SelectedSource].Loaded := TRUE;
// Twain.Source[SelectedSource].SetICapUnits(tuInches);
// Twain.Source[SelectedSource].SetImagelayoutFrame(PicLeft/25.4, PicTop/25.4, (PicLeft+PicWidth)/25.4, (PicTop+PicHeight)/25.4);
// Twain.Source[SelectedSource].SetIYResolution(200);
// Twain.Source[SelectedSource].SetIXResolution(200);
// Twain.Source[SelectedSource].TransferMode := ttmMemory;
// Twain.Source[SelectedSource].EnableSource(FALSE, TRUE);
// while Twain.Source[SelectedSource].Enabled do Application.ProcessMessages;
// end; {if SelectedSource <> -1}
//// Twain.UnloadLibrary;
// end
// else
// ShowMessage('未安装扫描仪');
end;
procedure TFormGetPic.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
Image1.Picture.Assign(Image);
Cancel := TRUE;
CreThumb(150, 150);
SpeedButton2.Enabled := TRUE;
end;
procedure TFormGetPic.FormShow(Sender: TObject);
var
Ini: TIniFile;
begin
{ Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
SelectedSource := Ini.ReadInteger( 'SCANNER', 'Scanner', 0);
PicLeft := Ini.ReadInteger( 'SCANNER', 'Left', 0);
PicTop := Ini.ReadInteger( 'SCANNER', 'Top', 0);
PicWidth := Ini.ReadInteger( 'SCANNER', 'Width', 100);
PicHeight := Ini.ReadInteger( 'SCANNER', 'Height', 100);
finally
Ini.Free;
end; }
Initimage();
end;
{
procedure TFormGetPic.ToolButton6Click(Sender: TObject);
var
Ini: TIniFile;
begin
FormGetPos := TFormGetPos.Create(Self);
FormGetPos.SpinEdit1.Value := PicLeft;
FormGetPos.SpinEdit2.Value := PicTop;
FormGetPos.SpinEdit3.Value := PicWidth;
FormGetPos.SpinEdit4.Value := PicHeight;
if FormGetPos.ShowModal = 1 then
begin
PicLeft := FormGetPos.SpinEdit1.Value;
PicTop := FormGetPos.SpinEdit2.Value;
PicWidth := FormGetPos.SpinEdit3.Value;
PicHeight := FormGetPos.SpinEdit4.Value;
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
Ini.WriteInteger( 'SCANNER', 'Left', PicLeft);
Ini.WriteInteger( 'SCANNER', 'Top', PicTop);
Ini.WriteInteger( 'SCANNER', 'Width', PicWidth);
Ini.WriteInteger( 'SCANNER', 'Height', PicHeight);
finally
Ini.Free;
end;
end;
FormGetPos.Free;
end;
}
procedure TFormGetPic.CreThumb(Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
if Ratio > 0.75 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));
// StretchDraw original image
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
// Assign back to the Jpeg, and save to the file
Image2.Picture.Assign(Bitmap);
// MyJpeg1.Assign(Image2.Picture.Graphic);
finally
Bitmap.Free;
end;
end;
procedure TFormGetPic.FormCreate(Sender: TObject);
begin
MyJpeg := TJpegImage.Create;
// MyJpeg1 := TJpegImage.Create;
Button2.Enabled := false;
if FWidth = 0 then
FWidth := 197;
if FHeight = 0 then
FHeight := 110;
end;
procedure TFormGetPic.FormDestroy(Sender: TObject);
begin
// MyJpeg1.Free;
MyJpeg.Free;
end;
procedure TFormGetPic.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClickPos.x := X;
ClickPos.y := Y;
end;
procedure TFormGetPic.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
NewPos: TPoint;
begin
{The left button was pressed}
if ssLeft in Shift then
begin
{Calculate new position}
NewPos.X := Image1.Left + X - ClickPos.x;
NewPos.Y := Image1.Top + Y - ClickPos.y;
if NewPos.x + Image1.Width < ScrollBox1.Width then
NewPos.x := ScrollBox1.Width - Image1.Width;
if NewPos.y + Image1.Height < ScrollBox1.Height then
NewPos.y := ScrollBox1.Height - Image1.Height;
if NewPos.X > 0 then
NewPos.X := 0;
if NewPos.Y > 0 then
NewPos.Y := 0;
Image1.Top := NewPos.Y;
Image1.Left := NewPos.X;
end {if ssLeft in Shift}
end;
procedure TFormGetPic.SpeedButton1Click(Sender: TObject);
var
Jpeg: TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
Image1.Top := 0;
Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FilePath := OpenPictureDialog1.FileName;
FileName := ExtractFileName(FilePath);
// Jpeg := TJPEGImage.Create;
// Rotate90(Image1.Picture.Graphic, Jpeg);
// Image1.Picture.Assign(Jpeg);
// Jpeg.Free;
CreThumb(FWidth, FHeight);
SpeedButton2.Enabled := TRUE;
end;
end;
procedure TFormGetPic.SpeedButton2Click(Sender: TObject);
begin
if SaveImage() then
begin
ModalResult := 1;
end
else
begin
application.MessageBox('数据保存失败!', '提示信息', 0)
end;
// JPStream := TMemoryStream.Create;
// MyJPeg.Assign(Image1.Picture.Graphic);
// MyJPeg.SaveToStream(JPStream);
end;
procedure TFormGetPic.SpeedButton3Click(Sender: TObject);
begin
ModalResult := 2;
end;
procedure TFormGetPic.Button1Click(Sender: TObject);
begin
hWndC := 0;
try
hWndC := capCreateCaptureWindowA('My Own Capture Window', WS_CHILD or WS_VISIBLE, ScrollBox1.Left, ScrollBox1.Top, ScrollBox1.Width, ScrollBox1.Height, FormGetPic.Handle, 0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
//SendMessage(hWndC, WM_CAP_SEQUENCE_NOFILE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
Button1.Enabled := false;
Button2.Enabled := true;
end
else
begin
application.MessageBox('连接摄像头失败!', '错误信息', MB_ICONERROR);
end;
except
end;
application.ProcessMessages;
end;
procedure TFormGetPic.Button2Click(Sender: TObject);
var
sFieldName: string;
MBMP: TBitmap;
MJPG: TJpegImage;
begin
sFieldName := 'D:\抓图';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName), nil);
sFieldName := sFieldName + '\' + formatdateTime('yyyyMMddhhnnss', SGetServerDateTime(ADOQuery1));
FileName := ExtractFileName(sFieldName);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar(sFieldName + '.BMP')));
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
application.ProcessMessages;
Button1.Enabled := true;
Button2.Enabled := false;
try
MBMP := TBitmap.Create;
MJPG := TJpegImage.Create;
MBMP.LoadFromFile(pchar(sFieldName + '.BMP'));
MJPG.assign(MBMP);
Image1.Picture.Bitmap.Assign(MJPG);
application.ProcessMessages;
MJPG.SaveToFile(pchar(sFieldName + '.JPG'));
CreThumb(240, 180);
finally
MBMP.Free;
MJPG.Free;
if Fileexists(pchar(sFieldName + '.BMP')) then
DeleteFile(pchar(sFieldName + '.BMP'));
FilePath := sFieldName + '.JPG';
FileName := ExtractFileName(FilePath);
end;
SpeedButton2.Enabled := true;
end;
end;
procedure TFormGetPic.SpeedButton4Click(Sender: TObject);
var
MJPG: TJpegImage;
pathFile: string;
begin
if Image1.Picture.Graphic = nil then
exit;
MJPG := TJpegImage.Create;
try
SaveDialog1.FileName := FileName;
if SaveDialog1.Execute then
begin
if SaveDialog1.FileName <> '' then
begin
pathFile := trim(SaveDialog1.FileName);
if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
begin
pathFile := pathFile + '.JPG';
end;
MJPG.Assign(Image1.Picture.Graphic);
if fileexists(pathFile) then
begin
if application.MessageBox(pchar('文件[' + trim(pathFile) + ']已存在,是否要替换它?'), '提示信息', MB_YESNO + mb_iconinformation + MB_DEFBUTTON2) = idyes then
MJPG.SaveToFile(pathFile);
end
else
MJPG.SaveToFile(pathFile);
end;
end;
finally
MJPG.Free;
end;
end;
procedure TFormGetPic.SpeedButton5Click(Sender: TObject);
begin
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
open;
if RecordCount > 0 then
begin
edit;
fieldByName(pat1).Value := null;
FieldByName(pic1).Value := null;
post;
Image1.Picture.Assign(nil);
Image2.Picture.Assign(nil);
end;
end;
except
end;
end;
end.

View File

@ -0,0 +1,116 @@
object frmFrameDateCheckSel: TfrmFrameDateCheckSel
Left = 0
Top = 0
Width = 1078
Height = 37
Color = clWhite
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentBackground = False
ParentColor = False
ParentFont = False
TabOrder = 0
DesignSize = (
1078
37)
object lbl2: TLabel
Left = 215
Top = 7
Width = 16
Height = 21
Caption = #33267
end
object BegDate: TcxDateEdit
Left = 91
Top = 1
AutoSize = False
ParentFont = False
Properties.ImmediatePost = True
Properties.ShowTime = False
TabOrder = 0
Height = 33
Width = 120
end
object EndDate: TcxDateEdit
Left = 235
Top = 1
Anchors = [akLeft]
AutoSize = False
ParentFont = False
Properties.ImmediatePost = True
Properties.ShowTime = False
TabOrder = 1
Height = 33
Width = 120
end
object cxButton1: TcxButton
Left = 443
Top = 1
Width = 80
Height = 33
Caption = #26412#26376
TabOrder = 2
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 611
Top = 1
Width = 80
Height = 33
Caption = #24448#21069
TabOrder = 3
OnClick = cxButton2Click
end
object cxButton3: TcxButton
Left = 750
Top = 1
Width = 80
Height = 33
Caption = #24448#21518
TabOrder = 4
OnClick = cxButton3Click
end
object cbbType: TcxComboBox
Left = 695
Top = 1
AutoSize = False
ParentFont = False
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#26085
#26376
#24180)
TabOrder = 5
Text = #26085
Height = 33
Width = 51
end
object cxButton4: TcxButton
Left = 359
Top = 1
Width = 80
Height = 33
Caption = #26412#26085
TabOrder = 6
OnClick = cxButton4Click
end
object cxButton5: TcxButton
Left = 527
Top = 1
Width = 80
Height = 33
Caption = #26412#24180
TabOrder = 7
OnClick = cxButton5Click
end
object CheckDate: TcxCheckBox
Left = 3
Top = 1
Caption = #26597#35810#26085#26399
Style.TransparentBorder = False
TabOrder = 8
end
end

View File

@ -0,0 +1,115 @@
unit FrameDateCheckSel;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.ComCtrls, dxCore, cxDateUtils,
cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar, Vcl.StdCtrls,
Vcl.Menus, cxButtons, Vcl.ExtCtrls, DateUtils,
cxCheckBox;
type
TfrmFrameDateCheckSel = class(TFrame)
lbl2: TLabel;
BegDate: TcxDateEdit;
EndDate: TcxDateEdit;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
cbbType: TcxComboBox;
cxButton4: TcxButton;
cxButton5: TcxButton;
CheckDate: TcxCheckBox;
procedure cxButton4Click(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton5Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure cxButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
//uses
// U_RTFun;
{$R *.dfm}
procedure TfrmFrameDateCheckSel.cxButton1Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
end;
procedure TfrmFrameDateCheckSel.cxButton2Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date - 1;
EndDate.Date := EndDate.Date - 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := StartOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
EndDate.Date := EndOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-01-01', EndDate.Date)) - 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateCheckSel.cxButton3Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date + 1;
EndDate.Date := EndDate.Date + 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := EndOfTheMonth(EndDate.Date) + 1;
EndDate.Date := EndOfTheMonth(EndOfTheMonth(EndDate.Date) + 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-12-31', EndDate.Date)) + 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateCheckSel.cxButton4Click(Sender: TObject);
begin
BegDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
EndDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
end;
procedure TfrmFrameDateCheckSel.cxButton5Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', Now)));
end;
end.

View File

@ -0,0 +1,108 @@
object frmFrameDateSel: TfrmFrameDateSel
Left = 0
Top = 0
Width = 1078
Height = 36
Color = clWhite
ParentBackground = False
ParentColor = False
TabOrder = 0
DesignSize = (
1078
36)
object lbl1: TLabel
Left = 23
Top = 7
Width = 64
Height = 21
AutoSize = False
Caption = #26597#35810#26085#26399
end
object lbl2: TLabel
Left = 215
Top = 7
Width = 12
Height = 13
Caption = #33267
end
object BegDate: TcxDateEdit
Left = 91
Top = 1
AutoSize = False
Properties.ImmediatePost = True
Properties.ShowTime = False
TabOrder = 0
Height = 33
Width = 120
end
object EndDate: TcxDateEdit
Left = 235
Top = 1
Anchors = [akLeft]
AutoSize = False
Properties.ImmediatePost = True
Properties.ShowTime = False
TabOrder = 1
Height = 33
Width = 120
end
object cxButton1: TcxButton
Left = 443
Top = 1
Width = 80
Height = 33
Caption = #26412#26376
TabOrder = 2
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 609
Top = 1
Width = 80
Height = 33
Caption = #24448#21069
TabOrder = 3
OnClick = cxButton2Click
end
object cxButton3: TcxButton
Left = 750
Top = 1
Width = 80
Height = 33
Caption = #24448#21518
TabOrder = 4
OnClick = cxButton3Click
end
object cbbType: TcxComboBox
Left = 695
Top = 1
AutoSize = False
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#26085
#26376
#24180)
TabOrder = 5
Text = #26085
Height = 33
Width = 51
end
object cxButton4: TcxButton
Left = 359
Top = 1
Width = 80
Height = 33
Caption = #26412#26085
TabOrder = 6
OnClick = cxButton4Click
end
object cxButton5: TcxButton
Left = 527
Top = 1
Width = 80
Height = 33
Caption = #26412#24180
TabOrder = 7
OnClick = cxButton5Click
end
end

View File

@ -0,0 +1,99 @@
unit FrameDateSel;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.ComCtrls, dxCore, cxDateUtils, cxTextEdit, cxMaskEdit, cxDropDownEdit,
cxCalendar, Vcl.StdCtrls, Vcl.Menus, cxButtons, Vcl.ExtCtrls, DateUtils,
dxSkinsCore, dxSkinsDefaultPainters;
type
TfrmFrameDateSel = class(TFrame)
lbl1: TLabel;
lbl2: TLabel;
BegDate: TcxDateEdit;
EndDate: TcxDateEdit;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
cbbType: TcxComboBox;
cxButton4: TcxButton;
cxButton5: TcxButton;
procedure cxButton4Click(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton5Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure cxButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
//uses
// U_RTFun;
{$R *.dfm}
procedure TfrmFrameDateSel.cxButton1Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
end;
procedure TfrmFrameDateSel.cxButton2Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date - 1;
EndDate.Date := EndDate.Date - 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := StartOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
EndDate.Date := EndOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-01-01', EndDate.Date)) - 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateSel.cxButton3Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date + 1;
EndDate.Date := EndDate.Date + 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := EndOfTheMonth(EndDate.Date) + 1;
EndDate.Date := EndOfTheMonth(EndOfTheMonth(EndDate.Date) + 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-12-31', EndDate.Date)) + 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateSel.cxButton4Click(Sender: TObject);
begin
BegDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
EndDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
end;
procedure TfrmFrameDateSel.cxButton5Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', Now)));
end;
end.

View File

@ -0,0 +1,139 @@
object frmFramePagingSel: TfrmFramePagingSel
Left = 0
Top = 0
Width = 1078
Height = 37
Color = clWhite
ParentBackground = False
ParentColor = False
TabOrder = 0
DesignSize = (
1078
37)
object lbl1: TLabel
Left = 23
Top = 7
Width = 64
Height = 21
Alignment = taCenter
Caption = #27599#39029#26465#25968
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
end
object LBDQY: TLabel
Left = 237
Top = 7
Width = 9
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = '1'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object Label2: TLabel
Left = 181
Top = 7
Width = 52
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = #24403#21069#39029':'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object LBZYS: TLabel
Left = 338
Top = 7
Width = 9
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = '1'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object Label3: TLabel
Left = 282
Top = 7
Width = 52
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = #24635#39029#25968':'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object BTLP: TcxButton
Left = 392
Top = 1
Width = 80
Height = 33
Caption = #19978#19968#39029
TabOrder = 0
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
end
object cxButton3: TcxButton
Left = 476
Top = 1
Width = 80
Height = 33
Caption = #19979#19968#39029
TabOrder = 1
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
end
object TCBNOR: TcxComboBox
Left = 91
Top = 1
ParentFont = False
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
'1000'
'2000'
'5000'
'10000')
Style.Font.Charset = ANSI_CHARSET
Style.Font.Color = clWindowText
Style.Font.Height = -16
Style.Font.Name = #24494#36719#38597#40657
Style.Font.Style = []
Style.IsFontAssigned = True
TabOrder = 2
Text = '2000'
Width = 86
end
end

View File

@ -0,0 +1,35 @@
unit FramePagingSel;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.ComCtrls, dxCore, cxDateUtils, cxTextEdit, cxMaskEdit, cxDropDownEdit,
cxCalendar, Vcl.StdCtrls, Vcl.Menus, cxButtons, Vcl.ExtCtrls, DateUtils,
dxSkinsCore, dxSkinsDefaultPainters;
type
TfrmFramePagingSel = class(TFrame)
lbl1: TLabel;
BTLP: TcxButton;
cxButton3: TcxButton;
TCBNOR: TcxComboBox;
LBDQY: TLabel;
Label2: TLabel;
LBZYS: TLabel;
Label3: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.dfm}
end.

Binary file not shown.

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:\凌志超开发代码\项目代码\振永\客户供应商管理(Company.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,66 @@
library Company;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
midaslib,
U_GetDllForm in 'U_GetDllForm.pas',
U_ModuleNote in 'U_ModuleNote.pas' {frmModuleNote},
U_iniParam in 'U_iniParam.pas',
U_BaseInput in '..\..\..\public10\design\U_BaseInput.pas' {frmBaseInput},
U_BaseList in '..\..\..\public10\design\U_BaseList.pas' {frmBaseList},
U_cxGridCustomCss in '..\..\..\public10\design\U_cxGridCustomCss.pas',
U_RTFun in '..\..\..\public10\ThreeFun\Fun\U_RTFun.pas',
U_Factory in 'U_Factory.pas' {frmFactory},
U_CustInput in 'U_CustInput.pas' {frmCustInput},
U_BaseHelp in '..\..\..\public10\design\U_BaseHelp.pas' {frmBaseHelp},
U_EmployeeList in 'U_EmployeeList.pas' {frmEmployeeList},
U_ClothInfoSel in '..\A00通用窗体\U_ClothInfoSel.pas' {frmClothInfoSel},
U_CompanySel in '..\A00通用窗体\U_CompanySel.pas' {frmCompanySel},
U_AttachmentUpload in '..\A00通用窗体\U_AttachmentUpload.pas' {frmFjList_RZ},
U_CompressionFun in '..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas',
U_BankList in 'U_BankList.pas' {frmBankList},
U_LabelMapSet in '..\A00通用窗体\U_LabelMapSet.pas' {frmLabelMapSet},
U_LabelPrint in '..\A00通用窗体\U_LabelPrint.pas' {frmLabelPrint},
U_DataLink in 'U_DataLink.pas' {DataLink_Company: TDataModule},
U_BaseDataLink in '..\..\..\public10\design\U_BaseDataLink.pas' {BaseDataLink: TDataModule},
U_Customer in 'U_Customer.pas' {frmCustomer},
U_FactoryInput in 'U_FactoryInput.pas' {frmFactoryInput},
U_Company in 'U_Company.pas' {frmCompany},
U_ZDYHelp in '..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas' {frmZDYHelp},
U_CustomerInput in 'U_CustomerInput.pas' {frmCustomerInput},
U_SYDept in 'U_SYDept.pas' {frmSYDept},
U_EmployeeInPut in 'U_EmployeeInPut.pas' {frmYGInPut},
U_FactoryImport in 'U_FactoryImport.pas' {frmFactoryImport},
U_printPdf in '..\..\..\public10\ThreeFun\Fun\U_printPdf.pas',
U_cxGridCustomSet in '..\..\..\public10\design\U_cxGridCustomSet.pas',
U_FormLayOutDesign in '..\..\..\public10\design\U_FormLayOutDesign.pas',
U_globalVar in '..\..\..\public10\design\U_globalVar.pas',
U_WindowFormdesign in '..\..\..\public10\design\U_WindowFormdesign.pas',
FrameDateSel in '..\A00通用组件\FrameDateSel.pas' {frmFrameDateSel: TFrame},
FramePagingSel in '..\A00通用组件\FramePagingSel.pas' {frmFramePagingSel: TFrame},
U_UserSel in '..\A00通用窗体\U_UserSel.pas' {frmUserSel},
uSZHN_JSON in '..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas';
{$R *.res}
procedure DllEnterPoint(dwReason: DWORD); far; stdcall;
begin
DLLProc := @DLLEnterPoint;
DllEnterPoint(DLL_PROCESS_ATTACH);
end;
procedure DLLUnloadProc(Reason: Integer); register;
begin
// if (Reason = DLL_PROCESS_DETACH) or (Reason=DLL_THREAD_DETACH) then
// Application:=NewDllApp;
end;
exports
GetDllForm;
begin
try
NewDllApp := Application;
DLLProc := @DLLUnloadProc;
except
end;
end.

View File

@ -0,0 +1,982 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{E16427F3-666C-4A0D-9F4B-79271477F72C}</ProjectGuid>
<MainSource>Company.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>38017</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>19.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
<Base_Android64>true</Base_Android64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
<Base_iOSDevice64>true</Base_iOSDevice64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Android64)'!=''">
<Cfg_2_Android64>true</Cfg_2_Android64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_2)'=='true') or '$(Cfg_2_iOSDevice64)'!=''">
<Cfg_2_iOSDevice64>true</Cfg_2_iOSDevice64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX64>true</Cfg_2_OSX64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_UnitSearchPath>D:\富通ERP;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_UsePackage>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;$(DCC_UsePackage)</DCC_UsePackage>
<GenDll>true</GenDll>
<SanitizedProjectName>Company</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>2052</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android64)'!=''">
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
<iOS_AppStore1024>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png</iOS_AppStore1024>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Icon_MainIcon>Company_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>Company_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Android64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_iOSDevice64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<Debugger_HostApplication>D:\Dp10RepoV1\项目代码\d10myxushang\A01基础公司管理\testDll.exe</Debugger_HostApplication>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="U_GetDllForm.pas"/>
<DCCReference Include="U_ModuleNote.pas">
<Form>frmModuleNote</Form>
</DCCReference>
<DCCReference Include="U_iniParam.pas"/>
<DCCReference Include="..\..\..\public10\design\U_BaseInput.pas">
<Form>frmBaseInput</Form>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseList.pas">
<Form>frmBaseList</Form>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_cxGridCustomCss.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_RTFun.pas"/>
<DCCReference Include="U_Factory.pas">
<Form>frmFactory</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_CustInput.pas">
<Form>frmCustInput</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseHelp.pas">
<Form>frmBaseHelp</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_EmployeeList.pas">
<Form>frmEmployeeList</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_ClothInfoSel.pas">
<Form>frmClothInfoSel</Form>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_CompanySel.pas">
<Form>frmCompanySel</Form>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_AttachmentUpload.pas">
<Form>frmFjList_RZ</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas"/>
<DCCReference Include="U_BankList.pas">
<Form>frmBankList</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_LabelMapSet.pas">
<Form>frmLabelMapSet</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_LabelPrint.pas">
<Form>frmLabelPrint</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_DataLink.pas">
<Form>DataLink_Company</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseDataLink.pas">
<Form>BaseDataLink</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="U_Customer.pas">
<Form>frmCustomer</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_FactoryInput.pas">
<Form>frmFactoryInput</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_Company.pas">
<Form>frmCompany</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas">
<Form>frmZDYHelp</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_CustomerInput.pas">
<Form>frmCustomerInput</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_SYDept.pas">
<Form>frmSYDept</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_EmployeeInPut.pas">
<Form>frmYGInPut</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="U_FactoryImport.pas">
<Form>frmFactoryImport</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_printPdf.pas"/>
<DCCReference Include="..\..\..\public10\design\U_cxGridCustomSet.pas"/>
<DCCReference Include="..\..\..\public10\design\U_FormLayOutDesign.pas"/>
<DCCReference Include="..\..\..\public10\design\U_globalVar.pas"/>
<DCCReference Include="..\..\..\public10\design\U_WindowFormdesign.pas"/>
<DCCReference Include="..\A00通用组件\FrameDateSel.pas">
<Form>frmFrameDateSel</Form>
<FormType>dfm</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="..\A00通用组件\FramePagingSel.pas">
<Form>frmFramePagingSel</Form>
<FormType>dfm</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_UserSel.pas">
<Form>frmUserSel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">Company.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Android64">True</Platform>
<Platform value="iOSDevice64">True</Platform>
<Platform value="Linux64">True</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
<Deployment Version="3">
<DeployFile LocalName="Company.dll" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>Company.dll</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiv7aFile">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="Android64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements"/>
<DeployClass Name="ProjectiOSInfoPList"/>
<DeployClass Name="ProjectiOSLaunchScreen"/>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug"/>
<DeployClass Name="ProjectOSXEntitlements"/>
<DeployClass Name="ProjectOSXInfoPList"/>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
</Deployment>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

Binary file not shown.

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